start with management tasks

[mTask.git] / miTask.icl

diff --git a/miTask.icl b/miTask.icl
index 767cd98..e81f47d 100644 (file)
--- a/miTask.icl
+++ b/miTask.icl
@@ -24,11 +24,15 @@ import TTY
 derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize
 derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED
 
 derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize
 derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED
 

+derive class iTask MTaskDevice
+

 :: SerTCP = Serial | TCP
 :: *Resource | TTYd !*TTY
 :: SerTCP = Serial | TCP
 :: *Resource | TTYd !*TTY

+:: MTaskDevice = SerialDevice String TTYSettings | TCPDevice String Int

 
 Start :: *World -> *World
 
 Start :: *World -> *World

-Start world = startEngine mTaskTask world
+Start world = startEngine (mTaskManager
+       >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world

 //Start world = startEngine mTaskTask world
 
 bc :: Main (ByteCode () Stmt)
 //Start world = startEngine mTaskTask world
 
 bc :: Main (ByteCode () Stmt)


@@ -55,7 +59,6 @@ bc2 d = {main = ledOn d}
 bc3 :: UserLED -> Main (ByteCode () Stmt)
 bc3 d = {main = ledOff d}
 
 bc3 :: UserLED -> Main (ByteCode () Stmt)
 bc3 d = {main = ledOff d}
 

-

 withDevice :: ((Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task a) -> Task a | iTask a
 withDevice t = withShared ([], [], False) \ch->
                enterInformation "Type" []
 withDevice :: ((Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task a) -> Task a | iTask a
 withDevice t = withShared ([], [], False) \ch->
                enterInformation "Type" []


@@ -74,6 +77,30 @@ withDevice t = withShared ([], [], False) \ch->
                                isTTY s = not (isEmpty (filter (flip startsWith s) prefixes))
                                prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"]
 
                                isTTY s = not (isEmpty (filter (flip startsWith s) prefixes))
                                prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"]
 

+mTaskManager :: Task ()
+mTaskManager = viewSharedInformation "Devices" [] deviceStore
+       ||- forever (addDevice >>= \d->upd (\l->[d:l]) deviceStore) @! ()
+       where
+               deviceStore :: Shared [MTaskDevice]
+               deviceStore = sdsFocus "mTaskDevices" $ memoryStore "" (Just [])
+
+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->
 mTaskTask :: Task ()
 mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in
        withDevice \ch->