blob: 6bebe0213291d2b7ae747b7b4bccf5ec0642393d (
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
|
(***********************************************************************)
(* *)
(* MLTk, Tcl/Tk interface of OCaml *)
(* *)
(* Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis *)
(* projet Cristal, INRIA Rocquencourt *)
(* Jacques Garrigue, Kyoto University RIMS *)
(* *)
(* Copyright 2002 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, with the special exception on linking *)
(* described in file LICENSE found in the OCaml source tree. *)
(* *)
(***********************************************************************)
open Camltk;;
let main () =
let top = opentk () in
(* The widgets. They all have "top" as parent widget. *)
let en1 = Entry.create top [TextWidth 6; Relief Sunken] in
let lab1 = Label.create top [Text "plus"] in
let en2 = Entry.create top [TextWidth 6 ; Relief Sunken] in
let lab2 = Label.create top [Text "="] in
let result_display = Label.create top [] in
(* References holding values of entry widgets *)
let n1 = ref 0
and n2 = ref 0 in
(* Refresh result *)
let refresh () =
Label.configure result_display [Text (string_of_int (!n1 + !n2))] in
(* Electric *)
let get_and_refresh (w,r) =
fun _ _ ->
try
r := int_of_string (Entry.get w);
refresh ()
with
Failure "int_of_string" ->
Label.configure result_display [Text "error"]
in
(* Set the callbacks *)
Entry.configure en1 [XScrollCommand (get_and_refresh (en1,n1)) ];
Entry.configure en2 [XScrollCommand (get_and_refresh (en2,n2)) ];
(* Map the widgets *)
pack [en1;lab1;en2;lab2;result_display] [];
(* Make the window resizable *)
Wm.minsize_set top 1 1;
(* Start interaction (event-driven program) *)
mainLoop ()
;;
Printexc.catch main ()
;;
|
