summaryrefslogtreecommitdiffstats
path: root/otherlibs/labltk/example/clock.ml
diff options
context:
space:
mode:
Diffstat (limited to 'otherlibs/labltk/example/clock.ml')
-rw-r--r--otherlibs/labltk/example/clock.ml72
1 files changed, 42 insertions, 30 deletions
diff --git a/otherlibs/labltk/example/clock.ml b/otherlibs/labltk/example/clock.ml
index 37d4542eb..f1fce00db 100644
--- a/otherlibs/labltk/example/clock.ml
+++ b/otherlibs/labltk/example/clock.ml
@@ -35,7 +35,7 @@ let pi = acos (-1.)
class clock :parent = object (self)
(* Instance variables *)
- val canvas = Canvas.create parent width:100 height:100
+ val canvas = Canvas.create width:100 height:100 parent
val mutable height = 100
val mutable width = 100
val mutable rflag = -1
@@ -46,74 +46,86 @@ class clock :parent = object (self)
initializer
(* Create the oval border *)
- Canvas.create_oval canvas tags:[`Tag "cadran"]
- x1:1 y1:1 x2:(width - 2) y2:(height - 2)
- width:3 outline:`Yellow fill:`White;
+ Canvas.create_oval x1:1 y1:1 x2:(width - 2) y2:(height - 2)
+ tags:["cadran"] width:3 outline:`Yellow fill:`White
+ canvas;
(* Draw the figures *)
self#draw_figures;
(* Create the arrows with dummy position *)
- Canvas.create_line canvas tags:[`Tag "hours"] fill:`Red
- xys:[self#x 0.; self#y 0.; self#x 0.; self#y 0.];
- Canvas.create_line canvas tags:[`Tag "minutes"] fill:`Blue
- xys:[self#x 0.; self#y 0.; self#x 0.; self#y 0.];
- Canvas.create_line canvas tags:[`Tag "seconds"] fill:`Black
- xys:[self#x 0.; self#y 0.; self#x 0.; self#y 0.];
+ Canvas.create_line xys:[self#x 0.; self#y 0.; self#x 0.; self#y 0.]
+ tags:["hours"] fill:`Red
+ canvas;
+ Canvas.create_line xys:[self#x 0.; self#y 0.; self#x 0.; self#y 0.]
+ tags:["minutes"] fill:`Blue
+ canvas;
+ Canvas.create_line xys:[self#x 0.; self#y 0.; self#x 0.; self#y 0.]
+ tags:["seconds"] fill:`Black
+ canvas;
(* Setup a timer every second *)
let rec timer () =
self#draw_arrows (Unix.localtime (Unix.time ()));
Timer.add ms:1000 callback:timer; ()
in timer ();
(* Redraw when configured (changes size) *)
- bind canvas events:[`Configure]
+ bind events:[`Configure]
action:(fun _ ->
width <- Winfo.width canvas;
height <- Winfo.height canvas;
- self#redraw);
+ self#redraw)
+ canvas;
(* Change direction with right button *)
- bind canvas events:[`ButtonPressDetail 3]
- action:(fun _ -> rflag <- -rflag; self#redraw);
+ bind events:[`ButtonPressDetail 3]
+ action:(fun _ -> rflag <- -rflag; self#redraw)
+ canvas;
(* Pack, expanding in both directions *)
- pack [canvas] fill:`Both expand:true
+ pack fill:`Both expand:true [canvas]
(* Redraw everything *)
method redraw =
- Canvas.coords_set canvas tag:(`Tag "cadran")
- coords:[ 1; 1; width - 2; height - 2 ];
+ Canvas.coords_set :canvas
+ coords:[ 1; 1; width - 2; height - 2 ]
+ (`Tag "cadran");
self#draw_figures;
self#draw_arrows (Unix.localtime (Unix.time ()))
(* Delete and redraw the figures *)
method draw_figures =
- Canvas.delete canvas tags:[`Tag "figures"];
+ Canvas.delete :canvas [`Tag "figures"];
for i = 1 to 12 do
let angle = float (rflag * i - 3) *. pi /. 6. in
- Canvas.create_text canvas tags:[`Tag "figures"]
+ Canvas.create_text
+ x:(self#x (0.8 *. cos angle)) y:(self#y (0.8 *. sin angle))
+ tags:["figures"]
text:(string_of_int i) font:"variable"
- x:(self#x (0.8 *. cos angle))
- y:(self#y (0.8 *. sin angle))
anchor:`Center
+ canvas
done
(* Resize and reposition the arrows *)
method draw_arrows tm =
- Canvas.configure_line canvas tag:(`Tag "hours")
- width:(min width height / 40);
+ Canvas.configure_line :canvas
+ width:(min width height / 40)
+ (`Tag "hours");
let hangle =
float (rflag * (tm.Unix.tm_hour * 60 + tm.Unix.tm_min) - 180)
*. pi /. 360. in
- Canvas.coords_set canvas tag:(`Tag "hours")
+ Canvas.coords_set :canvas
coords:[ self#x 0.; self#y 0.;
- self#x (cos hangle /. 2.); self#y (sin hangle /. 2.) ];
- Canvas.configure_line canvas tag:(`Tag "minutes")
- width:(min width height / 50);
+ self#x (cos hangle /. 2.); self#y (sin hangle /. 2.) ]
+ (`Tag "hours");
+ Canvas.configure_line :canvas
+ width:(min width height / 50)
+ (`Tag "minutes");
let mangle = float (rflag * tm.Unix.tm_min - 15) *. pi /. 30. in
- Canvas.coords_set canvas tag:(`Tag "minutes")
+ Canvas.coords_set :canvas
coords:[ self#x 0.; self#y 0.;
- self#x (cos mangle /. 1.5); self#y (sin mangle /. 1.5) ];
+ self#x (cos mangle /. 1.5); self#y (sin mangle /. 1.5) ]
+ (`Tag "minutes");
let sangle = float (rflag * tm.Unix.tm_sec - 15) *. pi /. 30. in
- Canvas.coords_set canvas tag:(`Tag "seconds")
+ Canvas.coords_set :canvas
coords:[ self#x 0.; self#y 0.;
self#x (cos sangle /. 1.25); self#y (sin sangle /. 1.25) ]
+ (`Tag "seconds")
end
(* Initialize the Tcl interpreter *)