blob: a330a9ecb3361e4646455bef0ca67c8ca09aa41b (
plain)
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
|
(* $Id$ *)
(* A simple calculator demonstrating OO programming with O'Labl
and LablTk.
LablTk itself is not OO, but it is good to wrap complex
structures in objects. Even if the absence of initializers
makes things a little bit awkward.
*)
open Tk
let mem_string elt:c s =
try
for i = 0 to String.length s -1 do
if s.[i] = c then raise Exit
done; false
with Exit -> true
let ops = ['+',(+.); '-',(-.); '*',( *.); '/',(/.)]
(* The abstract calculator class.
Does not use Tk (only Textvariable) *)
class calc () = object (calc)
val variable = Textvariable.create ()
val mutable x = 0.0
val mutable op = None
val mutable displaying = true
method set = Textvariable.set variable
method get = Textvariable.get variable
method insert s = calc#set to:(calc#get ^ s)
method get_float = float_of_string (calc#get)
method command s =
if s <> "" then match s.[0] with
'0'..'9' ->
if displaying then (calc#set to:""; displaying <- false);
calc#insert s
| '.' ->
if displaying then
(calc#set to:"0."; displaying <- false)
else
if not (mem_string elt:'.' calc#get) then calc#insert s
| '+'|'-'|'*'|'/' as c ->
displaying <- true;
begin match op with
None ->
x <- calc#get_float;
op <- Some (List.assoc key:c ops)
| Some f ->
x <- f x (calc#get_float);
op <- Some (List.assoc key:c ops);
calc#set to:(string_of_float x)
end
| '='|'\n'|'\r' ->
displaying <- true;
begin match op with
None -> ()
| Some f ->
x <- f x (calc#get_float);
op <- None;
calc#set to:(string_of_float x)
end
| 'q' -> closeTk (); exit 0
| _ -> ()
end
(* Buttons for the calculator *)
let m =
[|["7";"8";"9";"+"];
["4";"5";"6";"-"];
["1";"2";"3";"*"];
["0";".";"=";"/"]|]
(* The physical calculator. Inherits from the abstract one *)
class calculator :parent = object
inherit calc () as calc
val label = Label.create :parent anchor:`E relief:`Sunken padx:(`Pix 10) ()
val frame = Frame.create :parent ()
initializer
let buttons =
Array.map fun:
(List.map fun:
(fun text ->
Button.create parent:frame :text
command:(fun () -> calc#command text) ()))
m
in
Label.configure textvariable:variable label;
calc#set to:"0";
bind parent events:[[],`KeyPress]
action:(`Set([`Char],fun ev -> calc#command ev.ev_Char));
for i = 0 to Array.length m - 1 do
Grid.configure row:i buttons.(i)
done;
pack side:`Top fill:`X [label];
pack side:`Bottom fill:`Both expand:true [frame];
end
(* Finally start everything *)
let top = openTk ()
let applet = new calculator parent:top
let _ = mainLoop ()
|
