Graphics macros: fix edit_curv
[scilab.git] / scilab / modules / graphics / macros / edit_curv.sci
1 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 // Copyright (C) 1993 - INRIA - Serge Steer
3 // Copyright (C) 1993 - INRIA - Habib Jreij
4 // Copyright (C) 2012 - 2016 - Scilab Enterprises
5 //
6 // This file is hereby licensed under the terms of the GNU GPL v2.0,
7 // pursuant to article 5.3.4 of the CeCILL v.2.1.
8 // This file was originally licensed under the terms of the CeCILL v2.1,
9 // and continues to be available under such terms.
10 // For more information, see the COPYING file which you should have received
11 // along with this program.
12
13 function [x,y,ok,gc]=edit_curv(x,y,job,tit,gc)
14     //   mod_curv  - Edition  de courbe interactive
15     //%Syntaxe
16     //  [x,y,ok]=mod_curv(xd,yd,job,tit)
17     //%Parametres
18     //  xd    :  vecteur des abscisses donnees (eventuellement [])
19     //  yd    :  vecteur des ordonnees donnees (eventuellement [])
20     //  job   :  chaine de 3 caracteres  specifiant les operations
21     //           permises:
22     //            - Si la chaine contient le caractere 'a', il est
23     //              possible d'ajouter des points aux donnees, sinon
24     //              il est seulement possible de les deplacer
25     //            - Si la chaine contient le caractere 'x', il est
26     //              possible de deplacer les points horizontalement
27     //            - Si la chaine contient le caractere 'y', il est
28     //              possible de deplacer les points verticalement
29     //  tit   : liste de trois chaines de caracteres
30     //          tit(1) : titre de la courbe (peut etre un vecteur colonne)
31     //          tit(2) : label de l'axe des abscisses
32     //          tit(3) : label de l'axe des ordonnees
33     //  x     : vecteur des abscisses resultat
34     //  y     : vecteur des ordonnees resultat
35     //  ok    : vaut %t si la sortie as ete demandee par le menu Ok
36     //           et  %f si la sortie as ete demandee par le menu Abort
37     //%menus
38     //  Ok    : sortie de l'editeur et retour de la courbe editee
39     //  Abort : sortie de l'editeur et retour au donnes initiales
40     //  Undo  : annulation de la derniere modification
41     //  Size  : changement des bornes du graphique
42     //  Grids : changement des graduations du graphique
43     //  Clear : effacement de la courbe (x=[] et y=[]) (sans quitter l'editeur)
44     //  Read  : lecture de la courbe a partir d'un fichier d'extension .xy
45     //  Save  : sauvegarde binaire (sur un fichier d'extension .xy) de
46     //          la courbe
47     //!
48     [lhs,rhs]=argn(0)
49
50     ok = %t;
51     if rhs==0 then x=[]; y=[],end;
52     if rhs==1 then y=x;x=(1:size(y,"*"))',end
53     if rhs<3  then job="axy",end
54     if rhs<4 then tit=[" "," "," "],end
55     if size(tit,"*")<3 then tit(3)=" ",end
56     //
57
58     [mx,nx] = size(x); x=x(:)
59     [my,ny] = size(y); y=y(:)
60     n = min(mx*nx,my*ny)
61     x= x(1:n);y=y(1:n);
62     xsav=x; ysav=y; xs=x; ys=y;
63     //
64     lj = length(job)
65     add=0;modx=0;mody=0
66     for k=1:lj
67         jk = part(job,k)
68         select jk
69         case "a" then add = 1,
70         case "x" then modx= 1
71         case "y" then mody= 1
72         else error(msprintf(gettext("%s: Wrong value for input argument #%d: Must be in the set {%s}.\n"), "edit_curv", 3, "a, x, y"));
73         end
74     end
75     eps = 0.03
76     symbsiz = 0.2
77     // bornes initiales du graphique
78     if rhs<5 then
79         if mx<>0 then
80             xmx = max(x); xmn = min(x)
81             ymx = max(y); ymn = min(y)
82             dx = xmx-xmn;  dy = ymx-ymn
83             if dx==0 then dx=max(xmx/2,1),end
84             xmn=xmn-dx/10;xmx=xmx+dx/10
85             if dy==0 then dy=max(ymx/2,1),end;
86             ymn=ymn-dy/10;ymx=ymx+dy/10;
87         else
88             xmn=0;ymn=0;xmx=1;ymx=1;dx=1;dy=1
89         end
90         rect=[xmn,ymn,xmx,ymx];
91         axisdata=[2 10 2 10];
92         gc = list(rect,axisdata);
93     else //** rhs=5 as in Scicos ;)
94         [rect,axisdata] = gc(1:2)
95         xmn = rect(1);
96         ymn = rect(2);
97         xmx = rect(3);
98         ymx = rect(4);
99         dx  = xmx-xmn;
100         dy  = ymx-ymn;
101     end
102
103     // Set menus and callbacks
104     menu_d = ["Read","Save","Clear"]
105     menu_e = ["Undo","Size","Replot","Ok","Abort"]
106     menus  = list(["Edit","Data"],menu_e,menu_d)
107     w="menus(2)(";rpar=")"
108     Edit=w(ones(menu_e))+string(1:size(menu_e,"*"))+rpar(ones(menu_e))
109     w="menus(3)(";rpar=")"
110     Data=w(ones(menu_d))+string(1:size(menu_d,"*"))+rpar(ones(menu_d))
111
112     wins = winsid();
113     if ~isempty(wins) then
114         curwin = max(winsid())+1;
115     else
116         curwin = 1;
117     end
118     scf(curwin);
119
120     // Disable the menus and toolbars
121     toolbar(curwin,"off");
122     delmenu(curwin,gettext("File"));
123     delmenu(curwin,gettext("Tools"));
124     delmenu(curwin,gettext("Edit"));;
125     delmenu(curwin,"?");
126
127     execstr("Edit_"+string(curwin)+"=Edit");
128     execstr("Data_"+string(curwin)+"=Data");
129     menubar(curwin,menus)
130     //
131     edit_curv_figure = gcf();
132     edit_curv_figure.figure_name = "edit_curv";
133
134     edit_curv_axes = gca();
135     edit_curv_axes.data_bounds = [rect(1),rect(2);rect(3),rect(4)]
136     edit_curv_axes.axes_visible="on";
137     edit_curv_axes.grid=[4 4];
138     if x<>[] then
139         xpolys(x*[1 1],y*[1 1],[1,-1])
140         hdl=edit_curv_axes.children.children
141     else
142         hdl=[]
143     end
144
145     xtitle(tit(1),tit(2),tit(3));
146
147
148     // -- boucle principale
149     while %t then
150         [n1,n2] = size(x);
151         npt = n1*n2 ;
152
153         [btn,xc,yc,win,Cmenu] = get_click();
154
155         //** disp([btn,xc,yc,win]); //** DEBUG only
156
157         c1 = [xc,yc];
158
159         if Cmenu=="Quit" then Cmenu="Abort",end
160         if Cmenu==[]     then Cmenu="edit",end
161         if Cmenu=="Exit" then Cmenu="Ok",end
162
163         select Cmenu
164         case [] then
165             // ce n est pas un menu
166             break
167
168         case "Ok" then    //    -- ok menu
169             rect = matrix(edit_curv_axes.data_bounds',1,4);
170             gc   = list(rect,axisdata);
171             delete(edit_curv_figure)
172             return;
173
174         case "Abort" then //    -- abort menu
175             x = xsav
176             y = ysav
177             delete(edit_curv_figure)
178             ok = %f;
179             return
180
181         case "XClose" then //** the user manually close the win
182             x = xsav
183             y = ysav
184             ok = %f;
185             return
186
187         case "Undo" then
188             x=xs;y=ys
189             if x<>[] then hdl.data=[x y]; end
190
191         case "Size" then
192             while %t
193                 [ok,xmn,xmx,ymn,ymx]=getvalue("Please input new limits",..
194                 ["xmin";"xmax";"ymin";"ymax"],..
195                 list("vec",1,"vec",1,"vec",1,"vec",1),..
196                 string([xmn;xmx;ymn;ymx]))
197                 if ~ok then break,end
198                 if xmn>xmx|ymn>ymx then
199                     messagebox("Limits are not accettable","modal");
200                 else
201                     break
202                 end
203             end
204             if ok then
205                 dx=xmx-xmn;dy=ymx-ymn
206                 if dx==0 then dx=max(xmx/2,1),xmn=xmn-dx/10;xmx=xmx+dx/10;end
207                 if dy==0 then dy=max(ymx/2,1),ymn=ymn-dy/5;ymx=ymx+dy/10;end
208                 rect=[xmn,ymn,xmx,ymx];
209                 edit_curv_axes.data_bounds=[rect(1),rect(2);rect(3),rect(4)]
210             end
211
212         case "Clear" then
213             if hdl<>[] then delete(hdl),hdl=[];end
214             x=[];y=[];
215
216         case "Read" then
217             [x,y]=readxy()
218             mx=min(prod(size(x)),prod(size(y)))
219             if mx<>0 then
220                 xmx=max(x);xmn=min(x)
221                 ymx=max(y);ymn=min(y)
222                 dx=xmx-xmn;dy=ymx-ymn
223                 if dx==0 then dx=max(xmx/2,1),xmn=xmn-dx/10;xmx=xmx+dx/10;end
224                 if dy==0 then dy=max(ymx/2,1),ymn=ymn-dy/5;ymx=ymx+dy/10;end
225             else
226                 xmn=0;ymn=0;xmx=1;ymx=1;dx=1;dy=1
227             end
228             rect=[xmn,ymn,xmx,ymx];
229             edit_curv_axes.data_bounds=[rect(1),rect(2);rect(3),rect(4)]
230             if x<>[]&y<>[] then
231                 if hdl==[] then
232                     xpolys(x(1)*[1 1],y(1)*[1 1],[1,-1])
233                     hdl=gce();hdl=hdl.children
234                 end
235                 hdl.data=[x y];
236             else
237                 if hdl<>[] then delete(hdl),end
238                 x=[];y=[];
239             end
240
241         case "Save" then
242             savexy(x,y)
243
244         case "Replot" then
245             // for compatibility only, perform nothing on purpose
246
247         case "edit" then
248             npt=prod(size(x))
249             if npt<>0 then
250                 dist=((x-ones(npt,1)*c1(1))/dx).^2+((y-ones(npt,1)*c1(2))/dy).^2
251                 [m,k]=min(dist);m=sqrt(m)
252             else
253                 m=3*eps
254             end
255             if m<eps then                 //on deplace le point
256                 xs=x;ys=y
257                 [x,y]=movept(x,y)
258             else
259                 if add==1 then
260                     xs=x;ys=y                  //on rajoute un point de cassure
261                     [x,y]=addpt(c1,x,y)
262                 end
263             end
264         end
265     end
266 endfunction
267
268
269 function [btn,xc,yc,win,Cmenu] = get_click(flag)
270     //** 05/01/09 : update for Scilab 5.1: (close code is now -1000)
271
272     if ~or(winsid()==curwin) then
273         Cmenu = "Quit";
274         return        ;
275     end
276
277     if argn(2) == 1 then
278         [btn, xc, yc, win, str] = xclick(flag);
279     else
280         [btn, xc, yc, win, str] = xclick();
281     end
282
283     if btn == -1000 then //** user close the window [X]
284         if win == curwin then
285             Cmenu = "XClose";
286         else
287             Cmenu = "Open/Set";
288         end
289         return ;
290     end
291
292     if btn == -2 then //** user select a dynamic menu
293         xc = 0; yc = 0;
294         execstr("Cmenu=" + part(str, 9:length(str) - 1) );
295         execstr("Cmenu=" + Cmenu);
296         return;
297     end
298
299     Cmenu = [];
300
301 endfunction
302
303
304 function [x,y] = addpt(c1,x,y)
305     // permet de rajouter un point de cassure
306     npt = prod(size(x))
307     c1 = c1'
308     if hdl==[] then
309         x = c1(1);
310         y = c1(2);
311         xpolys(x*[1 1],y*[1 1],[1,-1]);
312         hdl = resume(edit_curv_axes.children(1).children)
313     end
314     //recherche des intervalles en x contenant l'abscisse designee
315     kk=[]
316     if npt>1 then
317         kk=find((x(1:npt-1)-c1(1)*ones(x(1:npt-1)))..
318         .*(x(2:npt)-c1(1)*ones(x(2:npt)))<=0)
319     end
320     if  kk<>[] then
321         //    recherche du segment sur le quel on a designe un point
322         pp=[];d=[];i=0
323         for k=kk
324             i=i+1
325             pr=projaff(x(k:k+1),y(k:k+1),c1)
326             if (x(k)-pr(1))*(x(k+1)-pr(1))<=0 then
327                 pp=[pp pr]
328                 d1=rect(3)-rect(1)
329                 d2=rect(4)-rect(2)
330                 d=[d norm([d1;d2].\(pr-c1))]
331             end
332         end
333         if d<>[] then
334             [m,i]=min(d)
335             if m<eps
336                 k=kk(i)
337                 pp=pp(:,i)
338                 x=x([1:k k:npt]);x(k+1)=pp(1);
339                 y=y([1:k k:npt]);y(k+1)=pp(2);
340                 hdl.data=[x y];
341                 return
342             end
343         end
344     end
345     d1=rect(3)-rect(1)
346     d2=rect(4)-rect(2)
347     if norm([d1;d2].\([x(1);y(1)]-c1))<norm([d1;d2].\([x(npt);y(npt)]-c1)) then
348         //  -- mise a jour de x et y
349         x(2:npt+1)=x;x(1)=c1(1)
350         y(2:npt+1)=y;y(1)=c1(2)
351     else
352         //  -- mise a jour de x et y
353         x(npt+1)=c1(1)
354         y(npt+1)=c1(2)
355     end
356     hdl.data=[x y];
357 endfunction
358
359 function [x,y]=movept(x,y)
360     //on bouge un point existant
361     hdl;
362     rep(3)=-1
363     while rep(3)==-1 do
364         rep = xgetmouse();
365         xc=rep(1);yc=rep(2);c2=[xc;yc]
366         if modx==0 then c2(1)=x(k);end
367         if mody==0 then c2(2)=y(k);end
368         x(k)=c2(1);y(k)=c2(2)
369         hdl.data=[x,y];
370     end
371 endfunction
372
373
374 function [x,y] = readxy()
375
376     function xy = findPolyline(children)
377         xy = [];
378         for i = 1:length(children)
379             select children(i).type,
380             case "Polyline" then
381                 xy = children(i).data;
382                 return
383             case "Axes" then
384                 xy = findPolyline(children(i).children);
385                 return
386             case "Compound" then
387                 xy = findPolyline(children(i).children);
388                 return
389             end
390         end
391     endfunction
392
393     fn=uigetfile(["*.scg";"*.sod";"*.xy"], "", _("Select a file to load"));
394     if fn <> "" then
395         [pth, fnm, ext] = fileparts(fn);
396         flname = fnm + ext;
397
398         select ext
399         case ".scg" then
400             loaded_figure=figure("visible", "off");
401             if execstr("xload(fn, loaded_figure.figure_id)","errcatch") == 0 then
402                 loaded_figure.visible = "off";
403                 scf(edit_curv_figure);
404                 xy = findPolyline(loaded_figure.children);
405                 delete(loaded_figure);
406                 if xy <> [] then
407                     x=xy(:,1);y=xy(:,2);
408                 else
409                     messagebox(msprintf(_("%s: The file "'%s"' does not " +..
410                     "contains any "'Polyline"' graphic entity.\n"), "edit_curve", flname));
411                     return
412                 end
413             else
414                 messagebox(msprintf(_("%s: Cannot open file "'%s"' " +..
415                 "for reading.\n"), "edit_curv", flname), "modal");
416                 return
417             end
418         case ".xy" then
419             if execstr("xy = read(fn,-1,2)","errcatch") == 0 then
420                 x=xy(:,1);y=xy(:,2);
421             else
422                 messagebox(msprintf(_("%s: Cannot open file "'%s"' " +..
423                 "for reading.\n"), "edit_curv", flname), "modal");
424                 return
425             end
426         case ".sod" then
427             if execstr("load(fn)","errcatch") == 0 then
428                 x=xy(:,1);y=xy(:,2);
429             else
430                 messagebox(msprintf(_("%s: Cannot open file "'%s"' " +..
431                 "for reading.\n"), "edit_curv", flname), "modal");
432                 return
433             end
434         else
435             messagebox(_("Error in file format."), "modal");
436             return
437         end
438     else
439         x=x
440         y=y
441     end
442 endfunction
443
444
445 function savexy(x,y)
446     fn=uiputfile(["*.sod";"*.xy"], "", _("Select a file to write"));
447     if fn <> "" then
448         [pth, fnm, ext] = fileparts(fn);
449         flname = fnm + ext;
450         xy = [x y];
451         fil = fn;
452
453         select ext
454         case "" then
455             fil = fil + ".xy";
456             ext = ".xy";
457         case ".xy" then
458             // empty case fil = fn
459         case ".sod" then
460             // empty case fil = fn
461         else
462             fil = pth + fnm + ".xy";
463             ext = ".xy";
464         end
465
466         select ext
467         case ".sod" then
468             if execstr("save(fil,""xy"")","errcatch")<>0 then
469                 messagebox(msprintf(_("%s: The file "'%s"' " +..
470                 "cannot be written.\n"), "edit_curv", flname), "modal");
471                 return
472             end
473         case ".xy" then
474             isErr = execstr("write(fil,xy)","errcatch")
475             if isErr == 240 then
476                 mdelete(fil); // write cannot overwrite an existing file
477                 isErr = execstr("write(fil,xy)","errcatch");
478             end
479             if isErr <> 0 then
480                 messagebox(msprintf(_("%s: The file "'%s"' " +..
481                 "cannot be written.\n"), "edit_curv", flname), "modal");
482                 return
483             end
484         end
485     end
486 endfunction