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 Start world = startEngine [
28 publish "/manage" $ const $ mTaskManager
29 >>* [OnAction (Action "Shutdown") (always $ shutDown 0)],
30 publish "/" $ const demo
34 demo = set 5 (sharedDynamicStore "Hoi" 5)
35 >>| viewSharedInformation "Devices" [] deviceStoreNP
36 >>* [OnValue $ ifValue pred (cont o hd)]
39 pred [x:_] = not $ isEmpty x.deviceShares
41 cont :: MTaskDevice -> Task ()
43 # rs = getRealShare dev (hd dev.deviceShares)
44 = get rs >>= \oldvalue->
45 forever (updateSharedInformation "Blinkyblink" [] (getRealShare dev (hd dev.deviceShares))
46 >>* [OnAction ActionContinue (const $ Just $ treturn ())])
47 -|| (wait "bigger than 10" (\x->x == oldvalue) rs
48 >>= viewInformation "Bigger:)" [])
50 toInt :: BCValue -> Int
51 toInt (BCValue e) = dynToInt (dynamic e)
53 dynToInt :: Dynamic -> Int
54 dynToInt (a :: Int) = a
55 dynToInt x = abort "Not an int"
57 mTaskManager :: Task ()
58 mTaskManager = (>>|) startupDevices $
59 forever viewmTasks ||-
60 ((manageShares ||- forever (manageDevices process)) <<@ ArrangeSplit Vertical True)
61 <<@ ArrangeWithSideBar 0 LeftSide 260 True
63 viewmTasks :: Task [MTaskDevice]
64 viewmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore
65 >>= \task->get deviceStoreNP
66 >>* [OnValue $ (ifValue isEmpty) $ \_->
67 viewInformation "No devices yet" [] [] >>= treturn
68 ,OnValue $ (ifValue $ not o isEmpty) $ \d->
69 fromJust ('DM'.get task allmTasks)
70 >>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] d
71 -&&- enterInformation "Timeout" []
72 ) >>* [OnAction (Action "Send") (withValue $ Just o sendTaskToDevice task bc)]
76 process :: MTaskDevice (Shared Channels) -> Task ()
77 process device ch = forever
78 $ traceValue "Waiting for channel change"
79 >>| wait "process" (not o isEmpty o fst3) ch
80 >>= \(r,s,ss)->upd (appFst3 (const [])) ch
83 proc :: [MTaskMSGRecv] -> Task ()
85 proc [MTEmpty:ms] = proc ms
86 proc [m:ms] = traceValue (toString m) >>| (case m of
87 // MTSDSAck i = traceValue (toString m) @! ()
88 // MTSDSDelAck i = traceValue (toString m) @! ()
89 MTPub i val = updateShareFromPublish device i val @! ()
90 MTTaskAck i mem = deviceTaskAcked device i mem @! ()
91 MTTaskDelAck i = deviceTaskDeleteAcked device i @! ()
92 MTDevSpec s = deviceAddSpec device s @! ()