(***********************************************************************)

(*                                                                     *)

(*                 MLTk, Tcl/Tk interface of OCaml                     *)

(*                                                                     *)

(*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)

(*               projet Cristal, INRIA Rocquencourt                    *)

(*            Jacques Garrigue, Kyoto University RIMS                  *)

(*                                                                     *)

(*  Copyright 2002 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, with the special exception on linking      *)

(*  described in file LICENSE found in the OCaml source tree.          *)

(*                                                                     *)

(***********************************************************************)

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