- deviceStore :: Shared [MTaskDevice]
- deviceStore = sdsFocus "mTaskDevices" $ memoryStore "" (Just [])
-
- showTabbed :: [MTaskDevice] -> Task ()
- showTabbed [] = viewInformation "" [] "No devices yet" @! ()
- showTabbed [l:ls] = foldr (\e es->viewInformation "Dev" [] e ||- es) (viewInformation "Dev" [] l @! ()) ls
-
- 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 (||-)
-
-addDevice :: Task MTaskDevice
-addDevice = enterInformation "Enter device type" []
- >>= \ty->case ty of
- TCP = (enterInformation "Host" [] -&&- enterInformation "Port" [])
- >>= return o uncurry TCPDevice
- Serial = accWorld getDevices
- >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero)
- >>= return o uncurry SerialDevice
- where
- getDevices :: !*World -> *(![String], !*World)
- getDevices w = case readDirectory "/dev" w of
- (Error (errcode, errmsg), w) = abort errmsg
- (Ok entries, w) = (map ((+++) "/dev/") (filter isTTY entries), w)
- where
- isTTY s = not (isEmpty (filter (flip startsWith s) prefixes))
- prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"]
-
-mTaskTask :: Task ()
-mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in
- withDevice \ch->
- sendMsg msgs ch
- ||- processMessages ch messageShare sdsShares
- ||- forever (enterChoice "Choose led to enable" [] [LED1, LED2, LED3]
- >>= \p->sendMsg (fst (makeMsgs 0 (bc2 p))) ch)
- ||- forever (enterChoice "Choose led to disable" [] [LED1, LED2, LED3]
- >>= \p->sendMsg (fst (makeMsgs 0 (bc3 p))) ch)
- ||- viewSharedInformation "channels" [ViewAs lens] ch
- ||- viewSharedInformation "messages" [] messageShare
- ||- viewSh sdsShares ch
- >>* [OnAction ActionFinish (always shutDown)]
- where
- messageShare :: Shared [String]
- messageShare = sharedStore "mTaskMessagesRecv" []
-
- processMessages ch msgs sdss = forever (watch ch
- >>* [OnValue (ifValue (not o isEmpty o fst3) (process ch))])
- where
- process :: (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> Task ()
- process ch (r,_,_) = upd (appFst3 (const [])) ch >>| process` r
- where
- process` = foldr (\r t->updateSDSs sdss msgs r >>| t) (return ())
-
- makeMsgs :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)])
- makeMsgs timeout bc
- # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc))
- = (msgs, map f st.sdss)
- where
- f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d))
- dd [x,y] = toInt x*265 + toInt y
-
- updateSDSs :: [(Int, Shared Int)] (Shared [String]) MTaskMSGRecv -> Task ()
- updateSDSs [(id, sh):xs] m n=:(MTPub i d)
- | id == i = set ((toInt d.[0])*265 + toInt d.[1]) sh @! ()
- = updateSDSs xs m n
- updateSDSs _ m mtm = case mtm of
- MTMessage s = upd (\l->take 5 [s:l]) m @! ()
- mta=:(MTTaskAck _) = upd (\l->take 5 [toString mta:l]) m @! ()
- //TODO other recv msgs
- _ = return ()
-
- lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String])
- lens (r,s,_) = (map toString r, map toString s)
-
- viewSh :: [(Int, Shared Int)] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task ()
- viewSh [] ch = return ()
- viewSh [(i, sh):xs] ch
- # sharename = "SDS-" +++ toString i
- = (
- viewSharedInformation ("SDS-" +++ toString i) [] sh ||-
- forever (
- enterInformation sharename []
- >>* [OnAction ActionOk
- (ifValue (\j->j>=1 && j <= 3)
- (\c->set c sh
- >>= \_->sendMsg (toSDSUpdate i c) ch
- @! ()
- )
- )]