Messages standardization
[scilab.git] / scilab / modules / compatibility_functions / macros / mtlb_save.sci
1 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 // Copyright (C) ???? - INRIA - Scilab 
3 // 
4 // This file must be used under the terms of the CeCILL.
5 // This source file is licensed as described in the file COPYING, which
6 // you should have received as part of this distribution.  The terms
7 // are also available at    
8 // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
9
10 // @OBSOLETE
11
12 function mtlb_save(mtlb_thefile,varargin)
13 //save variable under  matlab 4.x .mat binary format files
14 //see: www.mathworks.com/access/helpdesk/help/pdf_doc/matlab/matfile_format.pdf 
15
16 warnobsolete("savematfile", "5.1");
17
18 // Verify that all inputs are character strings
19 for k=1:size(varargin)
20   if type(varargin(k))<>10 then
21     error(msprintf(gettext("%s: All inputs must be character strings.\n"),"mtlb_save"));
22   end
23 end
24
25 [lhs,rhs]=argn(0)
26 mtlb_opts=[]
27 if rhs==1 then
28   mtlb_names=who('get')
29   mtlb_names(1:6)=[] // clear functions variables
30   mtlb_names($-predef()+1:$)=[] // clear predefined variables
31   funcprot(0)
32   for k=size(mtlb_names,'*'):-1:1
33     execstr('x='+mtlb_names(k))
34     select type(x)
35     case 1 then
36     case 4 then
37     case 5 then
38     case 6 then
39     case 10 then
40     else
41       mtlb_names(k)=[]
42     end
43   end
44 else
45   for k=size(varargin):-1:1
46     vk=varargin(k)
47     if part(vk,1)=='-' then 
48       mtlb_opts=[convstr(vk),mtlb_opts],
49     else
50       kk=k
51       break
52     end
53   end
54   mtlb_names=[]
55   for k=1:kk
56     mtlb_names=[mtlb_names, varargin(k)]
57   end
58 end
59
60 k=strindex(mtlb_thefile,'.')
61 if k==[] then  //no extension given
62   if find(mtlb_opts=='-ascii')==[] then
63     mtlb_thefile=mtlb_thefile+'.mat'
64   end
65 end
66
67
68 if mtlb_names==[] then return,end
69 if mtlb_opts==[] then //binary save
70   [mtlb_fd,err]=mopen(mtlb_thefile,'wb',0)
71   // check name conflicts
72   for k=['mtlb_thefile','varargin','mtlb_names','mtlb_opts','mtlb_fd']
73     if or(mtlb_names==k) then
74       error(msprintf(gettext("%s: Name conflict, it is not possible to save variable with name ''%s''.\n"),"mtlb_save",k));
75     end
76   end
77   // clear variable wich are no more used to avoid name conflicts
78   clear('rhs','lhs','kk','k','err','mtlb_thefile');
79
80   for mtlb_k=1:size(mtlb_names,'*')
81     // perform changes on variables
82     execstr('x='+mtlb_names(mtlb_k))
83     it=0
84     select type(x)
85     case 1 then
86       P=0
87       T=0
88       if norm(imag(x),1)<>0 then it=1,end
89     case 4 then
90       x=bool2s(x)
91       P=5
92       T=0
93     case 5 then
94       if norm(imag(x),1)<>0 then it1=1,else it1=0,end
95       P=0
96       T=2
97       [x,v,mn]=spget(x);
98       if it1==0 then
99         x=[x real(v);[mn 0]]
100       else
101         x=[x real(v) imag(v);[mn 0 0]]
102       end
103     case 6 then
104       x=bool2s(x)
105       P=0
106       T=2
107       [x,v,mn]=spget(x);
108       x=[x v;[mn 0]]
109     case 8 then
110       T=0
111       select inttype(x)
112         case 4 then P=2,
113         case 14 then P=2,
114         case 2 then P=3
115         case 12 then P=4
116         case 1 then P=5,
117         case 11 then P=5,
118       end
119       x=double(x)
120     case 10 then
121       x1=part(x(:),1:max(length(x)))
122       x=[]
123       for l=1:size(x1,1)
124         x=[x;ascii(x1(l))]
125       end
126       P=5
127       T=1
128     else
129       error(msprintf(gettext("%s: Attempt to write an unsupported data type to an ASCII file.\n"),"mtlb_save")
130     end
131     [m,n]=size(x)
132   
133       
134     M = 0 //little endian
135     O = 0
136     MOPT=[M O P T]
137     
138     [m,n]=size(x)
139     head=[MOPT*[1000;100;10;1] m,n,it,length(mtlb_names(mtlb_k))+1]
140
141     head=mput(head,'uil',mtlb_fd);
142     mput([ascii(mtlb_names(mtlb_k)) 0],"c",mtlb_fd);
143     select P
144     case 0 then
145       flag='dl'
146     case 1 then
147       flag='fl'
148     case 2 then
149       flag='il'
150     case 3 then
151       flag='sl'
152     case 4 then
153       flag='usl'
154     case 5 then
155       flag='uc'
156     end
157     if T==0 then
158       if x<>[] then
159         mput(real(x(:).'),flag,mtlb_fd);
160         if it==1
161           mput(imag(x(:).'),flag,mtlb_fd);
162         end
163       end
164     elseif T==1
165       v=mput(x(:).',flag,mtlb_fd);
166     elseif T==2 then  //sparse
167       mput(x(:).',flag,mtlb_fd);
168     end
169   end
170   mclose(mtlb_fd);
171 else //ascii save
172
173   if convstr(mtlb_opts(1))<>'-ascii' then 
174     error(msprintf(gettext("%s: Unknown or misplaced option ''%s''.\n"),"mtlb_save",mtlb_opts(1)));
175   end
176     if size(mtlb_opts,'*')==3 then
177     sep=str2code(-40)
178   else
179     sep=' '
180   end
181   if size(mtlb_opts,'*')==1 then //8 digits save
182     mtlb_fmt='(1pe14.7'+sep+')'
183   else
184     mtlb_fmt='(1pe23.15'+sep+')'
185   end
186
187   mtlb_fd=file('open',mtlb_thefile,'unknown')
188   // clear variable wich are no more used to avoid name conflicts
189   for k=['mtlb_thefile','varargin','mtlb_names','mtlb_fmt','mtlb_fd']
190     if or(mtlb_names==k) then
191       error(msprintf(gettext("%s: Name conflict, it is not possible to save variable with name ''%s''.\n"),"mtlb_save",k));
192     end
193   end
194   clear('rhs','lhs','kk','err','sep');
195   for mtlb_k=1:size(mtlb_names,'*')
196     // perform changes on variables
197     execstr('x='+mtlb_names(mtlb_k))
198     select type(x)
199     case 1 then
200       write(mtlb_fd,real(x),'('+string(size(x,2))+mtlb_fmt+')')
201     case 4 then
202       write(mtlb_fd,bool2s(x),'('+string(size(x,2))+mtlb_fmt+')')
203     case 5 then
204       [ij,x]=spget(real(x));x=[ij x];
205       write(mtlb_fd,real(x),'(2f8.0,1x'+string(size(x,2))+mtlb_fmt+')')
206     case 6 then
207       [ij,x]=spget(bool2s(x));x=[ij x];
208       write(mtlb_fd,real(x),'(2f8.0,1x'+string(size(x,2))+mtlb_fmt+')')
209     case 10 then
210       x=part(x(:),1:max(length(x)))
211       x1=[]
212       for l=1:size(x,1)
213         x1=[x1;ascii(x(l))]
214       end
215       write(mtlb_fd,x1,'('+string(size(x1,2))+mtlb_fmt+')')
216     end
217   end
218   file('close',mtlb_fd)
219 end
220
221
222  
223 endfunction