repositories / mTask.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
clean up, move iTasks serial stuff to Cleanserial, add toplevel tasks for syncing
[mTask.git] / miTask.icl
diff --git a/miTask.icl b/miTask.icl
index 738f8c2..a20108c 100644 (file)
--- a/miTask.icl
+++ b/miTask.icl
@@ -23,7 +23,7 @@ import iTasks._Framework.IWorld
 import iTasks._Framework.Store
 
 
 import iTasks._Framework.Store
 
 
-import TTY
+import TTY, iTasksTTY
 
 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
@@ -33,11 +33,14 @@ derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED
 
 :: SerTCP = SerialDevice | TCPDevice
 :: MTaskDevice = {
 
 :: SerTCP = SerialDevice | TCPDevice
 :: MTaskDevice = {
+               deviceTask :: Maybe TaskId,
                deviceConnected :: Maybe String,
                deviceName :: String,
                deviceTasks :: [(String, Int)]
        }
 :: MTaskShare = {
                deviceConnected :: Maybe String,
                deviceName :: String,
                deviceTasks :: [(String, Int)]
        }
 :: MTaskShare = {
+               initValue :: Int,
+               withTask :: String,
                identifier :: Int,
                realShare :: String
        }
                identifier :: Int,
                realShare :: String
        }
@@ -61,6 +64,9 @@ bcStateStore = memoryShare "mTaskBCState" zero
 mTaskTaskStore :: Shared [String]
 mTaskTaskStore = memoryShare "mTaskTasks" ["ledder", "ledon", "ledoff"]
 
 mTaskTaskStore :: Shared [String]
 mTaskTaskStore = memoryShare "mTaskTasks" ["ledder", "ledon", "ledoff"]
 
+mTaskMap :: Map String (Main (ByteCode () Stmt))
+mTaskMap = 'DM'.fromList [("ledder", bc), ("ledon", bc2 LED1), ("ledoff", bc3 LED3)]
+
 bc :: Main (ByteCode () Stmt)
 bc = sds \x=1 In sds \pinnetje=1 In {main =
                IF (digitalRead D3) (
 bc :: Main (ByteCode () Stmt)
 bc = sds \x=1 In sds \pinnetje=1 In {main =
                IF (digitalRead D3) (
@@ -95,8 +101,10 @@ mTaskManager = anyTask
                , whileUnchanged deviceStore viewDevices
                ] <<@ ApplyLayout layout
        where
                , whileUnchanged deviceStore viewDevices
                ] <<@ ApplyLayout layout
        where
-               isValue (Value _ _) = True
-               isValue _                       = False
+               layout = sequenceLayouts
+                       [ arrangeWithSideBar 0 LeftSide 260 True
+                       , arrangeSplit Vertical True
+                       ]
 
                viewmTasks = listmTasks
                        >&^ \sh->whileUnchanged sh $ \mi->case mi of
 
                viewmTasks = listmTasks
                        >&^ \sh->whileUnchanged sh $ \mi->case mi of
@@ -109,27 +117,46 @@ mTaskManager = anyTask
                                listmTasks :: Task String
                                listmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore
 
                                listmTasks :: Task String
                                listmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore
 
-                               sendmTask mTaskId ds = enterChoice "Choose Device" [ChooseFromDropdown (\t->t.deviceName)] ds <<@ Title mTaskId
-                                       >>* [OnAction (Action "Send") (withValue $ sendToDevice mTaskId)]
-
-                               sendToDevice mTask device = Just $ viewInformation "" [] device
+                               sendmTask mTaskId ds = 
+                                               (enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds
+                                               -&&- enterInformation "Timeout, 0 for one-shot" [])
+                                       >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskId)]
+
+                               sendToDevice :: String (MTaskDevice, Int) -> Task ()
+                               sendToDevice mTask (device, timeout) =
+                                               get bcStateStore @ createBytecode
+                                       >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords
+                                       >>= \sdss->upd ((++)sdss) sdsStore//MTaskShareaddToSDSShare
+                                       >>| makeShares sdss
+                                       >>| upd (\(r,s,ss)->(r,s++msgs,ss)) (channels device)
+                                       @! ()
+                                       where
+                                               createBytecode st = toMessages timeout $ toRealByteCode (unMain $ fromJust ('DM'.get mTask mTaskMap)) st
+                                               sharename i = fromJust (device.deviceConnected) +++ "-" +++ toString i
+                                               toSDSRecords st = [{MTaskShare |
+                                                       initValue=toInt d1*265 + toInt d2,
+                                                       withTask=mTask,
+                                                       identifier=i,
+                                                       realShare="mTaskSDS-" +++ toString i}
+                                                               \\(i,[d1,d2])<-st.sdss]
+                                               makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
                                        
                                        
+               getSDSStore :: MTaskShare -> Shared Int
+               getSDSStore sh = memoryShare sh.realShare 0
                                        
                                        
-
-               layout = sequenceLayouts
-                       [ arrangeWithSideBar 0 LeftSide 260 True
-                       , arrangeSplit Vertical True
-                       ]
+               channels :: MTaskDevice -> Shared Channels
+               channels d = memoryShare (fromJust d.deviceConnected) ([], [], False)
 
                viewShares :: Task ()
 
                viewShares :: Task ()
