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