File: calc.ml

package info (click to toggle)
lablgtk3 3.1.5-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 5,796 kB
  • sloc: ml: 40,890; ansic: 22,312; makefile: 133; sh: 17
file content (122 lines) | stat: -rw-r--r-- 3,455 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
(**************************************************************************)
(*    Lablgtk - Examples                                                  *)
(*                                                                        *)
(*    This code is in the public domain.                                  *)
(*    You may freely copy parts of it in your application.                *)
(*                                                                        *)
(**************************************************************************)

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

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 = GMain.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 _ = GMain.init ()

let w = GWindow.window ()

let applet = new calculator ~packing: w#add ()

let _ =
  w#connect#destroy ~callback: GMain.quit;
  w#event#connect#key_press
    ~callback:(fun ev -> applet#command (GdkEvent.Key.string ev); true);
  w#show ();
  GMain.main ()