3 import StdDebug, StdMisc
4 from StdFunc import flip
8 import Devices.mTaskDevice
9 import Shares.mTaskShare
13 from Text import class Text(startsWith,concat,split,join), instance Text String
15 import qualified Data.Map as DM
17 from Data.Func import $
20 import System.Directory
22 import iTasks._Framework.Store
23 import iTasks._Framework.Serialization
27 derive class iTask UserLED
29 Start :: *World -> *World
30 Start world = startEngine (mTaskManager
31 >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world
33 mTaskManager :: Task ()
34 mTaskManager = anyTask
36 , whileUnchanged sdsStore viewShares
37 , whileUnchanged deviceStore $ manageDevices process
38 ] <<@ ApplyLayout layout
40 layout = sequenceLayouts
41 [ arrangeWithSideBar 0 LeftSide 260 True
42 , arrangeSplit Vertical True
45 viewmTasks :: Task String
46 viewmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore
47 >&^ \sh->whileUnchanged sh $ \mi->forever (case mi of
48 Nothing = viewInformation "No task selected" [] ()
49 Just mTaskTask = get deviceStore
50 >>= \devices->case devices of
51 [] = viewInformation "No devices yet" [] ()
52 ds = fromJust ('DM'.get mTaskTask allmTasks)
53 >>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds
54 -&&- enterInformation "Timeout, 0 for one-shot" []
55 ) >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskTask bc)]
58 process :: MTaskDevice (Shared Channels) -> Task ()
59 process device ch = forever (watch ch >>* [OnValue (
60 ifValue (not o isEmpty o fst3)
61 (\t->upd (appFst3 (const [])) ch >>| proc (fst3 t)))])
63 proc :: [MTaskMSGRecv] -> Task ()
65 proc [m:ms] = (case m of
66 // MTSDSAck i = traceValue (toString m) @! ()
67 // MTSDSDelAck i = traceValue (toString m) @! ()
68 MTPub i val = getSDSRecord i >>= set (toInt val.[0]*256 + toInt val.[1]) o getSDSStore @! ()
69 MTTaskAck i = deviceTaskAcked device i
70 MTTaskDelAck i = deviceTaskDeleteAcked device i @! ()
72 _ = traceValue (toString m) @! ()
75 mapPar :: (a -> Task a) [a] -> Task ()
76 mapPar f l = foldr1 (\x y->f x ||- y) l <<@ ArrangeWithTabs @! ()
77 allAtOnce t = foldr1 (||-) t @! ()
78 //allAtOnce = (flip (@!) ()) o foldr1 (||-)