blob: a20116ed588a7873bf334893ecf8ee1fc462c757 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
(*************************************************************************)
(* *)
(* Objective Caml LablTk library *)
(* *)
(* Jun Furuse, projet Cristal, INRIA Rocquencourt *)
(* Jacques Garrigue, Kyoto University RIMS *)
(* *)
(* Copyright 1999 Institut National de Recherche en Informatique et *)
(* en Automatique and Kyoto University. All rights reserved. *)
(* This file is distributed under the terms of the GNU Library *)
(* General Public License. *)
(* *)
(*************************************************************************)
(* $Id$ *)
open Tk
let _ =
let top = openTk () in
let fw = Frame.create top in
pack [fw];
let c = Canvas.create ~width: 200 ~height: 200 fw in
let create_eye cx cy wx wy ewx ewy bnd =
let o2 = Canvas.create_oval
~x1:(cx - wx) ~y1:(cy - wy)
~x2:(cx + wx) ~y2:(cy + wy)
~outline: `Black ~width: 7
~fill: `White
c
and o = Canvas.create_oval
~x1:(cx - ewx) ~y1:(cy - ewy)
~x2:(cx + ewx) ~y2:(cy + ewy)
~fill:`Black
c in
let curx = ref cx
and cury = ref cy in
bind ~events:[`Motion] ~extend:true ~fields:[`MouseX; `MouseY]
~action:(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 ~x: (nx - !curx) ~y: (ny - !cury);
curx := nx;
cury := ny)
c
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 ()
|
