localization (compatibility_functions module)
[scilab.git] / scilab / modules / compatibility_functions / macros / savematfile.sci
1 function savematfile(varargin)
2 // Save variables in a Matlab binary or ASCII file into Scilab
3 // This function has been developped following the 'MAT-File Format' description:
4 // www.mathworks.com/access/helpdesk/help/pdf_doc/matlab/matfile_format.pdf 
5 // Copyright INRIA
6 // Authors: SS, VC
7 vars=who('get');
8 // Verify that all inputs are character strings
9 for k=1:size(varargin)
10   if type(varargin(k))<>10 then
11     error(gettext("errors","compatibility_functions_error_59"));
12   end
13 end
14
15 [lhs,rhs]=argn(0);
16
17 mtlb_opts=[]; // Options for ASCII format
18 mtlb_thefile=[]; // Name of file to write
19 mtlb_names=[]; // Variable names to save
20 version=[]; // MAT-file version (4 or 6, miCOMPRESSED not yet implemented)
21 bin=[]; // %T is binary file %F if ASCII file
22
23 // Default format is binary
24 if rhs==1 then
25   bin=%T;
26 end
27
28 // Sort all inputs (Options/Names/Filename)
29 k=1
30 while k<=lstsize(varargin)
31   // All options are converted to lower case
32   if part(varargin(k),1)=="-" then
33     varargin(k)=convstr(varargin(k));
34   end
35   
36   select varargin(k)
37   case "-append"
38     warning(msprintf(gettext("messages","compatibility_functions_message_1"),"-append"));
39     k=k+1
40   case "-mat"
41     bin=%T
42     k=k+1
43   case "-ascii"
44     mtlb_opts=[mtlb_opts varargin(k)];
45     bin=%F
46     k=k+1
47   case "-struct"
48     k=k+1;
49     stname=varargin(k);
50     k=k+1;
51     // Verify if one or more field name is/are given
52     if k<=lstsize(varargin) & part(varargin(k),1)<>"-" & mtlb_thefile<>"" then // struct field
53       while k<=lstsize(varargin) & part(varargin(k),1)<>"-"
54         // Add field to variable names
55         mtlb_names=[mtlb_names;varargin(k)]; 
56         execstr(varargin(k)+"="+stname+"(mtlb_names($))");
57         k=k+1;
58       end
59     else // All vars(1)=[];fields have to be saved
60       fields=getfield(1,evstr(stname));
61       fields(1:2)=[]
62       for kk=fields
63         mtlb_names=[mtlb_names;kk];
64         execstr(kk+"="+stname+"(mtlb_names($))");
65       end
66     end
67   case "-v4"
68     version=4;
69     bin=%T;
70     k=k+1
71   case "-v6"
72     version=6;
73     bin=%T;
74     k=k+1
75   case "-tabs"
76     bin=%F;
77     mtlb_opts=[mtlb_opts varargin(k)];
78     k=k+1
79   case "-double"
80     bin=%F;
81     mtlb_opts=[mtlb_opts varargin(k)];
82     k=k+1
83   case "-regexp"
84     warning(msprintf(gettext("messages","compatibility_functions_message_1"),"-regexp"));
85     while k<=lstsize(varargin) & and(varargin(k)<>["-mat","-ascii"])
86       k=k+1
87     end
88   else 
89     if isempty(mtlb_thefile) then // Filename
90       mtlb_thefile=varargin(k)
91       if fileparts(mtlb_thefile,"extension")==".mat" & isempty(bin) then // extension .mat and bin not already fixed by options
92         bin=%T
93       end
94     else // Variable names
95       mtlb_names=[mtlb_names;varargin(k)]
96     end
97     k=k+1
98   end
99 end
100
101 // Default version 6 for binary files
102 if isempty(version) & bin then
103   version=6;
104   warning(gettext("messages","compatibility_functions_message_27"));
105 end
106
107 // If no name given then all workspace saved
108 if isempty(mtlb_names) then
109   mtlb_names=vars;
110   
111   // Part to delete Scilab variables from mtlb_names (should be improved)
112   mtlb_names(1)=[];// remove varargin
113   mtlb_names(mtlb_names=='savematfile')=[];
114   mtlb_names(($-predef()+1):$)=[]; // clear predefined variables
115 end
116
117 // If binary format and no extension for filename, .mat is added
118 if bin & isempty(strindex(mtlb_thefile,".")) then
119   mtlb_thefile=mtlb_thefile+".mat"
120 end
121
122 // Do not handle function redefinition
123 funcprot(0);
124
125 // Binary save
126 if bin then
127   // LEVEL 4 MAT-file (This part comes from mtlb_save.sci)
128   if version==4 then
129     // Matlab 5 types are not saved (structs...)
130     for k=size(mtlb_names,"*"):-1:1
131       execstr("x="+mtlb_names(k))
132       if and(type(x)<>[1 4 5 6 10]) then
133         warning(msprintf(gettext("messages","compatibility_functions_message_28"),mtlb_names(k)));
134         mtlb_names(k)=[]
135       end
136     end
137     
138     // Open file for writing
139     [mtlb_fd,err]=mopen(mtlb_thefile,"wb",0)
140
141     // Clear variable wich are no more used to avoid name conflicts
142     for k=["varargin","mtlb_names","mtlb_fmt","mtlb_fd"]
143       if or(mtlb_names==k) then
144         error(msprintf(gettext("errors","compatibility_functions_error_60"),k));
145       end
146     end
147     clear("x","k","rhs","lhs","kk","err","bin","version","mtlb_thefile","mtlb_opts");
148     
149     // Following 'for loop' from SS
150     for mtlb_k=1:size(mtlb_names,"*")
151       // perform changes on variables
152       execstr("x="+mtlb_names(mtlb_k))
153       it=0
154       select type(x)
155       case 1 then
156         P=0
157         T=0
158         if norm(imag(x),1)<>0 then it=1,end
159       case 4 then
160         x=bool2s(x)
161         P=5
162         T=0
163       case 5 then
164         if norm(imag(x),1)<>0 then it1=1,else it1=0,end
165         P=0
166         T=2
167         [x,v,mn]=spget(x);
168         if it1==0 then
169           x=[x real(v);[mn 0]]
170         else
171           x=[x real(v) imag(v);[mn 0 0]]
172         end
173       case 6 then
174         x=bool2s(x)
175         P=0
176         T=2
177         [x,v,mn]=spget(x);
178         x=[x v;[mn 0]]
179       case 8 then
180         T=0
181         select inttype(x)
182         case 4 then P=2,
183         case 14 then P=2,
184         case 2 then P=3
185         case 12 then P=4
186         case 1 then P=5,
187         case 11 then P=5,
188         end
189         x=double(x)
190       case 10 then
191         x1=part(x(:),1:max(length(x)))
192         x=[]
193         for l=1:size(x1,1)
194           x=[x;ascii(x1(l))]
195         end
196         P=5
197         T=1
198       else
199         error(gettext("errors","compatibility_functions_error_61"));
200       end
201       [m,n]=size(x)
202       
203       
204       M = 0 //little endian
205       O = 0
206       MOPT=[M O P T]
207       
208       [m,n]=size(x)
209       head=[MOPT*[1000;100;10;1] m,n,it,length(mtlb_names(mtlb_k))+1]
210       
211       head=mput(head,"uil",mtlb_fd);
212       mput([ascii(mtlb_names(mtlb_k)) 0],"c",mtlb_fd);
213       select P
214       case 0 then
215         flag="dl"
216       case 1 then
217         flag="fl"
218       case 2 then
219         flag="il"
220       case 3 then
221         flag="sl"
222       case 4 then
223         flag="usl"
224       case 5 then
225         flag="uc"
226       end
227       if T==0 then
228         if x<>[] then
229           mput(real(x(:).'),flag,mtlb_fd);
230           if it==1
231             mput(imag(x(:).'),flag,mtlb_fd);
232           end
233         end
234       elseif T==1
235         v=mput(x(:).',flag,mtlb_fd);
236       elseif T==2 then  //sparse
237         mput(x(:).',flag,mtlb_fd);
238       end
239     end
240     mclose(mtlb_fd);
241     // End of loop written by SS
242   // LEVEL 6 MAT-file  
243   elseif version==6 then
244     // Load functions
245     ReadmiMatrix=ReadmiMatrix;
246     WritemiMatrix=WritemiMatrix;
247     
248     // Open file for writing
249     mtlb_fd=open_matfile_wb(mtlb_thefile);
250     
251     // Write header
252     endian=write_matfile_header(mtlb_fd);
253   
254     //--set constants
255     exec(LoadMatConstants,-1);
256     
257     // Clear variable wich are no more used to avoid name conflicts
258     for k=["endian","varargin","mtlb_names","mtlb_fmt","mtlb_fd"]
259       if or(mtlb_names==k) then
260         error(msprintf(gettext("messages","compatibility_functions_message_60"),k))
261       end
262     end
263     clear("x","k","rhs","lhs","kk","err","sep","bin","version","mtlb_thefile","mtlb_opts");
264
265     // Write variables as miMATRIX data type
266     for k=1:size(mtlb_names,"*")
267       %var=evstr(mtlb_names(k));
268       if and(type(%var)<>[9 11 13]) then
269         WritemiMatrix(mtlb_fd,evstr(mtlb_names(k)),mtlb_names(k));
270       end
271     end
272     
273     mclose(mtlb_fd);
274   else
275     // This part should contain miCOMPRESSED data type handling
276     error(msprintf(gettext("errors","compatibility_functions_error_67"),version));
277   end
278   
279 // ASCII save
280 else
281   // The end of this function has been adapted from mtlb_save.sci 
282
283   // Matlab 5 types are not saved (structs...)
284   for k=size(mtlb_names,"*"):-1:1
285     execstr("x="+mtlb_names(k))
286     if and(type(x)<>[1 4 5 6 10]) then
287       warning(msprintf(gettext("messages","compatibility_functions_message_29"),mtlb_names(k)));
288       mtlb_names(k)=[]
289     end
290   end
291   if ( (mtlb_opts <> []) & (strindex("-tabs",mtlb_opts)<>[]) ) then
292     sep=code2str(-40)
293   else
294     sep=" "
295   end
296   if size(mtlb_opts,"*")==1 then //8 digits save
297     mtlb_fmt="(2x,1pe14.7"+sep+")"
298   else
299     mtlb_fmt="(2x,1pe23.15"+sep+")"
300   end
301
302   mtlb_fd=file("open",mtlb_thefile,"unknown")
303   
304   // Clear variable wich are no more used to avoid name conflicts
305   for k=["varargin","mtlb_names","mtlb_fmt","mtlb_fd"]
306     if or(mtlb_names==k) then
307       error(msprintf(gettext("errors","compatibility_functions_error_60"),k));
308     end
309   end
310   clear("x","k","rhs","lhs","kk","err","sep","bin","version","mtlb_thefile","mtlb_opts");
311
312   for mtlb_k=1:size(mtlb_names,"*")
313     // perform changes on variables
314     execstr("x="+mtlb_names(mtlb_k))
315     select type(x)
316     case 1 then
317       write(mtlb_fd,real(x),"("+string(size(x,2))+mtlb_fmt+")")
318     case 4 then
319       write(mtlb_fd,bool2s(x),"("+string(size(x,2))+mtlb_fmt+")")
320     case 5 then
321       [ij,x]=spget(real(x));x=[ij x];
322       write(mtlb_fd,real(x),"(2f8.0,1x"+string(size(x,2))+mtlb_fmt+")")
323     case 6 then
324       [ij,x]=spget(bool2s(x));x=[ij x];
325       write(mtlb_fd,real(x),"(2f8.0,1x"+string(size(x,2))+mtlb_fmt+")")
326     case 10 then
327       x=part(x(:),1:max(length(x)))
328       x1=[]
329       for l=1:size(x,1)
330         x1=[x1;ascii(x(l))]
331       end
332       write(mtlb_fd,x1,"("+string(size(x1,2))+mtlb_fmt+")")
333     end
334   end
335   file("close",mtlb_fd)
336 end
337 endfunction
338
339