Notice.icl 2.62 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
1
2
3
4
5
6
7
8
9
10
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
//	
//	**************************************************************************************************

Peter Achten's avatar
Peter Achten committed
11
12
import StdMisc, StdTuple
import StdId, StdPSt, StdWindow
Peter Achten's avatar
Peter Achten committed
13
14
15
16
17
18
19
20
21

/*  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
22
23
24
25
26
    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
27
    
28
29
30
31
32
    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
33
34
35
36
37
38
39
    
    getDialogType :: (Notice .ls .pst) -> WindowType
    getDialogType notice
        = "Notice"

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

/*  noticeToDialog converts a Notice expression into a Dialog expression.
*/
46
noticeToDialog :: Id Id (Notice .ls (PSt .l)) 
Peter Achten's avatar
Peter Achten committed
47
48
49
               -> Dialog (:+: (CompoundControl (ListLS TextControl))
                         (:+:  ButtonControl
                              (ListLS ButtonControl)
50
                         )) .ls (PSt .l)
Peter Achten's avatar
Peter Achten committed
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
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)