import macros
[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 // Copyright INRIA
87 [%lhs,%rhs]=argn(0)
88
89 %nn=prod(size(%lables))
90 if %lhs<>%nn+2&%lhs<>%nn+1 then error(41),end
91 if size(%typ)<>2*%nn then
92   error('typ : list(''type'',[sizes],...)')
93 end
94 %1=[];%2=[];%3=[];%4=[];%5=[];
95 %6=[];%7=[];%8=[];%9=[];%10=[];
96 %11=[];%12=[];%13=[];%14=[],%15=[];
97 %16=[];%17=[];%18=[];%19=[],%20=[];
98
99 if %rhs==3 then  %ini=emptystr(%nn,1),end
100 %ok=%t
101 while %t do
102   %str=%ini;
103   if %str==[] then %ok=%f,break,end
104   for %kk=1:%nn
105     %cod=ascii(%str(%kk))
106     %spe=find(%cod==10)
107     if %spe<>[] then
108       %semi=ascii(';')
109       %cod(%spe)=%semi*ones(%spe')
110       %str(%kk)=ascii(%cod)
111     end
112   end
113
114   [%vv_list,%ierr_vec]=context_evstr(%str,%scicos_context,%typ);
115
116   %noooo=0
117   for %kk=1:%nn
118     %vv=%vv_list(%kk)
119     %ierr=%ierr_vec(%kk)
120     select part(%typ(2*%kk-1),1:3)
121     case 'mat'
122       if %ierr<>0  then 
123         %noooo=-%kk,break,
124       end
125       //29/12/06
126       //the type of %vv is accepted if it is constant or integer
127       if and(type(%vv)<>[1 8]) then %nok=-%kk,break,end
128       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
129       [%mmmm,%nnnnn]=size(%vv)
130       %ssss=string(%sz(1))+' x '+string(%sz(2))
131       if %mmmm*%nnnnn==0 then
132         if  %sz(1)>=0&%sz(2)>=0&%sz(1)*%sz(2)<>0 then %noooo=%kk,break,end
133       else
134         if %sz(1)>=0 then if %mmmm<>%sz(1) then %noooo=%kk,break,end,end
135         if %sz(2)>=0 then if %nnnnn<>%sz(2) then %noooo=%kk,break,end,end
136       end
137     case 'vec'
138       if %ierr<>0  then 
139         %noooo=-%kk,break,
140       end
141       //17/01/07
142       //the type of %vv is accepted if it is constant or integer
143       if and(type(%vv)<>[1 8]) then %nok=-%kk,break,end
144       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
145       %ssss=string(%sz(1))
146       %nnnnn=prod(size(%vv))
147       if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
148     case 'pol'
149       if %ierr<>0  then 
150         %noooo=-%kk,break,
151       end
152       if %ierr<>0 then %noooo=-%kk;break,end
153       if (type(%vv)>2 & type(%vv)<>8) then %noooo=-%kk,break,end
154       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
155       %ssss=string(%sz(1))
156       %nnnnn=prod(size(%vv))
157       if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
158     case 'row'
159       if %ierr<>0  then 
160         %noooo=-%kk,break,
161       end
162       //17/01/07
163       //the type of %vv is accepted if it is constant or integer
164       if and(type(%vv)<>[1 8]) then %nok=-%kk,break,end
165       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
166       if %sz(1)<0 then
167         %ssss='1 x *'
168       else
169         %ssss='1 x '+string(%sz(1))
170       end
171       [%mmmm,%nnnnn]=size(%vv)
172       if %mmmm<>1 then %noooo=%kk,break,end,
173       if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
174     case 'col'
175       if %ierr<>0  then 
176         %noooo=-%kk,break,
177       end
178       //17/01/07
179       //the type of %vv is accepted if it is constant or integer
180       if and(type(%vv)<>[1 8]) then %nok=-%kk,break,end
181       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
182       if %sz(1)<0 then
183         %ssss='* x 1'
184       else
185         %ssss=string(%sz(1))+' x 1'
186       end
187       [%mmmm,%nnnnn]=size(%vv)
188       if %nnnnn<>1 then %noooo=%kk,break,end,
189       if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
190     case 'str'
191       clear %vv
192       %vv=%str(%kk)
193       if type(%vv)<>10 then %noooo=-%kk,break,end
194       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
195       %ssss=string(%sz(1))
196       %nnnnn=prod(size(%vv))
197       if %sz(1)>=0 then if %nnnnn<>1 then %noooo=%kk,break,end,end
198     case 'lis'
199       if %ierr<>0  then 
200         %noooo=-%kk,break,
201       end
202       if type(%vv)<>15& type(%vv)<>16& type(%vv)<>17 then %noooo=-%kk,break,end
203       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
204       %ssss=string(%sz(1))
205       %nnnnn=size(%vv)
206       if %sz(1)>=0 then if %nnnnn<>%sz(1) then %noooo=%kk,break,end,end
207     case 'r  '
208       if %ierr<>0  then 
209         %noooo=-%kk,break,
210       end
211       if type(%vv)<>16 then %noooo=-%kk,break,end
212       if typeof(%vv)<>'rational' then %noooo=-%kk,break,end
213       %sz=%typ(2*%kk);if type(%sz)==10 then %sz=evstr(%sz),end
214       [%mmmm,%nnnnn]=size(%vv(2))
215       %ssss=string(%sz(1))+' x '+string(%sz(2))
216       if %mmmm*%nnnnn==0 then
217         if  %sz(1)>=0&%sz(2)>=0&%sz(1)*%sz(2)<>0 then %noooo=%kk,break,end
218       else
219         if %sz(1)>=0 then if %mmmm<>%sz(1) then %noooo=%kk,break,end,end
220         if %sz(2)>=0 then if %nnnnn<>%sz(2) then %noooo=%kk,break,end,end
221       end
222     case 'gen'
223       //accept all
224     else
225       error('Incorrect type :'+%typ(2*%kk-1))
226     end
227     execstr('%'+string(%kk)+'=%vv')
228     clear %vv
229   end
230   if %noooo>0 then 
231     message(['answer given for  '+%lables(%noooo);
232              'has invalid dimension: ';
233              'waiting for dimension  '+%ssss])
234     %ini=%str
235     %ok=%f;break
236   elseif %noooo<0 then
237     message(['answer given for  '+%lables(-%noooo);
238              'has incorrect type :'+ %typ(-2*%noooo-1)])
239     %ini=%str
240     %ok=%f;break
241   else
242     break
243   end
244 end
245 if %lhs==%nn+2 then
246   execstr('%'+string(%lhs-1)+'=%str')
247 end
248 endfunction