From 0781ce1e845d7ec4bd06a39105d5d0d68835c693 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Sun, 19 Feb 2017 11:20:10 +0100 Subject: [PATCH] move generics to a different directory, add task sending framework --- gCons.dcl => Generics/gCons.dcl | 2 +- gCons.icl => Generics/gCons.icl | 2 +- gdynamic.dcl => Generics/gdynamic.dcl | 2 +- gdynamic.icl => Generics/gdynamic.icl | 2 +- mTask.dcl | 5 ++- mTask.icl | 5 ++- mTaskCode.icl | 5 ++- mTaskExamples.icl | 2 +- mTaskInterpret.icl | 4 +- mTaskLCD.icl | 2 +- mTaskMakeSymbols.icl | 3 +- mTaskSerial.icl | 2 +- mTaskSimulation.icl | 5 ++- miTask.icl | 57 +++++++++++++++++++++------ 14 files changed, 72 insertions(+), 26 deletions(-) rename gCons.dcl => Generics/gCons.dcl (94%) rename gCons.icl => Generics/gCons.icl (97%) rename gdynamic.dcl => Generics/gdynamic.dcl (95%) rename gdynamic.icl => Generics/gdynamic.icl (98%) diff --git a/gCons.dcl b/Generics/gCons.dcl similarity index 94% rename from gCons.dcl rename to Generics/gCons.dcl index 571aefe..7877e11 100644 --- a/gCons.dcl +++ b/Generics/gCons.dcl @@ -1,4 +1,4 @@ -definition module gCons +definition module Generics.gCons /* Pieter Koopman 2015 diff --git a/gCons.icl b/Generics/gCons.icl similarity index 97% rename from gCons.icl rename to Generics/gCons.icl index 6e5aaa5..fc4debc 100644 --- a/gCons.icl +++ b/Generics/gCons.icl @@ -1,4 +1,4 @@ -implementation module gCons +implementation module Generics.gCons /* Pieter Koopman 2015 diff --git a/gdynamic.dcl b/Generics/gdynamic.dcl similarity index 95% rename from gdynamic.dcl rename to Generics/gdynamic.dcl index 2dea3c1..66e9bf8 100644 --- a/gdynamic.dcl +++ b/Generics/gdynamic.dcl @@ -1,4 +1,4 @@ -definition module gdynamic +definition module Generics.gdynamic /* Pieter Koopman 2015 diff --git a/gdynamic.icl b/Generics/gdynamic.icl similarity index 98% rename from gdynamic.icl rename to Generics/gdynamic.icl index 28966bf..3240d6d 100644 --- a/gdynamic.icl +++ b/Generics/gdynamic.icl @@ -1,4 +1,4 @@ -implementation module gdynamic +implementation module Generics.gdynamic /* Pieter Koopman 2015 diff --git a/mTask.dcl b/mTask.dcl index 114012c..ac9405c 100644 --- a/mTask.dcl +++ b/mTask.dcl @@ -14,12 +14,15 @@ todo: imporove setp: >>*. */ +import Generics.gCons +import Generics.gdynamic + import iTasks import iTasks._Framework.Generic from iTasks._Framework.Task import :: Task import StdClass -import gdynamic, gCons, GenEq, StdMisc, StdArray +import GenEq, StdMisc, StdArray import mTaskCode, mTaskSimulation, mTaskInterpret import mTaskSerial, mTaskLCD diff --git a/mTask.icl b/mTask.icl index 34703d2..66649d7 100644 --- a/mTask.icl +++ b/mTask.icl @@ -14,8 +14,11 @@ todo: imporove setp: >>*. */ +import Generics.gCons +import Generics.gdynamic + import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray +import GenEq, StdMisc, StdArray import mTaskCode import mTaskSerial, mTaskLCD diff --git a/mTaskCode.icl b/mTaskCode.icl index 410e05e..f1da0d8 100644 --- a/mTaskCode.icl +++ b/mTaskCode.icl @@ -1,7 +1,10 @@ implementation module mTaskCode +import Generics.gdynamic +import Generics.gCons + import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray +import GenEq, StdMisc, StdArray import mTask instance toCode MTask where toCode (MTask x) = "Task " + toCode x diff --git a/mTaskExamples.icl b/mTaskExamples.icl index d916951..4de01e6 100644 --- a/mTaskExamples.icl +++ b/mTaskExamples.icl @@ -1,7 +1,7 @@ module mTaskExamples import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray +import GenEq, StdMisc, StdArray import mTask Start = diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index c63c95d..f0cddf9 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -1,7 +1,9 @@ implementation module mTaskInterpret //import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray, GenBimap +import Generics.gCons + +import GenEq, StdMisc, StdArray, GenBimap import GenPrint import StdEnum import mTask diff --git a/mTaskLCD.icl b/mTaskLCD.icl index 56b4eb4..6c9d16b 100644 --- a/mTaskLCD.icl +++ b/mTaskLCD.icl @@ -1,7 +1,7 @@ implementation module mTaskLCD import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray +import GenEq, StdMisc, StdArray import mTask derive consIndex Button diff --git a/mTaskMakeSymbols.icl b/mTaskMakeSymbols.icl index f92cb2a..356493f 100644 --- a/mTaskMakeSymbols.icl +++ b/mTaskMakeSymbols.icl @@ -1,7 +1,8 @@ module mTaskMakeSymbols //import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray, GenBimap +import Generics.gCons +import GenEq, StdMisc, StdArray, GenBimap import GenPrint import mTask import StdEnum diff --git a/mTaskSerial.icl b/mTaskSerial.icl index e0e9f58..d010f4d 100644 --- a/mTaskSerial.icl +++ b/mTaskSerial.icl @@ -1,7 +1,7 @@ implementation module mTaskSerial import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray +import GenEq, StdMisc, StdArray import mTask instance serial Code where diff --git a/mTaskSimulation.icl b/mTaskSimulation.icl index 7c187f7..e158002 100644 --- a/mTaskSimulation.icl +++ b/mTaskSimulation.icl @@ -1,7 +1,10 @@ implementation module mTaskSimulation +import Generics.gdynamic +import Generics.gCons + import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray +import GenEq, StdMisc, StdArray import mTask derive class iTask Display diff --git a/miTask.icl b/miTask.icl index 11daaa9..738f8c2 100644 --- a/miTask.icl +++ b/miTask.icl @@ -34,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) ( @@ -65,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 @@ -78,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 @@ -87,16 +122,14 @@ mTaskManager = anyTask ] viewShares :: Task () - viewShares = forever ( + 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) - >>= \nv->upd viewDevices :: [MTaskDevice] -> Task () @@ -129,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 @@ -149,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 -- 2.20.1