-               viewShares = forever $
-                               enterChoiceWithShared "Shares" [ChooseFromList sdsvw] sdsShare
-                       >>* [OnValue $ withValue $ Just o updateShare]
-                       >>* [OnAction (Action "Back") (const $ Just $ treturn ())]
-                       where
-                               sdsvw (k, v) = concat ["SDS ", toString k, ": ", toString v]
-                               updateShare (k, v) = (viewInformation "Key" [] k
-                                       ||- updateInformation "Value" [] v)
+               viewShares = forever $ viewSharedInformation "Shares" [] sdsStore @! ()
+//                             enterChoiceWithShared "Shares" [ChooseFromList id] sdsStore
+//                     >>* [OnValue $ withValue $ Just o updateShare]
+//                     >>* [OnAction (Action "Back") (const $ Just $ treturn ())]
+//                     where
+//                             sdsvw (k, v) = concat ["SDS ", toString k, ": ", toString v]
+//                             updateShare s = viewInformation "" [] ()
+//                             updateShare (k, v) = (viewInformation "Key" [] k
+//                                     ||- updateInformation "Value" [] v)
                                        
 
                viewDevices :: [MTaskDevice] -> Task ()
                                        
 
                viewDevices :: [MTaskDevice] -> Task ()
@@ -141,36 +168,39 @@ mTaskManager = anyTask
                viewDevice :: MTaskDevice -> Task ()
                viewDevice d = (viewInformation "Device settings" [] d 
                                ||- (case d.deviceConnected of
                viewDevice :: MTaskDevice -> Task ()
                viewDevice d = (viewInformation "Device settings" [] d 
                                ||- (case d.deviceConnected of
-                                       Just s = viewSharedInformation "Channels" [] (channels d.deviceName) @! ()
+                                       Just s = viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
                                        Nothing = viewInformation "No channels yet" [] "" @! ()
                                )) <<@ ArrangeHorizontal
                                        Nothing = viewInformation "No channels yet" [] "" @! ()
                                )) <<@ ArrangeHorizontal
-
-               channels :: String -> Shared Channels
-               channels s = sdsFocus s $ memoryStore "" $ Just ([], [], False)
-
-               sdsShare :: Shared [(Int, Int)]
-               sdsShare = sdsFocus "mTaskSDSs" $ memoryStore "" $ Just [(1, 1)]
-
-               addDevice :: (Shared [MTaskDevice]) -> Task ()
-               addDevice devices = enterInformation "Device type and name" []
-                       >>= \(name, ty)->get randomInt @ ((+++) name o toString)
-                       >>= \realname->let ch = channels realname in case ty of
-                               TCPDevice = enterInformation "Hostname and port" []
-                                       >>= \(host, port)->cont realname name ||- syncNetworkChannel host port ch
-                               SerialDevice = accWorld getDevices
-                                       >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero)
-                                       >>= \(device, settings)->cont realname name ||- syncSerialChannel device settings ch
                        where
                        where
