-(* $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 ()