From 1e4c58b59800c21747181bb0c437c6cc47c47dec Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 27 Feb 2017 09:58:26 +0100 Subject: [PATCH] experimental --- Devices/mTaskDevice.dcl | 2 +- Devices/mTaskDevice.icl | 12 +++++----- Tasks/Examples.dcl | 11 +++++++++ Tasks/Examples.icl | 50 +++++++++++++++++++++++++++++++++++++++++ Utils/SDS.icl | 4 +++- miTask.icl | 37 +++++------------------------- 6 files changed, 77 insertions(+), 39 deletions(-) create mode 100644 Tasks/Examples.dcl create mode 100644 Tasks/Examples.icl diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl index 6a09c55..bae7af6 100644 --- a/Devices/mTaskDevice.dcl +++ b/Devices/mTaskDevice.dcl @@ -33,7 +33,7 @@ class MTaskDuplex a where synFun :: a (Shared Channels) -> Task () manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task () -sendToDevice :: (Map String (Main (ByteCode () Stmt))) String (MTaskDevice, Int) -> Task () +sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, Int) -> Task () deviceTaskDelete :: MTaskDevice MTaskTask -> Task () deviceTaskAcked :: MTaskDevice Int -> Task () diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index 972aa7b..9a93634 100644 --- a/Devices/mTaskDevice.icl +++ b/Devices/mTaskDevice.icl @@ -71,22 +71,22 @@ viewDevice d = anyTask where dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss) -sendToDevice :: (Map String (Main (ByteCode () Stmt))) String (MTaskDevice, Int) -> Task () -sendToDevice tmap mTask (device, timeout) = - get bcStateStore @ createBytecode +sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, Int) -> Task () +sendToDevice wta mTask (device, timeout) = + get bcStateStore + >>= \st->treturn (toMessages timeout (toRealByteCode (unMain mTask) st)) >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords >>= \sdss->upd ((++)sdss) sdsStore//MTaskShareaddToSDSShare >>| makeShares sdss >>| sendMessage device msgs - >>| makeTask mTask -1 + >>| makeTask wta -1 >>= \task->withDevices device (addTask timeout task) @! () where - createBytecode st = toMessages timeout $ toRealByteCode (unMain $ fromJust ('DM'.get mTask tmap)) st sharename i = device.deviceChannels +++ "-" +++ toString i toSDSRecords st = [{MTaskShare | initValue=toInt d1*265 + toInt d2, - withTask=mTask, + withTask=wta, identifier=i, realShare="mTaskSDS-" +++ toString i} \\(i,[d1,d2])<-st.sdss] diff --git a/Tasks/Examples.dcl b/Tasks/Examples.dcl new file mode 100644 index 0000000..6c099dd --- /dev/null +++ b/Tasks/Examples.dcl @@ -0,0 +1,11 @@ +definition module Tasks.Examples + +from Data.Map import :: Map +import mTask + +countAndLed :: Main (ByteCode () Stmt) +blink :: UserLED -> Main (ByteCode () Stmt) +ledtOn :: UserLED -> Main (ByteCode () Stmt) +ledtOff :: UserLED -> Main (ByteCode () Stmt) + +allmTasks :: Map String (Task (Main (ByteCode () Stmt))) diff --git a/Tasks/Examples.icl b/Tasks/Examples.icl new file mode 100644 index 0000000..7d872ef --- /dev/null +++ b/Tasks/Examples.icl @@ -0,0 +1,50 @@ +implementation module Tasks.Examples + +import qualified Data.Map as DM +import mTask + +import iTasks._Framework.Serialization + +derive class iTask UserLED, Main, ByteCode, Stmt, BC, BCState + +countAndLed :: Main (ByteCode () Stmt) +countAndLed = sds \x=1 In sds \pinnetje=1 In {main = + IF (digitalRead D3) ( + x =. x +. lit 1 :. + pub x + ) ( + noOp + ) :. + IF (pinnetje ==. lit 1) ( + ledOn LED1 + ) ( + IF (pinnetje ==. lit 2) ( + ledOn LED2 + ) ( + ledOn LED3 + ) + )} + +blink :: UserLED -> Main (ByteCode () Stmt) +blink led = sds \x=1 In {main = + IF (x ==. lit 1) ( + ledOn led ) ( + ledOff led ) :. + x =. lit 1 -. x :. noOp + } + +ledtOn :: UserLED -> Main (ByteCode () Stmt) +ledtOn d = {main = ledOn d} + +ledtOff :: UserLED -> Main (ByteCode () Stmt) +ledtOff d = {main = ledOff d} + +ledSelection :: Task UserLED +ledSelection = enterInformation "Select LED" [] + +allmTasks :: Map String (Task (Main (ByteCode () Stmt))) +allmTasks = 'DM'.fromList [ + ("countAndLed", treturn countAndLed), + ("ledOn", ledSelection @ ledtOn), + ("ledOff", ledSelection @ ledtOff), + ("blink", ledSelection @ blink)] diff --git a/Utils/SDS.icl b/Utils/SDS.icl index cd684ae..27ebeb7 100644 --- a/Utils/SDS.icl +++ b/Utils/SDS.icl @@ -4,6 +4,8 @@ import iTasks import iTasks._Framework.Store import Devices.mTaskDevice import Shares.mTaskShare +import Tasks.Examples +import qualified Data.Map as DM from Data.Func import $ derive class iTask MTaskShare, BCState @@ -21,7 +23,7 @@ bcStateStore :: Shared BCState bcStateStore = memoryShare "mTaskBCState" zero mTaskTaskStore :: Shared [String] -mTaskTaskStore = memoryShare "mTaskTasks" ["count", "ledon", "ledoff"] +mTaskTaskStore = memoryShare "mTaskTasks" $ 'DM'.keys allmTasks getSDSStore :: MTaskShare -> Shared Int getSDSStore sh = memoryShare sh.realShare 0 diff --git a/miTask.icl b/miTask.icl index 4bef600..dfdcd30 100644 --- a/miTask.icl +++ b/miTask.icl @@ -7,6 +7,7 @@ import iTasks import mTask import Devices.mTaskDevice import Shares.mTaskShare +import Tasks.Examples import Utils.SDS from Text import class Text(startsWith,concat,split,join), instance Text String @@ -19,6 +20,7 @@ import Data.List import System.Directory import iTasks._Framework.Store +import iTasks._Framework.Serialization import TTY, iTasksTTY @@ -28,33 +30,6 @@ Start :: *World -> *World Start world = startEngine (mTaskManager >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world -mTaskMap :: Map String (Main (ByteCode () Stmt)) -mTaskMap = 'DM'.fromList [("count", bc), ("ledon", bc2 LED1), ("ledoff", bc3 LED3)] - -bc :: Main (ByteCode () Stmt) -bc = sds \x=1 In sds \pinnetje=1 In {main = - IF (digitalRead D3) ( - x =. x +. lit 1 :. - pub x - ) ( - noOp - ) :. - IF (pinnetje ==. lit 1) ( - ledOn LED1 - ) ( - IF (pinnetje ==. lit 2) ( - ledOn LED2 - ) ( - ledOn LED3 - ) - )} - -bc2 :: UserLED -> Main (ByteCode () Stmt) -bc2 d = {main = ledOn d} - -bc3 :: UserLED -> Main (ByteCode () Stmt) -bc3 d = {main = ledOff d} - mTaskManager :: Task () mTaskManager = anyTask [ viewmTasks @! () @@ -78,10 +53,10 @@ mTaskManager = anyTask 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 mTaskMap mTaskId)] + sendmTask mTaskId ds = fromJust ('DM'.get mTaskId allmTasks) +// >>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds +// -&&- enterInformation "Timeout, 0 for one-shot" []) +// >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice bc)] process :: MTaskDevice (Shared Channels) -> Task () process device ch = forever (watch ch >>* [OnValue ( -- 2.20.1