Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

A more CamlTk-ish version.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13417 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information...
commit 677f402f684cf563e8274c1b0e102a7c7d7100b3 1 parent 5392f6f
Pierre Weis authored
Showing with 51 additions and 40 deletions.
  1. +51 −40 otherlibs/labltk/examples_camltk/eyes.ml
View
91 otherlibs/labltk/examples_camltk/eyes.ml
@@ -18,46 +18,57 @@
open Camltk;;
-let _ =
- let top = opentk () in
+let create_eye canvas cx cy wx wy ewx ewy bnd =
+ let _oval2 =
+ Canvas.create_oval canvas
+ (Pixels (cx - wx)) (Pixels (cy - wy))
+ (Pixels (cx + wx)) (Pixels (cy + wy))
+ [Outline (NamedColor "black"); Width (Pixels 7);
+ FillColor (NamedColor "white"); ]
+ and oval =
+ Canvas.create_oval canvas
+ (Pixels (cx - ewx)) (Pixels (cy - ewy))
+ (Pixels (cx + ewx)) (Pixels (cy + ewy))
+ [FillColor (NamedColor "black")] in
+ let curx = ref cx
+ and cury = ref cy in
+
+ let treat_event e =
+
+ let xdiff = e.ev_MouseX - cx
+ and ydiff = e.ev_MouseY - cy in
+
+ let diff =
+ sqrt ((float xdiff /. (float wx *. bnd)) ** 2.0 +.
+ (float ydiff /. (float wy *. bnd)) ** 2.0) in
+
+ let nx, ny =
+ if diff <= 1.0 then e.ev_MouseX, e.ev_MouseY else
+ truncate ((float xdiff) *. (1.0 /. diff)) + cx,
+ truncate ((float ydiff) *. (1.0 /. diff)) + cy in
+
+ Canvas.move canvas oval (Pixels (nx - !curx)) (Pixels (ny - !cury));
+ curx := nx;
+ cury := ny; in
+
+ bind canvas [[], Motion] (
+ BindExtend ([Ev_MouseX; Ev_MouseY], treat_event)
+ )
+;;
+let main () =
+ let top = opentk () in
let fw = Frame.create top [] in
pack [fw] [];
- let c = Canvas.create fw [Width (Pixels 200); Height (Pixels 200)] in
- let create_eye cx cy wx wy ewx ewy bnd =
- let _o2 =
- Canvas.create_oval c
- (Pixels (cx - wx)) (Pixels (cy - wy))
- (Pixels (cx + wx)) (Pixels (cy + wy))
- [Outline (NamedColor "black"); Width (Pixels 7);
- FillColor (NamedColor "white")]
- and o =
- Canvas.create_oval c
- (Pixels (cx - ewx)) (Pixels (cy - ewy))
- (Pixels (cx + ewx)) (Pixels (cy + ewy))
- [FillColor (NamedColor "black")] in
- let curx = ref cx
- and cury = ref cy in
- bind c [[], Motion]
- (BindExtend ([Ev_MouseX; Ev_MouseY],
- (fun e ->
- let nx, ny =
- let xdiff = e.ev_MouseX - cx
- and ydiff = e.ev_MouseY - cy in
- let diff = sqrt ((float xdiff /. (float wx *. bnd)) ** 2.0 +.
- (float ydiff /. (float wy *. bnd)) ** 2.0) in
- if diff > 1.0 then
- truncate ((float xdiff) *. (1.0 /. diff)) + cx,
- truncate ((float ydiff) *. (1.0 /. diff)) + cy
- else
- e.ev_MouseX, e.ev_MouseY
- in
- Canvas.move c o (Pixels (nx - !curx)) (Pixels (ny - !cury));
- curx := nx;
- cury := ny)))
- in
- create_eye 60 100 30 40 5 6 0.6;
- create_eye 140 100 30 40 5 6 0.6;
- pack [c] []
-
-let _ = Printexc.print mainLoop ()
+
+ let canvas = Canvas.create fw [Width (Pixels 200); Height (Pixels 200)] in
+
+ create_eye canvas 60 100 30 40 5 6 0.6;
+ create_eye canvas 140 100 30 40 5 6 0.6;
+ pack [canvas] [];
+
+ mainLoop ();
+;;
+
+Printexc.print main ();;
+
Please sign in to comment.
Something went wrong with that request. Please try again.