move generics to a different directory, add task sending framework
[mTask.git] / miTask.icl
index efff14d..738f8c2 100644 (file)
@@ -8,6 +8,8 @@ import mTask
 
 from Text import class Text(startsWith,concat,split,join), instance Text String
 
+import qualified Data.Map as DM
+
 from Data.Func import $
 import Data.Tuple
 import Data.List
@@ -32,13 +34,33 @@ derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED
 :: SerTCP = SerialDevice | TCPDevice
 :: MTaskDevice = {
                deviceConnected :: Maybe String,
-               deviceName :: String
+               deviceName :: String,
+               deviceTasks :: [(String, Int)]
+       }
+:: MTaskShare = {
+               identifier :: Int,
+               realShare :: String
        }
 
 Start :: *World -> *World
 Start world = startEngine (mTaskManager
        >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world
 
+memoryShare :: String a -> Shared a | iTask a
+memoryShare s d = sdsFocus s $ memoryStore "" $ Just d
+
+deviceStore :: Shared [MTaskDevice]
+deviceStore = memoryShare "mTaskDevices" []
+
+sdsStore :: Shared [MTaskShare]
+sdsStore = memoryShare "mTaskShares" []
+
+bcStateStore :: Shared BCState
+bcStateStore = memoryShare "mTaskBCState" zero
+
+mTaskTaskStore :: Shared [String]
+mTaskTaskStore = memoryShare "mTaskTasks" ["ledder", "ledon", "ledoff"]
+
 bc :: Main (ByteCode () Stmt)
 bc = sds \x=1 In sds \pinnetje=1 In {main =
                IF (digitalRead D3) (
@@ -63,8 +85,8 @@ bc2 d = {main = ledOn d}
 bc3 :: UserLED -> Main (ByteCode () Stmt)
 bc3 d = {main = ledOff d}
 
-:: MTaskDeviceStatus = {connected :: Bool, name :: String}
-derive class iTask MTaskDeviceStatus, MTaskDevice
+:: MTaskDeviceStatus = {connected :: Bool, name :: String, tasks :: [(String, Int)]}
+derive class iTask MTaskDeviceStatus, MTaskDevice, MTaskShare, BCState
 
 mTaskManager :: Task ()
 mTaskManager = anyTask 
@@ -76,8 +98,23 @@ mTaskManager = anyTask
                isValue (Value _ _) = True
                isValue _                       = False
 
-               viewmTasks = enterChoice "Available mTasks" [ChooseFromList id] ["ledder", "ledon", "ledoff"]
-                       >>= viewInformation "" []
+               viewmTasks = listmTasks
+                       >&^ \sh->whileUnchanged sh $ \mi->case mi of
+                               Nothing = viewInformation "No task selected" [] ()
+                               Just mTaskTask = get deviceStore
+                                       >>= \devices->case devices of
+                                               [] = viewInformation "No devices yet" [] ()
+                                               ds = sendmTask mTaskTask ds @! ()
+                       where
+                               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
+                                       
+                                       
 
                layout = sequenceLayouts
                        [ arrangeWithSideBar 0 LeftSide 260 True
@@ -85,7 +122,15 @@ mTaskManager = anyTask
                        ]
 
                viewShares :: Task ()
-               viewShares = viewInformation () [] ()
+               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)
+                                       
 
                viewDevices :: [MTaskDevice] -> Task ()
                viewDevices ds = anyTask [
@@ -103,6 +148,9 @@ mTaskManager = anyTask
                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)
@@ -114,7 +162,7 @@ mTaskManager = anyTask
                                        >>= \(device, settings)->cont realname name ||- syncSerialChannel device settings ch
                        where
                                cont rn nm = (upd (\l->[dev rn nm:l]) devices >>| addDevice devices)
-                               dev rn nm = {deviceConnected=Just rn,deviceName=nm}
+                               dev rn nm = {deviceConnected=Just rn,deviceName=nm,deviceTasks=[]}
 
                                getDevices :: !*World -> *(![String], !*World)
                                getDevices w = case readDirectory "/dev" w of
@@ -134,11 +182,9 @@ mTaskManager = anyTask
 
                deviceviewer :: [MTaskDevice] -> [MTaskDeviceStatus]
                deviceviewer ds = [{MTaskDeviceStatus | name = d.deviceName,
-                       connected = if (isNothing d.deviceConnected) False True}\\d<-ds]
+                       connected = if (isNothing d.deviceConnected) False True,
+                       tasks = d.deviceTasks}\\d<-ds]
        
-               deviceStore :: Shared [MTaskDevice]
-               deviceStore = sdsFocus "mTaskDevices" $ memoryStore "" (Just [])
-
 //             showTabbed :: [MTaskDevice] -> Task ()
 //             showTabbed [] = viewInformation "" [] "No devices yet" @! ()
 //             showTabbed [l:ls] = foldr (\e es->manageDevice e ||- es) (manageDevice l) ls