helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/old/fixpoint.ml

   1 (* $Id$ *)
   2
   3 open GtkData
   4 open GtkBase
   5 open GtkPack
   6 open GtkWindow
   7 open GtkEdit
   8 open GtkMain
   9
  10 let rec fix fun:f :eq x =
  11   let x' = f x in
  12   if eq x x' then x
  13   else fix fun:f :eq x'
  14
  15 let eq_float x y = abs_float (x -. y) < 1e-13
  16
  17 let _ =
  18   let top = Window.create `TOPLEVEL in
  19   GtkSignal.connect sig:Object.Signals.destroy top callback:Main.quit;
  20   let hbox = Box.create `VERTICAL in
  21   Container.add top hbox;
  22   let entry = Entry.create () in
  23   Entry.set entry max_length:20;
  24   let tips = Tooltips.create () in
  25   Tooltips.set_tip tips entry text:"Initial value for fix-point";
  26   let result = Entry.create () in
  27   Entry.set result max_length:20 editable:false;
  28   Box.pack hbox entry;
  29   Box.pack hbox result;
  30
  31   GtkSignal.connect sig:Editable.Signals.activate entry callback:
  32     begin fun () ->
  33       let x = try float_of_string (Entry.get_text entry) with _ -> 0.0 in
  34       Entry.set entry text:(string_of_float (cos x));
  35       let res = fix fun:cos eq:eq_float x in
  36       Entry.set result text:(string_of_float res)
  37     end;
  38   Widget.show_all top;
  39   Main.main ()