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

   1 (* $Id$ *)
   2
   3 (* A simple calculator ported from LablTk to LablGtk *)
   4
   5 let mem_string ~char s =
   6   try
   7     for i = 0 to String.length s -1 do
   8       if s.[i] = char then raise Exit
   9     done; false
  10   with Exit -> true
  11
  12 let ops = ['+',(+.); '-',(-.); '*',( *.); '/',(/.)]
  13
  14 (* The abstract calculator class. Does not use Gtk *)
  15
  16 class virtual calc = object (calc)
  17   val mutable x = 0.0
  18   val mutable op = None
  19   val mutable displaying = true
  20
  21   method virtual set : string -> unit
  22   method virtual get : string
  23   method virtual quit : unit -> unit
  24   method insert s = calc#set (calc#get ^ s)
  25   method get_float = float_of_string (calc#get)
  26
  27   initializer calc#set "0"
  28
  29   method command s =
  30     if s <> "" then match s.[0] with
  31       '0'..'9' ->
  32         if displaying then (calc#set ""; displaying <- false);
  33         calc#insert s
  34     | '.' ->
  35         if displaying then
  36           (calc#set "0."; displaying <- false)
  37         else
  38           if not (mem_string ~char:'.' calc#get) then calc#insert s
  39     | '+'|'-'|'*'|'/' as c ->
  40         displaying <- true;
  41         begin match op with
  42           None ->
  43             x <- calc#get_float;
  44             op <- Some (List.assoc c ops)
  45         | Some f ->
  46             x <- f x (calc#get_float);
  47             op <- Some (List.assoc c ops);
  48             calc#set (string_of_float x)
  49         end
  50     | '='|'\n'|'\r' ->
  51         displaying <- true;
  52         begin match op with
  53           None -> ()
  54         | Some f ->
  55             x <- f x (calc#get_float);
  56             op <- None;
  57             calc#set (string_of_float x)
  58         end
  59     | 'q' -> calc#quit ()
  60     | _ -> ()
  61 end
  62
  63 (* Buttons for the calculator *)
  64
  65 let m =
  66   [|[|"7";"8";"9";"+"|];
  67     [|"4";"5";"6";"-"|];
  68     [|"1";"2";"3";"*"|];
  69     [|"0";".";"=";"/"|]|]
  70
  71 (* The physical calculator. Inherits from the abstract one *)
  72
  73 open GMain
  74
  75 class calculator ?packing ?show () =
  76   let table = GPack.table ~rows:5 ~columns:4 ~homogeneous:true ~show:false () in
  77   object (calc)
  78     inherit calc
  79
  80     val label =
  81       let frame = GBin.frame ~shadow_type:`IN ()
  82         ~packing:(table#attach ~left:0 ~top:0 ~right:4 ~expand:`BOTH) in
  83       let evbox = GBin.event_box ~packing:frame#add () in
  84       evbox#misc#set_style evbox#misc#style#copy;
  85       evbox#misc#style#set_bg [`NORMAL,`WHITE];
  86       GMisc.label ~justify:`RIGHT ~xalign:0.95 ~packing:evbox#add ()
  87     val table = table
  88
  89     method set = label#set_text
  90     method get = label#text
  91     method quit = Main.quit
  92
  93     initializer
  94       for i = 0 to 3 do for j = 0 to 3 do
  95         let button =
  96           GButton.button ~label:("  " ^ m.(i).(j) ^ "  ")
  97             ~packing:(table#attach ~top:(i+1) ~left:j ~expand:`BOTH) () in
  98         button#connect#clicked ~callback:(fun () -> calc#command m.(i).(j));
  99       done done;
 100       ignore (GObj.pack_return table ~packing ~show)
 101   end
 102
 103 (* Finally start everything *)
 104
 105 let w = GWindow.window ~auto_shrink:true ()
 106
 107 let applet = new calculator ~packing: w#add ()
 108
 109 let _ =
 110   w#connect#destroy ~callback: Main.quit;
 111   w#event#connect#key_press
 112     ~callback:(fun ev -> applet#command (GdkEvent.Key.string ev); true);
 113   w#show ();
 114   Main.main ()