From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 6 Mar 2017 18:48:38 +0000 (+0100)
Subject: merge
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=5019b4f7dbeda8679421ec482f40b85eec9ebd72;hp=a2b8b2a0de173f92092bf6cbbed23551e674ca3c;p=mTask.git

merge
---

diff --git a/CleanSerial b/CleanSerial
index bfa6a41..ef64133 160000
--- a/CleanSerial
+++ b/CleanSerial
@@ -1 +1 @@
-Subproject commit bfa6a41e5ecfb2e11e9e389b6bb6720fda7f1ebb
+Subproject commit ef6413393c66231637cc89c252c28e866a46f14b
diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl
index f254a22..c489d01 100644
--- a/Devices/mTaskDevice.dcl
+++ b/Devices/mTaskDevice.dcl
@@ -10,12 +10,10 @@ import mTaskInterpret
 import Generics.gCons
 import iTasksTTY
 
-derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend
+derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend, BCShare
 derive conses MTaskResource, TCPSettings
 derive consName MTaskResource, TCPSettings
 
-
-channels :: MTaskDevice -> Shared Channels
 :: Channels :== ([MTaskMSGRecv], [MTaskMSGSend], Bool)
 
 :: MTaskResource 
@@ -40,6 +38,7 @@ startupDevices :: Task [MTaskDevice]
 connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
 manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task ()
 sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
+sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels)
 
 deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
 deviceTaskAcked :: MTaskDevice Int -> Task ()
diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index 58dd5ed..b3f3e85 100644
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -8,6 +8,7 @@ import iTasksTTY
 import TTY
 import qualified Data.Map as DM
 import Utils.SDS
+import Utils.Devices
 
 import GenBimap
 import Devices.mTaskSerial
@@ -17,16 +18,13 @@ import iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.Editor.Builtin, iTasks.
 
 from Data.Func import $
 
-derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend
+derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend, BCShare
 derive conses MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings
 derive consName MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings
 
 instance == MTaskDevice where
 	(==) a b = a.deviceChannels == b.deviceChannels
 
-channels :: MTaskDevice -> Shared Channels
-channels d = memoryShare d.deviceChannels ([], [], False)
-
 startupDevices :: Task [MTaskDevice]
 startupDevices = upd (map reset) deviceStore
 	where reset d = {d & deviceTask=Nothing, deviceTasks=[], deviceError=Nothing}
@@ -99,28 +97,29 @@ deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d)
 sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
 sendToDevice wta mTask (device, timeout) =
 		get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask)
-	>>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords
+	>>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords 
 	>>= \sdss->set sdss sdsStore//MTaskShareaddToSDSShare
 	>>| makeShares sdss
-	>>| sendMessage device msgs
+	>>| sendMessages msgs device
 	>>| makeTask wta -1
 	>>= withDevices device o addTask
 	@! ()
 	where
 		sharename i = device.deviceChannels +++ "-" +++ toString i
 		toSDSRecords st = [{MTaskShare |
-			initValue=toInt d1*265 + toInt d2,
+			initValue=toInt (sdsval!!0)*265 + toInt (sdsval!!1),
 			withTask=wta,
-			identifier=i,
-			realShare="mTaskSDS-" +++ toString i}
-				\\(i,[d1,d2])<-st.sdss]
+			identifier=sdsi,
+			//We skip the only/local shares
+			realShare="mTaskSDS-" +++ toString sdsi}
+				\\{sdsi,sdspub,sdsval}<-st.sdss | sdspub]
 		makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
 
 		addTask :: MTaskTask MTaskDevice -> MTaskDevice
 		addTask task device = {device & deviceTasks=[task:device.deviceTasks]}
 
-sendMessage :: MTaskDevice [MTaskMSGSend] -> Task ()
-sendMessage dev msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) (channels dev) @! ()
+sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels)
+sendMessages msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) o channels
 
 withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task ()
 withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStore @! ()
@@ -135,7 +134,7 @@ deviceTaskAcked dev i
 			[{t & ident=i}:ts] [t:ackFirst ts]
 
 deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
