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