Set svn:eol-style to native
[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 //
6 // This program is free software; you can redistribute it and/or modify
7 // it under the terms of the GNU General Public License as published by
8 // the Free Software Foundation; either version 2 of the License, or
9 // (at your option) any later version.
10 //
11 // This program is distributed in the hope that it will be useful,
12 // but WITHOUT ANY WARRANTY; without even the implied warranty of
13 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 // GNU General Public License for more details.
15 //
16 // You should have received a copy of the GNU General Public License
17 // along with this program; if not, write to the Free Software
18 // Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19 //
20 // See the file ../license.txt
21 //
22
23 function [%ok,%1,%2,%3,%4,%5,...
24           %6,%7,%8,%9,%10,...
25           %11,%12,%13,%14,%15,...
26           %16,%17,%18,%19,%20]=setvalue(%desc,%lables,%typ,%ini)
27
28 // To avoid infinite loops in set section of blocks during eval
29 if %scicos_prob==%t then 
30         %ok=%f
31         [%1,%2,%3,%4,%5,...
32          %6,%7,%8,%9,%10,...
33          %11,%12,%13,%14,%15,...
34          %16,%17,%18,%19,%20]=(0,0,0,0,...
35                                0,0,0,0,0,0,...
36                                0,0,0,0,0,...
37                                0,0,0,0,0)
38 return;end
39 //  setvalues -  data acquisition, getvalue equivalent without dialog
40 //%Syntax
41 //  [%ok,x1,..,x18]=setvalue(desc,labels,typ,ini)
42 //%Parameters
43 //  desc    : column vector of strings, dialog general comment 
44 //  labels  : n column vector of strings, labels(i) is the label of 
45 //            the ith required value
46 //  typ     : list(typ1,dim1,..,typn,dimn)
47 //            typi : defines the type of the ith required value
48 //                   if may have the following values:
49 //                   'mat' : stands for matrix of scalars 
50 //                   'col' : stands for column vector of scalars
51 //                   'row' : stands for row vector of scalars
52 //                   'vec' : stands for  vector of scalars
53 //                   'str' : stands for string
54 //                   'lis' : stands for list
55 //                   'pol' : stands for polynomials
56 //                   'r'   : stands for rational
57 //            dimi : defines the size of the ith required value
58 //                   it must be
59 //                    - an integer or a 2-vector of integers (-1 stands for
60 //                      arbitrary dimension)
61 //                    - an evaluatable character string
62 //  ini     : n column vector of strings, ini(i) gives the suggested
63 //            response for the ith required value
64 //  %ok      : boolean ,%t if %ok button pressed, %f if cancel button pressed
65 //  xi      : contains the ith required value if %ok==%t
66 //%Description
67 // getvalues function uses ini strings to evaluate required args 
68 // with error checking,
69 //%Remarks
70 // All correct scilab syntax may be used as responses, for matrices 
71 // and vectors getvalues automatically adds [ ] around the given response
72 // before numerical evaluation
73 //%Example
74 // labels=['magnitude';'frequency';'phase    '];
75 // [ampl,freq,ph]=setvalue('define sine signal',labels,..
76 //            list('vec',1,'vec',1,'vec',1),['0.85';'10^2';'%pi/3'])
77 // 
78 //%See also
79 // x_mdialog, dialog
80 //!
81 // 17/01/07 -Alan- - %scicos_context behavior reviewed in accordance to context_evstr macro
82 //                 - pass int in field of type vec/mat/row/col (F. Nassif's Work)
83 //
84 // 05/02/07 -Alan- : update to %20 rhs parameters
85 //
86 [%lhs,%rhs]=argn(0)
87
88 %nn=prod(size(%lables))
89 if %lhs<>%nn+2&%lhs<>%nn+1 then error(41),end
90 if size(%typ)<>2*%nn then
91   error('typ : list(''type'',[sizes],...)')
92 end
93 %1=[];%2=[];%3=[];%4=[];%5=[];
94 %6=[];%7=[];%8=[];%9=[];%10=[];
95 %11=[];%12=[];%13=[];%14=[],%15=[];
96 %16=[];%17=[];%18=[];%19=[],%20=[];
97
98 if %rhs==3 then  %ini=emptystr(%nn,1),end
99 %ok=%t
100 while %t do
101   %str=%ini;
102   if %str==[] then %ok=%f,break,end
103   for %kk=1:%nn
104     %cod=ascii(%str(%kk))
105     %spe=find(%cod==10)
106     if %spe<>[] then
107       %semi=ascii(';')
108       %cod(%spe)=%semi*ones(%spe')
109       %str(%kk)=ascii(%cod)
110     end
111   end
112
113   [%vv_list,%ierr_vec]=context_evstr(%str,%scicos_context);
114
115   %noooo=0
116   for %kk=1:%nn
117     %vv=%vv_list(%kk)
118     %ierr=%ierr_vec(%kk)
119     select part(%typ(2*%kk-1),1:3)
120     case 'mat'
121       if %ierr<>0  then 
122         %noooo=-%kk,break,
123       end
124       //29/12/06
125       //the type of %vv is accepted if it is constant or integer
126       if and(type(%vv)<>[1 8]) then %nok=-%kk,break,end
127       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
128       [%mmmm,%nnnnn]=size(%vv)
129       %ssss=string(%sz(1))+' x '+string(%sz(2))
130       if %mmmm*%nnnnn==0 then
131         if  %sz(1)>=0&%sz(2)>=0&%sz(1)*%sz(2)<>0 then %noooo=%kk,break,end
132       else
133         if %sz(1)>=0 then if %mmmm<>%sz(1) then %noooo=%kk,break,end,end
134         if %sz(2)>=0 then if %nnnnn<>%sz(2) then %noooo=%kk,break,end,end
135       end
136     case 'vec'
137       if %ierr<>0  then 
138         %noooo=-%kk,break,
139       end
140       //17/01/07
141       //the type of %vv is accepted if it is constant or integer
142       if and(type(%vv)<>[1 8]) then %nok=-%kk,break,end
143       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
144       %ssss=string(%sz(1))
145       %nnnnn=prod(size(%vv))
146       if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
147     case 'pol'
148       if %ierr<>0  then 
149         %noooo=-%kk,break,
150       end
151       if %ierr<>0 then %noooo=-%kk;break,end
152       if type(%vv)>2 then %noooo=-%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 'row'
158       if %ierr<>0  then 
159         %noooo=-%kk,break,
160       end
161       //17/01/07
162       //the type of %vv is accepted if it is constant or integer
163       if and(type(%vv)<>[1 8]) then %nok=-%kk,break,end
164       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
165       if %sz(1)<0 then
166         %ssss='1 x *'
167       else
168         %ssss='1 x '+string(%sz(1))
169       end
170       [%mmmm,%nnnnn]=size(%vv)
171       if %mmmm<>1 then %noooo=%kk,break,end,
172       if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
173     case 'col'
174       if %ierr<>0  then 
175         %noooo=-%kk,break,
176       end
177       //17/01/07
178       //the type of %vv is accepted if it is constant or integer
179       if and(type(%vv)<>[1 8]) then %nok=-%kk,break,end
180       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
181       if %sz(1)<0 then
182         %ssss='* x 1'
183       else
184         %ssss=string(%sz(1))+' x 1'
185       end
186       [%mmmm,%nnnnn]=size(%vv)
187       if %nnnnn<>1 then %noooo=%kk,break,end,
188       if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
189     case 'str'
190       clear %vv
191       %vv=%str(%kk)
192       if type(%vv)<>10 then %noooo=-%kk,break,end
193       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
194       %ssss=string(%sz(1))
195       %nnnnn=prod(size(%vv))
196       if %sz(1)>=0 then if %nnnnn<>1 then %noooo=%kk,break,end,end
197     case 'lis'
198       if %ierr<>0  then 
199         %noooo=-%kk,break,
200       end
201       if type(%vv)<>15& type(%vv)<>16& type(%vv)<>17 then %noooo=-%kk,break,end
202       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
203       %ssss=string(%sz(1))
204       %nnnnn=size(%vv)
205       if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
206     case 'r  '
207       if %ierr<>0  then 
208         %noooo=-%kk,break,
209       end
210       if type(%vv)<>16 then %noooo=-%kk,break,end
211       if typeof(%vv)<>'rational' then %noooo=-%kk,break,end
212       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
213       [%mmmm,%nnnnn]=size(%vv(2))
214       %ssss=string(%sz(1))+' x '+string(%sz(2))
215       if %mmmm*%nnnnn==0 then
216         if  %sz(1)>=0&%sz(2)>=0&%sz(1)*%sz(2)<>0 then %noooo=%kk,break,end
217       else
218         if %sz(1)>=0 then if %mmmm<>%sz(1) then %noooo=%kk,break,end,end
219         if %sz(2)>=0 then if %nnnnn<>%sz(2) then %noooo=%kk,break,end,end
220       end
221     else
222       error('Incorrect type :'+%typ(2*%kk-1))
223     end
224     execstr('%'+string(%kk)+'=%vv')
225     clear %vv
226   end
227   if %noooo>0 then 
228     message(['answer given for  '+%lables(%noooo);
229              'has invalid dimension: ';
230              'waiting for dimension  '+%ssss])
231     %ini=%str
232     %ok=%f;break
233   elseif %noooo<0 then
234     message(['answer given for  '+%lables(-%noooo);
235              'has incorrect type :'+ %typ(-2*%noooo-1)])
236     %ini=%str
237     %ok=%f;break
238   else
239     break
240   end
241 end
242 if %lhs==%nn+2 then
243   execstr('%'+string(%lhs-1)+'=%str')
244 end
245 endfunction