Scilab Reorganisation. Add macros in the graphics module.
[scilab.git] / scilab / modules / graphics / macros / edit_curv.sci
1 function [x,y,ok,gc]=edit_curv(x,y,job,tit,gc)
2 //   mod_curv  - Edition  de courbe interactive
3 //%Syntaxe
4 //  [x,y,ok]=mod_curv(xd,yd,job,tit)
5 //%Parametres
6 //  xd    :  vecteur des abscisses donnees (eventuellement [])
7 //  yd    :  vecteur des ordonnees donnees (eventuellement [])
8 //  job   :  chaine de 3 caracteres  specifiant les operations
9 //           permises:
10 //            - Si la chaine contient le caractere 'a', il est 
11 //              possible d'ajouter des points aux donnees, sinon
12 //              il est seulement possible de les deplacer
13 //            - Si la chaine contient le caractere 'x', il est 
14 //              possible de deplacer les points horizontalement
15 //            - Si la chaine contient le caractere 'y', il est 
16 //              possible de deplacer les points verticalement
17 //  tit   : liste de trois chaines de caracteres
18 //          tit(1) : titre de la courbe (peut etre un vecteur colonne)
19 //          tit(2) : label de l'axe des abscisses
20 //          tit(3) : label de l'axe des ordonnees
21 //  x     : vecteur des abscisses resultat
22 //  y     : vecteur des ordonnees resultat
23 //  ok    : vaut %t si la sortie as ete demandee par le menu Ok
24 //           et  %f si la sortie as ete demandee par le menu Abort
25 //%menus
26 //  Ok    : sortie de l'editeur et retour de la courbe editee
27 //  Abort : sortie de l'editeur et retour au donnes initiales 
28 //  Undo  : annulation de la derniere modification
29 //  Size  : changement des bornes du graphique
30 //  Grids : changement des graduations du graphique
31 //  Clear : effacement de la courbe (x=[] et y=[]) (sans quitter l'editeur)
32 //  Read  : lecture de la courbe a partir d'un fichier d'extension .xy
33 //  Save  : sauvegarde binaire (sur un fichier d'extension .xy) de 
34 //          la courbe
35 //!
36 //origine: serge Steer, Habib Jreij INRIA 1993
37 // Copyright INRIA
38 [lhs,rhs]=argn(0)
39 xset('default')
40 //in line definition of get_click
41 deff('[btn,xc,yc,win,Cmenu]=get_click(flag)',[
42 'if ~or(winsid() == curwin) then   Cmenu = ''Quit'';return,end,';
43 'if argn(2) == 1 then';
44 '  [btn, xc, yc, win, str] = xclick(flag);';
45 'else';
46 '  [btn, xc, yc, win, str] = xclick();';
47 'end';
48 'if btn == -100 then';
49 '  if win == curwin then';
50 '    Cmenu = ''Quit'';';
51 '  else';
52 '    Cmenu = ''Open/Set'';';
53 '  end,';
54 '  return,';
55 'end';
56 'if btn == -2 then';
57 '  xc = 0;yc = 0;';
58 '  execstr(''Cmenu='' + part(str, 9:length(str) - 1));';
59 '  execstr(''Cmenu='' + Cmenu);';
60 '  return,';
61 'end';
62 'Cmenu=[]'])
63  
64
65
66 ok=%t
67 if rhs==0 then x=[];y=[],end;
68 if rhs==1 then y=x;x=(1:size(y,'*'))',end
69 if rhs<3  then job='axy',end
70 if rhs<4 then tit=[' ',' ',' '],end
71 if size(tit,'*')<3 then tit(3)=' ',end
72 //
73 [mx,nx]=size(x);x=x(:)
74 [my,ny]=size(y);y=y(:)
75 xsav=x;ysav=y;xs=x;ys=y;
76 //
77 lj=length(job)
78 add=0;modx=0;mody=0
79 for k=1:lj
80   jk=part(job,k)
81   select jk
82   case 'a' then add=1,
83   case 'x' then modx=1
84   case 'y' then mody=1
85   else error('parametre job incorrect')
86   end
87 end
88 eps=0.03
89 symbsiz=0.2
90 // bornes initiales du graphique
91 if rhs<5 then
92   if mx<>0 then
93     xmx=maxi(x);xmn=mini(x)
94     ymx=maxi(y);ymn=mini(y)
95     dx=xmx-xmn;dy=ymx-ymn
96     if dx==0 then dx=maxi(xmx/2,1),end
97     xmn=xmn-dx/10;xmx=xmx+dx/10
98     if dy==0 then dy=maxi(ymx/2,1),end;
99     ymn=ymn-dy/10;ymx=ymx+dy/10;
100   else
101     xmn=0;ymn=0;xmx=1;ymx=1;dx=1;dy=1
102   end
103   rect=[xmn,ymn,xmx,ymx];
104   axisdata=[2 10 2 10]
105   gc=list(rect,axisdata)
106 else
107   [rect,axisdata]=gc(1:2)
108   xmn=rect(1);ymn=rect(2);xmx=rect(3);ymx=rect(4)
109   dx=xmx-xmn;dy=ymx-ymn
110 end
111 xbasc()
112 auto=%t
113
114 // Set menus and callbacks
115 menu_d=['Read','Save','Clear']
116 menu_e=['Undo','Size','Grids','Replot','Ok','Abort']
117 menus=list(['Edit','Data'],menu_e,menu_d)
118 w='menus(2)(';rpar=')'
119 Edit=w(ones(menu_e))+string(1:size(menu_e,'*'))+rpar(ones(menu_e))
120 w='menus(3)(';rpar=')'
121 Data=w(ones(menu_d))+string(1:size(menu_d,'*'))+rpar(ones(menu_d))
122
123 xselect()
124 curwin=xget('window')
125 unsetmenu(curwin,'File',1) //clear
126 unsetmenu(curwin,'File',2) //select
127 unsetmenu(curwin,'File',6) //load
128 unsetmenu(curwin,'File',7) //close
129 unsetmenu(curwin,'3D Rot.')
130 //
131 execstr('Edit_'+string(curwin)+'=Edit')
132 execstr('Data_'+string(curwin)+'=Data')
133 menubar(curwin,menus)
134 //
135 xset('alufunction',3)
136 xset('dashes',1)
137 xset('pattern',1)
138 // -- trace du cadre
139 plot2d(rect(1),rect(2),-1,'011',' ',rect,axisdata);
140 xgrid(4)
141 xtitle(tit(1),tit(2),tit(3));
142 xset('alufunction',6)
143 if x<>[]&y<>[] then 
144   plot2d(x,y,1,'000',' ');plot2d(x,y,-1,'000',' ');
145 end
146
147
148
149 // -- boucle principale
150 while %t then
151   [n1,n2]=size(x);npt=n1*n2
152   [btn,xc,yc,win,Cmenu]=get_click()
153   c1=[xc,yc]
154   if Cmenu=='Quit' then Cmenu='Abort',end
155   if Cmenu==[] then Cmenu='edit',end
156   if Cmenu=='Exit' then Cmenu='Ok',end
157   select Cmenu
158   case [] then 
159     //ce n est pas un menu
160     break
161   case 'Ok' then 
162     //    -- ok menu
163     xset('default')
164     gc=list(rect,axisdata)
165     xdel()
166     return
167   case 'Abort' then 
168     //    -- abort menu
169     x=xsav
170     y=ysav
171 //    xset('default')
172     if or(curwin==winsid()) then xdel(curwin);end
173     ok=%f
174     return
175   case 'Undo' then
176     if x<>[]&y<>[] then plot2d(x,y,-1,'000',' ');plot2d(x,y,1,'000',' ');end
177     x=xs;y=ys
178     if x<>[]&y<>[] then plot2d(x,y,-1,'000',' ');plot2d(x,y,1,'000',' ');end
179     x=xs;y=ys
180   case 'Size' then
181     while %t
182       [ok,xmn,xmx,ymn,ymx]=getvalue('entrez les nouvelles bornes',..
183           ['xmin';'xmax';'ymin';'ymax'],..
184           list('vec',1,'vec',1,'vec',1,'vec',1),..
185           string([xmn;xmx;ymn;ymx]))
186       if ~ok then break,end
187       if xmn>xmx|ymn>ymx then
188         x_message('Les bornes sont incorrectes')
189       else
190         break
191       end
192     end
193     if ok then
194       xset('alufunction',3)
195       dx=xmx-xmn;dy=ymx-ymn
196       if dx==0 then dx=maxi(xmx/2,1),xmn=xmn-dx/10;xmx=xmx+dx/10;end
197       if dy==0 then dy=maxi(ymx/2,1),ymn=ymn-dy/5;ymx=ymx+dy/10;end
198       rect=[xmn,ymn,xmx,ymx];
199       xbasc()
200       auto=%f
201       xset('alufunction',3)
202       if x<>[]&y<>[] then 
203         plot2d(x,y,-1,'011',' ',rect,axisdata);
204         xset('alufunction',6)
205         plot2d(x,y,1,'000',' ')
206       else
207         plot2d(rect(1),rect(2),-1,'011',' ',rect,axisdata);
208         xset('alufunction',6)
209       end
210       xgrid(4)
211
212     end
213   case 'Grids' then 
214     rep=x_mdialog('entrez les nouveaux nombres d''intervalles',..
215         ['axe des x';'axe des y'],..
216         string([axisdata(2);axisdata(4)]))
217     if rep<>[] then
218       rep=evstr(rep)
219       axisdata(2)=rep(1);axisdata(4)=rep(2);
220       xset('alufunction',3)
221       rect=[xmn,ymn,xmx,ymx];
222       xbasc()
223       auto=%f
224       if x<>[]&y<>[] then 
225         plot2d(x,y,-1,'011',' ',rect,axisdata);
226         xset('alufunction',6)
227         plot2d(x,y,1,'000',' ')
228       else
229         plot2d(rect(1),rect(2),-1,'011',' ',rect,axisdata);
230         xset('alufunction',6)
231       end
232       xgrid(4)
233     end
234   case 'Clear' then
235     if x<>[]&y<>[] then 
236       plot2d(x,y,1,'000',' ');plot2d(x,y,-1,'000',' ')
237       x=[];y=[];
238     end
239   case 'Read' then
240     [x,y]=readxy()
241     mx=mini(prod(size(x)),prod(size(y)))
242     if mx<>0 then
243       xmx=maxi(x);xmn=mini(x)
244       ymx=maxi(y);ymn=mini(y)
245       dx=xmx-xmn;dy=ymx-ymn
246       if dx==0 then dx=maxi(xmx/2,1),xmn=xmn-dx/10;xmx=xmx+dx/10;end
247       if dy==0 then dy=maxi(ymx/2,1),ymn=ymn-dy/5;ymx=ymx+dy/10;end
248     else
249       xmn=0;ymn=0;xmx=1;ymx=1;dx=1;dy=1
250     end
251     rect=[xmn,ymn,xmx,ymx];
252     xbasc()
253     xset('alufunction',3)
254     if x<>[]&y<>[] then 
255       plot2d(x,y,-1,'011',' ',rect,axisdata);
256       xset('alufunction',6)
257       plot2d(x,y,1,'000',' ')
258     else
259       plot2d(rect(1),rect(2),-1,'011',' ',rect,axisdata);
260       xset('alufunction',6)
261     end
262     xgrid(4)
263   case 'Save' then
264     savexy(x,y)
265   case 'Replot' then
266     xbasc()
267     xset('alufunction',3)
268     plot2d(rect(1),rect(2),-1,'011',' ',rect,axisdata);
269     xgrid(4)
270     xset('alufunction',6)
271     if x<>[]&y<>[] then 
272       plot2d(x,y,1,'000',' ');plot2d(x,y,-1,'000',' ');
273     end
274   case 'edit' then
275     npt=prod(size(x))
276     if npt<>0 then
277       dist=((x-ones(npt,1)*c1(1))/dx)^2+((y-ones(npt,1)*c1(2))/dy)^2
278       [m,k]=mini(dist);m=sqrt(m)
279     else
280       m=3*eps
281     end
282     if m<eps then                 //on deplace le point
283       xs=x;ys=y
284       [x,y]=movept(x,y)         
285     else                          
286       if add==1 then 
287         xs=x;ys=y                  //on rajoute un point de cassure
288         [x,y]=addpt(c1,x,y)
289       end
290     end
291   end
292 end
293
294
295 endfunction
296
297 function [x,y]=addpt(c1,x,y)
298 //permet de rajouter un point de cassure
299   npt=prod(size(x))
300   c1=c1'
301   if npt==0 then
302     x=c1(1);y=c1(2)
303     plot2d(x,y,1,'000',' ')
304     return
305   end
306   //recherche des intervalles en x contenant l'abscisse designee
307   kk=[]
308   if npt>1 then
309     kk=find((x(1:npt-1)-c1(1)*ones(x(1:npt-1)))..
310             .*(x(2:npt)-c1(1)*ones(x(2:npt)))<=0)
311   end
312   if  kk<>[] then
313     //    recherche du segment sur le quel on a designe un point
314     pp=[];d=[];i=0
315     for k=kk
316       i=i+1
317       pr=projaff(x(k:k+1),y(k:k+1),c1)
318       if (x(k)-pr(1))*(x(k+1)-pr(1))<=0 then
319         pp=[pp pr]
320         d1=rect(3)-rect(1)
321         d2=rect(4)-rect(2)
322         d=[d norm([d1;d2].\(pr-c1))]
323       end
324     end
325     if d<>[] then
326       [m,i]=mini(d)
327       if m<eps
328         k=kk(i)
329         pp=pp(:,i)
330         //  -- trace du point designe
331         plot2d(pp(1),pp(2),-1,'000',' ')
332         //  acquisition du nouveau point
333         //        [btn,xc,yc]=xclick();c2=[xc;yc]
334         c2=pp
335         //  -- effacage de l'ancien segment
336         plot2d(pp(1),pp(2),-1,'000',' ')
337         plot2d(x(k:k+1),y(k:k+1),1,'000',' ')
338         //  -- mise a jour de x et y
339         x=x([1:k k:npt]);x(k+1)=c2(1);
340         y=y([1:k k:npt]);y(k+1)=c2(2);
341         //  -- dessin des 2 nouveaux segments
342         plot2d(x(k:k+2),y(k:k+2),1,'000',' ')
343         plot2d(x(k+1),y(k+1),-1,'000',' ')
344         return
345       end
346     end
347   end
348   d1=rect(3)-rect(1)
349   d2=rect(4)-rect(2)
350   if norm([d1;d2].\([x(1);y(1)]-c1))<norm([d1;d2].\([x(npt);y(npt)]-c1)) then
351     //  -- mise a jour de x et y
352     x(2:npt+1)=x;x(1)=c1(1)
353     y(2:npt+1)=y;y(1)=c1(2)
354     //  -- dessin du nouveau segment
355     plot2d(x(1),y(1),-1,'000',' ')
356     plot2d(x(1:2),y(1:2),1,'000',' ')
357   else
358     //  -- mise a jour de x et y
359     x(npt+1)=c1(1)
360     y(npt+1)=c1(2)
361     //  -- dessin du nouveau segment
362     plot2d(x(npt+1),y(npt+1),-1,'000',' ')
363     plot2d(x(npt:npt+1),y(npt:npt+1),1,'000',' ')
364   end
365 endfunction
366
367 function [x,y]=movept(x,y)
368 //on bouge un point existant
369   rep(3)=-1
370   while rep(3)==-1 do
371     rep=xgetmouse()
372     xc=rep(1);yc=rep(2);c2=[xc;yc]
373     //[btn,xc,yc]=xclick();c2=[xc;yc]
374     if modx==0 then c2(1)=x(k);end
375     if mody==0 then c2(2)=y(k);end
376     pts=maxi(k-1,1):mini(k+1,npt)
377     // - effacage des deux segments   
378     plot2d(x(pts),y(pts),1,'000',' ')
379     plot2d(x(pts),y(pts),-1,'000',' ')
380     // - trace dans la nouvelle position
381     x(k)=c2(1);y(k)=c2(2)
382     plot2d(x(pts),y(pts),1,'000',' ')
383     plot2d(x(pts),y(pts),-1,'000',' ')
384   end
385
386 endfunction
387 function [x,y]=readxy()
388   fn=xgetfile('*.xy')
389   if fn<>emptystr() then 
390     if execstr('load(fn)','errcatch')<>0 then
391       xy=read(fn,-1,2)
392       x=xy(:,1);y=xy(:,2)
393     else
394       x=xy(:,1);y=xy(:,2)
395     end
396   else
397     x=x
398     y=y
399   end
400
401 endfunction
402
403 function savexy(x,y)
404   fn=xgetfile('*.xy')
405   if fn<>emptystr()  then 
406     xy=[x y];
407     fil=fn+'.xy'
408     if execstr('save(fil,xy)','errcatch')<>0 then
409       x_message(['Impossible to save in the selected file';
410                  'Check file and directory access'])
411       return
412     end
413   end
414 endfunction