3 import StdDebug, StdMisc
4 from StdFunc import flip
8 import Devices.mTaskDevice
9 import Shares.mTaskShare
12 from Text import class Text(startsWith,concat,split,join), instance Text String
14 import qualified Data.Map as DM
16 from Data.Func import $
19 import System.Directory
21 import iTasks._Framework.Store
25 derive class iTask UserLED
27 Start :: *World -> *World
28 Start world = startEngine (mTaskManager
29 >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world
31 mTaskMap :: Map String (Main (ByteCode () Stmt))
32 mTaskMap = 'DM'.fromList [("count", bc), ("ledon", bc2 LED1), ("ledoff", bc3 LED3)]
34 bc :: Main (ByteCode () Stmt)
35 bc = sds \x=1 In sds \pinnetje=1 In {main =
42 IF (pinnetje ==. lit 1) (
45 IF (pinnetje ==. lit 2) (
52 bc2 :: UserLED -> Main (ByteCode () Stmt)
53 bc2 d = {main = ledOn d}
55 bc3 :: UserLED -> Main (ByteCode () Stmt)
56 bc3 d = {main = ledOff d}
58 mTaskManager :: Task ()
59 mTaskManager = anyTask
61 , whileUnchanged sdsStore viewShares
62 , whileUnchanged deviceStore $ manageDevices process
63 ] <<@ ApplyLayout layout
65 layout = sequenceLayouts
66 [ arrangeWithSideBar 0 LeftSide 260 True
67 , arrangeSplit Vertical True
70 viewmTasks = listmTasks
71 >&^ \sh->whileUnchanged sh $ \mi->forever (case mi of
72 Nothing = viewInformation "No task selected" [] ()
73 Just mTaskTask = get deviceStore
74 >>= \devices->case devices of
75 [] = viewInformation "No devices yet" [] ()
76 ds = sendmTask mTaskTask ds @! ())
78 listmTasks :: Task String
79 listmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore
81 sendmTask mTaskId ds =
82 (enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds
83 -&&- enterInformation "Timeout, 0 for one-shot" [])
84 >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskMap mTaskId)]
86 process :: MTaskDevice (Shared Channels) -> Task ()
87 process device ch = forever (watch ch >>* [OnValue (
88 ifValue (not o isEmpty o fst3)
89 (\t->upd (appFst3 (const [])) ch >>| proc (fst3 t)))])
91 proc :: [MTaskMSGRecv] -> Task ()
93 proc [m:ms] = (case m of
94 // MTSDSAck i = traceValue (toString m) @! ()
95 // MTSDSDelAck i = traceValue (toString m) @! ()
96 MTPub i val = getSDSRecord i >>= set (toInt val.[0]*256 + toInt val.[1]) o getSDSStore @! ()
97 MTTaskAck i = deviceTaskAcked device i
98 MTTaskDelAck i = deviceTaskDeleteAcked device i @! ()
100 _ = traceValue (toString m) @! ()
103 mapPar :: (a -> Task a) [a] -> Task ()
104 mapPar f l = foldr1 (\x y->f x ||- y) l <<@ ArrangeWithTabs @! ()
105 allAtOnce t = foldr1 (||-) t @! ()
106 //allAtOnce = (flip (@!) ()) o foldr1 (||-)