X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fexamples%2Frpn.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fexamples%2Frpn.ml;h=e701f185c64183fb72aaefa2aa0dcc75474bff1a;hb=2ee84a2a641938988703e329aef9fc3c5eb5aacf;hp=0000000000000000000000000000000000000000;hpb=34d83812af9b7064cc8f735c2a78169881140010;p=helm.git

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/rpn.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/rpn.ml
new file mode 100644
index 000000000..e701f185c
--- /dev/null
+++ b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/rpn.ml
@@ -0,0 +1,129 @@
+(* $Id$ *)
+
+(* reverse polish calculator *)
+
+open GMain
+
+let wow _ = prerr_endline "Wow!"; ()
+let main () =
+  let stack = Stack.create () in	
+
+  (* toplevel window *)
+  let window =
+    GWindow.window ~border_width: 10 ~title:"Reverse Polish Calculator" () in
+  window#connect#destroy ~callback:Main.quit;
+
+
+  (* vbox *)
+  let vbx = GPack.vbox ~packing:window#add () in
+
+  (* entry *)
+  let entry =
+    GEdit.entry ~text:"0" ~editable:false ~max_length: 20 ~packing: vbx#add () in
+
+  (* BackSpace, Clear, All Clear, Quit *) 
+  let table0 = GPack.table ~rows:1 ~columns:4 ~packing:vbx#add () in
+  let bs_clicked _ = begin
+    let txt = entry#text in
+    let len = String.length txt in 
+    if len <= 1 then
+      entry#set_text "0"
+    else entry#set_text (String.sub txt ~pos:0 ~len:(len-1))
+  end in
+  let c_clicked _ = entry#set_text("0") in
+  let ac_clicked _ = Stack.clear stack; entry#set_text("0") in
+  let labels0 = [("BS", bs_clicked) ; ("C", c_clicked);
+		 ("AC", ac_clicked); ("Quit", window#destroy)] in
+  let rec loop0 labels n =
+    match labels 
+    with  [] -> ()
+        | (lbl, cb) :: t  ->
+    let button =
+      GButton.button ~label:lbl
+        ~packing:(table0#attach ~left:n ~top:1 ~expand:`BOTH) () in
+    button#connect#clicked ~callback:cb;
+    loop0 t (n+1) in
+  loop0 labels0 1;
+
+  (* Numerals *)
+  let table1 = GPack.table ~rows:4 ~columns:5 ~packing:vbx#add () in
+  let labels1 = ["7"; "8"; "9"; "4"; "5"; "6"; "1"; "2"; "3"; "0"] in
+  let numClicked n _ =
+     let txt = entry#text in
+     if (txt = "0") then
+       entry#set_text n
+     else begin
+       entry#append_text n
+     end in
+  let rec loop1 labels n =
+    match labels with [] -> ()
+    | lbl :: lbls ->
+        let button = GButton.button ~label:(" "^lbl^" ")
+	    ~packing:(table1#attach ~left:(n mod 3) ~top:(n/3) ~expand:`BOTH)
+            () in
+        button#connect#clicked ~callback:(numClicked lbl);
+        loop1 lbls (n+1) in
+  loop1 labels1 0; 
+
+  (* Period *)
+  let periodClicked _ = 
+     let txt = entry#text in
+     if (String.contains txt '.') then begin
+      	Printf.printf "\a";
+        flush stdout;
+     end
+     else
+       entry#append_text "." in
+  (GButton.button ~label:" . "
+     ~packing:(table1#attach ~left:1 ~top:3 ~expand:`BOTH) ())
+    #connect#clicked ~callback:periodClicked;
+
+  (* Enter (Push) *)
+  let enterClicked _ =
+     let txt = entry#text in
+     let n = float_of_string txt in begin
+       Stack.push n stack;
+       entry#set_text "0"
+     end in
+  (GButton.button ~label:"Ent"
+     ~packing:(table1#attach ~left:2 ~top:3 ~expand:`BOTH) ())
+    #connect#clicked ~callback:enterClicked;
+
+  (* Operators *)
+  let op2Clicked op _ =
+    let n1 = float_of_string (entry#text) in
+    let n2 = Stack.pop stack in
+    entry#set_text (string_of_float (op n2 n1)) 
+  in
+  let op1Clicked op _ =
+    let n1 = float_of_string (entry#text) in
+    entry#set_text (string_of_float (op n1)) 
+  in
+  let modClicked _ =
+    let n1 = int_of_string (entry#text) in
+    let n2 = truncate (Stack.pop stack) in
+    entry#set_text (string_of_int (n2 mod n1))
+  in
+  let labels2 = [(" / ", op2Clicked (/.)); (" * ", op2Clicked ( *. ));
+		 (" - ", op2Clicked (-.)); (" + ", op2Clicked (+.));
+		 ("mod", modClicked); (" ^ ", op2Clicked ( ** ));
+		 ("+/-", op1Clicked (~-.));
+                 ("1/x", op1Clicked (fun x -> 1.0/.x))] in
+  let rec loop2 labels n =
+    match labels
+    with [] -> ()
+    | (lbl, cb) :: t ->
+	let button = GButton.button ~label:lbl
+            ~packing:(table1#attach ~left:(3 + n/4) ~top: (n mod 4)
+                        ~expand:`BOTH)
+            () in
+	button#connect#clicked ~callback:cb;
+	loop2 t (n+1)
+  in
+  loop2 labels2 0;
+
+  (* show all and enter event loop *)
+  window#show ();
+  Main.main ()
+
+let _ = Printexc.print main()