blob: c9657dfa6087b1a3a93cabdc7b2439adeebd1d8d (
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
113
114
115
116
117
118
119
120
121
122
123
124
125
|
(*************************************************************************)
(* *)
(* Objective Caml LablTk library *)
(* *)
(* Jun Furuse, projet Cristal, INRIA Rocquencourt *)
(* Jacques Garrigue, Kyoto University RIMS *)
(* *)
(* Copyright 1999 Institut National de Recherche en Informatique et *)
(* en Automatique and Kyoto University. All rights reserved. *)
(* This file is distributed under the terms of the GNU Library *)
(* General Public License. *)
(* *)
(*************************************************************************)
(* $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 anchor:`E relief:`Sunken padx:10 parent
val frame = Frame.create parent
initializer
let buttons =
Array.map fun:
(List.map fun:
(fun text ->
Button.create :text command:(fun () -> calc#command text) frame))
m
in
Label.configure textvariable:variable label;
calc#set to:"0";
bind parent events:[`KeyPress] fields:[`Char]
action:(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 ()
|
