1 /*****************************************************************************
2 *
3 * Elmer, A Finite Element Software for Multiphysical Problems
4 *
5 * Copyright 1st April 1995 - , CSC - IT Center for Science Ltd., Finland
6 *
7 * This library is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU Lesser General Public
9 * License as published by the Free Software Foundation; either
10 * version 2.1 of the License, or (at your option) any later version.
11 *
12 * This library is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 * Lesser General Public License for more details.
16 *
17 * You should have received a copy of the GNU Lesser General Public
18 * License along with this library (in file ../LGPL-2.1); if not, write
19 * to the Free Software Foundation, Inc., 51 Franklin Street,
20 * Fifth Floor, Boston, MA 02110-1301 USA
21 *
22 *****************************************************************************/
23
24 /*******************************************************************************
25 *
26 * String handling user functions.
27 *
28 *******************************************************************************
29 *
30 * Author: Juha Ruokolainen
31 *
32 * Address: CSC - IT Center for Science Ltd.
33 * Keilaranta 14, P.O. BOX 405
34 * 02101 Espoo, Finland
35 * Tel. +358 0 457 2723
36 * Telefax: +358 0 457 2302
37 * EMail: Juha.Ruokolainen@csc.fi
38 *
39 * Date: 30 May 1996
40 *
41 * Modified by:
42 *
43 * Date of modification:
44 *
45 ******************************************************************************/
46
47 /*
48 * $Id: str.c,v 1.1.1.1 2005/04/14 13:29:14 vierinen Exp $
49 *
50 * $Log: str.c,v $
51 * Revision 1.1.1.1 2005/04/14 13:29:14 vierinen
52 * initial matc automake package
53 *
54 * Revision 1.2 1998/08/01 12:34:55 jpr
55 *
56 * Added Id, started Log.
57 *
58 *
59 */
60
61 #include "elmer/matc.h"
62 #include "str.h"
63
str_sprintf(var)64 VARIABLE *str_sprintf(var) VARIABLE *var;
65 {
66 char *fmt = var_to_string(var);
67 VARIABLE *res;
68 int i;
69
70 if (NEXT(var) != NULL)
71 {
72 for(i = 0; i < NCOL(NEXT(var)); i++)
73 {
74 str_p[i] = M(NEXT(var),0,i);
75 }
76 sprintf(str_pstr, fmt,
77 str_p[0], str_p[1], str_p[2], str_p[3], str_p[4], str_p[5],
78 str_p[6], str_p[7], str_p[8], str_p[9], str_p[10], str_p[11],
79 str_p[12], str_p[13], str_p[14], str_p[15], str_p[16], str_p[17],
80 str_p[18], str_p[19], str_p[20], str_p[21], str_p[22], str_p[23],
81 str_p[24], str_p[25], str_p[26], str_p[27], str_p[28], str_p[29]);
82 }
83 else
84 {
85 sprintf(str_pstr, fmt);
86 }
87
88 FREEMEM(fmt);
89
90 res = var_temp_new(TYPE_STRING,1,strlen(str_pstr));
91 for(i = 0; i < NCOL(res); i++)
92 {
93 M(res,0,i) = str_pstr[i];
94 }
95
96 return res;
97 }
98
str_sscanf(var)99 VARIABLE *str_sscanf(var) VARIABLE *var;
100 {
101 char *fmt = var_to_string(NEXT(var));
102 char *str = var_to_string(var);
103 VARIABLE *res;
104 int i, got;
105
106 got = sscanf(str, fmt,
107 &str_p[0], &str_p[1], &str_p[2], &str_p[3], &str_p[4], &str_p[5],
108 &str_p[6], &str_p[7], &str_p[8], &str_p[9], &str_p[10], &str_p[11],
109 &str_p[12], &str_p[13], &str_p[14], &str_p[15], &str_p[16], &str_p[17],
110 &str_p[18], &str_p[19], &str_p[20], &str_p[21], &str_p[22], &str_p[23],
111 &str_p[24], &str_p[25], &str_p[26], &str_p[27], &str_p[28], &str_p[29]);
112
113 FREEMEM(str);
114 FREEMEM(fmt);
115
116 res = NULL;
117 if (got > 0) {
118 res = var_temp_new(TYPE_DOUBLE,1,got);
119 for(i = 0; i < got; i++)
120 {
121 M(res,0,i) = str_p[i];
122 }
123 }
124
125 return res;
126 }
127
str_matcvt(var)128 VARIABLE *str_matcvt(var) VARIABLE *var;
129 {
130 VARIABLE *res = NULL;
131
132 char *type = var_to_string(NEXT(var));
133 double *d = MATR(var);
134
135 int i, rlen;
136
137 if (strcmp(type, "float")==0)
138 {
139 float *f;
140
141 rlen = (MATSIZE(var)/2+7)/8;
142 res = var_temp_new(TYPE(var), 1, rlen);
143 f = (float *)MATR(res);
144
145 for(i = 0; i < NCOL(var)*NROW(var); i++)
146 {
147 *f++ = (float)*d++;
148 }
149 }
150 else if (strcmp(type, "int")==0)
151 {
152 int *n;
153
154 rlen = (MATSIZE(var)/2+7)/8;
155 res = var_temp_new(TYPE(var), 1, rlen);
156 n = (int *)MATR(res);
157
158 for(i = 0; i < NCOL(var)*NROW(var); i++)
159 {
160 *n++ = (int)*d++;
161 }
162 }
163 else if (strcmp(type, "char")==0)
164 {
165 char *c;
166
167 rlen = (MATSIZE(var)/8+7)/8;
168 res = var_temp_new(TYPE(var), 1, rlen);
169 c = (char *)MATR(res);
170
171 for(i = 0; i < NCOL(var)*NROW(var); i++)
172 {
173 *c++ = (char)*d++;
174 }
175 }
176 else
177 {
178 fprintf(math_err, "matcvt: unknown result type specified.\n");
179 }
180
181 FREEMEM(type);
182
183 return res;
184 }
185
str_cvtmat(var)186 VARIABLE *str_cvtmat(var) VARIABLE *var;
187 {
188 VARIABLE *res = NULL;
189 double *d;
190
191 char *type = var_to_string(NEXT(var));
192
193 int i, rlen;
194
195 if (strcmp(type, "float")==0)
196 {
197 float *f = (float *)MATR(var);
198
199 rlen = MATSIZE(var)/4;
200 res = var_temp_new(TYPE(var), 1, rlen);
201 d = MATR(res);
202
203 for(i = 0; i < rlen; i++)
204 {
205 *d++ = (double)*f++;
206 }
207 }
208 else if (strcmp(type, "int")==0)
209 {
210 int *n = (int *)MATR(var);
211
212 rlen = MATSIZE(var)/4;
213 res = var_temp_new(TYPE(var), 1, rlen);
214 d = MATR(res);
215
216 for(i = 0; i < rlen; i++)
217 {
218 *d++ = (double)*n++;
219 }
220 }
221 else if (strcmp(type, "char")==0)
222 {
223 char *c = (char *)MATR(var);
224
225 rlen = MATSIZE(var);
226 res = var_temp_new(TYPE(var), 1, rlen);
227 d = MATR(res);
228
229 for(i = 0; i < rlen; i++)
230 {
231 *d++ = (double)*c++;
232 }
233 }
234 else
235 {
236 fprintf(math_err, "matcvt: unknown result type specified.\n");
237 }
238
239 FREEMEM(type);
240
241 return res;
242 }
243
244
245
str_env(var)246 VARIABLE *str_env(var) VARIABLE *var;
247 {
248 VARIABLE *res = NULL;
249 int i;
250 char *name = var_to_string(var), *str;
251
252 str = getenv(name);
253
254 if ( str ) {
255 res = var_temp_new(TYPE_STRING,1,strlen(str));
256 for(i = 0; i < NCOL(res); i++)
257 {
258 M(res,0,i) = str[i];
259 }
260 }
261
262 return res;
263 }
264
str_com_init()265 void str_com_init()
266 {
267 static char *sprintfHelp =
268 {
269 "str = sprintf( fmt[, vec] )\n"
270 "Return a string formated using fmt and values from vec. A call to\n"
271 "corresponding C-language function is made.\n\n"
272 };
273
274 static char *sscanfHelp =
275 {
276 "vec = sscanf( str,fmt )\n"
277 "Return values from str using format fmt. A call to corresponding C-language\n"
278 "function is made.\n\n"
279 };
280
281 static char *matcvtHelp =
282 {
283 "special = matcvt( matrix, type )\n"
284 "Makes a type conversion from MATC matrix double precision array to given\n"
285 "type, which can be one of the following: \"int\", \"char\" or \"float\"\n\n"
286 "\n"
287 "SEE ALSO: cvtmat, fwrite\n"
288 };
289
290 static char *cvtmatHelp =
291 {
292 "matrix = cvtmat( special, type )\n"
293 "Makes a type conversion from given type to MATC matrix.\n"
294 "Type can be one of the following: \"int\", \"char\" or \"float\".\n\n"
295 "\n"
296 "SEE ALSO: fread, matcvt.\n"
297 };
298
299 static char *envHelp =
300 {
301 "str = env(name)\n"
302 "return environment variable value.\n"
303 };
304
305 com_init( "sprintf", FALSE, TRUE, str_sprintf, 1, 2, sprintfHelp );
306 com_init( "sscanf", FALSE, TRUE, str_sscanf, 2, 2, sscanfHelp );
307 com_init( "matcvt", FALSE, TRUE, str_matcvt, 2, 2, matcvtHelp );
308 com_init( "cvtmat", FALSE, TRUE, str_cvtmat, 2, 2, cvtmatHelp );
309 com_init( "env", FALSE, TRUE, str_env, 1, 1, envHelp );
310 }
311