change Canvas, pour des labels/ordre plus naturels

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3029 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

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