|
Packit |
bd2e5d |
(***********************************************************************)
|
|
Packit |
bd2e5d |
(* *)
|
|
Packit |
bd2e5d |
(* MLTk, Tcl/Tk interface of OCaml *)
|
|
Packit |
bd2e5d |
(* *)
|
|
Packit |
bd2e5d |
(* Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis *)
|
|
Packit |
bd2e5d |
(* projet Cristal, INRIA Rocquencourt *)
|
|
Packit |
bd2e5d |
(* Jacques Garrigue, Kyoto University RIMS *)
|
|
Packit |
bd2e5d |
(* *)
|
|
Packit |
bd2e5d |
(* Copyright 2002 Institut National de Recherche en Informatique et *)
|
|
Packit |
bd2e5d |
(* en Automatique and Kyoto University. All rights reserved. *)
|
|
Packit |
bd2e5d |
(* This file is distributed under the terms of the GNU Library *)
|
|
Packit |
bd2e5d |
(* General Public License, with the special exception on linking *)
|
|
Packit |
bd2e5d |
(* described in file LICENSE found in the OCaml source tree. *)
|
|
Packit |
bd2e5d |
(* *)
|
|
Packit |
bd2e5d |
(***********************************************************************)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* $Id$ *)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* Clock/V, a simple clock.
|
|
Packit |
bd2e5d |
Reverts every time you push the right button.
|
|
Packit |
bd2e5d |
Adapted from ASCII/V May 1997
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
Uses Tk and Unix, so you must link with
|
|
Packit |
bd2e5d |
labltklink unix.cma clock.ml -o clock -cclib -lunix
|
|
Packit |
bd2e5d |
*)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
open Tk
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* pi is not a constant! *)
|
|
Packit |
bd2e5d |
let pi = acos (-1.)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* The main class:
|
|
Packit |
bd2e5d |
* create it with a parent: [new clock parent:top]
|
|
Packit |
bd2e5d |
* initialize with [#init]
|
|
Packit |
bd2e5d |
*)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
class clock ~parent = object (self)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* Instance variables *)
|
|
Packit |
bd2e5d |
val canvas = Canvas.create ~width:100 ~height:100 parent
|
|
Packit |
bd2e5d |
val mutable height = 100
|
|
Packit |
bd2e5d |
val mutable width = 100
|
|
Packit |
bd2e5d |
val mutable rflag = -1
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* Convert from -1.0 .. 1.0 to actual positions on the canvas *)
|
|
Packit |
bd2e5d |
method x x0 = truncate (float width *. (x0 +. 1.) /. 2.)
|
|
Packit |
bd2e5d |
method y y0 = truncate (float height *. (y0 +. 1.) /. 2.)
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
initializer
|
|
Packit |
bd2e5d |
(* Create the oval border *)
|
|
Packit |
bd2e5d |
Canvas.create_oval canvas ~tags:["cadran"]
|
|
Packit |
bd2e5d |
~x1:1 ~y1:1 ~x2:(width - 2) ~y2:(height - 2)
|
|
Packit |
bd2e5d |
~width:3 ~outline:`Yellow ~fill:`White;
|
|
Packit |
bd2e5d |
(* Draw the figures *)
|
|
Packit |
bd2e5d |
self#draw_figures;
|
|
Packit |
bd2e5d |
(* Create the arrows with dummy position *)
|
|
Packit |
bd2e5d |
Canvas.create_line canvas
|
|
Packit |
bd2e5d |
~xys:[self#x 0., self#y 0.; self#x 0., self#y 0.]
|
|
Packit |
bd2e5d |
~tags:["hours"] ~fill:`Red;
|
|
Packit |
bd2e5d |
Canvas.create_line canvas
|
|
Packit |
bd2e5d |
~xys:[self#x 0., self#y 0.; self#x 0., self#y 0.]
|
|
Packit |
bd2e5d |
~tags:["minutes"] ~fill:`Blue;
|
|
Packit |
bd2e5d |
Canvas.create_line canvas
|
|
Packit |
bd2e5d |
~xys:[self#x 0., self#y 0.; self#x 0., self#y 0.]
|
|
Packit |
bd2e5d |
~tags:["seconds"] ~fill:`Black;
|
|
Packit |
bd2e5d |
(* Setup a timer every second *)
|
|
Packit |
bd2e5d |
let rec timer () =
|
|
Packit |
bd2e5d |
self#draw_arrows (Unix.localtime (Unix.time ()));
|
|
Packit |
bd2e5d |
Timer.add ~ms:1000 ~callback:timer; ()
|
|
Packit |
bd2e5d |
in timer ();
|
|
Packit |
bd2e5d |
(* Redraw when configured (changes size) *)
|
|
Packit |
bd2e5d |
bind canvas ~events:[`Configure] ~action:
|
|
Packit |
bd2e5d |
begin fun _ ->
|
|
Packit |
bd2e5d |
width <- Winfo.width canvas;
|
|
Packit |
bd2e5d |
height <- Winfo.height canvas;
|
|
Packit |
bd2e5d |
self#redraw
|
|
Packit |
bd2e5d |
end;
|
|
Packit |
bd2e5d |
(* Change direction with right button *)
|
|
Packit |
bd2e5d |
bind canvas ~events:[`ButtonPressDetail 3]
|
|
Packit |
bd2e5d |
~action:(fun _ -> rflag <- -rflag; self#redraw);
|
|
Packit |
bd2e5d |
(* Pack, expanding in both directions *)
|
|
Packit |
bd2e5d |
pack ~fill:`Both ~expand:true [canvas]
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* Redraw everything *)
|
|
Packit |
bd2e5d |
method redraw =
|
|
Packit |
bd2e5d |
Canvas.coords_set canvas (`Tag "cadran")
|
|
Packit |
bd2e5d |
~xys:[ 1, 1; width - 2, height - 2 ];
|
|
Packit |
bd2e5d |
self#draw_figures;
|
|
Packit |
bd2e5d |
self#draw_arrows (Unix.localtime (Unix.time ()))
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* Delete and redraw the figures *)
|
|
Packit |
bd2e5d |
method draw_figures =
|
|
Packit |
bd2e5d |
Canvas.delete canvas [`Tag "figures"];
|
|
Packit |
bd2e5d |
for i = 1 to 12 do
|
|
Packit |
bd2e5d |
let angle = float (rflag * i - 3) *. pi /. 6. in
|
|
Packit |
bd2e5d |
Canvas.create_text canvas
|
|
Packit |
bd2e5d |
~x:(self#x (0.8 *. cos angle)) ~y:(self#y (0.8 *. sin angle))
|
|
Packit |
bd2e5d |
~tags:["figures"]
|
|
Packit |
bd2e5d |
~text:(string_of_int i) ~font:"variable"
|
|
Packit |
bd2e5d |
~anchor:`Center
|
|
Packit |
bd2e5d |
done
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* Resize and reposition the arrows *)
|
|
Packit |
bd2e5d |
method draw_arrows tm =
|
|
Packit |
bd2e5d |
Canvas.configure_line ~width:(min width height / 40)
|
|
Packit |
bd2e5d |
canvas (`Tag "hours");
|
|
Packit |
bd2e5d |
let hangle =
|
|
Packit |
bd2e5d |
float (rflag * (tm.Unix.tm_hour * 60 + tm.Unix.tm_min) - 180)
|
|
Packit |
bd2e5d |
*. pi /. 360. in
|
|
Packit |
bd2e5d |
Canvas.coords_set canvas (`Tag "hours")
|
|
Packit |
bd2e5d |
~xys:[ self#x 0., self#y 0.;
|
|
Packit |
bd2e5d |
self#x (cos hangle /. 2.), self#y (sin hangle /. 2.) ];
|
|
Packit |
bd2e5d |
Canvas.configure_line ~width:(min width height / 50)
|
|
Packit |
bd2e5d |
canvas (`Tag "minutes");
|
|
Packit |
bd2e5d |
let mangle = float (rflag * tm.Unix.tm_min - 15) *. pi /. 30. in
|
|
Packit |
bd2e5d |
Canvas.coords_set canvas (`Tag "minutes")
|
|
Packit |
bd2e5d |
~xys:[ self#x 0., self#y 0.;
|
|
Packit |
bd2e5d |
self#x (cos mangle /. 1.5), self#y (sin mangle /. 1.5) ];
|
|
Packit |
bd2e5d |
let sangle = float (rflag * tm.Unix.tm_sec - 15) *. pi /. 30. in
|
|
Packit |
bd2e5d |
Canvas.coords_set canvas (`Tag "seconds")
|
|
Packit |
bd2e5d |
~xys:[ self#x 0., self#y 0.;
|
|
Packit |
bd2e5d |
self#x (cos sangle /. 1.25), self#y (sin sangle /. 1.25) ]
|
|
Packit |
bd2e5d |
end
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* Initialize the Tcl interpreter *)
|
|
Packit |
bd2e5d |
let top = openTk ()
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* Create a clock on the main window *)
|
|
Packit |
bd2e5d |
let clock =
|
|
Packit |
bd2e5d |
new clock ~parent:top
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* Wait for events *)
|
|
Packit |
bd2e5d |
let _ = mainLoop ()
|