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
|
implementation module Notice
// **************************************************************************************************
//
// A new instance of the Dialogs type constructor class to easily create simple notice dialogues.
//
// This module has been written in Clean 2.0 and uses the Clean Standard Object I/O library 1.2.2
//
// **************************************************************************************************
import StdMisc, StdTuple
import StdId, StdPSt, StdWindow
/* The data type that defines a notice.
*/
:: Notice ls pst = Notice [String] (NoticeButton *(ls,pst)) [NoticeButton *(ls,pst)]
:: NoticeButton st = NoticeButton String (IdFun st)
/* Notices are defined as a new instance of the Dialogs type constructor class.
*/
instance Dialogs Notice where
openDialog ls notice pst
# (wId, pst) = accPIO openId pst
# (okId,pst) = accPIO openId pst
= openDialog ls (noticeToDialog wId okId notice) pst
openModalDialog ls notice pst
# (wId,pst) = accPIO openId pst
# (okId,pst) = accPIO openId pst
= openModalDialog ls (noticeToDialog wId okId notice) pst
getDialogType notice
= "Notice"
/* A specialised version that ignores the error report.
*/
openNotice :: !(Notice .ls (PSt .l)) !(PSt .l) -> PSt .l
openNotice notice pst
= snd (openModalDialog undef notice pst)
/* noticeToDialog converts a Notice expression into a Dialog expression.
*/
noticeToDialog :: Id Id (Notice .ls (PSt .l))
-> *Dialog (:+: (LayoutControl (ListLS TextControl))
(:+: ButtonControl
(ListLS ButtonControl)
)) .ls (PSt .l)
noticeToDialog wId okId (Notice texts (NoticeButton text f) buttons)
= Dialog ""
( LayoutControl
( ListLS
[ TextControl text [ControlPos (Left,zero)]
\\ text <- texts
]
) [ControlHMargin 0 0, ControlVMargin 0 0, ControlItemSpace 3 3]
:+: ButtonControl text
[ControlFunction (noticefun f), ControlPos (Right,zero), ControlId okId]
:+: ListLS
[ ButtonControl text [ControlFunction (noticefun f),ControlPos (LeftOfPrev,zero)]
\\ (NoticeButton text f) <- buttons
]
)
[ WindowId wId
, WindowOk okId
]
where
noticefun f (ls,pst) = f (ls,closeWindow wId pst)
|
