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

6 files changed, 189 insertions, 1 deletions

diff --git a/Makefile b/Makefile
index 25ccd32..94cd5dd 100644
--- a/Makefile
+++ b/Makefile
@@ -14,7 +14,7 @@ CLM_OPTS=-tst
 
 APP_OPTS=-h 512M
 
-ICL=$(filter-out Notice.icl, $(wildcard *.icl))
+ICL=$(filter-out Notice.icl tut11_3_2_stopwatch.icl, $(wildcard *.icl))
 EXE=$(patsubst %.icl,%,$(ICL))
 
 all: $(EXE)
diff --git a/tut11_3_2.icl b/tut11_3_2.icl
new file mode 100644
index 0000000..a959b60
--- /dev/null
+++ b/tut11_3_2.icl
@@ -0,0 +1,35 @@
+module tut11_3_2
+
+// ********************************************************************************
+// Clean tutorial example program.
+//
+// This program creates a simple program that uses the stopwatch process.
+// The program only has a menu to open the stopwatch and control it.
+// ********************************************************************************
+
+import StdEnv, StdIO
+import tut11_3_2_stopwatch
+
+Start :: *World -> *World
+Start world
+# (stopwatchId, world)  = openRId world
+= startIO SDI Void (initialise stopwatchId) [] world
+
+initialise :: (RId StopwatchCommands) (PSt .l) -> PSt .l
+initialise stopwatchId pst
+# (error, pst)      = openMenu Void mdef pst
+| error <> NoError  = closeProcess pst
+| otherwise         = openProcesses (stopwatch stopwatchId) pst
+where
+    mdef = Menu "&Stopwatch" (MenuItem "&Reset"     [MenuFunction (noLS (send Reset))] :+:
+                              MenuItem "&Pause"     [MenuFunction (noLS (send Pause))] :+:
+                              MenuItem "C&ontinue"  [MenuFunction (noLS (send Continue))] :+:
+                              MenuItem "&Close"     [MenuFunction (noLS (send Close))] :+:
+                              MenuSeparator         [] :+:
+                              MenuItem "&Quit"      [MenuFunction (noLS (closeProcess o (send Close)))]) []
+    where
+        send msg pst
+        # (error, pst)      = syncSend stopwatchId msg pst
+        | error <> SendOk   = appPIO beep pst
+        | otherwise         = pst
+
diff --git a/tut11_3_2_stopwatch.dcl b/tut11_3_2_stopwatch.dcl
new file mode 100644
index 0000000..89dbd45
--- /dev/null
+++ b/tut11_3_2_stopwatch.dcl
@@ -0,0 +1,15 @@
+definition module tut11_3_2_stopwatch
+
+// ********************************************************************************
+// Clean tutorial example program.
+//
+// This module exports the types and functions needed to incorporate a stopwatch
+// component.
+// ********************************************************************************
+
+import StdIO
+
+:: StopwatchCommands = Reset | Pause | Continue | Close
+
+stopwatch :: (RId StopwatchCommands) -> Process
+
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)
+
diff --git a/tut6_7_1.icl b/tut6_7_1.icl
new file mode 100644
index 0000000..c26c244
--- /dev/null
+++ b/tut6_7_1.icl
@@ -0,0 +1,30 @@
+module tut6_7_1
+
+// ********************************************************************************
+// Clean tutorial example program.
+//
+// This program monitors keyboard input that is sent to a Window.
+// ********************************************************************************
+
+import StdEnv, StdIO
+
+Start :: *World -> *World
+Start world
+# (wid, world)      = openId world
+# window            = Window "Keyspotting" NilLS [
+                        WindowKeyboard (const True) Able (noLS1 (spotting wid)), 
+                        WindowId wid, 
+                        WindowClose (noLS closeProcess)]
+= startIO SDI Void (snd o openWindow Void window) [ProcessClose closeProcess] world
+where
+    spotting :: Id x (PSt .l) -> PSt .l | toString x
+    spotting wid x pst = appPIO (setWindowLook wid True (False, look (toString x))) pst
+
+    look :: String SelectState UpdateState *Picture -> *Picture
+    look text _ {newFrame} picture
+    # picture           = unfill newFrame picture
+    # (width, picture)  = getPenFontStringWidth text picture
+    = drawAt {x=(w-width)/2,y=h/2} text picture
+    where
+        {w,h}           = rectangleSize newFrame
+
diff --git a/tut6_7_2.icl b/tut6_7_2.icl
new file mode 100644
index 0000000..dadf8e9
--- /dev/null
+++ b/tut6_7_2.icl
@@ -0,0 +1,30 @@
+module tut6_7_2
+
+// ********************************************************************************
+// Clean tutorial example program.
+//
+// This program monitors keyboard input that is sent to a Window.
+// ********************************************************************************
+
+import StdEnv, StdIO
+
+Start :: *World -> *World
+Start world
+# (wid, world)      = openId world
+# window            = Window "Mousespotting" NilLS [
+                        WindowMouse (const True) Able (noLS1 (spotting wid)), 
+                        WindowId wid, 
+                        WindowClose (noLS closeProcess)]
+= startIO SDI Void (snd o openWindow Void window) [ProcessClose closeProcess] world
+where
+    spotting :: Id x (PSt .l) -> PSt .l | toString x
+    spotting wid x pst = appPIO (setWindowLook wid True (False, look (toString x))) pst
+
+    look :: String SelectState UpdateState *Picture -> *Picture
+    look text _ {newFrame} picture
+    # picture           = unfill newFrame picture
+    # (width, picture)  = getPenFontStringWidth text picture
+    = drawAt {x=(w-width)/2,y=h/2} text picture
+    where
+        {w,h}           = rectangleSize newFrame
+