miTask.icl

   1 module miTask
   2
   3 import StdDebug, StdMisc
   4
   5 from Text import class Text(concat,join,split), instance Text String
   6
   7 import iTasks
   8 import mTask
   9
  10 derive class iTask MTaskMSGRecv, MTaskMSGSend
  11
  12 Start :: *World -> *World
  13 Start world = startEngine (
  14         enterInformation "Port Number?" []
  15         >>= \port->withShared ([], False, [], False) (mTaskTask port)
  16         ) world
  17 //Start world = startEngine mTaskTask world
  18
  19 mTaskTask :: Int (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task ()
  20 mTaskTask port ch =
  21         syncNetworkChannel "localhost" port "\n" decode encode` ch ||-
  22         sendMsg msgs ch ||-
  23         (
  24                 (
  25                         consumeNetworkStream (processSDSs sdsShares messageShare) ch ||-
  26                         viewSharedInformation "channels" [ViewWith lens] ch ||-
  27                         viewSh sdsShares ch
  28                 ) >>* [OnAction ActionFinish (always shutDown)]
  29         )
  30         where
  31                 encode` m
  32                 | not (trace_tn (toString (toJSON m))) = undef
  33                 = encode m
  34
  35                 messageShare :: Shared [String]
  36                 messageShare = sharedStore "mTaskMessagesRecv" []
  37
  38                 processSDSs :: [(Int, Shared Int)] (Shared [String]) [MTaskMSGRecv] -> Task ()
  39                 processSDSs _ _ [] = return ()
  40                 processSDSs s y [x:xs] = updateSDSs s y x >>= \_->processSDSs s y xs
  41
  42                 updateSDSs :: [(Int, Shared Int)] (Shared [String]) MTaskMSGRecv -> Task ()
  43                 updateSDSs _ m (MTMessage s) = upd (\l->[s:l]) m @! ()
  44                 updateSDSs _ _ MTEmpty = return ()
  45                 updateSDSs [(id, sh):xs] m n=:(MTPub i d)
  46                 | id == i = set ((toInt d.[0])*265 + toInt d.[1]) sh @! ()
  47                 = updateSDSs xs m n
  48
  49                 lens :: ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool) -> ([String], [String])
  50                 lens (r,_,s,_) = (f r, map toString s)
  51                         where
  52                                 f [] = []
  53                                 f [MTEmpty:xs] = f xs
  54                                 f [x:xs] = [toString x:f xs]
  55
  56                 viewSh :: [(Int, Shared Int)] (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task ()
  57                 viewSh [] ch = return ()
  58                 viewSh [(i, sh):xs] ch
  59                 # sharename = "SDS-" +++ toString i
  60                 = (
  61                                 viewSharedInformation ("SDS-" +++ toString i) [] sh ||-
  62                                 forever (
  63                                         enterInformation sharename []
  64                                         >>* [OnAction ActionOk
  65                                                         (ifValue (\j->j>=1 && j <= 3)
  66                                                         (\c->set c sh
  67                                                                 >>= \_->sendMsg (toSDSUpdate i c) ch
  68                                                                 @! ()
  69                                                         )
  70                                                 )]
  71                                 )
  72                         ) ||- viewSh xs ch
  73
  74                 sdsShares = makeShares st
  75
  76                 (msgs, st) = toMessages 500 (toRealByteCode (unMain bc))
  77
  78                 bc :: Main (ByteCode () Stmt)
  79                 bc = sds \x=1 In sds \pinnetje=1 In {main =
  80                                 x =. x +. lit 1 :.
  81                                 pub x :.
  82                                 IF (pinnetje ==. lit 1) (
  83                                         analogWrite A0 (lit 1) :.
  84                                         analogWrite A1 (lit 0) :.
  85                                         analogWrite A2 (lit 0)
  86                                 ) (
  87                                         IF (pinnetje ==. lit 2) (
  88                                                 analogWrite A0 (lit 0) :.
  89                                                 analogWrite A1 (lit 1) :.
  90                                                 analogWrite A2 (lit 0)
  91                                         ) (
  92                                                 analogWrite A0 (lit 0):.
  93                                                 analogWrite A1 (lit 0):.
  94                                                 analogWrite A2 (lit 1)
  95                                         )
  96                                 )}
  97 //              bc :: Main (ByteCode Int Stmt)
  98 //              bc = sds \x=1 In {main =
  99 //                      If (x ==. lit 3)
 100 //                      (x =. lit 1)
 101 //                      (x =. x +. lit 1) :. pub x}
 102
 103 makeShares :: BCState -> [(Int, Shared Int)]
 104 makeShares {sdss=[]} = []
 105 makeShares s=:{sdss=[(i,d):xs]} =
 106         [(i, sharedStore ("mTaskSDS-" +++ toString i) 0):makeShares {s & sdss=xs}]
 107
 108 sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task ()
 109 sendMsg m ch = upd (\(r,rs,s,ss)->(r,rs,s ++ m,ss)) ch @! ()
 110
 111 syncNetworkChannel :: String Int String (String -> m) (n -> String) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
 112 syncNetworkChannel server port msgSeparator decodeFun encodeFun channel
 113         = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()
 114         where
 115                 onConnect _ (received,receiveStopped,send,sendStopped)
 116                         = (Ok "",if (not (isEmpty send)) (Just (received,False,[],sendStopped)) Nothing, map encodeFun send,False)
 117                 whileConnected Nothing acc (received,receiveStopped,send,sendStopped)
 118                         = (Ok acc, Nothing, [], False)
 119                 whileConnected (Just newData) acc (received,receiveStopped,send,sendStopped)
 120                 # [acc:msgs] = reverse (split msgSeparator (concat [acc,newData]))
 121                 # write = if (not (isEmpty msgs && isEmpty send))
 122                         (Just (received ++ map decodeFun (reverse msgs),receiveStopped,[],sendStopped))
 123                         Nothing
 124                 = (Ok acc,write,map encodeFun send,False)
 125
 126                 onDisconnect l (received,receiveStopped,send,sendStopped)
 127                         = (Ok l,Just (received,True,send,sendStopped))
 128
 129 consumeNetworkStream :: ([m] -> Task ()) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
 130 consumeNetworkStream processTask channel
 131         = ((watch channel >>* [OnValue (ifValue ifProcess process)]) <! id) @! ()
 132         where
 133                 ifProcess (received,receiveStopped,_,_)
 134                         = receiveStopped || (not (isEmpty received))
 135
 136                 process (received,receiveStopped,_,_)
 137                         =   upd empty channel
 138                         >>| if (isEmpty received) (return ()) (processTask received)
 139                         @!  receiveStopped
 140
 141                 empty :: ([m],Bool,[n],Bool) -> ([m],Bool,[n],Bool)
 142                 empty (_,rs,s,ss) = ([],rs,s,ss)