l4/pkg/ocaml/contrib/otherlibs/labltk/examples_camltk/taddition.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                 MLTk, Tcl/Tk interface of Objective Caml            *)
   4 (*                                                                     *)
   5 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
   6 (*               projet Cristal, INRIA Rocquencourt                    *)
   7 (*            Jacques Garrigue, Kyoto University RIMS                  *)
   8 (*                                                                     *)
   9 (*  Copyright 2002 Institut National de Recherche en Informatique et   *)
  10 (*  en Automatique and Kyoto University.  All rights reserved.         *)
  11 (*  This file is distributed under the terms of the GNU Library        *)
  12 (*  General Public License, with the special exception on linking      *)
  13 (*  described in file LICENSE found in the Objective Caml source tree. *)
  14 (*                                                                     *)
  15 (***********************************************************************)
  16 open Tk
  17
  18 let main () =
  19   let top = opentk ()  in
  20   (* The widgets. They all have "top" as parent widget. *)
  21   let en1 = Entry.create top [TextWidth 6; Relief Sunken] in
  22   let lab1 = Label.create top [Text "plus"] in
  23   let en2 = Entry.create top [TextWidth 6 ; Relief Sunken] in
  24   let lab2 = Label.create top [Text "="] in
  25   let result_display = Label.create top [] in
  26   (* References holding values of entry widgets *)
  27   let n1 = ref 0
  28   and n2 = ref 0  in
  29   (* Refresh result *)
  30   let refresh () =
  31     Label.configure result_display [Text (string_of_int (!n1 + !n2))]  in
  32   (* Electric *)
  33   let get_and_refresh (w,r) =
  34     fun _ _ ->
  35       try
  36        r := int_of_string (Entry.get w);
  37        refresh ()
  38       with
  39         Failure "int_of_string" ->
  40           Label.configure result_display [Text "error"]
  41   in
  42   (* Set the callbacks *)
  43   Entry.configure en1 [XScrollCommand (get_and_refresh (en1,n1)) ];
  44   Entry.configure en2 [XScrollCommand (get_and_refresh (en2,n2)) ];
  45   (* Map the widgets *)
  46   pack [en1;lab1;en2;lab2;result_display] [];
  47   (* Make the window resizable *)
  48   Wm.minsize_set top 1 1;
  49   (* Start interaction (event-driven program) *)
  50   Threadtk.mainLoop ()
  51 ;;
  52
  53 let _ = Printexc.catch main () ;;