3 import StdDebug, StdMisc
5 from Text import class Text(concat,join,split), instance Text String
10 derive class iTask MTaskMessage
12 Start :: *World -> *World
13 Start world = startEngine (withShared ([], False, [], False) mTaskTask) world
14 //Start world = startEngine mTaskTask world
16 mTaskTask :: (Shared ([MTaskMessage],Bool,[MTaskMessage],Bool)) -> Task ()
18 syncNetworkChannel "localhost" 8124 "\n" decode encode ch ||-
20 sendMsg (hd msgs) ch >>= \_->
21 sendMsg (hd (tl msgs)) ch >>= \_->
22 viewSharedInformation "channels" [ViewWith lens] ch @! ()
25 lens :: ([MTaskMessage],Bool,[MTaskMessage],Bool) -> ([String], [String])
26 lens (r,_,s,_) = (map toString r, map toString s)
28 msgs = toMessages 500 (toRealByteCode (unMain bc))
30 bc :: Main (ByteCode Int Expr)
31 bc = sds \x=0 In {main = x =. x +. lit 1}
33 makemTask :: Int (Main (ByteCode a Expr)) -> String
35 # (bc, st) = toRealByteCode (unMain bc)
36 = "t" +++ toString (toChar (to / 265))
37 +++ toString (toChar (to rem 265)) +++ toString bc +++ "\n"
39 sendMsg :: MTaskMessage (Shared ([MTaskMessage],Bool,[MTaskMessage],Bool)) -> Task ()
41 | not (trace_tn ("\'" +++ toString m +++ "\'")) = undef
42 = upd (\(r,rs,s,ss)->(r,rs,s ++ [m],ss)) ch @! ()
44 syncNetworkChannel :: String Int String (String -> m) (m -> String) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m
45 syncNetworkChannel server port msgSeparator decodeFun encodeFun channel
46 = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()
48 onConnect _ (received,receiveStopped,send,sendStopped)
49 = (Ok "",if (not (isEmpty send)) (Just (received,False,[],sendStopped)) Nothing, map encodeFun send,False)
50 whileConnected Nothing acc (received,receiveStopped,send,sendStopped)
51 = (Ok acc, Nothing, [], False)
52 whileConnected (Just newData) acc (received,receiveStopped,send,sendStopped)
53 # [acc:msgs] = reverse (split msgSeparator (concat [acc,newData]))
54 # write = if (not (isEmpty msgs && isEmpty send))
55 (Just (received ++ map decodeFun (reverse msgs),receiveStopped,[],sendStopped))
57 = (Ok acc,write,map encodeFun send,False)
59 onDisconnect l (received,receiveStopped,send,sendStopped)
60 = (Ok l,Just (received,True,send,sendStopped))
62 consumeNetworkStream :: ([m] -> Task ()) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m
63 consumeNetworkStream processTask channel
64 = ((watch channel >>* [OnValue (ifValue ifProcess process)]) <! id) @! ()
66 ifProcess (received,receiveStopped,_,_)
67 = receiveStopped || (not (isEmpty received))
69 process (received,receiveStopped,_,_)
71 >>| if (isEmpty received) (return ()) (processTask received)
74 empty :: ([m],Bool,[m],Bool) -> ([m],Bool,[m],Bool)
75 empty (_,rs,s,ss) = ([],rs,s,ss)