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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
module calculator
// ********************************************************************************
// Clean example program.
//
// This program creates a dialog with a simple calculator
// ********************************************************************************
import StdEnv, StdIO
:: Calculator :== History
:: History :== [Entry]
:: Entry = Cmd Command | N Real | Invalid
:: Command = Add | Sub | Mul | Div
calc :: History -> History
calc [] = [N 0.0]
calc [Cmd c:es] = [Cmd c:es]
calc [N b:[Cmd c:[N a:es]]] = [apply a c b : es]
where
apply :: Real Command Real -> Entry
apply a Add b = N (a + b)
apply a Sub b = N (a - b)
apply a Mul b = N (a * b)
apply _ Div 0.0 = Invalid
apply a Div b = N (a / b)
calc h = h
instance zero History where zero = [N 0.0]
instance toString History
where
toString [] = "0"
toString [N n:h]
| toReal (toInt n) == n = toString (toInt n)
| otherwise = toString n
toString [Invalid:h] = "C"
toString [Cmd Add:h] = toString h +++ "+"
toString [Cmd Sub:h] = toString h +++ "-"
toString [Cmd Mul:h] = toString h +++ "*"
toString [Cmd Div:h] = toString h +++ "/"
Start :: *World -> *World
Start world
# (ids, world) = openIds 17 world
# id_add = ids!!10
# id_sub = ids!!11
# id_mul = ids!!12
# id_div = ids!!13
# id_clr = ids!!14
# id_eq = ids!!15
# id_res = ids!!16
# but_numbers = [ButtonControl ("&" +++ toString i) [ControlId (ids!!i), ControlFunction (func_num i id_res), buttonwidth] \\ i <- [0..9]]
# but_add = ButtonControl "&+" [ControlId id_add, ControlFunction (func_add id_res), buttonwidth]
# but_sub = ButtonControl "&-" [ControlId id_sub, ControlFunction (func_sub id_res), buttonwidth]
# but_mul = ButtonControl "&*" [ControlId id_mul, ControlFunction (func_mul id_res), buttonwidth]
# but_div = ButtonControl "&/" [ControlId id_div, ControlFunction (func_div id_res), buttonwidth]
# but_clr = ButtonControl "&C" [ControlId id_clr, ControlFunction (func_clr id_res), buttonwidth]
# but_eq = ButtonControl "&=" [ControlId id_eq, ControlFunction (func_eq id_res), buttonwidth]
# text_res = TextControl "0" [ControlId id_res, ControlWidth (PixelWidth 200)]
# controls = text_res :+: LayoutControl (ListLS [
LayoutControl (ListLS [but_numbers!!7, but_numbers!!8, but_numbers!!9, but_add]) [ControlPos (Left, zero)],
LayoutControl (ListLS [but_numbers!!4, but_numbers!!5, but_numbers!!6, but_sub]) [ControlPos (Left, zero)],
LayoutControl (ListLS [but_numbers!!1, but_numbers!!2, but_numbers!!3, but_mul]) [ControlPos (Left, zero)],
LayoutControl (ListLS [but_numbers!!0, but_clr, but_eq, but_div]) [ControlPos (Left, zero)]
]) [ControlHMargin 0 0, ControlVMargin 0 0, ControlPos (Left, zero)]
# dialog = Dialog "Calculator" controls [WindowClose (noLS closeProcess)]
= startIO NDI Void (initialise dialog) [] world
where
initialise dialog pst
# (error,pst) = openDialog zero dialog pst
| error <> NoError = closeProcess pst
| otherwise = pst
buttonwidth = ControlWidth (ContentWidth "+")
func_num :: Int Id (History, PSt .l) -> (History, PSt .l)
func_num n textid (h, pst) = (new_h n h, appPIO (setControlText textid (toString (new_h n h))) pst)
where
new_h n [] = [N (toReal n)]
new_h n [N m:h] = [N (10.0 * m + toReal n) : h]
new_h n h = [N (toReal n) : h]
add_cmd :: History Command -> History
add_cmd [] _ = []
add_cmd [Invalid : h] _ = [Invalid : h]
add_cmd [Cmd _ : h] c = [Cmd c : h]
add_cmd h c = [Cmd c : calc h]
func_add :: Id (History, PSt .l) -> (History, PSt .l)
func_add textid (h, pst) = let new_h = add_cmd h Add in (new_h, appPIO (setControlText textid (toString new_h)) pst)
func_sub :: Id (History, PSt .l) -> (History, PSt .l)
func_sub textid (h, pst) = let new_h = add_cmd h Sub in (new_h, appPIO (setControlText textid (toString new_h)) pst)
func_mul :: Id (History, PSt .l) -> (History, PSt .l)
func_mul textid (h, pst) = let new_h = add_cmd h Mul in (new_h, appPIO (setControlText textid (toString new_h)) pst)
func_div :: Id (History, PSt .l) -> (History, PSt .l)
func_div textid (h, pst) = let new_h = add_cmd h Div in (new_h, appPIO (setControlText textid (toString new_h)) pst)
func_clr :: Id (History, PSt .l) -> (History, PSt .l)
func_clr textid ([_:h], pst) = (h, appPIO (setControlText textid (toString h)) pst)
func_clr textid st = st
func_eq :: Id (History, PSt .l) -> (History, PSt .l)
func_eq textid (h, pst) = let new_h = calc h in (new_h, appPIO (setControlText textid (toString new_h)) pst)
|
