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

diff --git a/miTask.icl b/miTask.icl
index e5483cc..d483490 100644
--- a/miTask.icl
+++ b/miTask.icl
@@ -1,24 +1,56 @@
 module miTask
 
 import StdDebug, StdMisc
-
-from Text import class Text(concat,join,split), instance Text String
+from StdFunc import flip
 
 import iTasks
 import mTask
 
+from Text import class Text(startsWith,concat,split,join), instance Text String
+
+import Data.Tuple
+import System.Directory
+
+import iTasks.UI.Definition
+
+import iTasks._Framework.TaskState
+import iTasks._Framework.TaskServer
+import iTasks._Framework.IWorld
+import iTasks._Framework.Store
+
+import TTY
+
+derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize
 derive class iTask MTaskMSGRecv, MTaskMSGSend
 
+:: *Resource | TTYd !*TTY
+
 Start :: *World -> *World
-Start world = startEngine (
-	enterInformation "Port Number?" []
-	>>= \port->withShared ([], False, [], False) (mTaskTask port)
-	) world
+Start world = startEngine (withShared ([], False, [], False) mTaskTask) world
 //Start world = startEngine mTaskTask world
+//
+deviceSelectorNetwork :: Task (Int, String)
+deviceSelectorNetwork = enterInformation "Port Number?" []
+	-&&- enterInformation "Network address" []
+
+deviceSelectorSerial :: Task (String, TTYSettings)
+deviceSelectorSerial = accWorld getDevices
+	>>= \dl->(enterChoice "Device" [] dl -&&- deviceSettings)
+	where
+		deviceSettings = updateInformation "Settings" [] zero
 
-mTaskTask :: Int (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task ()
-mTaskTask port ch =
-	syncNetworkChannel "localhost" port "\n" decode encode` ch ||-
+		getDevices :: !*World -> *(![String], !*World)
+		getDevices w = case readDirectory "/dev" w of
+			(Error (errcode, errmsg), w) = abort errmsg
+			(Ok entries, w) = (map ((+++) "/dev/") (filter isTTY entries), w)
+			where
+				isTTY s = not (isEmpty (filter (flip startsWith s) prefixes))
+				prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"]
+
+mTaskTask :: (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task ()
+mTaskTask ch =
+	deviceSelectorNetwork >>= \(p,h)->syncNetworkChannel h p "\n" decode encode` ch ||-
+//	deviceSelectorSerial >>= \(s,set)->syncSerialChannel s set decode` encode` ch ||- 
 	sendMsg msgs ch ||-
 	(
 		(
@@ -32,6 +64,10 @@ mTaskTask port ch =
 		| not (trace_tn (toString (toJSON m))) = undef
 		= encode m
 
+		decode` m
+		| not (trace_tn (toString (toJSON m))) = undef
+		= decode m
+
 		messageShare :: Shared [String]
 		messageShare = sharedStore "mTaskMessagesRecv" []
 
@@ -73,11 +109,11 @@ mTaskTask port ch =
 
 		sdsShares = makeShares st
 
-		(msgs, st) = toMessages 500 (toRealByteCode (unMain bc))
+		(msgs, st) = toMessages 1000 (toRealByteCode (unMain bc))
 
 		bc :: Main (ByteCode () Stmt)
 		bc = sds \x=1 In sds \pinnetje=1 In {main =
-				x =. x +. lit 1 :.
+				x =. x +. pinnetje :.
 				pub x :.
 				IF (pinnetje ==. lit 1) (
 					analogWrite A0 (lit 1) :.
@@ -103,11 +139,55 @@ mTaskTask port ch =
 makeShares :: BCState -> [(Int, Shared Int)]
 makeShares {sdss=[]} = []
 makeShares s=:{sdss=[(i,d):xs]} =
-	[(i, sharedStore ("mTaskSDS-" +++ toString i) 0):makeShares {s & sdss=xs}]
+	[(i, sharedStore ("mTaskSDS-" +++ toString i) 1):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 @! ()
 
+syncSerialChannel :: String TTYSettings (String -> m) (n -> String) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
+syncSerialChannel dev opts decodeFun encodeFun rw = Task eval
+	where
+		eval event evalOpts tree=:(TCInit taskId ts) iworld=:{IWorld|world}
+		= case TTYopen dev opts world of
+			(False, _, world)
+			# (err, world) = TTYerror world
+			= (ExceptionResult (exception err), {iworld & world=world})
+			(True, tty, world)
+			# iworld = {iworld & world=world, resources=Just (TTYd tty)}
+			= case addBackgroundTask 42 (BackgroundTask (serialDeviceBackgroundTask rw decodeFun encodeFun)) iworld of
+				(Error e, iworld) = (ExceptionResult (exception "h"), iworld)
+				(Ok _, iworld) = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} NoRep (TCBasic taskId ts JSONNull False), iworld)
+
+		eval _ _ tree=:(TCBasic _ ts _ _) iworld
+		= (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=False} NoRep tree, iworld)
+
+		eval event evalOpts tree=:(TCDestroy _) iworld=:{IWorld|resources,world}
+		# (TTYd tty) = fromJust resources
+		# (ok, world) = TTYclose tty world
+		# iworld = {iworld & world=world,resources=Nothing}
+		= case removeBackgroundTask  42 iworld of
+			(Error e, iworld) = (ExceptionResult (exception "h"), iworld)
+			(Ok _, iworld) = (DestroyedResult, iworld)
+
+serialDeviceBackgroundTask :: (Shared ([m],Bool,[n],Bool)) (String -> m) (n -> String) !*IWorld -> *IWorld
+serialDeviceBackgroundTask rw en de iworld
+	= case read rw iworld of
+		(Error e, iworld) = iworld
+		(Ok (r,rs,s,ss), iworld)
+		# (Just (TTYd tty)) = iworld.resources
+		# tty = writet (map de s) tty
+		= case TTYavailable tty of
+			(False, tty) = {iworld & resources=Just (TTYd tty)}
+			(_, tty)
+			# (l, tty) = appFst en (TTYreadline tty)
+			# iworld = {iworld & resources=Just (TTYd tty)}
+			= snd (write (r ++ [l],rs,[],ss) rw iworld)
+	where
+		writet :: [String] !*TTY -> *TTY
+		writet [] t = t
+		writet [x:xs] t = writet xs (TTYwrite t x)
+
+
 syncNetworkChannel :: String Int String (String -> m) (n -> String) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
 syncNetworkChannel server port msgSeparator decodeFun encodeFun channel
 	= tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()