Initial revision

[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / examples / calc.ml

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/calc.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/calc.ml
new file mode 100644 (file)
index 0000000..405d1bf
--- /dev/null
+++ b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/calc.ml
@@ -0,0 +1,114 @@
+(* $Id$ *)
+
+(* A simple calculator ported from LablTk to LablGtk *)
+
+let mem_string ~char s =
+  try
+    for i = 0 to String.length s -1 do
+      if s.[i] = char then raise Exit
+    done; false
+  with Exit -> true
+
+let ops = ['+',(+.); '-',(-.); '*',( *.); '/',(/.)]
+
+(* The abstract calculator class. Does not use Gtk *)
+
+class virtual calc = object (calc)
+  val mutable x = 0.0
+  val mutable op = None
+  val mutable displaying = true
+
+  method virtual set : string -> unit
+  method virtual get : string
+  method virtual quit : unit -> unit
+  method insert s = calc#set (calc#get ^ s)
+  method get_float = float_of_string (calc#get)
+
+  initializer calc#set "0"
+
+  method command s =
+    if s <> "" then match s.[0] with
+      '0'..'9' ->
+       if displaying then (calc#set ""; displaying <- false);
+       calc#insert s
+    | '.' ->
+       if displaying then
+         (calc#set "0."; displaying <- false)
+       else
+         if not (mem_string ~char:'.' calc#get) then calc#insert s
+    | '+'|'-'|'*'|'/' as c ->
+       displaying <- true;
+       begin match op with
+         None ->
+           x <- calc#get_float;
+           op <- Some (List.assoc c ops)
+       | Some f ->
+           x <- f x (calc#get_float);
+           op <- Some (List.assoc c ops);
+           calc#set (string_of_float x)
+       end
+    | '='|'\n'|'\r' ->
+       displaying <- true;
+       begin match op with
+         None -> ()
+       | Some f ->
+           x <- f x (calc#get_float);
+           op <- None;
+           calc#set (string_of_float x)
+       end
+    | 'q' -> calc#quit ()
+    | _ -> ()
+end
+
+(* Buttons for the calculator *)
+
+let m =
+  [|[|"7";"8";"9";"+"|];
+    [|"4";"5";"6";"-"|];
+    [|"1";"2";"3";"*"|];
+    [|"0";".";"=";"/"|]|]
+
+(* The physical calculator. Inherits from the abstract one *)
+
+open GMain
+
+class calculator ?packing ?show () =
+  let table = GPack.table ~rows:5 ~columns:4 ~homogeneous:true ~show:false () in
+  object (calc)
+    inherit calc
+
+    val label =
+      let frame = GBin.frame ~shadow_type:`IN ()
+       ~packing:(table#attach ~left:0 ~top:0 ~right:4 ~expand:`BOTH) in
+      let evbox = GBin.event_box ~packing:frame#add () in
+      evbox#misc#set_style evbox#misc#style#copy;
+      evbox#misc#style#set_bg [`NORMAL,`WHITE];
+      GMisc.label ~justify:`RIGHT ~xalign:0.95 ~packing:evbox#add ()
+    val table = table
+
+    method set = label#set_text
+    method get = label#text
+    method quit = Main.quit
+
+    initializer
+      for i = 0 to 3 do for j = 0 to 3 do
+       let button =
+         GButton.button ~label:("  " ^ m.(i).(j) ^ "  ")
+           ~packing:(table#attach ~top:(i+1) ~left:j ~expand:`BOTH) () in
+       button#connect#clicked ~callback:(fun () -> calc#command m.(i).(j));
+      done done;
+      ignore (GObj.pack_return table ~packing ~show)
+  end
+
+(* Finally start everything *)
+
+let w = GWindow.window ~auto_shrink:true ()
+
+let applet = new calculator ~packing: w#add ()
+
+let _ =
+  w#connect#destroy ~callback: Main.quit;
+  w#event#connect#key_press
+    ~callback:(fun ev -> applet#command (GdkEvent.Key.string ev); true);
+  w#show ();
+  Main.main ()