started externalizing devices
authorMart Lubbers <mart@martlubbers.net>
Fri, 24 Feb 2017 11:21:30 +0000 (12:21 +0100)
committerMart Lubbers <mart@martlubbers.net>
Fri, 24 Feb 2017 11:21:30 +0000 (12:21 +0100)
client/main.c
miTask.icl
miTaskDevices.dcl [new file with mode: 0644]
miTaskDevices.icl [new file with mode: 0644]

index f3dd06a..337834f 100644 (file)
@@ -107,7 +107,6 @@ int main(int argc, char *argv[]){
        debug("booting up");
        while(true){
                //Check for newetasks
-               write_byte('\n');
                loop();
                delay(50);
        }
index 5a87999..81c765b 100644 (file)
@@ -25,10 +25,11 @@ derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED
 
 :: SerTCP = SerialDevice | TCPDevice
 :: MTaskDevice = {
-               deviceTask :: Maybe TaskId,
-               deviceConnected :: Maybe String,
-               deviceName :: String,
-               deviceTasks :: [(String, Int)]
+                deviceTask :: Maybe TaskId
+               ,deviceChannels :: String
+               ,deviceName :: String
+               ,deviceTasks :: [(String, Int)]
+//             ,deviceSyncfun :: (Shared Channels) -> Task ()
        }
 :: MTaskShare = {
                initValue :: Int,
@@ -124,7 +125,7 @@ mTaskManager = anyTask
                                        @! ()
                                        where
                                                createBytecode st = toMessages timeout $ toRealByteCode (unMain $ fromJust ('DM'.get mTask mTaskMap)) st
-                                               sharename i = fromJust (device.deviceConnected) +++ "-" +++ toString i
+                                               sharename i = device.deviceChannels +++ "-" +++ toString i
                                                toSDSRecords st = [{MTaskShare |
                                                        initValue=toInt d1*265 + toInt d2,
                                                        withTask=mTask,
@@ -140,7 +141,7 @@ mTaskManager = anyTask
                getSDSRecord i = get sdsStore @ \l->hd [s\\s<-l | s.identifier == i]
 
                channels :: MTaskDevice -> Shared Channels
-               channels d = memoryShare (fromJust d.deviceConnected) ([], [], False)
+               channels d = memoryShare d.deviceChannels ([], [], False)
 
                viewShares :: [MTaskShare] -> Task ()
                viewShares st = anyTask $ map viewer st
@@ -166,10 +167,8 @@ mTaskManager = anyTask
                
                viewDevice :: MTaskDevice -> Task ()
                viewDevice d = (viewInformation "Device settings" [] d 
-                               ||- (case d.deviceConnected of
-                                       Just s = viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
-                                       Nothing = viewInformation "No channels yet" [] "" @! ()
-                               )) <<@ ArrangeHorizontal
+                               ||- viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
+                               ) <<@ ArrangeHorizontal
                        where
                                dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)
 
@@ -185,11 +184,32 @@ mTaskManager = anyTask
                        where
                                cont :: String ((Shared Channels) -> Task ()) -> Task ()
                                cont name synfun = get randomInt 
-                                       @ (\randint->{deviceConnected=Just (name +++ toString randint), deviceName=name, deviceTasks=[], deviceTask=Nothing})
+                                       @ (\randint->{MTaskDevice |
+                                               deviceChannels=name +++ toString randint,
+                                               deviceName=name,
+                                               deviceTasks=[],
+                                               deviceTask=Nothing})
                                        >>= \dev->appendTopLevelTask 'DM'.newMap True (let ch = channels dev in process ch -||- synfun ch)
                                        >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
                                        @! ()
 
+//             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 = (enterInformation "Name" [] -&&- enterTTYSettings)
+//                                             >>= \(name, set)->cont name (syncSerialChannel set encode decode)
+//                     where
+//                             cont :: String ((Shared Channels) -> Task ()) -> Task ()
+//                             cont name synfun = get randomInt 
+//                                     @ (\randint->{deviceChannels=name +++ toString randint, deviceName=name, deviceTasks=[], deviceTask=Nothing})
+//                                     >>= \dev->appendTopLevelTask 'DM'.newMap True (let ch = channels dev in process ch -||- synfun ch)
+//                                     >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
+//                                     @! ()
+
                process :: (Shared Channels) -> Task ()
                process ch = forever (watch ch >>* [OnValue (
                                ifValue (not o isEmpty o fst3)
@@ -209,7 +229,7 @@ mTaskManager = anyTask
 
                deviceviewer :: [MTaskDevice] -> [MTaskDeviceStatus]
                deviceviewer ds = [{MTaskDeviceStatus | name = d.deviceName,
-                       connected = if (isNothing d.deviceConnected) False True,
+                       connected = if (isNothing d.deviceTask) False True,
                        tasks = [s +++ toString i\\(s, i)<-d.deviceTasks]}\\d<-ds]
 
                mapPar :: (a -> Task a) [a] -> Task ()
@@ -230,11 +250,11 @@ syncNetworkChannel server port channel = catchAll
                        = (Ok "", Just (msgs,[],sendStopped), map encode send, False)
 
                whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
-               whileConnected Nothing acc (msgs,send,sendStopped)
-               = (Ok acc, Nothing, [], False)
-
-               whileConnected (Just newData) acc (msgs,send,sendStopped)
-               = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
+               
+               //whileConnected Nothing acc (msgs,send,sendStopped)
+               //= (Ok acc, Just (msgs,[],sendStopped), map encode send, False)
+               whileConnected mnewData acc (msgs,send,sendStopped)
+               = (Ok acc, Just (msgs ++ map decode (maybeToList mnewData),[],sendStopped), map encode send, False)
                //| sendStopped = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
 //             = (Ok acc, Just (msgs ++ [decode newData],[],False), [], False)
                
diff --git a/miTaskDevices.dcl b/miTaskDevices.dcl
new file mode 100644 (file)
index 0000000..05aca62
--- /dev/null
@@ -0,0 +1,21 @@
+definition module miTaskDevices
+
+import mTask
+import iTasks
+import iTasksTTY
+
+:: Channels :== ([MTaskMSGRecv], [MTaskMSGSend], Bool)
+:: TCPDevice = {hostname :: String, port :: Int}
+:: SerialDevice = {settings :: TTYSettings}
+
+derive class iTask TCPDevice, SerialDevice
+
+getmTaskDevice :: Task a | mTaskDevice a
+
+class mTaskDevice a where
+       syncTask :: a (Shared Channels) -> Task ()
+       entermTaskDevice :: Task a
+       viewmTaskDevice :: a -> Task a
+
+instance mTaskDevice TCPDevice
+instance mTaskDevice SerialDevice
diff --git a/miTaskDevices.icl b/miTaskDevices.icl
new file mode 100644 (file)
index 0000000..1a0b3eb
--- /dev/null
@@ -0,0 +1,50 @@
+implementation module miTaskDevices
+
+import mTask
+import iTasks
+
+:: Channels :== ([MTaskMSGRecv], [MTaskMSGSend], Bool)
+:: TCPDevice = {hostname :: String, port :: Int}
+:: SerialDevice = {settings :: TTYSettings}
+
+:: DeviceType = SerialDevice | TCPDevice
+
+derive class iTask TCPDevice, SerialDevice, DeviceType
+
+getmTaskDevice :: Task a | mTaskDevice a
+getmTaskDevice = enterInformation "Device type" []
+       >&^ \st->whileUnchanged st $ \dt->case dt of
+               Nothing = viewInformation "No type selected yet" [] Nothing
+               Just SerialDevice = getSerialDevice @ pure
+               Just TCPDevice = getTDevice @ pure
+       >>* [OnValue (ifValue isJust fromJust)]
+       where
+               getSD :: Task SerialDevice
+               getSD = entermTaskDevice
+               getTD :: Task TCPDevice
+               getTD = entermTaskDevice
+
+instance mTaskDevice TCPDevice where
+       entermTaskDevice = enterInformation "" []
+       viewmTaskDevice = viewInformation "" []
+       syncTask d ch = catchAll (
+                       tcpconnect d.host d.port ch {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) = (Ok "", Just (msgs,[],sendStopped), map encode send, False)
+
+                       whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
+                       whileConnected Nothing acc (msgs,send,sendStopped) = (Ok acc, Nothing, [], False)
+                       whileConnected (Just newData) acc (msgs,send,sendStopped) = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
+                       
+                       onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
+                       onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing)
+
+instance mTaskDevice SerialDevice where
+       entermTaskDevice = enterTTYSettings >>= \s->{SerialDevice|settings=s}
+       viewmTaskDevice = viewInformation "" []
+       syncTask d ch = syncSerialSettings d.settings encode decode ch