3 import StdDebug, StdMisc
4 from StdFunc import flip
9 from Text import class Text(startsWith,concat,split,join), instance Text String
12 import System.Directory
14 import iTasks.UI.Definition
16 import iTasks._Framework.TaskState
17 import iTasks._Framework.TaskServer
18 import iTasks._Framework.IWorld
19 import iTasks._Framework.Store
23 derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize
24 derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP
26 :: SerTCP = Serial | TCP
27 :: *Resource | TTYd !*TTY
29 Start :: *World -> *World
30 Start world = startEngine mTaskTask world
31 //Start world = startEngine mTaskTask world
33 bc :: Main (ByteCode () Stmt)
34 bc = sds \x=1 In sds \pinnetje=1 In {main =
35 IF (digitalRead D3 ==. lit True) (
41 IF (pinnetje ==. lit 1) (
42 digitalWrite D0 (lit True) :.
43 digitalWrite D1 (lit False) :.
44 digitalWrite D2 (lit False)
46 IF (pinnetje ==. lit 2) (
47 digitalWrite D0 (lit False) :.
48 digitalWrite D1 (lit True) :.
49 digitalWrite D2 (lit False)
51 digitalWrite D0 (lit False) :.
52 digitalWrite D1 (lit False) :.
53 digitalWrite D2 (lit True)
57 deviceSelector :: (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task ()
58 deviceSelector ch = enterInformation "Type" []
60 TCP = (enterInformation "Host" [] -&&- enterInformation "Port" [])
61 >>= \(port,host)->syncNetworkChannel host port ch
62 // Serial = accWorld getDevices
63 // >>= \dl->(enterChoice "Device" [] dl -&&- enterInformation "Settings" [])
64 // >>= \(dev,set)->syncSerialChannel dev set decode encode ch
66 getDevices :: !*World -> *(![String], !*World)
67 getDevices w = case readDirectory "/dev" w of
68 (Error (errcode, errmsg), w) = abort errmsg
69 (Ok entries, w) = (map ((+++) "/dev/") (filter isTTY entries), w)
71 isTTY s = not (isEmpty (filter (flip startsWith s) prefixes))
72 prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"]
75 mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in
76 withShared ([], msgs, False) (\ch->
78 // ||- sendTasks msgs ch//sendMsg msgs ch
79 ||- processMessages ch messageShare sdsShares
80 ||- viewSharedInformation "channels" [ViewWith lens] ch
81 ||- viewSharedInformation "messages" [] messageShare
82 ||- viewSh sdsShares ch
83 >>* [OnAction ActionFinish (always shutDown)]
86 messageShare :: Shared [String]
87 messageShare = sharedStore "mTaskMessagesRecv" []
89 processMessages ch msgs sdss = forever (watch ch
90 >>* [OnValue (ifValue (not o isEmpty o fst3) (process ch))])
92 process :: (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> Task ()
93 process ch (r,_,_) = upd (appFst3 (const [])) ch >>| process` r
95 process` = foldr (\r t->updateSDSs sdss msgs r >>| t) (return ())
97 makeMsgs :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)])
99 # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc))
100 = (msgs, map f st.sdss)
102 f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) 0)
104 updateSDSs :: [(Int, Shared Int)] (Shared [String]) MTaskMSGRecv -> Task ()
105 updateSDSs _ m (MTMessage s) = upd (\l->take 20 [s:l]) m @! ()
106 updateSDSs _ _ MTEmpty = return ()
107 updateSDSs [(id, sh):xs] m n=:(MTPub i d)
108 | id == i = set ((toInt d.[0])*265 + toInt d.[1]) sh @! ()
111 lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String])
112 lens (r,s,_) = (map toString r, map toString s)
114 viewSh :: [(Int, Shared Int)] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task ()
115 viewSh [] ch = return ()
116 viewSh [(i, sh):xs] ch
117 # sharename = "SDS-" +++ toString i
119 viewSharedInformation ("SDS-" +++ toString i) [] sh ||-
121 enterInformation sharename []
122 >>* [OnAction ActionOk
123 (ifValue (\j->j>=1 && j <= 3)
125 >>= \_->sendMsg (toSDSUpdate i c) ch
132 sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task ()
133 sendMsg m ch = upd (\(r,s,ss)->(r,s ++ m,True)) ch @! ()
135 syncSerialChannel :: String TTYSettings (String -> m) (n -> String) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
136 syncSerialChannel dev opts decodeFun encodeFun rw = Task eval
138 eval event evalOpts tree=:(TCInit taskId ts) iworld=:{IWorld|world}
139 = case TTYopen dev opts world of
141 # (err, world) = TTYerror world
142 = (ExceptionResult (exception err), {iworld & world=world})
144 # iworld = {iworld & world=world, resources=Just (TTYd tty)}
145 = case addBackgroundTask 42 (BackgroundTask (serialDeviceBackgroundTask rw decodeFun encodeFun)) iworld of
146 (Error e, iworld) = (ExceptionResult (exception "h"), iworld)
147 (Ok _, iworld) = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} NoRep (TCBasic taskId ts JSONNull False), iworld)
149 eval _ _ tree=:(TCBasic _ ts _ _) iworld
150 = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=False} NoRep tree, iworld)
152 eval event evalOpts tree=:(TCDestroy _) iworld=:{IWorld|resources,world}
153 # (TTYd tty) = fromJust resources
154 # (ok, world) = TTYclose tty world
155 # iworld = {iworld & world=world,resources=Nothing}
156 = case removeBackgroundTask 42 iworld of
157 (Error e, iworld) = (ExceptionResult (exception "h"), iworld)
158 (Ok _, iworld) = (DestroyedResult, iworld)
160 serialDeviceBackgroundTask :: (Shared ([m],Bool,[n],Bool)) (String -> m) (n -> String) !*IWorld -> *IWorld
161 serialDeviceBackgroundTask rw de en iworld
162 = case read rw iworld of
163 (Error e, iworld) = abort "share couldn't be read"
164 (Ok (r,rs,s,ss), iworld)
165 # (Just (TTYd tty)) = iworld.resources
166 # tty = writet (map en s) tty
167 # (ml, tty) = case TTYavailable tty of
168 (False, tty) = ([], tty)
170 # (l, tty) = TTYreadline tty
172 # iworld = {iworld & resources=Just (TTYd tty)}
173 = case write (r++ml,rs,[],ss) rw iworld of
174 (Error e, iworld) = abort "share couldn't be written"
175 (Ok _, iworld) = case notify rw iworld of
176 (Error e, iworld) = abort "share couldn't be notified"
177 (Ok _, iworld) = iworld
179 writet :: [String] !*TTY -> *TTY
181 writet [x:xs] t = writet xs (TTYwrite x t)
184 syncNetworkChannel :: String Int (Shared ([MTaskMSGRecv], [MTaskMSGSend], Bool)) -> Task ()
185 syncNetworkChannel server port channel
186 = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()
188 onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
189 onConnect _ (msgs,send,sendStopped)
190 = (Ok "", Just (msgs,[],sendStopped), map encode send, False)
192 whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
193 whileConnected Nothing acc (msgs,send,sendStopped)
194 = (Ok acc, Nothing, [], False)
195 // = (Ok acc, Just (msgs,[],sendStopped), map encode send, False)
197 whileConnected (Just newData) acc (msgs,send,sendStopped)
198 | sendStopped = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
199 = (Ok acc, Just (msgs ++ [decode newData],[],False), [], False)
201 onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
202 onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing)