(***********************************************************************)

(*                                                                     *)

(*                 MLTk, Tcl/Tk interface of OCaml                     *)

(*                                                                     *)

(*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)

(*               projet Cristal, INRIA Rocquencourt                    *)

(*            Jacques Garrigue, Kyoto University RIMS                  *)

(*                                                                     *)

(*  Copyright 2002 Institut National de Recherche en Informatique et   *)

(*  en Automatique and Kyoto University.  All rights reserved.         *)

(*  This file is distributed under the terms of the GNU Library        *)

(*  General Public License, with the special exception on linking      *)

(*  described in file LICENSE found in the OCaml source tree.          *)

(*                                                                     *)

(***********************************************************************)

(* $Id$ *)

(* A simple calculator demonstrating OO programming with O'Labl

   and LablTk.

   LablTk itself is not OO, but it is good to wrap complex

   structures in objects. Even if the absence of initializers

   makes things a little bit awkward.

*)

open StdLabels

open Tk

let mem_string ~elt:c s =

  try

    for i = 0 to String.length s -1 do

      if s.[i] = c then raise Exit

    done; false

  with Exit -> true

let ops = ['+',(+.); '-',(-.); '*',( *.); '/',(/.)]

(* The abstract calculator class.

   Does not use Tk (only Textvariable) *)

class calc () = object (calc)

  val variable = Textvariable.create ()

  val mutable x = 0.0

  val mutable op = None

  val mutable displaying = true

  method set = Textvariable.set variable

  method get = Textvariable.get variable

  method insert s = calc#set (calc#get ^ s)

  method get_float = float_of_string (calc#get)

  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 ~elt:'.' 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 (Printf.sprintf "%g" x)

        end

    | '='|'\n'|'\r' ->

        displaying <- true;

        begin match op with

          None -> ()

        | Some f ->

            x <- f x (calc#get_float);

            op <- None;

            calc#set (Printf.sprintf "%g" x)

        end

    | 'q' -> closeTk (); exit 0

    | _ -> ()

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 ~parent = object

  inherit calc () as calc

  val label = Label.create ~anchor:`E ~relief:`Sunken ~padx:10 parent

  val frame = Frame.create parent

  initializer

    let buttons =

      Array.map ~f:

        (List.map ~f:

           (fun text ->

             Button.create ~text ~command:(fun () -> calc#command text) frame))

        m

    in

    Label.configure ~textvariable:variable label;

    calc#set "0";

    bind ~events:[`KeyPress] ~fields:[`Char]

      ~action:(fun ev -> calc#command ev.ev_Char)

      parent;

    for i = 0 to Array.length m - 1 do

      Grid.configure ~row:i buttons.(i)

    done;

    pack ~side:`Top ~fill:`X [label];

    pack ~side:`Bottom ~fill:`Both ~expand:true [frame];

end

(* Finally start everything *)

let top = openTk ()

let applet = new calculator ~parent:top

let _ = mainLoop ()