From bfbcdc683846195fbe720f4b3c38f3b0604c8f22 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Tue, 21 Mar 2017 15:34:37 +0100 Subject: [PATCH] add share update, albeit a bit ugly. also add device to share --- Shares/mTaskShare.dcl | 4 +++- Shares/mTaskShare.icl | 20 +++++++++++++++++--- Tasks/mTaskTask.icl | 8 ++++---- mTaskInterpret.dcl | 5 ++--- mTaskInterpret.icl | 9 +++------ todo.txt | 1 - 6 files changed, 29 insertions(+), 18 deletions(-) diff --git a/Shares/mTaskShare.dcl b/Shares/mTaskShare.dcl index 3cfd7a1..3dee1e8 100644 --- a/Shares/mTaskShare.dcl +++ b/Shares/mTaskShare.dcl @@ -3,12 +3,14 @@ definition module Shares.mTaskShare import iTasks import iTasks._Framework.Serialization import mTask +import Devices.mTaskDevice derive class iTask MTaskShareType, MTaskShare :: MTaskShareType = MTaskWithShare String | MTaskLens String :: MTaskShare = {withTask :: [String] + ,withDevice :: [MTaskDevice] ,identifier :: Int ,realShare :: MTaskShareType ,value :: BCValue @@ -17,6 +19,6 @@ derive class iTask MTaskShareType, MTaskShare manageShares :: [MTaskShare] -> Task () ///makeShare :: String Int Dynamic -> Task MTaskShare -makeShare :: String Int BCValue -> Task MTaskShare +makeShare :: String MTaskDevice Int BCValue -> Task MTaskShare updateShare :: Int BCValue -> Task () diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl index 8c0ae61..ed4b5e3 100644 --- a/Shares/mTaskShare.icl +++ b/Shares/mTaskShare.icl @@ -12,7 +12,20 @@ derive class iTask MTaskShareType, MTaskShare manageShares :: [MTaskShare] -> Task () manageShares shares = withShared Nothing $ \cs->forever $ - viewSharesGrid cs shares /*||- (viewSharedInformation "" [] cs*/ @! ()//)//||- editCurrentShare cs + (viewSharesGrid cs shares -|| updateShares shares <<@ ArrangeVertical) + @! () +updateShares :: [MTaskShare] -> Task BCValue +updateShares shares = anyTask (map updateS shares) <<@ ArrangeWithTabs + +updateS :: MTaskShare -> Task BCValue +updateS sh = flip (<<@) (Title $ toString sh.identifier) $ forever $ + viewSharedInformation "Current value" [] (getSDSShare sh) + ||- ( + updateSharedInformation "New value" [] (getSDSShare sh) + >>= \nv->allTasks (map (sendMessages [MTUpd sh.identifier nv]) sh.withDevice) + >>| treturn nv + ) + <<@ ArrangeHorizontal // >&^ \st->whileUnchanged st $ \msh->case msh of // Nothing = viewShares shares @@ -54,10 +67,11 @@ viewShare m = viewSharedInformation "" [] (getSDSShare m) getSDSShare :: MTaskShare -> Shared BCValue getSDSShare s=:{realShare=(MTaskWithShare id),value} = memoryShare id value -makeShare :: String Int BCValue -> Task MTaskShare -makeShare withTask identifier value = treturn +makeShare :: String MTaskDevice Int BCValue -> Task MTaskShare +makeShare withTask withDevice identifier value = treturn {MTaskShare |withTask=[withTask] + ,withDevice=[withDevice] ,identifier=identifier ,value=value ,realShare=MTaskWithShare $ "mTaskSDS-" +++ toString identifier diff --git a/Tasks/mTaskTask.icl b/Tasks/mTaskTask.icl index 3e209da..52191b5 100644 --- a/Tasks/mTaskTask.icl +++ b/Tasks/mTaskTask.icl @@ -17,7 +17,7 @@ sendTaskToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval sendTaskToDevice wta mTask (device, timeout) = get bcStateStore @ toMessages timeout mTask >>= \(msgs, st1)->set st1 bcStateStore - >>| toSDSRecords msgs st1 + >>| toSDSRecords msgs st1 device >>= \sdss->upd (mergeShares sdss) sdsStore >>| sendMessages msgs device >>| makeTask wta -1 @@ -26,9 +26,9 @@ sendTaskToDevice wta mTask (device, timeout) = where sharename i = device.deviceChannels +++ "-" +++ toString i - toSDSRecords :: [MTaskMSGSend] BCState -> Task [MTaskShare] - toSDSRecords s st = sequence "" - [makeShare wta sdsi sdsval + toSDSRecords :: [MTaskMSGSend] BCState MTaskDevice -> Task [MTaskShare] + toSDSRecords s st device = sequence "" + [makeShare wta device sdsi sdsval \\{sdsi,sdspub,sdsval}<-st.sdss , (MTSds sdsi` _)<-s | sdsi == sdsi`] diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl index 2e9e5b8..7ddff19 100644 --- a/mTaskInterpret.dcl +++ b/mTaskInterpret.dcl @@ -23,8 +23,8 @@ from Generics.gCons import class gCons, generic conses, generic consName, generi :: MTaskMSGSend = MTTask MTaskInterval String | MTTaskDel Int - | MTSds Int String - | MTUpd Int String + | MTSds Int BCValue + | MTUpd Int BCValue | MTSpec :: MTaskInterval @@ -151,7 +151,6 @@ instance seq ByteCode instance serial ByteCode toMessages :: MTaskInterval (Main (ByteCode a b)) BCState -> ([MTaskMSGSend], BCState) -toSDSUpdate :: Int Int -> [MTaskMSGSend] toByteVal :: BC -> String toReadableByteCode :: (ByteCode a b) BCState -> (String, BCState) diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index 34dc617..ef75b9a 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -43,8 +43,8 @@ import Tasks.Examples encode :: MTaskMSGSend -> String encode (MTTask to data) = "t" +++ toByteCode to +++ to16bit (size data) +++ data +++ "\n" encode (MTTaskDel i) = "d" +++ to16bit i +++ "\n" -encode (MTSds i v) = "s" +++ to16bit i +++ v +++ "\n" -encode (MTUpd i v) = "u" +++ to16bit i +++ v +++ "\n" +encode (MTSds i v) = "s" +++ to16bit i +++ toByteCode v +++ "\n" +encode (MTUpd i v) = "u" +++ to16bit i +++ toByteCode v +++ "\n" encode (MTSpec) = "c\n" import StdDebug @@ -338,14 +338,11 @@ toMessages interval x s | not (trace_tn $ printToString s.sdss) = undef | not (trace_tn $ printToString newstate.sdss) = undef | not (trace_tn $ printToString newsdss) = undef -= ([MTSds sdsi $ toByteCode e\\{sdsi,sdsval=(BCValue e)}<-newsdss] ++ += ([MTSds sdsi e\\{sdsi,sdsval=e}<-newsdss] ++ [MTTask interval bc], newstate) instance == BCShare where (==) a b = a.sdsi == b.sdsi -toSDSUpdate :: Int Int -> [MTaskMSGSend] -toSDSUpdate i v = [MTUpd i (to16bit v)] - //Start = toMessages (OnInterval 500) $ toRealByteCode (unMain bc) zero Start = fst $ toReadableByteCode (unMain $ countAndLed) zero //Start = fst $ toReadableByteCode (unMain $ blink LED1) zero diff --git a/todo.txt b/todo.txt index 6b09dc5..4647ddd 100644 --- a/todo.txt +++ b/todo.txt @@ -1,3 +1,2 @@ delete tasks when deleting device let tasks have a unique name -add field in task that denotes to which device it belongs -- 2.20.1