|
Packit |
bd2e5d |
(***********************************************************************)
|
|
Packit |
bd2e5d |
(* *)
|
|
Packit |
bd2e5d |
(* MLTk, Tcl/Tk interface of OCaml *)
|
|
Packit |
bd2e5d |
(* *)
|
|
Packit |
bd2e5d |
(* Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis *)
|
|
Packit |
bd2e5d |
(* projet Cristal, INRIA Rocquencourt *)
|
|
Packit |
bd2e5d |
(* Jacques Garrigue, Kyoto University RIMS *)
|
|
Packit |
bd2e5d |
(* *)
|
|
Packit |
bd2e5d |
(* Copyright 2002 Institut National de Recherche en Informatique et *)
|
|
Packit |
bd2e5d |
(* en Automatique and Kyoto University. All rights reserved. *)
|
|
Packit |
bd2e5d |
(* This file is distributed under the terms of the GNU Library *)
|
|
Packit |
bd2e5d |
(* General Public License, with the special exception on linking *)
|
|
Packit |
bd2e5d |
(* described in file LICENSE found in the OCaml source tree. *)
|
|
Packit |
bd2e5d |
(* *)
|
|
Packit |
bd2e5d |
(***********************************************************************)
|
|
Packit |
bd2e5d |
open Tk
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let main () =
|
|
Packit |
bd2e5d |
let top = opentk () in
|
|
Packit |
bd2e5d |
(* The widgets. They all have "top" as parent widget. *)
|
|
Packit |
bd2e5d |
let en1 = Entry.create top [TextWidth 6; Relief Sunken] in
|
|
Packit |
bd2e5d |
let lab1 = Label.create top [Text "plus"] in
|
|
Packit |
bd2e5d |
let en2 = Entry.create top [TextWidth 6 ; Relief Sunken] in
|
|
Packit |
bd2e5d |
let lab2 = Label.create top [Text "="] in
|
|
Packit |
bd2e5d |
let result_display = Label.create top [] in
|
|
Packit |
bd2e5d |
(* References holding values of entry widgets *)
|
|
Packit |
bd2e5d |
let n1 = ref 0
|
|
Packit |
bd2e5d |
and n2 = ref 0 in
|
|
Packit |
bd2e5d |
(* Refresh result *)
|
|
Packit |
bd2e5d |
let refresh () =
|
|
Packit |
bd2e5d |
Label.configure result_display [Text (string_of_int (!n1 + !n2))] in
|
|
Packit |
bd2e5d |
(* Electric *)
|
|
Packit |
bd2e5d |
let get_and_refresh (w,r) =
|
|
Packit |
bd2e5d |
fun _ _ ->
|
|
Packit |
bd2e5d |
try
|
|
Packit |
bd2e5d |
r := int_of_string (Entry.get w);
|
|
Packit |
bd2e5d |
refresh ()
|
|
Packit |
bd2e5d |
with
|
|
Packit |
bd2e5d |
Failure "int_of_string" ->
|
|
Packit |
bd2e5d |
Label.configure result_display [Text "error"]
|
|
Packit |
bd2e5d |
in
|
|
Packit |
bd2e5d |
(* Set the callbacks *)
|
|
Packit |
bd2e5d |
Entry.configure en1 [XScrollCommand (get_and_refresh (en1,n1)) ];
|
|
Packit |
bd2e5d |
Entry.configure en2 [XScrollCommand (get_and_refresh (en2,n2)) ];
|
|
Packit |
bd2e5d |
(* Map the widgets *)
|
|
Packit |
bd2e5d |
pack [en1;lab1;en2;lab2;result_display] [];
|
|
Packit |
bd2e5d |
(* Make the window resizable *)
|
|
Packit |
bd2e5d |
Wm.minsize_set top 1 1;
|
|
Packit |
bd2e5d |
(* Start interaction (event-driven program) *)
|
|
Packit |
bd2e5d |
Threadtk.mainLoop ()
|
|
Packit |
bd2e5d |
;;
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let _ = Printexc.catch main () ;;
|