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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
(**************************************************************************)
(* Lablgtk - Examples *)
(* *)
(* This code is in the public domain. *)
(* You may freely copy parts of it in your application. *)
(* *)
(**************************************************************************)
(* $Id$ *)
(* reverse polish calculator *)
open StdLabels
open GMain
let wow _ = prerr_endline "Wow!"; ()
let main () =
let stack = Stack.create () in
(* toplevel window *)
let window =
GWindow.window ~border_width: 10 ~title:"Reverse Polish Calculator" () in
window#connect#destroy ~callback:Main.quit;
(* vbox *)
let vbx = GPack.vbox ~packing:window#add () in
(* entry *)
let entry =
GEdit.entry ~text:"0" ~editable:false ~max_length: 20 ~packing: vbx#add () in
(* BackSpace, Clear, All Clear, Quit *)
let table0 = GPack.table ~rows:1 ~columns:4 ~packing:vbx#add () in
let bs_clicked _ = begin
let txt = entry#text in
let len = String.length txt in
if len <= 1 then
entry#set_text "0"
else entry#set_text (String.sub txt ~pos:0 ~len:(len-1))
end in
let c_clicked _ = entry#set_text("0") in
let ac_clicked _ = Stack.clear stack; entry#set_text("0") in
let labels0 = [("BS", bs_clicked) ; ("C", c_clicked);
("AC", ac_clicked); ("Quit", window#destroy)] in
let rec loop0 labels n =
match labels
with [] -> ()
| (lbl, cb) :: t ->
let button =
GButton.button ~label:lbl
~packing:(table0#attach ~left:n ~top:1 ~expand:`BOTH) () in
button#connect#clicked ~callback:cb;
loop0 t (n+1) in
loop0 labels0 1;
(* Numerals *)
let table1 = GPack.table ~rows:4 ~columns:5 ~packing:vbx#add () in
let labels1 = ["7"; "8"; "9"; "4"; "5"; "6"; "1"; "2"; "3"; "0"] in
let numClicked n _ =
let txt = entry#text in
if (txt = "0") then
entry#set_text n
else begin
entry#append_text n
end in
let rec loop1 labels n =
match labels with [] -> ()
| lbl :: lbls ->
let button = GButton.button ~label:(" "^lbl^" ")
~packing:(table1#attach ~left:(n mod 3) ~top:(n/3) ~expand:`BOTH)
() in
button#connect#clicked ~callback:(numClicked lbl);
loop1 lbls (n+1) in
loop1 labels1 0;
(* Period *)
let periodClicked _ =
let txt = entry#text in
if not (String.contains txt '.') then entry#append_text "." in
(GButton.button ~label:" . "
~packing:(table1#attach ~left:1 ~top:3 ~expand:`BOTH) ())
#connect#clicked ~callback:periodClicked;
(* Enter (Push) *)
let enterClicked _ =
let txt = entry#text in
let n = float_of_string txt in begin
Stack.push n stack;
entry#set_text "0"
end in
(GButton.button ~label:"Ent"
~packing:(table1#attach ~left:2 ~top:3 ~expand:`BOTH) ())
#connect#clicked ~callback:enterClicked;
(* Operators *)
let op2Clicked op _ =
let n1 = float_of_string (entry#text) in
let n2 = Stack.pop stack in
entry#set_text (string_of_float (op n2 n1))
in
let op1Clicked op _ =
let n1 = float_of_string (entry#text) in
entry#set_text (string_of_float (op n1))
in
let modClicked _ =
let n1 = int_of_string (entry#text) in
let n2 = truncate (Stack.pop stack) in
entry#set_text (string_of_int (n2 mod n1))
in
let labels2 = [(" / ", op2Clicked (/.)); (" * ", op2Clicked ( *. ));
(" - ", op2Clicked (-.)); (" + ", op2Clicked (+.));
("mod", modClicked); (" ^ ", op2Clicked ( ** ));
("+/-", op1Clicked (~-.));
("1/x", op1Clicked (fun x -> 1.0/.x))] in
let rec loop2 labels n =
match labels
with [] -> ()
| (lbl, cb) :: t ->
let button = GButton.button ~label:lbl
~packing:(table1#attach ~left:(3 + n/4) ~top: (n mod 4)
~expand:`BOTH)
() in
button#connect#clicked ~callback:cb;
loop2 t (n+1)
in
loop2 labels2 0;
(* show all and enter event loop *)
window#show ();
Main.main ()
let _ = Printexc.print main()
|