-                               cont rn nm = (upd (\l->[dev rn nm:l]) devices >>| addDevice devices)
-                               dev rn nm = {deviceConnected=Just rn,deviceName=nm,deviceTasks=[]}
-
-                               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)
-
-                               isTTY s = not (isEmpty (filter (flip startsWith s) prefixes))
-                               prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"]
+                               dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)
+
+               addDevice :: (Shared [MTaskDevice]) -> Task SerTCP
+               addDevice devices = enterInformation "Device type" []
+                       >&^ \sh->whileUnchanged sh $ \mty->case mty of
+                               Nothing = viewInformation "No type selected yet" [] "" @! ()
+                               Just ty = case ty of
+                                       TCPDevice = (enterInformation "Name" [] -&&- enterInformation "Hostname" [] -&&- enterInformation "Port" [])
+                                               >>= \(name, (host, port))->cont name (syncNetworkChannel host port)
+                                       SerialDevice = accWorld getTTYDevices
+                                               >>= \dl->(enterInformation "Name" [] -&&- enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero)
+                                               >>= \(name, (dev, set))->cont name (syncSerialChannel dev set)
+                       where
+                               cont :: String ((Shared Channels) -> Task ()) -> Task ()
+                               cont name synfun = get randomInt 
+                                       @ (\randint->{deviceConnected=Just (name +++ toString randint), deviceName=name, deviceTasks=[], deviceTask=Nothing})
+                                       >>= \dev->appendTopLevelTask 'DM'.newMap True (synfun $ channels dev)
+                                       >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
+                                       @! ()
+                                               
+//                             >= \ty->get randomInt @ (\randint->{deviceConnected=Just (name +++ toString randint), deviceName=name, deviceTasks=[]})
+//                     >>= \dev->let ch = channels dev in case ty of
+//                             TCPDevice = enterInformation "Hostname and port" []
+//                                     >>= \(host, port)->cont dev ||- syncNetworkChannel host port ch
+//                             SerialDevice = accWorld getDevices
+//                                     >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero)
+//                                     >>= \(device, settings)->cont dev ||- syncSerialChannel device settings ch
+//                     where
+//                             cont d = (upd (\l->[d:l]) devices >>| addDevice devices)
 
 //             connectDevice :: [MTaskDevice] -> Task ()
 //             connectDevice [] = treturn ()
 
 //             connectDevice :: [MTaskDevice] -> Task ()
 //             connectDevice [] = treturn ()
@@ -221,14 +251,6 @@ mTaskManager = anyTask
 //             messageShare :: Shared [String]
 //             messageShare = sharedStore "mTaskMessagesRecv" []
 //
 //             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))
 //             makeMsgs :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)])
 //             makeMsgs timeout bc
 //             # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc))
@@ -321,8 +343,9 @@ serialDeviceBackgroundTask rw iworld
 
 
 syncNetworkChannel :: String Int (Shared ([MTaskMSGRecv], [MTaskMSGSend], Bool)) -> Task ()
 
 
 syncNetworkChannel :: String Int (Shared ([MTaskMSGRecv], [MTaskMSGSend], Bool)) -> Task ()
-syncNetworkChannel server port channel
-       = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()
+syncNetworkChannel server port channel = catchAll
+               (tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ())
+               (\v->traceValue v @! ())
        where
                onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
                onConnect _ (msgs,send,sendStopped)
        where
                onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
                onConnect _ (msgs,send,sendStopped)
@@ -333,8 +356,9 @@ syncNetworkChannel server port channel
                = (Ok acc, Nothing, [], False)
 
                whileConnected (Just newData) acc (msgs,send,sendStopped)
                = (Ok acc, Nothing, [], False)
 
                whileConnected (Just newData) acc (msgs,send,sendStopped)
-               | sendStopped = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
-               = (Ok acc, Just (msgs ++ [decode newData],[],False), [], False)
+               = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
+               //| sendStopped = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
+//             = (Ok acc, Just (msgs ++ [decode newData],[],False), [], False)
                
                onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
                onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing)
                
                onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
                onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing)
Repo containing the code for the mTask system (see msc-thesis1617)