Notice.icl 2.64 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
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
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 1.3.1 and uses the Clean Standard Object I/O library 1.0.2
//	
//	**************************************************************************************************

import StdEnv, StdIO

/*  A simple state type.
*/
::  NoState
    =   NoState

/*  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
26
27
28
29
30
    openDialog :: .ls !(Notice .ls (PSt .l)) !(PSt .l) -> (!ErrorReport,!PSt .l)
    openDialog ls notice pst
        # (wId, pst) = accPIO openId pst
        # (okId,pst) = accPIO openId pst
        = openDialog ls (noticeToDialog wId okId notice) pst
Peter Achten's avatar
Peter Achten committed
31
    
32
33
34
35
36
    openModalDialog :: .ls !(Notice .ls (PSt .l)) !(PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
    openModalDialog ls notice pst
        # (wId,pst)  = accPIO openId pst
        # (okId,pst) = accPIO openId pst
        = openModalDialog ls (noticeToDialog wId okId notice) pst
Peter Achten's avatar
Peter Achten committed
37
38
39
40
41
42
43
    
    getDialogType :: (Notice .ls .pst) -> WindowType
    getDialogType notice
        = "Notice"

/*  A specialised version that ignores the error report.
*/
44
45
46
openNotice :: !(Notice .ls (PSt .l)) !(PSt .l) -> PSt .l
openNotice notice pst
    = snd (openModalDialog undef notice pst)
Peter Achten's avatar
Peter Achten committed
47
48
49

/*  noticeToDialog converts a Notice expression into a Dialog expression.
*/
50
noticeToDialog :: Id Id (Notice .ls (PSt .l)) 
Peter Achten's avatar
Peter Achten committed
51
52
53
               -> Dialog (:+: (CompoundControl (ListLS TextControl))
                         (:+:  ButtonControl
                              (ListLS ButtonControl)
54
                         )) .ls (PSt .l)
Peter Achten's avatar
Peter Achten committed
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
noticeToDialog wId okId (Notice texts (NoticeButton text f) buttons)
    = Dialog ""
        (   CompoundControl 
        (   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)