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