diff options
| -rw-r--r-- | tut9_1_2.icl | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/tut9_1_2.icl b/tut9_1_2.icl new file mode 100644 index 0000000..74ce29a --- /dev/null +++ b/tut9_1_2.icl @@ -0,0 +1,53 @@ +module tut9_1_2 + +// ******************************************************************************** +// Clean tutorial example program. +// +// This program creates a window that displays growing concentric circles. +// For this purpose it uses a timer. +// ******************************************************************************** + +import StdEnv, StdIO + +:: DialogIds = { secondsId :: Id, minutesId :: Id, hoursId :: Id } + +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) + +Start :: *World -> *World +Start world + # (dialogIds, world) = openDialogIds world + = startIO NDI Void (initialise dialogIds) [] world + +initialise :: DialogIds (PSt .l) -> (PSt .l) +initialise {secondsId, minutesId, hoursId} pst + # (errors, pst) = seqList [openTimer 0 (tdef timerinfo) \\ timerinfo <- [second,minute,hour]] pst + | any ((<>) NoError) errors + = closeProcess pst + # (error, pst) = openDialog Void ddef pst + | error <> NoError + = closeProcess pst + | otherwise = pst +where + tdef dt = Timer dt NilLS [TimerFunction tick] + where + tick nrElapsed (time,pst) + # time = (time + nrElapsed) rem maxunit + = (time, appPIO (setControlText id (toString time)) pst) + + (id, maxunit) = if (dt == second) (secondsId, 60) + (if (dt == minute) (minutesId, 60) + (hoursId, 24)) + + ddef = Dialog "Clock" (LayoutControl (ListLS [TextControl text [ControlPos (Left,zero)] \\ text <- ["Hours:","Minutes:","Seconds:"]]) [] :+: + LayoutControl (ListLS [TextControl "0" [ControlPos (Left,zero), + ControlId id, + ControlWidth (ContentWidth "00")] \\ id <- [hoursId,minutesId,secondsId]]) []) + [WindowClose (noLS closeProcess)] + |