- f [] = []
- f [MTEmpty:xs] = f xs
- f [x:xs] = [toString x:f xs]
-
- 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
-
- (msgs, st) = toMessages 1000 (toRealByteCode (unMain bc))
-
- bc :: Main (ByteCode () Stmt)
- bc = sds \x=1 In sds \pinnetje=1 In {main =
- x =. x +. pinnetje :.
- pub x :.
- digitalWrite D0 (lit False) :.
- digitalWrite D1 (lit False) :.
- digitalWrite D2 (lit False) :.
- IF (pinnetje ==. lit 1) (
- digitalWrite D0 (lit True)
- ) (
- IF (pinnetje ==. lit 2) (
- digitalWrite D1 (lit True)
- ) (
- digitalWrite D2 (lit True)
- )
- )}
-// 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) 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 de en iworld
- = case read rw iworld of
- (Error e, iworld) = abort "share couldn't be read"
- (Ok (r,rs,s,ss), iworld)
- # (Just (TTYd tty)) = iworld.resources
- # tty = writet (map en s) tty
- # (ml, tty) = case TTYavailable tty of
- (False, tty) = ([], tty)
- (_, tty)
- # (l, tty) = TTYreadline tty
- = ([de l], tty)
- # iworld = {iworld & resources=Just (TTYd tty)}
- = case write (r++ml,rs,[],ss) rw iworld of
- (Error e, iworld) = abort "share couldn't be written"
- (Ok _, iworld) = case notify rw iworld of
- (Error e, iworld) = abort "share couldn't be notified"
- (Ok _, iworld) = iworld
+ viewer :: MTaskShare -> Task ()
+ viewer m = viewSharedInformation "" [] (getSDSStore m)
+ <<@ Title ("SDS: " +++ toString m.identifier) @! ()
+// enterChoiceWithShared "Shares" [ChooseFromList id] sdsStore
+// >>* [OnValue $ withValue $ Just o updateShare]
+// >>* [OnAction (Action "Back") (const $ Just $ treturn ())]
+// where
+// sdsvw (k, v) = concat ["SDS ", toString k, ": ", toString v]
+// updateShare s = viewInformation "" [] ()
+// updateShare (k, v) = (viewInformation "Key" [] k
+// ||- updateInformation "Value" [] v)
+
+
+// addDevice :: (Shared [MTaskDevice]) -> Task SerTCP
+// addDevice devices = enterInformation "Device type" []
+// >&^ \sh->whileUnchanged sh $ \mty->case mty of
+// Nothing = viewInformation "No type selected yet" [] "" @! ()
+// Just ty = case ty of
+// TCPDevice = (enterInformation "Name" [] -&&- enterInformation "Hostname" [] -&&- enterInformation "Port" [])
+// >>= \(name, (host, port))->cont name (syncNetworkChannel host port)
+// SerialDevice = (enterInformation "Name" [] -&&- enterTTYSettings)
+// >>= \(name, set)->cont name (syncSerialChannel set encode decode)
+// where
+// cont :: String ((Shared Channels) -> Task ()) -> Task ()
+// cont name synfun = get randomInt
+// @ (\randint->{deviceChannels=name +++ toString randint, deviceName=name, deviceTasks=[], deviceTask=Nothing})
+// >>= \dev->appendTopLevelTask 'DM'.newMap True (let ch = channels dev in process ch -||- synfun ch)
+// >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
+// @! ()
+
+ process :: (Shared Channels) -> Task ()
+ process ch = forever (watch ch >>* [OnValue (
+ ifValue (not o isEmpty o fst3)
+ (\t->upd (appFst3 (const [])) ch >>| process (fst3 t)))])
+ where
+ process :: [MTaskMSGRecv] -> Task ()
+ process [] = treturn ()
+ process [m:ms] = (case m of
+ MTTaskAck i = traceValue (toString m) @! ()
+ MTTaskDelAck i = traceValue (toString m) @! ()
+ MTSDSAck i = traceValue (toString m) @! ()
+ MTSDSDelAck i = traceValue (toString m) @! ()
+ MTPub i val = getSDSRecord i >>= set (toInt val.[0]*256 + toInt val.[1]) o getSDSStore @! ()
+ MTMessage val = traceValue (toString m) @! ()
+ MTEmpty = treturn ()
+ ) >>| process ms
+
+ deviceviewer :: [MTaskDevice] -> [MTaskDeviceStatus]
+ deviceviewer ds = [{MTaskDeviceStatus | name = d.deviceName,
+ connected = if (isNothing d.deviceTask) False True,
+ tasks = [s +++ toString i\\(s, i)<-d.deviceTasks]}\\d<-ds]
+
+ mapPar :: (a -> Task a) [a] -> Task ()
+ mapPar f l = foldr1 (\x y->f x ||- y) l <<@ ArrangeWithTabs @! ()
+ allAtOnce t = foldr1 (||-) t @! ()
+ //allAtOnce = (flip (@!) ()) o foldr1 (||-)
+
+sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task ()
+sendMsg m ch = upd (\(r,s,ss)->(r,s ++ m,True)) ch @! ()
+
+syncNetworkChannel :: String Int (Shared ([MTaskMSGRecv], [MTaskMSGSend], Bool)) -> Task ()
+syncNetworkChannel server port channel = catchAll
+ (tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ())
+ (\v->traceValue v @! ())