X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;ds=sidebyside;f=miTask.icl;h=8c17f09423768eebe75f71d318dd96818a4f1379;hb=6420aa92a3b4b341f8f86654df79adc1ef610741;hp=fd5dac509e840bcdd3c2b45becd930a55742436e;hpb=a9e2b5a0fbabf17796a88efc7ab0862948e33e0a;p=mTask.git diff --git a/miTask.icl b/miTask.icl index fd5dac5..8c17f09 100644 --- a/miTask.icl +++ b/miTask.icl @@ -26,39 +26,57 @@ import TTY, iTasksTTY Start world = startEngine [ publish "/manage" $ const $ mTaskManager - >>* [OnAction (Action "Shutdown") (always $ shutDown)], + >>* [OnAction (Action "Shutdown") (always $ shutDown 0)], publish "/" $ const demo ] world -demo = viewInformation "" [] "Hello 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 = startupDevices >>| anyTask - [ viewmTasks @! () - , manageShares @! () - , whileUnchanged deviceStore $ manageDevices process - ] <<@ ApplyLayout (foldl1 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 sendTaskToDevice 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 () @@ -67,7 +85,7 @@ mTaskManager = startupDevices >>| anyTask // MTSDSAck i = traceValue (toString m) @! () // MTSDSDelAck i = traceValue (toString m) @! () MTPub i val = updateShareFromPublish device i val @! () - MTTaskAck i mem = deviceTaskAcked device i mem + MTTaskAck i mem = deviceTaskAcked device i mem @! () MTTaskDelAck i = deviceTaskDeleteAcked device i @! () MTDevSpec s = deviceAddSpec device s @! () _ = treturn ()