caml-list - the Caml user's mailing list
 help / color / mirror / Atom feed
From: "Michaël Grünewald" <michael-grunewald@wanadoo.fr>
To: caml-list@inria.fr
Subject: [Caml-list] Re: probleme de liaison avec un canvas
Date: 09 Jan 2003 06:37:47 +0100	[thread overview]
Message-ID: <87el7mhoic.fsf@ketanu.dyndns.org> (raw)
In-Reply-To: <3E1C051D.AC1FE622@ifsic.univ-rennes1.fr>

Sebastien Gandia - maitrise <gandias@ifsic.univ-rennes1.fr> writes:

> Bonjour, je travaille avec la librairie LablTK, et je desire associer a
> un canvas un evenement.
> Cet evenement est par exemple :
> 
> -quand on clique dans le canvas , on recupere les coordonnées de la zone
> cliquée
> 
> ça peut-etre aussi une action associée.
> 
> J'ai essayé avec canvas.bind mais ça n'a aucun effet.
> Ainsi pourriez vous me donner un exemple de code utilisant canvas.bind
> pour que je puisse comparer son implementation avec la mienne, car je
> pense que la solution est là.

Avec plaisir, dans la distribution de Tk il y a une floppée d'exemples, pour
faire connaissance avec ocamltk, je me suis entraîné à les
traduire. Exercice recommandé, il me semble.

Je me suis arrêté à un, le voici :

(* simple_graph *)

open Tk;;

let font_label = "arial";;
let font_plot = "Helvetica 18";;

let toplevel = opentk ();;

let w_msg = Label.create 
        ~font:font_label 
        ~justify:`Left 
        ~takefocus:false 
	~text:("This windows displays a canvas widget containing"
                ^" a simple two dimensional plot." toplevel)
;;
pack [w_msg];;

(* frame and buttons *)
let w_frame = Frame.create toplevel;;
let b_dismiss = Button.create ~text:"Dismiss" w_frame;;
let b_seecode = Button.create ~text:"See Code" w_frame;;

pack ~side:`Bottom ~fill:`X [w_frame];;
pack ~side:`Left ~fill:`X [b_seecode; b_dismiss];;

(* canvas *)
let canvas = Canvas.create ~relief:`Raised  ~width:450 ~height:450 toplevel;;

pack ~side:`Top [canvas];;

(* oh le joli dessin *)
(* les axes *)

Canvas.create_line ~width:2 ~xys:[100,250; 400,250] canvas;;
Canvas.create_line ~width:2 ~xys:[100,250; 100,50]  canvas;;

for k = 0 to 10 do 
	ignore(Canvas.create_line ~width:2 
				  ~xys:[100+k*30,250;100+k*30,245] canvas)
	done;;

for k = 0 to 5 do 
	ignore(Canvas.create_line ~width:2 
				  ~xys:[100,250-k*40;105,250-k*40] canvas)
	done;;

let point_list = [12,56;20,94;33,98;32,120;61,180;75,160;98,223];;
let place_point (x,y) =
	let true_x = 100 + 3 * x in
	let true_y = 250 - (4*y)/5 in
	let r = 6 in
	let item = Canvas.create_oval 
		~x1:(true_x - r) 
		~x2:(true_x + r)
		~y1:(true_y - r)
		~y2:(true_y + r)
		~width:1
		~fill:(`Color "Orange")
		~outline:(`Color "Black")
		canvas
		in
	Canvas.addtag canvas ~tag:"point" ~specs:[`Withtag item]
	in

List.iter place_point point_list;;

(* Note: le tag "current" est géré par Tk, c'est l'objet en cours, par
   exemple, celui sous le pointeur. *)     
let change_color color = 
    Canvas.configure_oval ~fill:(`Color color) canvas (`Tag "current")
  ;;


type plot_t = {mutable lastX:int;
	       mutable lastY:int;
	       }
  ;;

let plot = {lastX = 0; lastY = 0; }
  ;;

let plot_down x y = 
    begin
      Canvas.dtag canvas (`Tag "selected" ) "selected"; 
      Canvas.addtag canvas ~tag:"selected" ~specs:[`Withtag (`Tag "current")];
      Canvas.raise canvas (`Tag "current");
      plot.lastX <- x;
      plot.lastY <- y;
   end
	;;

let plot_move x y =
    begin
      Canvas.move canvas (`Tag "selected") (x - plot.lastX)
			  (y - plot.lastY);
      plot.lastX <- x;
      plot.lastY <- y;

   
   end
  ;;

Canvas.bind ~events:[`Enter] 
		     ~fields:[]
		     ~action:(function x ->  change_color "Red"; () )
		     canvas
		     (`Tag "point");;

Canvas.bind ~events:[`Leave] 
		     ~fields:[]
		     ~action:(function x ->  change_color "Orange"; () )
		     canvas
		     (`Tag "point");;

Canvas.bind ~events:[`ButtonPressDetail 1]
	~fields:[`MouseX;`MouseY]
	~action:(function x -> plot_down x.ev_MouseX x.ev_MouseY)
	canvas 
	(`Tag "point")
  ;;

Canvas.bind ~events:[`ButtonReleaseDetail 1]
	~fields:[`MouseX;`MouseY]
	~action:(function x -> Canvas.dtag canvas (`Tag "selected") "selected")
	canvas 
	(`Tag "point")
  ;;

Canvas.bind ~events:[`Motion]
	~fields:[`MouseX;`MouseY]
	~action:(function x -> plot_move x.ev_MouseX x.ev_MouseY)
	canvas
	(`Tag "point")
;;

mainLoop();;
-- 
Michaël Grünewald <michael-grunewald@wanadoo.fr>  - RSA PGP Key ID: 0x20D90C12
-------------------
To unsubscribe, mail caml-list-request@inria.fr Archives: http://caml.inria.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/
Beginner's list: http://groups.yahoo.com/group/ocaml_beginners


      reply	other threads:[~2003-01-09  6:43 UTC|newest]

Thread overview: 2+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2003-01-08 11:01 [Caml-list] " Sebastien Gandia - maitrise
2003-01-09  5:37 ` Michaël Grünewald [this message]

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87el7mhoic.fsf@ketanu.dyndns.org \
    --to=michael-grunewald@wanadoo.fr \
    --cc=caml-list@inria.fr \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).