X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=miTask.icl;h=8c17f09423768eebe75f71d318dd96818a4f1379;hb=6badd886c4b09ac1805a005e525447a7e910ea56;hp=0d7f450d6ad1017be76ed8228f0edeb582d139cf;hpb=acd239b3f29e215ade0b63d5b26b6cf8e8ae0d63;p=mTask.git diff --git a/miTask.icl b/miTask.icl index 0d7f450..8c17f09 100644 --- a/miTask.icl +++ b/miTask.icl @@ -24,54 +24,69 @@ import iTasks._Framework.Serialization import TTY, iTasksTTY -derive class iTask UserLED +Start world = startEngine [ + publish "/manage" $ const $ mTaskManager + >>* [OnAction (Action "Shutdown") (always $ shutDown 0)], + publish "/" $ const demo + ] world -Start :: *World -> *World -Start world = startEngine (mTaskManager - >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world +demo :: Task () +demo = viewSharedInformation "Devices" [] deviceStoreNP + >>* [OnValue $ ifValue pred (cont o hd)] + where + pred [] = False + pred [x:_] = not $ isEmpty x.deviceShares + + cont :: MTaskDevice -> Task () + cont dev + # rs = getRealShare dev (hd dev.deviceShares) + = get rs >>= \oldvalue-> + forever (updateSharedInformation "Blinkyblink" [] (getRealShare dev (hd dev.deviceShares)) + >>* [OnAction ActionContinue (const $ Just $ treturn ())]) + -|| (wait "bigger than 10" (\x->x == oldvalue) rs + >>= viewInformation "Bigger:)" []) + + toInt :: BCValue -> Int + toInt (BCValue e) = dynToInt (dynamic e) + + dynToInt :: Dynamic -> Int + dynToInt (a :: Int) = a + dynToInt x = abort "Not an int" mTaskManager :: Task () -mTaskManager = anyTask - [ viewmTasks @! () - , whileUnchanged sdsStore manageShares - , whileUnchanged deviceStore $ manageDevices process - ] <<@ ApplyLayout (sequenceLayouts - [ arrangeWithSideBar 0 LeftSide 260 True - , arrangeSplit Vertical True - ]) +mTaskManager = (>>|) startupDevices $ + forever viewmTasks ||- + ((manageShares ||- forever (manageDevices process)) <<@ ArrangeSplit Vertical True) + <<@ ArrangeWithSideBar 0 LeftSide 260 True where - viewmTasks :: Task String + viewmTasks :: Task [MTaskDevice] viewmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore - >&^ \sh->whileUnchanged sh $ \mi->forever (case mi of - Nothing = viewInformation "No task selected" [] () - Just mTaskTask = get deviceStore - >>= \devices->case devices of - [] = viewInformation "No devices yet" [] () - ds = fromJust ('DM'.get mTaskTask allmTasks) - >>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds - -&&- enterInformation "Timeout" [] - ) >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskTask bc)] - @! () - ) + >>= \task->get deviceStoreNP + >>* [OnValue $ (ifValue isEmpty) $ \_-> + viewInformation "No devices yet" [] [] >>= treturn + ,OnValue $ (ifValue $ not o isEmpty) $ \d-> + fromJust ('DM'.get task allmTasks) + >>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] d + -&&- enterInformation "Timeout" [] + ) >>* [OnAction (Action "Send") (withValue $ Just o sendTaskToDevice task bc)] + ] process :: MTaskDevice (Shared Channels) -> Task () - process device ch = forever (watch ch >>* [OnValue ( - ifValue (not o isEmpty o fst3) - (\t->upd (appFst3 (const [])) ch >>| proc (fst3 t)))]) + process device ch = forever + $ traceValue "Waiting for channel change" + >>| wait "process" (not o isEmpty o fst3) ch + >>= \(r,s,ss)->upd (appFst3 (const [])) ch + >>| proc r where proc :: [MTaskMSGRecv] -> Task () proc [] = treturn () - proc [m:ms] = (case m of + proc [MTEmpty:ms] = proc ms + proc [m:ms] = traceValue (toString m) >>| (case m of // MTSDSAck i = traceValue (toString m) @! () // MTSDSDelAck i = traceValue (toString m) @! () - MTPub i val = getSDSRecord i >>= set (toInt val.[0]*256 + toInt val.[1]) o getSDSStore @! () - MTTaskAck i = deviceTaskAcked device i + MTPub i val = updateShareFromPublish device i val @! () + MTTaskAck i mem = deviceTaskAcked device i mem @! () MTTaskDelAck i = deviceTaskDeleteAcked device i @! () - MTEmpty = treturn () - _ = traceValue (toString m) @! () + MTDevSpec s = deviceAddSpec device s @! () + _ = treturn () ) >>| proc ms - - mapPar :: (a -> Task a) [a] -> Task () - mapPar f l = foldr1 (\x y->f x ||- y) l <<@ ArrangeWithTabs @! () - allAtOnce t = foldr1 (||-) t @! () - //allAtOnce = (flip (@!) ()) o foldr1 (||-)