-deviceTaskDelete dev task = sendMessage dev [MTTaskDel task.ident]
+deviceTaskDelete dev task = sendMessages [MTTaskDel task.ident] dev @! ()
 
 deviceTaskDeleteAcked :: MTaskDevice Int -> Task ()
 deviceTaskDeleteAcked d i = withDevices d $ deleteTask
diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl
index 0bb6265..1e9294c 100644
--- a/Shares/mTaskShare.icl
+++ b/Shares/mTaskShare.icl
@@ -1,17 +1,29 @@
 implementation module Shares.mTaskShare
 
 import Utils.SDS
+import Utils.Devices
 import iTasks
+import mTask
 from Data.Func import $
 
 manageShares :: [MTaskShare] -> Task ()
 manageShares shares = forever (enterChoice "Choose share to update" [ChooseFromGrid id] shares
 	>&^ \st->whileUnchanged st $ \msh->case msh of
 		Nothing = viewShares shares @! zero
-		Just sh = viewSharedInformation "View value" [] (getSDSStore sh)
-			>>= \_->return sh
+		Just sh = forever (
+				viewSharedInformation "View value" [] (getSDSStore sh)
+			>>* [OnAction (Action "Update") (withValue (Just o updateInformation "New value" []))]
+			>>= updateShare sh
+			)
+			
 	) @! ()
 
+updateShare :: MTaskShare a -> Task MTaskShare | toByteCode a
+updateShare sh=:{withTask,identifier} a = getDeviceByName withTask
+	>>= sendMessages [MTUpd identifier $ toString $ toByteCode a]
+	>>| treturn sh
+
+
 viewShares :: [MTaskShare] -> Task ()
 viewShares sh = anyTask (map viewShare sh) <<@ ArrangeHorizontal @! ()
 
diff --git a/Tasks/Examples.icl b/Tasks/Examples.icl
index 7d872ef..b2a79de 100644
--- a/Tasks/Examples.icl
+++ b/Tasks/Examples.icl
@@ -3,9 +3,10 @@ implementation module Tasks.Examples
 import qualified Data.Map as DM
 import mTask
 
+import Devices.mTaskDevice
 import iTasks._Framework.Serialization
 
