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

   1 (* $Id$ *)
   2
   3 open GMain
   4
   5 let rec fix ~f ~eq x =
   6   let x' = f x in
   7   if eq x x' then x
   8   else fix ~f ~eq x'
   9
  10 let eq_float x y = abs_float (x -. y) < 1e-13
  11
  12 let _ =
  13   let top = GWindow.window () in
  14   top#connect#destroy ~callback:Main.quit;
  15   let vbox = GPack.vbox ~packing: top#add () in
  16   let entry = GEdit.entry ~max_length: 20 ~packing: vbox#add () in
  17   let tips = GData.tooltips () in
  18   tips#set_tip entry#coerce ~text:"Initial value for fix-point";
  19   let result =
  20     GEdit.entry ~max_length: 20 ~editable: false ~packing: vbox#add () in
  21
  22   entry#connect#activate ~callback:
  23     begin fun () ->
  24       let x = try float_of_string entry#text with _ -> 0.0 in
  25       entry#set_text (string_of_float (cos x));
  26       let res = fix ~f:cos ~eq:eq_float x in
  27       result#set_text (string_of_float res)
  28     end;
  29   top#show ();
  30   Main.main ()