X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=miTask.icl;h=1e62ea7f0217aa4923d0a4bfbec3973cb219b222;hb=58e526fc46f667943873621c9029d7e5dd7c158e;hp=efff14d359209ac95aa5ac1f37ae54ac89914b13;hpb=68e65ffa79b10fc6762a0f7989a268126fc20c1b;p=mTask.git diff --git a/miTask.icl b/miTask.icl index efff14d..1e62ea7 100644 --- a/miTask.icl +++ b/miTask.icl @@ -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,36 @@ 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"] + +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) ( @@ -63,8 +88,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 +101,48 @@ 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 + -&&- 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 + @ toMessages timeout o toRealByteCode (unMain $ fromJust ('DM'.get mTask mTaskMap)) + >>= \(msgs, st1)->set st1 bcStateStore + //@ map f + >>| upd (\(r,s,ss)->(r,s++msgs,ss)) (channels device) + @! () + where + f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d)) + dd [x,y] = toInt x*265 + toInt y + +// = (msgs, map f st.sdss) +// where +// upd (\(r,s,ss)->(r,s++[],ss)) (channels device) @! () +// # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc)) +// = Just $ viewInformation "" [] device +// = (msgs, map f st.sdss) +// where +// f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d)) +// dd [x,y] = toInt x*265 + toInt y +// # +// = Just $ viewInformation "" [] device + + + channels :: MTaskDevice -> Shared Channels + channels d = memoryShare (fromJust d.deviceConnected) ([], [], False) layout = sequenceLayouts [ arrangeWithSideBar 0 LeftSide 260 True @@ -85,7 +150,16 @@ mTaskManager = anyTask ] viewShares :: Task () - viewShares = viewInformation () [] () + viewShares = forever $ + 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 ds = anyTask [ @@ -96,25 +170,23 @@ mTaskManager = anyTask 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 - - channels :: String -> Shared Channels - channels s = sdsFocus s $ memoryStore "" $ Just ([], [], False) + where + dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss) 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 + >>= \(name, 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 realname name ||- syncNetworkChannel host port ch + >>= \(host, port)->cont dev ||- syncNetworkChannel host port ch SerialDevice = accWorld getDevices >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero) - >>= \(device, settings)->cont realname name ||- syncSerialChannel device settings ch + >>= \(device, settings)->cont dev ||- 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} + cont d = (upd (\l->[d:l]) devices >>| addDevice devices) getDevices :: !*World -> *(![String], !*World) getDevices w = case readDirectory "/dev" w of @@ -134,11 +206,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 @@ -275,8 +345,9 @@ serialDeviceBackgroundTask rw iworld 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) @@ -287,8 +358,9 @@ syncNetworkChannel server port channel = (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)