miTask.icl

   1 module miTask
   2
   3 import StdDebug, StdMisc
   4 from StdFunc import flip
   5
   6 import iTasks
   7 import mTask
   8 import Devices.mTaskDevice
   9 import Shares.mTaskShare
  10 import Utils.SDS
  11
  12 from Text import class Text(startsWith,concat,split,join), instance Text String
  13
  14 import qualified Data.Map as DM
  15
  16 from Data.Func import $
  17 import Data.Tuple
  18 import Data.List
  19 import System.Directory
  20
  21 import iTasks._Framework.Store
  22
  23 import TTY, iTasksTTY
  24
  25 derive class iTask UserLED
  26
  27 Start :: *World -> *World
  28 Start world = startEngine (mTaskManager
  29         >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world
  30
  31 mTaskMap :: Map String (Main (ByteCode () Stmt))
  32 mTaskMap = 'DM'.fromList [("count", bc), ("ledon", bc2 LED1), ("ledoff", bc3 LED3)]
  33
  34 bc :: Main (ByteCode () Stmt)
  35 bc = sds \x=1 In sds \pinnetje=1 In {main =
  36                 IF (digitalRead D3) (
  37                         x =. x +. lit 1 :.
  38                         pub x
  39                 ) (
  40                         noOp
  41                 ) :.
  42                 IF (pinnetje ==. lit 1) (
  43                         ledOn LED1
  44                 ) (
  45                         IF (pinnetje ==. lit 2) (
  46                                 ledOn LED2
  47                         ) (
  48                                 ledOn LED3
  49                         )
  50                 )}
  51
  52 bc2 :: UserLED -> Main (ByteCode () Stmt)
  53 bc2 d = {main = ledOn d}
  54
  55 bc3 :: UserLED -> Main (ByteCode () Stmt)
  56 bc3 d = {main = ledOff d}
  57
  58 mTaskManager :: Task ()
  59 mTaskManager = anyTask
  60                 [ viewmTasks @! ()
  61                 , whileUnchanged sdsStore viewShares
  62                 , whileUnchanged deviceStore $ manageDevices process
  63                 ] <<@ ApplyLayout layout
  64         where
  65                 layout = sequenceLayouts
  66                         [ arrangeWithSideBar 0 LeftSide 260 True
  67                         , arrangeSplit Vertical True
  68                         ]
  69
  70                 viewmTasks = listmTasks
  71                         >&^ \sh->whileUnchanged sh $ \mi->forever (case mi of
  72                                 Nothing = viewInformation "No task selected" [] ()
  73                                 Just mTaskTask = get deviceStore
  74                                         >>= \devices->case devices of
  75                                                 [] = viewInformation "No devices yet" [] ()
  76                                                 ds = sendmTask mTaskTask ds @! ())
  77                         where
  78                                 listmTasks :: Task String
  79                                 listmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore
  80
  81                                 sendmTask mTaskId ds =
  82                                                 (enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds
  83                                                 -&&- enterInformation "Timeout, 0 for one-shot" [])
  84                                         >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskMap mTaskId)]
  85
  86                 process :: MTaskDevice (Shared Channels) -> Task ()
  87                 process device ch = forever (watch ch >>* [OnValue (
  88                                 ifValue (not o isEmpty o fst3)
  89                                 (\t->upd (appFst3 (const [])) ch >>| proc (fst3 t)))])
  90                         where
  91                                 proc :: [MTaskMSGRecv] -> Task ()
  92                                 proc [] = treturn ()
  93                                 proc [m:ms] = (case m of
  94 //                                      MTSDSAck i = traceValue (toString m) @! ()
  95 //                                      MTSDSDelAck i = traceValue (toString m) @! ()
  96                                         MTPub i val = getSDSRecord i >>= set (toInt val.[0]*256 + toInt val.[1]) o getSDSStore @! ()
  97                                         MTTaskAck i = deviceTaskAcked device i
  98                                         MTTaskDelAck i = deviceTaskDeleteAcked device i @! ()
  99                                         MTEmpty = treturn ()
 100                                         _ = traceValue (toString m) @! ()
 101                                         ) >>| proc ms
 102
 103                 mapPar :: (a -> Task a) [a] -> Task ()
 104                 mapPar f l = foldr1 (\x y->f x ||- y) l <<@ ArrangeWithTabs @! ()
 105                 allAtOnce t = foldr1 (||-) t @! ()
 106                 //allAtOnce = (flip (@!) ()) o foldr1 (||-)