- process` = foldr (\r t->updateSDSs sdss msgs r >>| t) (return ())
-
- makeMsgs :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)])
- makeMsgs timeout bc
- # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc))
- = (msgs, map f st.sdss)
- where
- f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d))
- dd [x,y] = toInt x*265 + toInt y
-
- updateSDSs :: [(Int, Shared Int)] (Shared [String]) MTaskMSGRecv -> Task ()
- updateSDSs [(id, sh):xs] m n=:(MTPub i d)
- | id == i = set ((toInt d.[0])*265 + toInt d.[1]) sh @! ()
- = updateSDSs xs m n
- updateSDSs _ m mtm = case mtm of
- MTMessage s = upd (\l->take 20 [s:l]) m @! ()
- mta=:(MTTaskAdded _) = upd (\l->take 20 [toString mta:l]) m @! ()
- _ = return ()
-
- lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String])
- lens (r,s,_) = (map toString r, map toString s)
-
- viewSh :: [(Int, Shared Int)] (Shared ([MTaskMSGRecv],[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
+ createBytecode st = toMessages timeout $ toRealByteCode (unMain $ fromJust ('DM'.get mTask mTaskMap)) st
+ sharename i = device.deviceChannels +++ "-" +++ toString i
+ toSDSRecords st = [{MTaskShare |
+ initValue=toInt d1*265 + toInt d2,
+ withTask=mTask,
+ identifier=i,
+ realShare="mTaskSDS-" +++ toString i}
+ \\(i,[d1,d2])<-st.sdss]
+ makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
+
+ getSDSStore :: MTaskShare -> Shared Int
+ getSDSStore sh = memoryShare sh.realShare 0
+
+ getSDSRecord :: Int -> Task MTaskShare
+ getSDSRecord i = get sdsStore @ \l->hd [s\\s<-l | s.identifier == i]
+
+ viewShares :: [MTaskShare] -> Task ()
+ viewShares st = anyTask $ map viewer st
+ where
+ 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 (||-)