* getfont, getmark, getlinestyle and getsymbol removed. Please use ged instead.
[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=xget("mark")
207         n1=c(1);dime=c(2)
208         sd1=list("symbs",c(1),c(2));
209     else
210         n1=sd(2);dime=sd(3)
211     end
212     xset("mark",n1,dime);
213 endfunction
214
215 function [sd1]=dashs(sd,del)
216     [lhs,rhs]=argn(0);sd1=[];
217     if rhs<=0 then
218         n1=x_choose(dash,"Choose a dash style");
219         if n1==[] then
220             sd1=list()
221         else
222             sd1=list("dashs",n1);
223         end
224     else
225         n1=sd(2)
226     end
227     xset("dashes",n1);
228 endfunction
229
230 function [sd1]=patts(sd,del)
231     [lhs,rhs]=argn(0);sd1=[];
232     if rhs<=0 then
233         n1=getcolor("Choose a pattern ",0)
234         if n1==[] then
235             sd1=list()
236         else
237             sd1=list("patts",n1);
238         end
239     else
240
241         n1=sd(2)
242     end
243     xset("pattern",n1);
244 endfunction
245
246 function [sd1]=Thick(sd,del)
247     [lhs,rhs]=argn(0);sd1=[];
248     if rhs<=0 then
249
250         T=string(1:15)
251         ll=list()
252         t=xget("thickness")
253         ll(1)=list("Thickness",t,T);
254         n1=x_choices("Choose a Thickness",ll);
255         if n1==[] then
256             sd1=list()
257         else
258             sd1=list("thick",n1);
259         end
260     else
261         n1=sd(2)
262     end
263     xset("thickness",n1);
264 endfunction
265
266 function sd1 =rect(sd,del)
267     [lhs,rhs]=argn(0);sd1=[];
268     if rhs<=0 then //get
269         [x1,y1,x2,y2,but]=xgetm(d_xrect)
270         if but==2 then sd1=list();return,end
271         sd1=list("rect",x1,x2,y1,y2);
272         d_xrect(x1,y1,x2,y2);
273     elseif rhs==1 then //draw
274         x1=sd(2);x2=sd(3),y1=sd(4),y2=sd(5);
275         d_xrect(x1,y1,x2,y2);
276     elseif del=="del" then //erase
277         x1=sd(2);x2=sd(3),y1=sd(4),y2=sd(5);
278         d_xrect(x1,y1,x2,y2);
279     elseif del=="mov" then //move
280         x1=sd(2);x2=sd(3),y1=sd(4),y2=sd(5)
281         x0=xx(1);y0=xx(2);
282         [xo,yo]=move_object("d_xrect(x1-(x0-xo),y1-(y0-yo),x2-(x0-xo),y2-(y0-yo))",x0,y0);
283         sd1=sd;
284         sd1(2)=sd(2)-(x0-xo)
285         sd1(3)=sd(3)-(x0-xo)
286         sd1(4)=sd(4)-(y0-yo)
287         sd1(5)=sd(5)-(y0-yo)
288     end
289 endfunction
290
291 function sd1=frect(sd,del)
292     [lhs,rhs]=argn(0);sd1=[];
293     if rhs<=0 then // get
294         [x1,y1,x2,y2,but]=xgetm(d_xrect)
295         if but==2 then sd1=list();return,end
296         sd1=list("frect",x1,x2,y1,y2);
297         d_xfrect(x1,y1,x2,y2);
298     elseif rhs==1 then //draw
299         x1=sd(2);x2=sd(3),y1=sd(4),y2=sd(5)
300         d_xfrect(x1,y1,x2,y2);
301     elseif del=="del" then //erase
302         x1=sd(2);x2=sd(3),y1=sd(4),y2=sd(5)
303         d_xfrect(x1,y1,x2,y2);
304     elseif del=="mov" then //move
305         x1=sd(2);x2=sd(3),y1=sd(4),y2=sd(5)
306         x0=xx(1);y0=xx(2);
307         [xo,yo]=move_object("d_xfrect(x1-(x0-xo),y1-(y0-yo),x2-(x0-xo),y2-(y0-yo))",x0,y0);
308         sd1=sd
309         sd1(2)=sd(2)-(x0-xo)
310         sd1(3)=sd(3)-(x0-xo)
311         sd1(4)=sd(4)-(y0-yo)
312         sd1(5)=sd(5)-(y0-yo)
313     end
314 endfunction
315
316 function sd1=cerc(sd,del)
317     [lhs,rhs]=argn(0);sd1=[];
318     if rhs<=0 then // get
319         [c1,c2,x1,x2,but]=xgetm(d_circle);
320         if but==2 then sd1=list();return,end
321         x=[x1;x2],c=[c1;c2];r=norm(x-c,2);
322         sd1=list("cercle",c,r);
323         d_circle(c,r);
324     elseif rhs==1 then //draw
325         c=sd(2);r=sd(3);
326         d_circle(c,r);
327     elseif del=="del" then //erase
328         c=sd(2);r=sd(3);
329         d_circle(c,r);
330     elseif del=="mov" then //move
331         c=sd(2);r=sd(3)
332         x0=xx(1);y0=xx(2);
333         [xo,yo]=move_object("d_circle(c-[x0-xo;y0-yo],r)",x0,y0);
334         sd(2)=sd(2)-[x0-xo;y0-yo]
335         sd1=sd
336     end;
337 endfunction
338
339 function sd1=fcerc(sd,del)
340     [lhs,rhs]=argn(0);sd1=[];
341     if rhs<=0 then // get
342         [c1,c2,x1,x2,but]=xgetm(d_circle);
343         if but==2 then sd1=list();return,end
344         x=[x1;x2],c=[c1;c2];r=norm(x-c,2);
345         sd1=list("fcercle",c,r);
346         d_fcircle(c,r);
347     elseif rhs==1 then //draw
348         c=sd(2);r=sd(3)
349         d_fcircle(c,r);
350     elseif del=="del" then //erase
351         c=sd(2);r=sd(3)
352         d_fcircle(c,r);
353     elseif del=="mov" then //move
354         c=sd(2);r=sd(3)
355         x0=xx(1);y0=xx(2);
356         [xo,yo]=move_object("d_fcircle(c-[x0-xo;y0-yo],r)",x0,y0);
357         sd(2)=sd(2)-[x0-xo;y0-yo]
358         sd1=sd
359     end;
360 endfunction
361
362 function [sd1]=fleche(sd,del)
363     [lhs,rhs]=argn(0);sd1=[]
364     if rhs<=0 then // get
365         [oi1,oi2,of1,of2,but]=xgetm(d_arrow);
366         if but==2 then sd1=list();return,end
367         o1=[oi1;of1],o2=[oi2;of2];
368         [r1,r2]=xgetech()
369         sz=1/(40*min(abs(r2(3)-r2(1)),abs(r2(4)-r2(2))))
370         sd1=list("fleche",o1,o2,sz);
371         d_arrow(o1,o2,sz);
372     elseif rhs==1 then //draw
373         o1=sd(2),o2=sd(3),
374         sz=-1
375         if size(sd)>=4 then sz=sd(4),end
376         d_arrow(o1,o2,sz);
377     elseif del=="del" then //erase
378         o1=sd(2),o2=sd(3),
379         sz=-1
380         if size(sd)>=4 then sz=sd(4),end
381         d_arrow(o1,o2,sz);
382     elseif del=="mov" then //move
383         o1=sd(2),o2=sd(3),
384         sz=-1
385         if size(sd)>=4 then sz=sd(4),end
386         x0=xx(1);y0=xx(2);
387         [xo,yo]=move_object("d_arrow(o1-(x0-xo),o2-(y0-yo),sz)",x0,y0);
388         sd(2)=sd(2)-(x0-xo)
389         sd(3)=sd(3)-(y0-yo)
390         sd1=sd
391     end
392 endfunction
393
394 function [sd1]=comment(sd,del)
395     [lhs,rhs]=argn(0),sd1=[];
396     if rhs<=0 then // get
397         [i,z1,z2]=xclick(0);z=[z1;z2];
398         com=x_dialog("Enter string"," ");
399         if com<>[] then
400             sd1=list("comm",z,com),
401             xstring(z(1),z(2),com,0,0);
402         end
403     elseif rhs==1 then //draw
404         z=sd(2);com=sd(3);
405         xstring(z(1),z(2),com,0,0);
406     elseif del=="del" then //erase
407         z=sd(2);com=sd(3);
408         xstring(z(1),z(2),com,0,0);
409     elseif del=="mov" then //move
410         z=sd(2);com=sd(3);
411         [xo,yo]=move_object("xstring(xo,yo,com,0,0)",z(1),z(2));
412         sd1=sd;sd1(2)(1)=xo;sd1(2)(2)=yo;
413     end;
414 endfunction
415
416 function [sd1]=ligne(sd,del)
417     // polyline
418     [lhs,rhs]=argn(0);sd1=[];
419     if rhs<=0 then // get
420         z=xgetpoly(d_seg);
421         if z==[], return;end;
422         sd1=list("ligne",z);
423         xpoly(z(1,:)',z(2,:)',"lines")
424     elseif rhs==1 then //draw
425         z=sd(2);
426         xpoly(z(1,:)',z(2,:)',"lines")
427     elseif del=="del" then //erase
428         z=sd(2);
429         xpoly(z(1,:)',z(2,:)',"lines")
430     elseif del=="mov" then //move
431         z=sd(2);
432         x0=xx(1);y0=xx(2);
433         [xo,yo]=move_object("xpoly(z(1,:)''-(x0-xo),z(2,:)''-(y0-yo),""lines"")",x0,y0);
434         sd(2)=[z(1,:)-(x0-xo);z(2,:)-(y0-yo)]
435         sd1=sd
436     end;
437 endfunction
438
439 function [sd1]=fligne(sd,del)
440     // filled polyline
441     [lhs,rhs]=argn(0);sd1=[];
442     if rhs<=0 then // get
443         z=xgetpoly(d_seg);
444         if z==[], return;end;
445         sd1=list("fligne",z);
446         xfpoly(z(1,:),z(2,:),1);
447     elseif rhs==1 then //draw
448         z=sd(2);
449         xfpoly(z(1,:),z(2,:),1);
450     elseif del=="del" then //erase
451         z=sd(2);
452         xfpoly(z(1,:),z(2,:),1)
453     elseif del=="mov" then //move
454         z=sd(2);
455         x0=xx(1);y0=xx(2);
456         [xo,yo]=move_object("xfpoly(z(1,:)-(x0-xo),z(2,:)-(y0-yo),1)",x0,y0);
457         sd(2)=[z(1,:)-(x0-xo);z(2,:)-(y0-yo)]
458         sd1=sd
459     end;
460 endfunction
461
462 function [sd1]=curve(sd,del)
463     // smoothed curve
464     [lhs,rhs]=argn(0);sd1=[];
465     if rhs<=0 then ,//get
466         z=xgetpoly(d_seg);
467         if z==[], return;end
468         mm=clearmode();xpoly(z(1,:)',z(2,:)',"lines");modeback(mm)
469         [x1,k1]=gsort(z(1,:));y1=z(2,k1);z=[x1;y1];
470         [n1,n2]=size(z);z=smooth(z(:,n2:-1:1));
471         sd1=list("ligne",z);
472     else
473         z=sd(2);
474     end;
475     xpoly(z(1,:)',z(2,:)',"lines");
476
477 endfunction
478
479 function [sd1]=points(sd,del)
480     // polymark
481     [lhs,rhs]=argn(0);sd1=[];
482     if rhs<=0 then //get
483         z=xgetpoly(d_point);
484         if z==[], return;end;
485         sd1=list("point",z);
486         xpoly(z(1,:)',z(2,:)',"marks");
487     elseif rhs==1 then //draw
488         z=sd(2);
489         xpoly(z(1,:)',z(2,:)',"marks");
490     elseif del=="del" then //erase
491         z=sd(2);
492         xpoly(z(1,:)',z(2,:)',"marks");
493     elseif del=="mov" then //move
494         z=sd(2);
495         x0=xx(1);y0=xx(2);
496         [xo,yo]=move_object("xpoly(z(1,:)''-(x0-xo),z(2,:)''-(y0-yo),""marks"")",x0,y0);
497         sd(2)=[z(1,:)-(x0-xo);z(2,:)-(y0-yo)]
498         sd1=sd
499     end;
500 endfunction
501
502 function [sd1]=grclipoff(sd,del)
503     [lhs,rhs]=argn(0),sd1=[];
504     if rhs<=0 then ,
505         sd1=list("clipoff")
506     end;
507     // disable clipping
508     axes = gca();
509     axes.clip_state = "off";
510 endfunction
511
512 function [sd1]=grclipon(sd,del)
513     [lhs,rhs]=argn(0),sd1=[];
514     if rhs<=0 then ,
515         sd1=list("clipon")
516     end;
517     // axes clip
518     axes = gca();
519     axes.clip_state = "clipgrf";
520 endfunction
521
522 function []=redraw(sd,s_t)
523     ksd=size(sd)
524     plot2d(0,0,[-1],s_t," ",sd(2));
525     xset("clipgrf");
526     for k=3:ksd,
527         obj=sd(k);
528         if size(obj)<>0 then
529             to=obj(1)
530             select to,
531             case "rect"    then rect(obj);
532             case "frect"   then frect(obj);
533             case "cercle"  then cerc(obj);
534             case "fcercle" then fcerc(obj);
535             case "fleche"  then fleche(obj);
536             case "comm"    then comment(obj);
537             case "ligne"   then ligne(obj);
538             case "fligne"  then fligne(obj);
539             case "point"   then points(obj);
540             case "symbs"   then symbs(obj);
541             case "dashs"   then dashs(obj);
542             case "patts"   then patts(obj);
543             case "clipon"  then grclipon(obj);
544             case "clipoff" then grclipoff(obj);
545             end
546         end
547     end
548 endfunction
549
550 function [x0,y0,x,y,ibutton]=xgetm(m_m)
551     // Object aquisition
552     kpd=driver();
553     driver("X11");
554     alu=xget("alufunction")
555     xset("alufunction",6);
556     // attente du click
557     [ii,x0,y0]=xclick()
558     x=x0;y=y0;
559     // suivit de la souris en attendant le button release
560     ibutton=-1
561     while ( ibutton<0)
562         // dessin
563         m_m(x0,y0,x,y);
564         rep=xgetmouse(0);
565         ibutton = rep(3)
566         m_m(x0,y0,x,y)
567         x=rep(1);y=rep(2);
568     end
569     xset("alufunction",alu);
570     //m_m(x0,y0,x,y)
571     driver(kpd);
572 endfunction
573
574 function []=d_xrect(x0,yy0,x,y)
575     xi=min(x0,x);
576     w=abs(x0-x);
577     yi=max(yy0,y);
578     h=abs(yy0-y);
579     xrect(xi,yi,w,h);
580 endfunction
581
582 function []=d_xfrect(x0,yy0,x,y)
583     xi=min(x0,x);
584     w=abs(x0-x);
585     yi=max(yy0,y);
586     h=abs(yy0-y);
587     xrects([xi,yi,w,h]',xget("pattern"));
588 endfunction
589
590 function []=d_circle(c1,c2,x1,x2)
591     [lhs,rhs]=argn(0);
592     if rhs==2 then
593         r=c2;c2=c1(2);c1=c1(1);
594         xarc(c1-r,c2+r,2*r,2*r,0,64*360);
595
596     else
597         r=norm([x1-c1;x2-c2],2);
598         xarc(c1-r,c2+r,2*r,2*r,0,64*360);
599     end
600 endfunction
601
602 function []=d_fcircle(c1,c2,x1,x2)
603     [lhs,rhs]=argn(0);
604     if rhs==2 then r=c2;c2=c1(2);c1=c1(1);
605     else
606         r=norm([x1-c1;x2-c2],2);
607     end
608     xfarc(c1-r,c2+r,2*r,2*r,0,64*360);
609 endfunction
610
611 function d_arrow(c1,c2,x1,x2)
612     [lhs,rhs]=argn(0);
613     if rhs<>4 then
614         sz=x1;x1=c1(2);c1=c1(1);x2=c2(2);c2=c2(1);
615     else
616         [r1,r2]=xgetech()
617         sz=1/(40*min(abs(r2(3)-r2(1)),abs(r2(4)-r2(2))))
618     end
619     xarrows([c1;x1],[c2;x2],sz,-1);
620 endfunction
621
622 function [z]=xgetpoly(m_m)
623     // interactive polyline aquisition m_m is
624     // used to draw between aquisitions
625     kpd=driver();
626     //driver("X11");
627     // attente du click
628     [ii,x0,y0]=xclick(0)
629     x=x0;y=y0;
630     z=[x0;y0];
631     ibutton=1
632     alu=xget("alufunction")
633     xset("alufunction",6);
634     while and(ibutton<>[0 3 10])
635         ibutton=-1
636         while ibutton==-1
637             // dessin
638             m_m(x0,y0,x,y);
639             rep=xgetmouse(0);
640             ibutton = rep(3)
641             m_m(x0,y0,x,y)
642             x=rep(1);y=rep(2);
643         end
644         if and(ibutton<>[0 3 10])  then
645             m_m(x0,y0,x,y)
646             z=[z,[x;y]]
647             x0=x;y0=y;
648         end
649     end
650     xset("alufunction",alu);
651
652     [nn,ll]=size(z);
653     if ll==1 then z=[];end
654     driver(kpd);
655 endfunction
656
657 function []=d_seg(x1,y1,x2,y2)
658     xpoly([x1,x2],[y1,y2],"lines");
659 endfunction
660
661 function []=d_point(x1,y1,x2,y2)
662     xpoly([x1,x2],[y1,y2],"marks");
663
664 endfunction
665
666 function [xo,yo]=move_object(inst,xo,yo)
667     // Object aquisition
668     xos=xo;yos=yo
669     kpd=driver();
670     alu=xget("alufunction")
671     xset("alufunction",6);
672     execstr(inst) //erase
673     driver("X11");
674     // suivi de la souris en attendant le button release
675     rep=[0 0 -1];
676     while rep(3)<0
677         execstr(inst) //draw
678         rep=xgetmouse(0);
679         execstr(inst) //erase
680         xo=rep(1);yo=rep(2);
681     end
682     if or(rep(3)==[2 5 12]) then
683         xo=xos;yo=yos, //move canceled
684     else
685         xo=rep(1);yo=rep(2);
686     end
687     xset("alufunction",alu);
688     driver(kpd);
689     execstr(inst) //draw
690 endfunction