-derive class iTask UserLED, Main, ByteCode, Stmt, BC, BCState
+derive class iTask UserLED
 
 countAndLed :: Main (ByteCode () Stmt)
 countAndLed = sds \x=1 In sds \pinnetje=1 In {main =
diff --git a/Tasks/mTaskTask.dcl b/Tasks/mTaskTask.dcl
index ef46243..94bcc8a 100644
--- a/Tasks/mTaskTask.dcl
+++ b/Tasks/mTaskTask.dcl
@@ -1,5 +1,6 @@
 definition module Tasks.mTaskTask
 
+import Devices.mTaskDevice
 import mTask
 import iTasks
 
diff --git a/Utils/Devices.dcl b/Utils/Devices.dcl
new file mode 100644
index 0000000..d816d3f
--- /dev/null
+++ b/Utils/Devices.dcl
@@ -0,0 +1,7 @@
+definition module Utils.Devices
+
+import iTasks
+import Devices.mTaskDevice
+
+getDeviceByName :: String -> Task MTaskDevice
+channels :: MTaskDevice -> Shared Channels
diff --git a/Utils/Devices.icl b/Utils/Devices.icl
new file mode 100644
index 0000000..6a8052e
--- /dev/null
+++ b/Utils/Devices.icl
@@ -0,0 +1,14 @@
+implementation module Utils.Devices
+
+import iTasks
+import mTask
+import Utils.SDS
+import Data.List
+
+getDeviceByName :: String -> Task MTaskDevice
+getDeviceByName nm = get deviceStore @ find (\d->d.deviceChannels == nm)
+	>>= maybe (throw "Help, device not found") treturn
+
+channels :: MTaskDevice -> Shared Channels
+channels d = memoryShare d.deviceChannels ([], [], False)
+
diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl
index 2701fcf..17034be 100644
--- a/mTaskInterpret.dcl
+++ b/mTaskInterpret.dcl
@@ -80,10 +80,16 @@ decode :: String -> MTaskMSGRecv
 instance Semigroup (ByteCode a p)
 instance Monoid (ByteCode a p)
 
+:: BCShare = {
+		sdsi :: Int,
+		sdspub :: Bool,
+		sdsval :: [Char]
+	}
+
 :: BCState = {
 		freshl :: [Int],
 		freshs :: [Int],
-		sdss :: [(Int, [Char])]
+		sdss :: [BCShare]
 	}
 instance zero BCState
 
diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 3f57e7d..acbff39 100644
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -180,9 +180,9 @@ instance digitalIO ByteCode where
 	digitalRead p = retrn [BCDigitalRead $ pin p]
 	digitalWrite p b = b <+-> [BCDigitalWrite $ pin p]
 
-//instance If ByteCode Stmt Stmt Stmt where If b t e = BCIfStmt b t e
-//instance If ByteCode e Stmt Stmt where If b t e = BCIfStmt b t e
-//instance If ByteCode Stmt e Stmt where If b t e = BCIfStmt b t e
+instance If ByteCode Stmt Stmt Stmt where If b t e = BCIfStmt b t e
+instance If ByteCode e Stmt Stmt where If b t e = BCIfStmt b t e
+instance If ByteCode Stmt e Stmt where If b t e = BCIfStmt b t e
 instance If ByteCode x y Stmt where If b t e = BCIfStmt b t e
 instance IF ByteCode where
 	IF b t e = BCIfStmt b t e
@@ -203,7 +203,8 @@ withSDS f = BC \s->let [fresh:fs] = s.freshs
 	in runBC (f fresh) {s & freshs=fs}
 
 setSDS :: Int v -> ByteCode b q | toByteCode v
-setSDS ident val = BC \s->([], {s & sdss = [(ident, toByteCode val):s.sdss]})
+setSDS ident val = BC \s->([], {s & sdss=[
+	{BCShare|sdsi=ident,sdspub=False,sdsval=toByteCode val}:s.sdss]})
 
 instance sds ByteCode where
 	sds f = {main = withSDS \sds->
@@ -211,20 +212,15 @@ instance sds ByteCode where
 			in setSDS sds v <++> unMain body
 		}
 	con f = undef
-	pub x = fmp makePub x
+	pub x = BC \s-> let ((i, bc), s`) = appFst makePub $ runBC x s 
+			in  (bc, {s` & sdss=map (publish i) s`.sdss})
+		where
+			publish i s = if (i == s.sdsi) {s & sdspub=True} s
+			makePub [BCSdsFetch i:xs] = (i, [BCSdsPublish i:xs])
 
 instance assign ByteCode where
 	(=.) v e = e <++> fmp makeStore v
-
-makePub [] = []
-makePub [x:xs] = case x of
-	BCSdsFetch i = [BCSdsPublish i:xs]
-	y = [y:xs]
-
-makeStore [] = []
-makeStore [x:xs] = case x of
-	BCSdsFetch i = [BCSdsStore i:xs]
-	y = [y:xs]
+		where makeStore [BCSdsFetch i:xs] = [BCSdsStore i:xs]
 
 instance seq ByteCode where
 	(>>=.) _ _ = abort "undef on >>=."
@@ -275,7 +271,9 @@ toReadableByteCode x
 = (join "\n" $ map readable (map (implGotos gtmap) bc), st)
 
 toMessages :: MTaskInterval (String, BCState) -> ([MTaskMSGSend], BCState)
-toMessages interval (bytes, st=:{sdss}) = ([MTSds i (toString b)\\(i,b)<-sdss] ++ [MTTask interval bytes], st)
+toMessages interval (bytes, st=:{sdss}) = (
+	[MTSds s.sdsi (toString s.sdsval)\\s<-sdss] ++
+	[MTTask interval bytes], st)
 
 toSDSUpdate :: Int Int -> [MTaskMSGSend]
 toSDSUpdate i v = [MTUpd i (to16bit v)]