implementation module mTaskSimulation
+import Generics.gdynamic
+import Generics.gCons
+
import iTasks
-import gdynamic, gCons, GenEq, StdMisc, StdArray
+import GenEq, StdMisc, StdArray
import mTask
+derive class iTask Display
eval :: (Main (Eval t p)) -> [String] | toString t
eval {main=(E f)} = [toString (fst (f Rd zero))]
-:: State =
- { tasks :: [(Int, State->State)]
+:: State` =
+ { tasks :: [(Int, State`->State`)]
, store :: [Dyn]
, dpins :: [(DigitalPin, Bool)]
, apins :: [(AnalogPin, Int)]
, millis:: Int
}
-instance zero State where
+instance zero State` where
zero = {store = [], tasks = [], serial = [], millis = 0, dpins = [] , apins = []}
-//:: TaskSim :== (Int, State->State)
-:: Eval t p = E ((ReadWrite t) State -> (t, State))
-toS2S :: (Eval t p) -> (State->State)
+//:: TaskSim :== (Int, State`->State`)
+:: Eval t p = E ((ReadWrite t) State` -> (t, State`))
+toS2S :: (Eval t p) -> (State`->State`)
toS2S (E f) = \state.snd (f Rd state)
-unEval :: (Eval t p) -> ((ReadWrite t) State -> (t, State))
+unEval :: (Eval t p) -> ((ReadWrite t) State` -> (t, State`))
unEval (E f) = f
:: ReadWrite t = Rd | Wrt t | Updt (t->t)
instance sds Eval where
sds f = defEval f
con f = defEval f
+ pub _ = undef
defEval :: ((Eval t p)->In t (Main (Eval u q))) -> (Main (Eval u q)) | dyn t
defEval f =
[] = 0
[a:x] = a
-writePinA :: AnalogPin Int State -> State
+writePinA :: AnalogPin Int State` -> State`
writePinA p x s
= {s & apins = [(p, x):[(q, y) \\ (q, y) <- s.apins | p <> q]]}
= case [b \\ (q,b) <- lista | p == q] of
[] = False
[a:x] = a <> 0
-class writePinD p :: p Bool State -> State
+class writePinD p :: p Bool State` -> State`
instance writePinD DigitalPin where
writePinD p b s=:{dpins} = {s & dpins = [(p, b):[(q, c) \\ (q, c) <- dpins | p <> q]]}
instance writePinD AnalogPin where
// ----- Interactive Simulation ----- //
-derive class iTask DigitalPin, AnalogPin, Dyn, StateInterface, DisplayVar, Pin
+derive class iTask StateInterface, DisplayVar
simulate :: (Main (Eval a p)) -> Task ()
simulate {main=(E f)} = setup zero where
setup s =
- updateInformation "State" [] (toView s)
- >>* [ OnAction ActionFinish (always shutDown)
- , OnAction (Action "setup" []) (hasValue
- (\si.simloop (snd (f Rd (mergeView s si)))))
- ]
+ updateInformation "State" [] (toView s) @! ()
+// >>* [ OnAction ActionFinish (always shutDown)
+// , OnAction (Action "setup" []) (hasValue
+// (\si.simloop (snd (f Rd (mergeView s si)))))
+// ]
simloop s =
- updateInformation "State" [] (toView s)
- >>* [ OnAction ActionFinish (always shutDown)
- , OnAction (Action "clear serial" []) (always (simloop {s & serial = []}))
- , OnAction ActionNew (always (setup zero))
- : if (isEmpty s.tasks)
- []
- [OnAction (Action "loop" []) (hasValue
- \si.simloop (step` (mergeView s si)))
- ]
- ]
-
-toView :: State -> StateInterface
+ updateInformation "State" [] (toView s) @!()
+// >>* [ OnAction ActionFinish (always shutDown)
+// , OnAction (Action "clear serial" []) (always (simloop {s & serial = []}))
+// , OnAction ActionNew (always (setup zero))
+// : if (isEmpty s.tasks)
+// []
+// [OnAction (Action "loop" []) (hasValue
+// \si.simloop (step` (mergeView s si)))
+// ]
+// ]
+
+toView :: State` -> StateInterface
toView s =
{ serialOut = Display s.serial
, analogPins = s.apins
, taskCount = Display (length s.tasks)
}
-mergeView :: State StateInterface -> State
+mergeView :: State` StateInterface -> State`
mergeView s si =
{ s
& store = [fromDisplayVar new old \\ new <- si.var2iables & old <- s.store]
| DisplayVar [String]
-step` :: State -> State
+step` :: State` -> State`
step` s =
foldr appTask {s & millis = s.millis + delta, tasks = []}
[(w - delta, f) \\ (w, f) <- s.tasks]
instance stringQuotes t where stringQuotes x = x
-derive toGenDynamic (), MTask, DigitalPin, AnalogPin, Pin, [], Long//, Servo
-derive fromGenDynamic (), MTask, DigitalPin, AnalogPin, Pin, [], Long//, Servo
+derive toGenDynamic (), MTask, DigitalPin, AnalogPin, Pin, [], Long, UserLED//, Servo
+derive fromGenDynamic (), MTask, DigitalPin, AnalogPin, Pin, [], Long, UserLED//, Servo
instance == () where (==) _ _ = True