X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=miTask.icl;h=e5483ccad3eccec4adcf49f236dab682e845a0c7;hb=ddfd196fa4999b117701121a2f4cb1fe378f902d;hp=ab37901f54abd219f453353f0c113c478792af37;hpb=7edf1780ae3b91d9136db2d94b25e88d64896645;p=mTask.git

diff --git a/miTask.icl b/miTask.icl
index ab37901..e5483cc 100644
--- a/miTask.icl
+++ b/miTask.icl
@@ -3,41 +3,109 @@ module miTask
 import StdDebug, StdMisc
 
 from Text import class Text(concat,join,split), instance Text String
-from Control.Monad import mapM
 
 import iTasks
 import mTask
 
-derive class iTask MTaskMessage
+derive class iTask MTaskMSGRecv, MTaskMSGSend
 
 Start :: *World -> *World
 Start world = startEngine (
-	withShared ([], False, [], False) (\ch->
-		enterInformation "Port Number?" [] >>= \port->mTaskTask port ch
-	)) world
+	enterInformation "Port Number?" []
+	>>= \port->withShared ([], False, [], False) (mTaskTask port)
+	) world
 //Start world = startEngine mTaskTask world
 
-mTaskTask :: Int (Shared ([MTaskMessage],Bool,[MTaskMessage],Bool)) -> Task ()
+mTaskTask :: Int (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task ()
 mTaskTask port ch =
-	syncNetworkChannel "localhost" port "\n" decode encode ch ||-
+	syncNetworkChannel "localhost" port "\n" decode encode` ch ||-
+	sendMsg msgs ch ||-
 	(
-		sendMsg msgs ch >>= \_->
-		viewSharedInformation "channels" [ViewWith lens] ch @! ()
-	) >>* [OnAction ActionFinish (always shutDown)]
+		(
+			consumeNetworkStream (processSDSs sdsShares messageShare) ch ||-
+			viewSharedInformation "channels" [ViewWith lens] ch ||-
+			viewSh sdsShares ch
+		) >>* [OnAction ActionFinish (always shutDown)]
+	)
 	where
-		lens :: ([MTaskMessage],Bool,[MTaskMessage],Bool) -> ([String], [String])
-		lens (r,_,s,_) = (f r, f s)
+		encode` m
+		| not (trace_tn (toString (toJSON m))) = undef
+		= encode m
+
+		messageShare :: Shared [String]
+		messageShare = sharedStore "mTaskMessagesRecv" []
+
+		processSDSs :: [(Int, Shared Int)] (Shared [String]) [MTaskMSGRecv] -> Task ()
+		processSDSs _ _ [] = return ()
+		processSDSs s y [x:xs] = updateSDSs s y x >>= \_->processSDSs s y xs
+
+		updateSDSs :: [(Int, Shared Int)] (Shared [String]) MTaskMSGRecv -> Task ()
+		updateSDSs _ m (MTMessage s) = upd (\l->[s:l]) m @! ()
+		updateSDSs _ _ MTEmpty = return ()
+		updateSDSs [(id, sh):xs] m n=:(MTPub i d)
+		| id == i = set ((toInt d.[0])*265 + toInt d.[1]) sh @! ()
+		= updateSDSs xs m n
+
+		lens :: ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool) -> ([String], [String])
+		lens (r,_,s,_) = (f r, map toString s)
 			where
 				f [] = []
 				f [MTEmpty:xs] = f xs
 				f [x:xs] = [toString x:f xs]
 
-		msgs = toMessages 500 (toRealByteCode (unMain bc))
+		viewSh :: [(Int, Shared Int)] (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task ()
+		viewSh [] ch = return ()
+		viewSh [(i, sh):xs] ch
+		# sharename = "SDS-" +++ toString i
+		= (
+				viewSharedInformation ("SDS-" +++ toString i) [] sh ||-
+				forever (
+					enterInformation sharename []
+					>>* [OnAction ActionOk 
+							(ifValue (\j->j>=1 && j <= 3) 
+							(\c->set c sh
+								>>= \_->sendMsg (toSDSUpdate i c) ch
+								@! ()
+							)
+						)]
+				)
+			) ||- viewSh xs ch
+
+		sdsShares = makeShares st
 
-		bc :: Main (ByteCode Int Stmt)
-		bc = sds \x=0 In {main = x =. x +. lit 1 :. pub x}
+		(msgs, st) = toMessages 500 (toRealByteCode (unMain bc))
 
-sendMsg :: [MTaskMessage] (Shared ([MTaskMessage],Bool,[MTaskMessage],Bool)) -> Task ()
+		bc :: Main (ByteCode () Stmt)
+		bc = sds \x=1 In sds \pinnetje=1 In {main =
+				x =. x +. lit 1 :.
+				pub x :.
+				IF (pinnetje ==. lit 1) (
+					analogWrite A0 (lit 1) :.
+					analogWrite A1 (lit 0) :.
+					analogWrite A2 (lit 0)
+				) (
+					IF (pinnetje ==. lit 2) (
+						analogWrite A0 (lit 0) :.
+						analogWrite A1 (lit 1) :.
+						analogWrite A2 (lit 0)
+					) (
+						analogWrite A0 (lit 0):.
+						analogWrite A1 (lit 0):.
+						analogWrite A2 (lit 1)
+					)
+				)}
+//		bc :: Main (ByteCode Int Stmt)
+//		bc = sds \x=1 In {main =
+//			If (x ==. lit 3)
+//			(x =. lit 1)
+//			(x =. x +. lit 1) :. pub x}
+
+makeShares :: BCState -> [(Int, Shared Int)]
+makeShares {sdss=[]} = []
+makeShares s=:{sdss=[(i,d):xs]} =
+	[(i, sharedStore ("mTaskSDS-" +++ toString i) 0):makeShares {s & sdss=xs}]
+
+sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task ()
 sendMsg m ch = upd (\(r,rs,s,ss)->(r,rs,s ++ m,ss)) ch @! ()
 
 syncNetworkChannel :: String Int String (String -> m) (n -> String) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
@@ -58,17 +126,17 @@ syncNetworkChannel server port msgSeparator decodeFun encodeFun channel
 		onDisconnect l (received,receiveStopped,send,sendStopped)
 			= (Ok l,Just (received,True,send,sendStopped))
 
-//consumeNetworkStream :: ([m] -> Task ()) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
-//consumeNetworkStream processTask channel
-//	= ((watch channel >>* [OnValue (ifValue ifProcess process)]) <! id) @! ()
-//	where
-//		ifProcess (received,receiveStopped,_,_)
-//			= receiveStopped || (not (isEmpty received))
-//
-//		process (received,receiveStopped,_,_)
-//			=   upd empty channel
-//			>>| if (isEmpty received) (return ()) (processTask received)
-//			@!  receiveStopped
-//		
-//		empty :: ([m],Bool,[m],Bool) -> ([m],Bool,[m],Bool)
-//		empty (_,rs,s,ss) = ([],rs,s,ss)
+consumeNetworkStream :: ([m] -> Task ()) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
+consumeNetworkStream processTask channel
+	= ((watch channel >>* [OnValue (ifValue ifProcess process)]) <! id) @! ()
+	where
+		ifProcess (received,receiveStopped,_,_)
+			= receiveStopped || (not (isEmpty received))
+
+		process (received,receiveStopped,_,_)
+			=   upd empty channel
+			>>| if (isEmpty received) (return ()) (processTask received)
+			@!  receiveStopped
+		
+		empty :: ([m],Bool,[n],Bool) -> ([m],Bool,[n],Bool)
+		empty (_,rs,s,ss) = ([],rs,s,ss)