9e74813ef35862a86dc264d5a3efbbb04025aabe
[scilab.git] / scilab / modules / graphics / macros / gr_macros.sce
1 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 // Copyright (C) INRIA
3 //
4 // This file must be used under the terms of the CeCILL.
5 // This source file is licensed as described in the file COPYING, which
6 // you should have received as part of this distribution.  The terms
7 // are also available at;
8 // http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
9
10 function []=Delete(sd)
11     //destruction d'un objet
12     xx=locate(1);eps=0.2
13     mm=clearmode();
14     //recherche de l'objet contenant le point
15     for ko=2:ksd;
16         obj=sd(ko);
17         to="rien";if size(obj)<>0 then to=obj(1);end,
18         select to
19         case "ligne" then
20             z=obj(2),[nw,npt]=size(z),
21             for kpt=2:npt
22                 e=norm(xx-z(:,kpt),2)+norm(xx-z(:,kpt-1),2)
23                 if abs(e-norm(z(:,kpt)-z(:,kpt-1),2))< eps then
24                     sd(ko)=ligne(obj,"del");
25                 end,
26             end,
27         case "fligne" then
28             z=obj(2),[nw,npt]=size(z),
29             for kpt=2:npt
30                 e=norm(xx-z(:,kpt),2)+norm(xx-z(:,kpt-1),2)
31                 if abs(e-norm(z(:,kpt)-z(:,kpt-1),2))< eps then
32                     sd(ko)=fligne(obj,"del");
33                 end,
34             end,
35         case "rect" then
36             x1=obj(2);x2=obj(3);y1=obj(4);y2=obj(5);
37             z=[x1,x1,x2,x2,x1 ; y1,y2,y2,y1,y1];
38             [nw,npt]=size(z),
39             for kpt=2:npt
40                 e=norm(xx-z(:,kpt),2)+norm(xx-z(:,kpt-1),2)
41                 if abs(e-norm(z(:,kpt)-z(:,kpt-1),2))< eps then
42                     sd(ko)=rect(obj,"del");
43                 end,
44             end,
45         case "frect" then
46             x1=obj(2);x2=obj(3);y1=obj(4);y2=obj(5);
47             z=[x1,x1,x2,x2,x1 ; y1,y2,y2,y1,y1];
48             [nw,npt]=size(z),
49             for kpt=2:npt
50                 e=norm(xx-z(:,kpt),2)+norm(xx-z(:,kpt-1),2)
51                 if abs(e-norm(z(:,kpt)-z(:,kpt-1),2))< eps then
52                     sd(ko)=frect(obj,"del");
53                 end,
54             end,
55         case "points" then
56             z=obj(2),[nw,npt]=size(z),
57             for kpt=2:npt
58                 e=norm(xx-z(:,kpt),2)+norm(xx-z(:,kpt-1),2)
59                 if abs(e-norm(z(:,kpt)-z(:,kpt-1),2))< eps then
60                     sd(ko)=points(obj,"del");
61                 end,
62             end,
63         case "cercle" then
64             dist=norm(obj(2)-xx,2);
65             if abs(dist-obj(3))<eps then sd(ko)=cerc(obj,"del");end,
66         case "fcercle" then
67             dist=norm(obj(2)-xx,2);
68             if abs(dist-obj(3))<eps then sd(ko)=fcerc(obj,"del");end,
69         case "fleche" then
70             o1=obj(2);o2=obj(3);p1=[o1(1);o2(1)];p2=[o1(2);o2(2)];
71             e=norm(xx-p1,2)+norm(xx-p2,2)
72             if abs(e-norm(p2-p1))< eps then sd(ko)=fleche(obj,"del");end,
73         case "comm" then
74             xxr=xstringl(0,0,obj(3))
75             hx=xxr(3);
76             hy=xxr(4);
77             crit=norm(obj(2)-xx)+norm(obj(2)+[hx;hy]-xx)
78             if crit<hx+hy then sd(ko)=comment(obj,"del");end
79         end, //fin selec to
80     end; //fin for ko ...
81     modeback(mm);
82     sd=resume(sd)
83 endfunction
84
85 function sd=Move(sd)
86     //deplacement d'un objet
87     // Copyright INRIA
88     xx=locate(1);eps=0.03
89     //mm=clearmode();
90     //recherche de l'objet contenant le point
91     for ko=2:ksd;
92         obj=sd(ko);
93         to="rien";if size(obj)<>0 then to=obj(1);end,
94         select to
95         case "ligne" then
96             z=obj(2),[nw,npt]=size(z),
97             for kpt=2:npt
98                 e=norm(xx-z(:,kpt),2)+norm(xx-z(:,kpt-1),2)
99                 if abs(e-norm(z(:,kpt)-z(:,kpt-1),2))< eps then
100                     new=ligne(obj,"mov");
101                     if new<>list() then
102                         sd(ko)=new
103                     end
104                     return;
105                 end,
106             end,
107         case "fligne" then
108             z=obj(2),[nw,npt]=size(z),
109             for kpt=2:npt
110                 e=norm(xx-z(:,kpt),2)+norm(xx-z(:,kpt-1),2)
111                 if abs(e-norm(z(:,kpt)-z(:,kpt-1),2))< eps then
112                     new=fligne(obj,"mov");
113                     if new<>list() then
114                         sd(ko)=new
115                     end
116                     return;
117                 end,
118             end,
119         case "rect" then
120             x1=obj(2);x2=obj(3);y1=obj(4);y2=obj(5);
121             z=[x1,x1,x2,x2,x1 ; y1,y2,y2,y1,y1];
122             [nw,npt]=size(z),
123             for kpt=2:npt
124                 e=norm(xx-z(:,kpt),2)+norm(xx-z(:,kpt-1),2)
125                 if abs(e-norm(z(:,kpt)-z(:,kpt-1),2))< eps then
126                     new=rect(obj,"mov");
127                     if new<>list() then
128                         sd(ko)=new
129                     end
130                     return;
131                 end,
132             end,
133         case "frect" then
134             x1=obj(2);x2=obj(3);y1=obj(4);y2=obj(5);
135             z=[x1,x1,x2,x2,x1 ; y1,y2,y2,y1,y1];
136             [nw,npt]=size(z),
137             for kpt=2:npt
138                 e=norm(xx-z(:,kpt),2)+norm(xx-z(:,kpt-1),2)
139                 if abs(e-norm(z(:,kpt)-z(:,kpt-1),2))< eps then
140                     new=frect(obj,"mov");
141                     if new<>list() then
142                         sd(ko)=new
143                     end
144                     return;
145                 end,
146             end,
147         case "points" then
148             z=obj(2),[nw,npt]=size(z),
149             for kpt=2:npt
150                 e=norm(xx-z(:,kpt),2)+norm(xx-z(:,kpt-1),2)
151                 if abs(e-norm(z(:,kpt)-z(:,kpt-1),2))< eps then
152                     new=points(obj,"mov");
153                     if new<>list() then
154                         sd(ko)=new
155                     end
156                     return;
157                 end,
158             end,
159         case "cercle" then
160             dist=norm(obj(2)-xx,2);
161             if abs(dist-obj(3))<eps then
162                 new=cerc(obj,"mov");
163                 if new<>list() then
164                     sd(ko)=new
165                 end
166                 return;
167             end
168         case "fcercle" then
169             dist=norm(obj(2)-xx,2);
170             if abs(dist-obj(3))<eps then
171                 new=fcerc(obj,"mov");
172                 if new<>list() then
173                     sd(ko)=new
174                 end
175                 return;
176             end
177         case "fleche" then
178             o1=obj(2);o2=obj(3);p1=[o1(1);o2(1)];p2=[o1(2);o2(2)];
179             e=norm(xx-p1,2)+norm(xx-p2,2)
180             if abs(e-norm(p2-p1))< eps then
181                 new=fleche(obj,"mov");
182                 if new<>list() then
183                     sd(ko)=new
184                 end
185                 return;
186             end
187         case "comm" then
188             xxr=xstringl(0,0,obj(3))
189             hx=xxr(3);
190             hy=xxr(4);
191             crit=norm(obj(2)-xx)+norm(obj(2)+[hx;hy]-xx)
192             if crit<hx+hy then
193                 new=comment(obj,"mov");
194                 if new<>list() then
195                     sd(ko)=new
196                 end
197                 return;
198             end
199         end, //fin selec to
200     end; //fin for ko ...
201 endfunction
202
203 function [sd1]=symbs(sd,del)
204     [lhs,rhs]=argn(0);sd1=[];
205     if rhs<=0 then
206         c=getsymbol("Choose a mark");
207         if c==[] then
208             c=xget("mark")
209         end
210         n1=c(1);dime=c(2)
211         sd1=list("symbs",c(1),c(2));
212     else
213         n1=sd(2);dime=sd(3)
214     end
215     xset("mark",n1,dime);
216 endfunction
217
218 function [sd1]=dashs(sd,del)
219     [lhs,rhs]=argn(0);sd1=[];
220     if rhs<=0 then
221         n1=x_choose(dash,"Choose a dash style");
222         if n1==[] then
223             sd1=list()
224         else
225             sd1=list("dashs",n1);
226         end
227     else
228         n1=sd(2)
229     end
230     xset("dashes",n1);
231 endfunction
232
233 function [sd1]=patts(sd,del)
234     [lhs,rhs]=argn(0);sd1=[];
235     if rhs<=0 then
236         n1=getcolor("Choose a pattern ",0)
237         if n1==[] then
238             sd1=list()
239         else
240             sd1=list("patts",n1);
241         end
242     else
243
244         n1=sd(2)
245     end
246     xset("pattern",n1);
247 endfunction
248
249 function [sd1]=Thick(sd,del)
250     [lhs,rhs]=argn(0);sd1=[];
251     if rhs<=0 then
252
253         T=string(1:15)
254         ll=list()
255         t=xget("thickness")
256         ll(1)=list("Thickness",t,T);
257         n1=x_choices("Choose a Thickness",ll);
258         if n1==[] then
259             sd1=list()
260         else
261             sd1=list("thick",n1);
262         end
263     else
264         n1=sd(2)
265     end
266     xset("thickness",n1);
267 endfunction
268
269 function sd1 =rect(sd,del)
270     [lhs,rhs]=argn(0);sd1=[];
271     if rhs<=0 then //get
272         [x1,y1,x2,y2,but]=xgetm(d_xrect)
273         if but==2 then sd1=list();return,end
274         sd1=list("rect",x1,x2,y1,y2);
275         d_xrect(x1,y1,x2,y2);
276     elseif rhs==1 then //draw
277         x1=sd(2);x2=sd(3),y1=sd(4),y2=sd(5);
278         d_xrect(x1,y1,x2,y2);
279     elseif del=="del" then //erase
280         x1=sd(2);x2=sd(3),y1=sd(4),y2=sd(5);
281         d_xrect(x1,y1,x2,y2);
282     elseif del=="mov" then //move
283         x1=sd(2);x2=sd(3),y1=sd(4),y2=sd(5)
284         x0=xx(1);y0=xx(2);
285         [xo,yo]=move_object("d_xrect(x1-(x0-xo),y1-(y0-yo),x2-(x0-xo),y2-(y0-yo))",x0,y0);
286         sd1=sd;
287         sd1(2)=sd(2)-(x0-xo)
288         sd1(3)=sd(3)-(x0-xo)
289         sd1(4)=sd(4)-(y0-yo)
290         sd1(5)=sd(5)-(y0-yo)
291     end
292 endfunction
293
294 function sd1=frect(sd,del)
295     [lhs,rhs]=argn(0);sd1=[];
296     if rhs<=0 then // get
297         [x1,y1,x2,y2,but]=xgetm(d_xrect)
298         if but==2 then sd1=list();return,end
299         sd1=list("frect",x1,x2,y1,y2);
300         d_xfrect(x1,y1,x2,y2);
301     elseif rhs==1 then //draw
302         x1=sd(2);x2=sd(3),y1=sd(4),y2=sd(5)
303         d_xfrect(x1,y1,x2,y2);
304     elseif del=="del" then //erase
305         x1=sd(2);x2=sd(3),y1=sd(4),y2=sd(5)
306         d_xfrect(x1,y1,x2,y2);
307     elseif del=="mov" then //move
308         x1=sd(2);x2=sd(3),y1=sd(4),y2=sd(5)
309         x0=xx(1);y0=xx(2);
310         [xo,yo]=move_object("d_xfrect(x1-(x0-xo),y1-(y0-yo),x2-(x0-xo),y2-(y0-yo))",x0,y0);
311         sd1=sd
312         sd1(2)=sd(2)-(x0-xo)
313         sd1(3)=sd(3)-(x0-xo)
314         sd1(4)=sd(4)-(y0-yo)
315         sd1(5)=sd(5)-(y0-yo)
316     end
317 endfunction
318
319 function sd1=cerc(sd,del)
320     [lhs,rhs]=argn(0);sd1=[];
321     if rhs<=0 then // get
322         [c1,c2,x1,x2,but]=xgetm(d_circle);
323         if but==2 then sd1=list();return,end
324         x=[x1;x2],c=[c1;c2];r=norm(x-c,2);
325         sd1=list("cercle",c,r);
326         d_circle(c,r);
327     elseif rhs==1 then //draw
328         c=sd(2);r=sd(3);
329         d_circle(c,r);
330     elseif del=="del" then //erase
331         c=sd(2);r=sd(3);
332         d_circle(c,r);
333     elseif del=="mov" then //move
334         c=sd(2);r=sd(3)
335         x0=xx(1);y0=xx(2);
336         [xo,yo]=move_object("d_circle(c-[x0-xo;y0-yo],r)",x0,y0);
337         sd(2)=sd(2)-[x0-xo;y0-yo]
338         sd1=sd
339     end;
340 endfunction
341
342 function sd1=fcerc(sd,del)
343     [lhs,rhs]=argn(0);sd1=[];
344     if rhs<=0 then // get
345         [c1,c2,x1,x2,but]=xgetm(d_circle);
346         if but==2 then sd1=list();return,end
347         x=[x1;x2],c=[c1;c2];r=norm(x-c,2);
348         sd1=list("fcercle",c,r);
349         d_fcircle(c,r);
350     elseif rhs==1 then //draw
351         c=sd(2);r=sd(3)
352         d_fcircle(c,r);
353     elseif del=="del" then //erase
354         c=sd(2);r=sd(3)
355         d_fcircle(c,r);
356     elseif del=="mov" then //move
357         c=sd(2);r=sd(3)
358         x0=xx(1);y0=xx(2);
359         [xo,yo]=move_object("d_fcircle(c-[x0-xo;y0-yo],r)",x0,y0);
360         sd(2)=sd(2)-[x0-xo;y0-yo]
361         sd1=sd
362     end;
363 endfunction
364
365 function [sd1]=fleche(sd,del)
366     [lhs,rhs]=argn(0);sd1=[]
367     if rhs<=0 then // get
368         [oi1,oi2,of1,of2,but]=xgetm(d_arrow);
369         if but==2 then sd1=list();return,end
370         o1=[oi1;of1],o2=[oi2;of2];
371         [r1,r2]=xgetech()
372         sz=1/(40*min(abs(r2(3)-r2(1)),abs(r2(4)-r2(2))))
373         sd1=list("fleche",o1,o2,sz);
374         d_arrow(o1,o2,sz);
375     elseif rhs==1 then //draw
376         o1=sd(2),o2=sd(3),
377         sz=-1
378         if size(sd)>=4 then sz=sd(4),end
379         d_arrow(o1,o2,sz);
380     elseif del=="del" then //erase
381         o1=sd(2),o2=sd(3),
382         sz=-1
383         if size(sd)>=4 then sz=sd(4),end
384         d_arrow(o1,o2,sz);
385     elseif del=="mov" then //move
386         o1=sd(2),o2=sd(3),
387         sz=-1
388         if size(sd)>=4 then sz=sd(4),end
389         x0=xx(1);y0=xx(2);
390         [xo,yo]=move_object("d_arrow(o1-(x0-xo),o2-(y0-yo),sz)",x0,y0);
391         sd(2)=sd(2)-(x0-xo)
392         sd(3)=sd(3)-(y0-yo)
393         sd1=sd
394     end
395 endfunction
396
397 function [sd1]=comment(sd,del)
398     [lhs,rhs]=argn(0),sd1=[];
399     if rhs<=0 then // get
400         [i,z1,z2]=xclick(0);z=[z1;z2];
401         com=x_dialog("Enter string"," ");
402         if com<>[] then
403             sd1=list("comm",z,com),
404             xstring(z(1),z(2),com,0,0);
405         end
406     elseif rhs==1 then //draw
407         z=sd(2);com=sd(3);
408         xstring(z(1),z(2),com,0,0);
409     elseif del=="del" then //erase
410         z=sd(2);com=sd(3);
411         xstring(z(1),z(2),com,0,0);
412     elseif del=="mov" then //move
413         z=sd(2);com=sd(3);
414         [xo,yo]=move_object("xstring(xo,yo,com,0,0)",z(1),z(2));
415         sd1=sd;sd1(2)(1)=xo;sd1(2)(2)=yo;
416     end;
417 endfunction
418
419 function [sd1]=ligne(sd,del)
420     // polyline
421     [lhs,rhs]=argn(0);sd1=[];
422     if rhs<=0 then // get
423         z=xgetpoly(d_seg);
424         if z==[], return;end;
425         sd1=list("ligne",z);
426         xpoly(z(1,:)',z(2,:)',"lines")
427     elseif rhs==1 then //draw
428         z=sd(2);
429         xpoly(z(1,:)',z(2,:)',"lines")
430     elseif del=="del" then //erase
431         z=sd(2);
432         xpoly(z(1,:)',z(2,:)',"lines")
433     elseif del=="mov" then //move
434         z=sd(2);
435         x0=xx(1);y0=xx(2);
436         [xo,yo]=move_object("xpoly(z(1,:)''-(x0-xo),z(2,:)''-(y0-yo),""lines"")",x0,y0);
437         sd(2)=[z(1,:)-(x0-xo);z(2,:)-(y0-yo)]
438         sd1=sd
439     end;
440 endfunction
441
442 function [sd1]=fligne(sd,del)
443     // filled polyline
444     [lhs,rhs]=argn(0);sd1=[];
445     if rhs<=0 then // get
446         z=xgetpoly(d_seg);
447         if z==[], return;end;
448         sd1=list("fligne",z);
449         xfpoly(z(1,:),z(2,:),1);
450     elseif rhs==1 then //draw
451         z=sd(2);
452         xfpoly(z(1,:),z(2,:),1);
453     elseif del=="del" then //erase
454         z=sd(2);
455         xfpoly(z(1,:),z(2,:),1)
456     elseif del=="mov" then //move
457         z=sd(2);
458         x0=xx(1);y0=xx(2);
459         [xo,yo]=move_object("xfpoly(z(1,:)-(x0-xo),z(2,:)-(y0-yo),1)",x0,y0);
460         sd(2)=[z(1,:)-(x0-xo);z(2,:)-(y0-yo)]
461         sd1=sd
462     end;
463 endfunction
464
465 function [sd1]=curve(sd,del)
466     // smoothed curve
467     [lhs,rhs]=argn(0);sd1=[];
468     if rhs<=0 then ,//get
469         z=xgetpoly(d_seg);
470         if z==[], return;end
471         mm=clearmode();xpoly(z(1,:)',z(2,:)',"lines");modeback(mm)
472         [x1,k1]=gsort(z(1,:));y1=z(2,k1);z=[x1;y1];
473         [n1,n2]=size(z);z=smooth(z(:,n2:-1:1));
474         sd1=list("ligne",z);
475     else
476         z=sd(2);
477     end;
478     xpoly(z(1,:)',z(2,:)',"lines");
479
480 endfunction
481
482 function [sd1]=points(sd,del)
483     // polymark
484     [lhs,rhs]=argn(0);sd1=[];
485     if rhs<=0 then //get
486         z=xgetpoly(d_point);
487         if z==[], return;end;
488         sd1=list("point",z);
489         xpoly(z(1,:)',z(2,:)',"marks");
490     elseif rhs==1 then //draw
491         z=sd(2);
492         xpoly(z(1,:)',z(2,:)',"marks");
493     elseif del=="del" then //erase
494         z=sd(2);
495         xpoly(z(1,:)',z(2,:)',"marks");
496     elseif del=="mov" then //move
497         z=sd(2);
498         x0=xx(1);y0=xx(2);
499         [xo,yo]=move_object("xpoly(z(1,:)''-(x0-xo),z(2,:)''-(y0-yo),""marks"")",x0,y0);
500         sd(2)=[z(1,:)-(x0-xo);z(2,:)-(y0-yo)]
501         sd1=sd
502     end;
503 endfunction
504
505 function [sd1]=grclipoff(sd,del)
506     [lhs,rhs]=argn(0),sd1=[];
507     if rhs<=0 then ,
508         sd1=list("clipoff")
509     end;
510     // disable clipping
511     axes = gca();
512     axes.clip_state = "off";
513 endfunction
514
515 function [sd1]=grclipon(sd,del)
516     [lhs,rhs]=argn(0),sd1=[];
517     if rhs<=0 then ,
518         sd1=list("clipon")
519     end;
520     // axes clip
521     axes = gca();
522     axes.clip_state = "clipgrf";
523 endfunction
524
525 function []=redraw(sd,s_t)
526     ksd=size(sd)
527     plot2d(0,0,[-1],s_t," ",sd(2));
528     xset("clipgrf");
529     for k=3:ksd,
530         obj=sd(k);
531         if size(obj)<>0 then
532             to=obj(1)
533             select to,
534             case "rect"    then rect(obj);
535             case "frect"   then frect(obj);
536             case "cercle"  then cerc(obj);
537             case "fcercle" then fcerc(obj);
538             case "fleche"  then fleche(obj);
539             case "comm"    then comment(obj);
540             case "ligne"   then ligne(obj);
541             case "fligne"  then fligne(obj);
542             case "point"   then points(obj);
543             case "symbs"   then symbs(obj);
544             case "dashs"   then dashs(obj);
545             case "patts"   then patts(obj);
546             case "clipon"  then grclipon(obj);
547             case "clipoff" then grclipoff(obj);
548             end
549         end
550     end
551 endfunction
552
553 function [x0,y0,x,y,ibutton]=xgetm(m_m)
554     // Object aquisition
555     kpd=driver();
556     driver("X11");
557     alu=xget("alufunction")
558     xset("alufunction",6);
559     // attente du click
560     [ii,x0,y0]=xclick()
561     x=x0;y=y0;
562     // suivit de la souris en attendant le button release
563     ibutton=-1
564     while ( ibutton<0)
565         // dessin
566         m_m(x0,y0,x,y);
567         rep=xgetmouse(0);
568         ibutton = rep(3)
569         m_m(x0,y0,x,y)
570         x=rep(1);y=rep(2);
571     end
572     xset("alufunction",alu);
573     //m_m(x0,y0,x,y)
574     driver(kpd);
575 endfunction
576
577 function []=d_xrect(x0,yy0,x,y)
578     xi=min(x0,x);
579     w=abs(x0-x);
580     yi=max(yy0,y);
581     h=abs(yy0-y);
582     xrect(xi,yi,w,h);
583 endfunction
584
585 function []=d_xfrect(x0,yy0,x,y)
586     xi=min(x0,x);
587     w=abs(x0-x);
588     yi=max(yy0,y);
589     h=abs(yy0-y);
590     xrects([xi,yi,w,h]',xget("pattern"));
591 endfunction
592
593 function []=d_circle(c1,c2,x1,x2)
594     [lhs,rhs]=argn(0);
595     if rhs==2 then
596         r=c2;c2=c1(2);c1=c1(1);
597         xarc(c1-r,c2+r,2*r,2*r,0,64*360);
598
599     else
600         r=norm([x1-c1;x2-c2],2);
601         xarc(c1-r,c2+r,2*r,2*r,0,64*360);
602     end
603 endfunction
604
605 function []=d_fcircle(c1,c2,x1,x2)
606     [lhs,rhs]=argn(0);
607     if rhs==2 then r=c2;c2=c1(2);c1=c1(1);
608     else
609         r=norm([x1-c1;x2-c2],2);
610     end
611     xfarc(c1-r,c2+r,2*r,2*r,0,64*360);
612 endfunction
613
614 function d_arrow(c1,c2,x1,x2)
615     [lhs,rhs]=argn(0);
616     if rhs<>4 then
617         sz=x1;x1=c1(2);c1=c1(1);x2=c2(2);c2=c2(1);
618     else
619         [r1,r2]=xgetech()
620         sz=1/(40*min(abs(r2(3)-r2(1)),abs(r2(4)-r2(2))))
621     end
622     xarrows([c1;x1],[c2;x2],sz,-1);
623 endfunction
624
625 function [z]=xgetpoly(m_m)
626     // interactive polyline aquisition m_m is
627     // used to draw between aquisitions
628     kpd=driver();
629     //driver("X11");
630     // attente du click
631     [ii,x0,y0]=xclick(0)
632     x=x0;y=y0;
633     z=[x0;y0];
634     ibutton=1
635     alu=xget("alufunction")
636     xset("alufunction",6);
637     while and(ibutton<>[0 3 10])
638         ibutton=-1
639         while ibutton==-1
640             // dessin
641             m_m(x0,y0,x,y);
642             rep=xgetmouse(0);
643             ibutton = rep(3)
644             m_m(x0,y0,x,y)
645             x=rep(1);y=rep(2);
646         end
647         if and(ibutton<>[0 3 10])  then
648             m_m(x0,y0,x,y)
649             z=[z,[x;y]]
650             x0=x;y0=y;
651         end
652     end
653     xset("alufunction",alu);
654
655     [nn,ll]=size(z);
656     if ll==1 then z=[];end
657     driver(kpd);
658 endfunction
659
660 function []=d_seg(x1,y1,x2,y2)
661     xpoly([x1,x2],[y1,y2],"lines");
662 endfunction
663
664 function []=d_point(x1,y1,x2,y2)
665     xpoly([x1,x2],[y1,y2],"marks");
666
667 endfunction
668
669 function [xo,yo]=move_object(inst,xo,yo)
670     // Object aquisition
671     xos=xo;yos=yo
672     kpd=driver();
673     alu=xget("alufunction")
674     xset("alufunction",6);
675     execstr(inst) //erase
676     driver("X11");
677     // suivi de la souris en attendant le button release
678     rep=[0 0 -1];
679     while rep(3)<0
680         execstr(inst) //draw
681         rep=xgetmouse(0);
682         execstr(inst) //erase
683         xo=rep(1);yo=rep(2);
684     end
685     if or(rep(3)==[2 5 12]) then
686         xo=xos;yo=yos, //move canceled
687     else
688         xo=rep(1);yo=rep(2);
689     end
690     xset("alufunction",alu);
691     driver(kpd);
692     execstr(inst) //draw
693 endfunction