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
|
module tut8_5
// ********************************************************************************
// Clean tutorial example program.
//
// This program creates a Multiple Document Interface process with a Window menu.
// ********************************************************************************
import StdEnv, StdIO, Notice
Start :: *World -> *World
Start world
# (id, world) = openId world
= startIO MDI Void (initialise id) [ProcessClose quit] world
quit :: (PSt .l) -> PSt .l
quit pst = openNotice notice pst
where
notice = Notice ["Do you really want to quit?"]
(NoticeButton "&Ok" (noLS closeProcess))
[NoticeButton "&Cancel" id]
initialise :: Id (PSt .l) -> PSt .l
initialise closeid pst
# (err, pst) = openMenu 0 menu pst
| err <> NoError = abort "MDI could not open File Menu"
| otherwise = pst
where
menu = Menu "&File"
({newLS=1, newDef=MenuItem "&New" [MenuShortKey 'n', MenuFunction new]} :+:
MenuItem "&Close" [MenuShortKey 'w', MenuFunction (noLS close), MenuId closeid, MenuSelectState Unable] :+:
MenuSeparator [] :+:
MenuItem "&Quit" [MenuShortKey 'q', MenuFunction (noLS quit)]) []
close :: (PSt .l) -> PSt .l
close pst
# pst = closeActiveWindow pst
# (rest, pst) = accPIO getWindowsStack pst
| isEmpty rest = appPIO (disableMenuElements [closeid]) pst
| otherwise = pst
new :: (Int, PSt .l) -> (Int, PSt .l)
new (i,pst)
# (err, pst) = openWindow Void window pst
| err <> NoError
# notice = Notice ["MDI could not open new window"] (NoticeButton "&Ok" id) []
= (i, openNotice notice pst)
| otherwise = (i+1, appPIO (enableMenuElements [closeid]) pst)
where
window = Window ("Window " +++ toString i) NilLS [
WindowClose (noLS close),
WindowViewSize {w=300, h=300},
WindowLook True look ]
look :: SelectState UpdateState *Picture -> *Picture
look _ {newFrame=frame=:{corner1,corner2}} picture
# picture = unfill frame picture
# picture = draw frame picture
# picture = drawLine corner1 corner2 picture
= drawLine {corner1 & x=corner2.x} {corner2 & x=corner1.x} picture
|
