diff options
| author | Pierre Weis <Pierre.Weis@inria.fr> | 2013-03-19 19:51:45 +0000 |
|---|---|---|
| committer | Pierre Weis <Pierre.Weis@inria.fr> | 2013-03-19 19:51:45 +0000 |
| commit | 677f402f684cf563e8274c1b0e102a7c7d7100b3 (patch) | |
| tree | 9e852bb0337b77c970ab9428962620e5db6d68c8 /otherlibs/labltk/examples_camltk | |
| parent | 5392f6f13e0909c5923610e75f82a1312636d964 (diff) | |
A more CamlTk-ish version.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13417 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'otherlibs/labltk/examples_camltk')
| -rw-r--r-- | otherlibs/labltk/examples_camltk/eyes.ml | 91 |
1 files changed, 51 insertions, 40 deletions
diff --git a/otherlibs/labltk/examples_camltk/eyes.ml b/otherlibs/labltk/examples_camltk/eyes.ml index b7636de42..056b72844 100644 --- a/otherlibs/labltk/examples_camltk/eyes.ml +++ b/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 ();; + |