Xcos macros: replace unhandled 'doc' property with handled 'model.uid'
[scilab.git] / scilab / modules / scicos / macros / scicos_scicos / setvalue.sci
1 //  Scicos
2 //
3 //  Copyright (C) INRIA - METALAU Project <scicos@inria.fr>
4 //                      - Alan Layec <alan.layec@inria.fr>
5 //  Copyright (C) 2010 - DIGITEO - ClĂ©ment DAVID <clement.david@scilab.org>
6 //
7 // This program is free software; you can redistribute it and/or modify
8 // it under the terms of the GNU General Public License as published by
9 // the Free Software Foundation; either version 2 of the License, or
10 // (at your option) any later version.
11 //
12 // This program is distributed in the hope that it will be useful,
13 // but WITHOUT ANY WARRANTY; without even the implied warranty of
14 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 // GNU General Public License for more details.
16 //
17 // You should have received a copy of the GNU General Public License
18 // along with this program; if not, write to the Free Software
19 // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
20 //
21 // See the file ../license.txt
22 //
23
24 function [%ok,%1,%2,%3,%4,%5,...
25     %6,%7,%8,%9,%10,...
26     %11,%12,%13,%14,%15,...
27     %16,%17,%18,%19,%20,...
28     %21,%22,%23,%24,%25,...
29     %26,%27,%28,%29,%30]=setvalue(%desc,%lables,%typ,%ini)
30
31     // To avoid infinite loops in set section of blocks during eval
32     if %scicos_prob==%t then
33         %ok=%f
34         [%1,%2,%3,%4,%5,...
35         %6,%7,%8,%9,%10,...
36         %11,%12,%13,%14,%15,...
37         %16,%17,%18,%19,%20,...
38         %21,%22,%23,%24,%25,...
39         %26,%27,%28,%29,%30]=(0,0,0,0,0,...
40         0,0,0,0,0,...
41         0,0,0,0,0,...
42         0,0,0,0,0,...
43         0,0,0,0,0,...
44         0,0,0,0,0)
45     return;end
46     //  setvalues -  data acquisition, getvalue equivalent without dialog
47     //%Syntax
48     //  [%ok,x1,..,x18]=setvalue(desc,labels,typ,ini)
49     //%Parameters
50     //  desc    : column vector of strings, dialog general comment
51     //  labels  : n column vector of strings, labels(i) is the label of
52     //            the ith required value
53     //  typ     : list(typ1,dim1,..,typn,dimn)
54     //            typi : defines the type of the ith required value
55     //                   if may have the following values:
56     //                   'mat' : stands for matrix of scalars
57     //                   'col' : stands for column vector of scalars
58     //                   'row' : stands for row vector of scalars
59     //                   'vec' : stands for  vector of scalars
60     //                   'str' : stands for string
61     //                   'lis' : stands for list
62     //                   'pol' : stands for polynomials
63     //                   'r'   : stands for rational
64     //            dimi : defines the size of the ith required value
65     //                   it must be
66     //                    - an integer or a 2-vector of integers (-1 stands for
67     //                      arbitrary dimension)
68     //                    - an evaluatable character string
69     //  ini     : n column vector of strings, ini(i) gives the suggested
70     //            response for the ith required value
71     //  %ok      : boolean ,%t if %ok button pressed, %f if cancel button pressed
72     //  xi      : contains the ith required value if %ok==%t
73     //%Description
74     // getvalues function uses ini strings to evaluate required args
75     // with error checking,
76     //%Remarks
77     // All correct scilab syntax may be used as responses, for matrices
78     // and vectors getvalues automatically adds [ ] around the given response
79     // before numerical evaluation
80     //%Example
81     // labels=['magnitude';'frequency';'phase    '];
82     // [ampl,freq,ph]=setvalue('define sine signal',labels,..
83     //            list('vec',1,'vec',1,'vec',1),['0.85';'10^2';'%pi/3'])
84     //
85     //%See also
86     // x_mdialog, dialog
87     //!
88     // 17/01/07 -Alan- - %scicos_context behavior reviewed in accordance to context_evstr macro
89     //                 - pass int in field of type vec/mat/row/col (F. Nassif's Work)
90     //
91     // 05/02/07 -Alan- : update to %20 rhs parameters
92     //
93     // Copyright INRIA
94     [%lhs,%rhs]=argn(0)
95
96     %nn=prod(size(%lables))
97     if %lhs<>%nn+2&%lhs<>%nn+1 then error(41),end
98     if size(%typ)<>2*%nn then
99         error("typ : list(''type'',[sizes],...)")
100     end
101     %1=[];%2=[];%3=[];%4=[];%5=[];
102     %6=[];%7=[];%8=[];%9=[];%10=[];
103     %11=[];%12=[];%13=[];%14=[],%15=[];
104     %16=[];%17=[];%18=[];%19=[],%20=[];
105     %21=[];%22=[];%23=[];%24=[],%25=[];
106     %26=[];%27=[];%28=[];%29=[],%30=[];
107
108     if %rhs==3 then  %ini=emptystr(%nn,1),end
109     %ok=%t
110     while %t do
111         %str=%ini;
112         if %str==[] then %ok=%f,break,end
113         for %kk=1:%nn
114             %cod=ascii(%str(%kk))
115             %spe=find(%cod==10)
116             if %spe<>[] then
117                 %semi=ascii(";")
118                 %cod(%spe)=%semi*ones(%spe')
119                 %str(%kk)=ascii(%cod)
120             end
121         end
122
123         [%vv_list,%ierr_vec]=context_evstr(%str,%scicos_context,%typ);
124
125         %noooo=0
126         for %kk=1:%nn
127             %vv=%vv_list(%kk)
128             %ierr=%ierr_vec(%kk)
129             select part(%typ(2*%kk-1),1:6)
130             case "mat   "
131                 if %ierr<>0  then
132                     %noooo=-%kk,break,
133                 end
134                 //29/12/06
135                 //the type of %vv is accepted if it is constant or integer
136                 if and(type(%vv)<>[1 8]) then %nok=-%kk,break,end
137                 %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
138                 [%mmmm,%nnnnn]=size(%vv)
139                 %ssss=string(%sz(1))+"-by-"+string(%sz(2)) + " matrix"
140                 if %mmmm*%nnnnn==0 then
141                     if  %sz(1)>=0&%sz(2)>=0&%sz(1)*%sz(2)<>0 then %noooo=%kk,break,end
142                 else
143                     if %sz(1)>=0 then if %mmmm<>%sz(1) then %noooo=%kk,break,end,end
144                     if %sz(2)>=0 then if %nnnnn<>%sz(2) then %noooo=%kk,break,end,end
145                 end
146             case "vec   "
147                 if %ierr<>0  then
148                     %noooo=-%kk,break,
149                 end
150                 //17/01/07
151                 //the type of %vv is accepted if it is constant or integer
152                 if and(type(%vv)<>[1 8]) then %nok=-%kk,break,end
153                 %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
154                 %ssss=string(%sz(1))
155                 %nnnnn=prod(size(%vv))
156                 if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
157             case "intvec"
158                 if %ierr<>0  then
159                     %noooo=-%kk,break,
160                 end
161                 //the type of %vv is accepted if it is constant or integer
162                 if and(type(%vv)<>[1 8]) then %nok=-%kk,break,end
163                 %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
164                 %ssss=string(%sz(1))
165                 %nnnnn=prod(size(%vv))
166                 if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
167             case "pol   "
168                 if %ierr<>0  then
169                     %noooo=-%kk,break,
170                 end
171                 if %ierr<>0 then %noooo=-%kk;break,end
172                 if (type(%vv)>2 & type(%vv)<>8) then %noooo=-%kk,break,end
173                 %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
174                 %ssss=string(%sz(1))
175                 %nnnnn=prod(size(%vv))
176                 if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
177             case "row   "
178                 if %ierr<>0  then
179                     %noooo=-%kk,break,
180                 end
181                 //17/01/07
182                 //the type of %vv is accepted if it is constant or integer
183                 if and(type(%vv)<>[1 8]) then %nok=-%kk,break,end
184                 %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
185                 if %sz(1)<0 then
186                     %ssss="1-by-n matrix"
187                 else
188                     %ssss="1-by-"+string(%sz(1))+" matrix"
189                 end
190                 [%mmmm,%nnnnn]=size(%vv)
191                 if %mmmm<>1 then %noooo=%kk,break,end,
192                 if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
193             case "col   "
194                 if %ierr<>0  then
195                     %noooo=-%kk,break,
196                 end
197                 //17/01/07
198                 //the type of %vv is accepted if it is constant or integer
199                 if and(type(%vv)<>[1 8]) then %nok=-%kk,break,end
200                 %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
201                 if %sz(1)<0 then
202                     %ssss="m-by-1 matrix"
203                 else
204                     %ssss=string(%sz(1))+"-by-1 matrix"
205                 end
206                 [%mmmm,%nnnnn]=size(%vv)
207                 if %nnnnn<>1 then %noooo=%kk,break,end,
208                 if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
209             case "str   "
210                 clear %vv
211                 %vv=%str(%kk)
212                 if type(%vv)<>10 then %noooo=-%kk,break,end
213                 %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
214                 %ssss=string(%sz(1))
215                 %nnnnn=prod(size(%vv))
216                 if %sz(1)>=0 then if %nnnnn<>1 then %noooo=%kk,break,end,end
217             case "lis   "
218                 if %ierr<>0  then
219                     %noooo=-%kk,break,
220                 end
221                 if type(%vv)<>15& type(%vv)<>16& type(%vv)<>17 then %noooo=-%kk,break,end
222                 %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
223                 %ssss=string(%sz(1))
224                 %nnnnn=size(%vv)
225                 if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
226             case "r     "
227                 if %ierr<>0  then
228                     %noooo=-%kk,break,
229                 end
230                 if type(%vv)<>16 then %noooo=-%kk,break,end
231                 if typeof(%vv)<>"rational" then %noooo=-%kk,break,end
232                 %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
233                 [%mmmm,%nnnnn]=size(%vv(2))
234                 %ssss=string(%sz(1))+"-by-"+string(%sz(2))
235                 if %mmmm*%nnnnn==0 then
236                     if  %sz(1)>=0&%sz(2)>=0&%sz(1)*%sz(2)<>0 then %noooo=%kk,break,end
237                 else
238                     if %sz(1)>=0 then if %mmmm<>%sz(1) then %noooo=%kk,break,end,end
239                     if %sz(2)>=0 then if %nnnnn<>%sz(2) then %noooo=%kk,break,end,end
240                 end
241             case "gen   "
242                 //accept all
243             else
244                 str = gettext("%s: Type %s is not implemented.\n");
245                 mess = msprintf(str, arg1.gui + "(''set'')", %typ(2*%kk-1));
246                 if length(arg1.doc) > 0 then
247                     warnBlockByUID(arg1.doc(1), mess); // arg1 is from the block interface function
248                 else
249                     error(mess);
250                 end
251             end
252             execstr("%"+string(%kk)+"=%vv")
253             clear %vv
254         end
255         if %noooo>0 then
256             str = gettext("%s: Wrong size for block parameter ''%s'': %s expected, getting %s");
257             mess = msprintf(str, arg1.gui + "(''set'')", %lables(%noooo), %ssss, %ini(%noooo));
258             if length(arg1.model.uid) > 0 then
259                 warnBlockByUID(arg1.model.uid, mess); // arg1 is from the block interface function
260             else
261                 disp(mess);
262             end
263             %ini=%str
264             %ok=%f;break
265         elseif %noooo<0 then
266             str = gettext("%s: Wrong type for block parameter ''%s'': %s(%s) expected, getting %s");
267             mess = msprintf(str, arg1.gui + "(''set'')", %lables(-%noooo), %typ(-2*%noooo-1), strcat(string(%typ(-2*%noooo))," by "), %ini(-%noooo));
268             if length(arg1.model.uid) > 0 then
269                 warnBlockByUID(arg1.model.uid, mess); // arg1 is from the block interface function
270             else
271                 disp(mess);
272             end
273             %ini=%str
274             %ok=%f;break
275         else
276             break
277         end
278     end
279     if %lhs==%nn+2 then
280         execstr("%"+string(%lhs-1)+"=%str")
281     end
282 endfunction