Tut 6.7 (mousespotting, keyspotting); tut 11.3.2 (stopwatch)

1 files changed, 78 insertions, 0 deletions

diff --git a/tut11_3_2_stopwatch.icl b/tut11_3_2_stopwatch.icl
new file mode 100644
index 0000000..5d5a451
--- /dev/null
+++ b/tut11_3_2_stopwatch.icl
@@ -0,0 +1,78 @@
+implementation module tut11_3_2_stopwatch
+
+// ********************************************************************************
+// Clean tutorial example program.
+//
+// This program defines a stopwatch process component.
+// It uses three timers to track the seconds, minutes, and hours separately.
+// Message passing is used to reset, pause, and continue timing.
+// The current time is displayed using a dialogue.
+// ********************************************************************************
+
+import StdEnv,StdIO
+
+:: DialogIds = {secondsId :: Id, minutesId :: Id, hoursId :: Id}
+:: TimerInfo = {timerId :: Id, timerRId :: RId StopwatchCommands, timerInterval :: TimerInterval}
+:: StopwatchCommands = Reset | Pause | Continue | Close
+
+second :== ticksPerSecond
+minute :== 60 * second
+hour   :== 60 * minute
+
+openDialogIds :: *env -> (DialogIds,*env) | Ids env
+openDialogIds env
+# ([secondsId, minutesId, hoursId:_],env) = openIds 3 env
+= ({secondsId=secondsId, minutesId=minutesId, hoursId=hoursId}, env)
+
+openTimerInfos :: *env -> ([TimerInfo], *env) | Ids env
+openTimerInfos env
+# (tids, env)       = openIds 3 env
+# (rids, env)       = openRIds 3 env
+# intervals         = [second, minute, hour]
+= ([{timerId=tid, timerRId=rid, timerInterval=i} \\ tid <- tids & rid <- rids & i <- intervals], env)
+
+stopwatch :: (RId StopwatchCommands) -> Process
+stopwatch rid = Process NDI Void initialise` []
+where
+    initialise` pst
+    # (dialogIds, pst)  = accPIO openDialogIds pst
+    # (timerInfos, pst) = accPIO openTimerInfos pst
+    = initialise rid dialogIds timerInfos pst
+
+initialise :: (RId StopwatchCommands) DialogIds [TimerInfo] (PSt .l) -> PSt .l
+initialise rid {secondsId, minutesId, hoursId} timerInfos pst
+# (errors, pst)     = seqList [openTimer 0 (tdef timerInfo) \\ timerInfo <- timerInfos] pst
+| any ((<>) NoError) errors = closeProcess pst
+# (error, pst)      = openDialog Void ddef pst
+| error <> NoError  = closeProcess pst
+# (error, pst)      = openReceiver Void rdef pst
+| error <> NoError  = closeProcess pst
+| otherwise         = pst
+where
+    tdef {timerId, timerRId, timerInterval} = Timer timerInterval (Receiver timerRId receive []) [TimerId timerId, TimerFunction tick]
+    where
+        tick nrElapsed (time, pst=:{io})
+        # time      = (time + nrElapsed) rem maxunit
+        # io        = setControlText textId (toString time) io
+        = (time, {pst & io = io})
+
+        receive Reset (time, pst=:{io})
+        # io        = disableTimer timerId io
+        # io        = enableTimer timerId io
+        # io        = setControlText textId "00" io
+        = (0, {pst & io = io})
+        receive Pause (time, pst=:{io}) = (time, {pst & io = disableTimer timerId io})
+        receive Continue (time, pst=:{io}) = (time, {pst & io = enableTimer timerId io})
+
+        (textId, maxunit) = if (timerInterval == second) (secondsId, 60)
+                           (if (timerInterval == minute) (minutesId, 60)
+                                                         (hoursId, 24))
+
+    ddef = Dialog "Stopwatch" (LayoutControl (ListLS [TextControl text [ControlPos (Left, zero)] \\ text <- ["Hours:","Minutes:","Second:"]]) [] :+:
+                                LayoutControl (ListLS [TextControl "0" [ControlPos (Left, zero), ControlId id, ControlWidth (ContentWidth "00")] \\ id <- [hoursId, minutesId, secondsId]]) []) [WindowClose (noLS closeProcess)]
+
+    rdef = Receiver rid (noLS1 receive) []
+    where
+        receive Close pst = closeProcess pst
+        receive msg pst = snd (seqList [syncSend timerRId msg \\ {timerRId} <- timerInfos] pst)
+