diff options
| author | Camil Staps | 2015-08-19 15:17:03 +0200 |
|---|---|---|
| committer | Camil Staps | 2015-08-19 15:17:03 +0200 |
| commit | 8c4d2170b5dbac4d82e2765cc63cfbe1ca9ead9a (patch) | |
| tree | 49a8738d019e4e33e20cb46c45b7dada342bd99e /Notice.icl | |
| parent | Setting up (diff) | |
tut 8.5 (menu)
Diffstat (limited to 'Notice.icl')
| -rw-r--r-- | Notice.icl | 67 |
1 files changed, 67 insertions, 0 deletions
diff --git a/Notice.icl b/Notice.icl new file mode 100644 index 0000000..813a85e --- /dev/null +++ b/Notice.icl @@ -0,0 +1,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)
|