1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
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)
|
