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
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Pierre Weis, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* The interactive additionner program.
Compile using:
ocamlc -I +labltk -c addition.ml
Link using:
ocamlc -I +labltk -custom labltk.cma addition.cmo -o addition
Try with ./addition
*)
open Camltk;;
let addition () =
let main_window = openTk () in
(* The widgets. They all have "main_window" as parent widget. *)
let first_operand =
Entry.create main_window [TextWidth 6; Relief Sunken] in
let operation = Label.create main_window [Text "+"] in
let second_operand =
Entry.create main_window [TextWidth 6 ; Relief Sunken] in
let result_sign = Label.create main_window [Text "="] in
let result = Label.create main_window [] in
(* References that contains the values of variables of the program. *)
let x = ref 0
and y = ref 0 in
(* Refresh result *)
let refresh () =
Label.configure result [Text (string_of_int (!x + !y))] in
(* Electric *)
let get_and_refresh (w, r) _ _ =
try
r := int_of_string (Entry.get w);
refresh ()
with
| Failure "int_of_string" ->
Label.configure result [Text "error"] in
(* Set the callbacks *)
Entry.configure
first_operand [XScrollCommand (get_and_refresh (first_operand, x))];
Entry.configure
second_operand [XScrollCommand (get_and_refresh (second_operand, y))];
let quit_button =
Button.create main_window
[Text "Quit"; Command closeTk] in
(* Map the widgets *)
pack
[first_operand; operation; second_operand; result_sign; result]
[Side Side_Left];
pack [quit_button] [];
(* Make the window resizable *)
Wm.minsize_set main_window 1 1;
(* Start interaction (event-driven program) *)
mainLoop ();;
if !Sys.interactive then () else Printexc.catch addition ();;
|
