diff options
Diffstat (limited to 'otherlibs/labltk/example/clock.ml')
-rw-r--r-- | otherlibs/labltk/example/clock.ml | 72 |
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 *) |