Fix some typos
[scilab.git] / scilab / modules / matio / macros / WritemiMatrix.sci
1 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 // Copyright (C) 2002-2004 - INRIA - Vincent COUVERT
3 // Copyright (C) ???? - INRIA - Serge STEER
4 // 
5 // This file must be used under the terms of the CeCILL.
6 // This source file is licensed as described in the file COPYING, which
7 // you should have received as part of this distribution.  The terms
8 // are also available at    
9 // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10
11 function WritemiMatrix(fd,value,ArrayName)
12 // Save variables in a Matlab binary file
13 // This function has been developed following the 'MAT-File Format' description:
14 // www.mathworks.com/access/helpdesk/help/pdf_doc/matlab/matfile_format.pdf 
15
16 TagSize=8; // 8 bytes
17 ArrayFlagSize=8; // 8 bytes
18
19 // Position is saved to come back here after writing
20 SavePosBefore=mtell(fd);
21
22 // Save space for TAG
23 WriteEmptyTag(fd);
24
25 // Position is saved to compute number of written bytes
26 NumberOfBytes=mtell(fd);
27
28 // Save space for ARRAY FLAGS
29 WriteEmptyArrayFlags(fd);
30
31 // Compute array dimensions
32 if type(value)==10 then
33   WriteDimensionArray(fd,size(mstr2sci(value)));
34 else
35   WriteDimensionArray(fd,size(value));
36 end
37
38 // Write variable name
39 WriteArrayName(fd,ArrayName);
40
41 Flags=[0 0 0];
42
43 if type(value)==1 then // DOUBLE value
44   value=matrix(value,1,-1);
45   Flags(1)=bool2s(~isreal(value));
46   Class=DoubleClass;
47   NnzMax=0;
48   WriteSimpleElement(fd,real(value),miDOUBLE);
49   if Flags(1) then
50     WriteSimpleElement(fd,imag(value),miDOUBLE);
51   end
52 elseif type(value)==10 then // CHARACTER STRING value
53   if size(value,"*")==1 then
54     value=matrix(ascii(mstr2sci(value)),1,-1);
55     Flags(1)=0;
56     Class=CharClass;
57     NnzMax=0;
58     WriteSimpleElement(fd,value,miUINT16);
59   else
60     warning(gettext("Scilab string matrix saved as Matlab Cell."));
61     sz=size(value);
62     value=matrix(value,1,-1);
63     entries=list()
64     for k=1:size(value,2)
65       entries(k)=value(k);
66     end
67     value=mlist(["ce","dims","entries"],int32(sz),entries)
68     mseek(SavePosBefore,fd);
69     WritemiMatrix(fd,value,ArrayName);
70     return
71   end
72 elseif type(value)==8 then // INTEGER value
73   value=matrix(value,1,-1);
74   Flags(1)=0;
75   NnzMax=0;
76   select typeof(value)
77   case "int8"
78     Class=Int8Class;
79     WriteSimpleElement(fd,value,miINT8);
80   case "uint8"
81     Class=Uint8Class;
82     WriteSimpleElement(fd,value,miUINT8);
83   case "int16"
84     Class=Int16Class;
85     WriteSimpleElement(fd,value,miINT16);
86   case "uint16"
87     Class=Uint16Class;
88     WriteSimpleElement(fd,value,miUINT16);
89   case "int32"
90     Class=Int32Class;
91     WriteSimpleElement(fd,value,miINT32);
92   case "uint32"
93     Class=Uint32Class;
94     WriteSimpleElement(fd,value,miUINT32);
95   else
96     error(msprintf(gettext("Unknown integer type: %s."),typeof(value)));
97   end
98 elseif type(value)==17 then // MLIST used ofr CELLS and STRUCTS
99   Flags(1)=0;
100   NnzMax=0;
101   select typeof(value)
102   case "ce" // CELL
103     Class=CellClass;
104     for k=1:lstsize(value.entries)
105       WritemiMatrix(fd,value(k).entries,"");
106     end
107   case "st" // STRUCT
108     Class=StructClass;
109     Fnams=getfield(1,value);
110     Fnams(1:2)=[];
111     FieldNameLength=32;
112     WriteSimpleElement(fd,FieldNameLength,miINT32);
113     
114     NumberOfFields=size(Fnams,2);
115     FieldNames=[]
116     for k=1:NumberOfFields
117       FieldNames=[FieldNames ascii(Fnams(k)) zeros(1,FieldNameLength-length(Fnams(k)))];
118     end
119     
120     WriteSimpleElement(fd,FieldNames,miINT8);
121     if prod(size(value))==1 then
122       for k=1:NumberOfFields
123         WritemiMatrix(fd,value(Fnams(k)),"");
124       end
125     else
126       for i=1:prod(size(value))
127         for k=1:NumberOfFields
128           WritemiMatrix(fd,value(i)(Fnams(k)),"");
129         end
130       end
131     end
132   else
133     error(msprintf(gettext("%s mlist type not yet implemented."),typeof(value)));
134   end
135 elseif or(type(value)==[5,7]) then // SPARSE matrices
136   if type(value)==5 then // Scilab sparse is converted to Matlab sparse
137     value=mtlb_sparse(value);
138   end
139   Class=SparseClass;
140   [ij,v,mn]=spget(value);
141   RowIndex=ij(:,1)-1;
142   col=ij(:,2);
143   NnzMax=length(RowIndex);
144   
145   WriteSimpleElement(fd,RowIndex,miINT32);
146   
147   ColumnIndex=col(1);
148   for k=1:size(col,"*")-1
149     if col(k)<>col(k+1) then
150       ColumnIndex=[ColumnIndex;col(k+1)]
151     end
152   end
153   
154   ptr=0;
155   for k=1:size(ColumnIndex,"*")
156     ptr=[ptr;size(find(col==ColumnIndex(k)),"*")]
157   end
158   ColumnIndex=cumsum(ptr);
159   
160   WriteSimpleElement(fd,ColumnIndex,miINT32);
161   
162   Flags(1)=bool2s(~isreal(v));
163   WriteSimpleElement(fd,real(v),miDOUBLE);
164   if Flags(1) then
165     WriteSimpleElement(fd,imag(v),miDOUBLE);
166   end
167 else
168   error(msprintf(gettext("%s not yet implemented."),typeof(value)));
169 end
170
171 SavePosAfter=mtell(fd);
172
173 NumberOfBytes=SavePosAfter-NumberOfBytes
174
175 // Update tag
176 WriteTag(fd,miMatrix,NumberOfBytes);
177
178 mseek(SavePosBefore+TagSize+TagSize+ArrayFlagSize,fd);
179
180 // Update array flags
181 WriteArrayFlags(fd,Flags,Class,NnzMax);
182
183 mseek(SavePosAfter,fd);
184 endfunction
185
186 function fd=open_matfile_wb(fil)
187 // Copyright INRIA
188 // Opens a file in 'w+b' mode
189 // VC
190 fil=stripblanks(fil)
191 fd=mopen(fil,"w+b",0)
192 endfunction
193
194 function swap=write_matfile_header(fd)
195 // Copyright INRIA
196 // Write the mat file header informations
197 // VC
198
199 head=gettext("MATLAB 5.0 MAT-file, Generated by Scilab");
200 head=head+part(" ",1:(124-length(head)));
201 mput(ascii(head),'uc',fd);
202
203 version=[1 0];
204 mput(version,'uc',fd);
205
206 endian_indicator=ascii(["M" "I"]);
207 mput(endian_indicator,'uc',fd);
208
209 // Character are read just after to get endian
210 // Because mput swap automatically bytes 
211 // if endian not given when writing
212 mseek(mtell(fd)-2,fd);
213 IM_MI=mget(2,'uc',fd);
214 if and(IM_MI==[73,77]) then // little endian file
215   swap='l'
216 elseif and(IM_MI==[77,73]) then // big endian file
217   swap='b'
218 else
219   error(gettext("Error while writing MI."));
220 end
221 // Following call to mseek is needed under Windows
222 // to set file pointer after reading
223 mseek(0,fd,'cur');
224 endfunction
225
226 function WriteEmptyTag(fd)
227 // Copyright INRIA
228 // Reserve space for a tag
229 // VC
230
231 for k=1:TagSize
232   mput(0,'uc',fd);
233 end
234 endfunction
235
236 function WriteEmptyArrayFlags(fd)
237 // Copyright INRIA
238 // Reserve space for an array flag
239 // VC
240
241 for k=1:ArrayFlagSize+TagSize
242   mput(0,'uc',fd);
243 end
244 endfunction
245
246 function WriteArrayFlags(fd,Flags,Class,NnzMax)
247 // Copyright INRIA
248 // Write an array flag
249 // VC
250
251 WriteTag(fd,miUINT32,ArrayFlagSize);
252
253 mseek(mtell(fd)-ArrayFlagSize,fd);
254
255 Flags=[0 Flags(3:-1:1)];
256
257 B=[0 0 0 0];
258 B(3)=bits2byte(Flags);
259 B(4)=Class;
260 mput(B,"uc",fd);
261
262 mput(NnzMax,md_i,fd);
263 endfunction
264
265 function WriteDimensionArray(fd,dims)
266 // Copyright INRIA
267 // Write dimensions of an array
268 // VC
269
270 WriteSimpleElement(fd,dims,miINT32);
271 endfunction
272
273 function WriteArrayName(fd,ArrayName)
274 // Copyright INRIA
275 // Write name of an array
276 // VC
277
278 WriteSimpleElement(fd,ascii(ArrayName),miINT8);
279 endfunction
280
281 function WriteTag(fd,DataType,NumberOfBytes,Compressed)
282 // Copyright INRIA
283 // Write a tag
284 // VC
285
286 SavePos=mtell(fd);
287
288 if argn(2)==3 then
289   Compressed=%F;
290 end
291 Compressed=NumberOfBytes<=4;
292
293 if Compressed then
294   mseek(SavePos-NumberOfBytes-TagSize/2,fd);
295   mput(NumberOfBytes,md_s,fd);
296   mput(DataType,md_s,fd);
297 else
298   mseek(SavePos-NumberOfBytes-TagSize,fd);
299   mput(DataType,md_i,fd);
300   mput(NumberOfBytes,md_i,fd);
301 end
302
303 mseek(SavePos,fd);
304 endfunction
305
306 function WriteSimpleElement(fd,value,DataType)
307 // Copyright INRIA
308 // Write an element in file
309 // VC
310
311 // If data is of double type
312 // and made of integer values 
313 // then it is writen in an INT* format to save space
314 if DataType==miDOUBLE & and(double(int(value))==value) then
315   if min(value)>=0 & max(value)<=255 then // min and max value for int8
316     DataType=miUINT8;
317   elseif min(value)>=-128 & max(value)<=127 then // min and max value for int8
318     DataType=miINT8;
319     //miINT8 replaced by miINT16 due to an error somewhere (matlab or
320     //scilab?) the generated file gives incorrect result in Matlab!
321     //example:
322     //  scilab var=-40;savematfile('foosci.mat','var','-mat','-v6');
323     //  matlab load foosci.mat;var
324     DataType=miINT16;
325
326   elseif min(value)>=0 & max(value)<=65535 then // min and max value for int16
327     DataType=miUINT16;
328   elseif min(value)>=-32768 & max(value)<=32767 then // min and max value for int16
329     DataType=miINT16;
330   elseif min(value)>=0 & max(value)<=4294967295 then // min and max value for int32
331     DataType=miINT32;
332   elseif min(value)>=-2147483648 & max(value)<=2147483647 then // min and max value for int32
333     DataType=miINT32;
334   end
335 end
336
337 NumberOfValues=length(value);
338
339 WriteEmptyTag(fd);
340
341 select DataType
342 case miDOUBLE
343   NumberOfBytes=NumberOfValues*8;
344   fmt=md_d;
345 case miINT8
346   NumberOfBytes=NumberOfValues;
347   fmt="c";
348 case miUINT8
349   NumberOfBytes=NumberOfValues;
350   fmt="uc";
351 case miINT16
352   NumberOfBytes=NumberOfValues*2;
353   fmt=md_s;
354 case miUINT16
355   NumberOfBytes=NumberOfValues*2;
356   fmt="u"+md_s;
357 case miINT32
358   NumberOfBytes=NumberOfValues*4;
359   fmt=md_i;
360 case miUINT32
361   NumberOfBytes=NumberOfValues*4;
362   fmt="u"+md_i;
363 else
364   error(msprintf(gettext("Error while writing MI."),string(DataType)));
365 end
366
367 Compressed=NumberOfBytes<=4;
368 if Compressed then
369   mseek(mtell(fd)-TagSize/2,fd);
370 end
371
372 mput(value,fmt,fd);
373
374 WriteTag(fd,DataType,NumberOfBytes);
375
376 WritePaddingBytes(fd);
377
378 endfunction
379
380 function WritePaddingBytes(fd)
381 // Copyright INRIA
382 // Write padding bytes to have a number of bytes multiple of 8
383 // VC
384
385 np=modulo(8-modulo(mtell(fd),8),8);
386 for k=1:np
387   mput(0,"uc",fd);
388 end
389 endfunction
390
391 function i=bits2byte(b)
392 // Copyright INRIA
393 // Converts 4-bits value to a byte value
394 // VC
395
396 i=b* 2^(0:3)';
397 endfunction