« back to all changes in this revision
Viewing changes to base/ctl.c
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Josselin Mouette
- Date: 2002-04-17 10:36:45 UTC
- Revision ID: james.westby@ubuntu.com-20020417103645-29vomjspk4yf4olw
Tags: upstream-2.1
Import upstream version 2.1
- files added:
- autom4te.cache
- base
- doc
- examples
- utils
added
removed
base/ctl.c
1
/* libctl: flexible Guile-based control files for scientific software
2
* Copyright (C) 1998, 1999, 2000, 2001, 2002, Steven G. Johnson
3
*
4
* This library is free software; you can redistribute it and/or
5
* modify it under the terms of the GNU Lesser General Public
6
* License as published by the Free Software Foundation; either
7
* version 2 of the License, or (at your option) any later version.
8
*
9
* This library is distributed in the hope that it will be useful,
10
* but WITHOUT ANY WARRANTY; without even the implied warranty of
11
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12
* Lesser General Public License for more details.
13
*
14
* You should have received a copy of the GNU Lesser General Public
15
* License along with this library; if not, write to the
16
* Free Software Foundation, Inc., 59 Temple Place - Suite 330,
17
* Boston, MA 02111-1307, USA.
18
*
19
* Steven G. Johnson can be contacted at stevenj@alum.mit.edu.
20
*/
21
22
#include <math.h>
23
24
#include "ctl.h"
25
26
/**************************************************************************/
27
28
/* Functions missing from Guile 1.2: */
29
30
#ifndef HAVE_GH_BOOL2SCM
31
/* Guile 1.2 is missing gh_bool2scm for some reason; redefine: */
32
SCM bool2scm(boolean b) { return (b ? SCM_BOOL_T : SCM_BOOL_F); }
33
#endif
34
35
#ifndef HAVE_GH_LENGTH
36
#define gh_length gh_list_length
37
#endif
38
39
#ifndef HAVE_GH_LIST_REF
40
/* Guile 1.2 doesn't have the gh_list_ref function. Sigh. */
41
/* Note: index must be in [0,list_length(l) - 1]. We don't check! */
42
static SCM list_ref(list l, int index)
43
{
44
SCM cur = SCM_UNSPECIFIED, rest = l;
45
46
while (index >= 0) {
47
cur = gh_car(rest);
48
rest = gh_cdr(rest);
49
--index;
50
}
51
return cur;
52
}
53
54
#else /* HAVE_GH_LIST_REF */
55
#define list_ref(l,index) gh_list_ref(l,gh_int2scm(index))
56
#endif
57
58
#ifndef HAVE_GH_VECTOR_REF
59
#define gh_vector_ref gh_vref
60
#endif
61
62
/**************************************************************************/
63
64
/* Scheme file loading (don't use gh_load directly because subsequent
65
loads won't use the correct path name). Uses our "include" function
66
from include.scm, or defaults to gh_load if this function isn't
67
defined. */
68
69
void ctl_include(char *filename)
70
{
71
SCM include_proc = gh_lookup("include");
72
if (include_proc == SCM_UNDEFINED)
73
gh_load(filename);
74
else
75
gh_call1(include_proc, gh_str02scm(filename));
76
}
77
78
/* convert a pathname into one relative to the current include dir */
79
char *ctl_fix_path(const char *path)
80
{
81
char *newpath;
82
if (path[0] != '/') {
83
SCM include_dir = gh_lookup("include-dir");
84
if (include_dir != SCM_UNDEFINED) {
85
char *dir = gh_scm2newstr(include_dir, NULL);
86
newpath = (char *) malloc(sizeof(char) * (strlen(dir) +
87
strlen(path) + 2));
88
strcpy(newpath, dir);
89
free(dir);
90
if (newpath[0] && newpath[strlen(newpath)-1] != '/')
91
strcat(newpath, "/");
92
strcat(newpath, path);
93
return newpath;
94
}
95
}
96
newpath = (char *) malloc(sizeof(char) * (strlen(path) + 1));
97
strcpy(newpath, path);
98
return newpath;
99
}
100
101
/**************************************************************************/
102
103
/* vector3 and matrix3x3 utilities: */
104
105
number vector3_dot(vector3 v1,vector3 v2)
106
{
107
return (v1.x * v2.x + v1.y * v2.y + v1.z * v2.z);
108
}
109
110
number vector3_norm(vector3 v)
111
{
112
return (sqrt(vector3_dot(v,v)));
113
}
114
115
vector3 vector3_scale(number s, vector3 v)
116
{
117
vector3 vnew;
118
119
vnew.x = s * v.x;
120
vnew.y = s * v.y;
121
vnew.z = s * v.z;
122
return vnew;
123
}
124
125
vector3 unit_vector3(vector3 v)
126
{
127
number norm = vector3_norm(v);
128
if (norm < 1.0e-15)
129
return v;
130
else
131
return vector3_scale(1.0/norm, v);
132
}
133
134
vector3 vector3_plus(vector3 v1,vector3 v2)
135
{
136
vector3 vnew;
137
138
vnew.x = v1.x + v2.x;
139
vnew.y = v1.y + v2.y;
140
vnew.z = v1.z + v2.z;
141
return vnew;
142
}
143
144
vector3 vector3_minus(vector3 v1,vector3 v2)
145
{
146
vector3 vnew;
147
148
vnew.x = v1.x - v2.x;
149
vnew.y = v1.y - v2.y;
150
vnew.z = v1.z - v2.z;
151
return vnew;
152
}
153
154
vector3 vector3_cross(vector3 v1,vector3 v2)
155
{
156
vector3 vnew;
157
158
vnew.x = v1.y * v2.z - v2.y * v1.z;
159
vnew.y = v1.z * v2.x - v2.z * v1.x;
160
vnew.z = v1.x * v2.y - v2.x * v1.y;
161
return vnew;
162
}
163
164
vector3 matrix3x3_vector3_mult(matrix3x3 m, vector3 v)
165
{
166
vector3 vnew;
167
168
vnew.x = m.c0.x * v.x + m.c1.x * v.y + m.c2.x * v.z;
169
vnew.y = m.c0.y * v.x + m.c1.y * v.y + m.c2.y * v.z;
170
vnew.z = m.c0.z * v.x + m.c1.z * v.y + m.c2.z * v.z;
171
return vnew;
172
}
173
174
matrix3x3 matrix3x3_mult(matrix3x3 m1, matrix3x3 m2)
175
{
176
matrix3x3 m;
177
178
m.c0.x = m1.c0.x * m2.c0.x + m1.c1.x * m2.c0.y + m1.c2.x * m2.c0.z;
179
m.c0.y = m1.c0.y * m2.c0.x + m1.c1.y * m2.c0.y + m1.c2.y * m2.c0.z;
180
m.c0.z = m1.c0.z * m2.c0.x + m1.c1.z * m2.c0.y + m1.c2.z * m2.c0.z;
181
182
m.c1.x = m1.c0.x * m2.c1.x + m1.c1.x * m2.c1.y + m1.c2.x * m2.c1.z;
183
m.c1.y = m1.c0.y * m2.c1.x + m1.c1.y * m2.c1.y + m1.c2.y * m2.c1.z;
184
m.c1.z = m1.c0.z * m2.c1.x + m1.c1.z * m2.c1.y + m1.c2.z * m2.c1.z;
185
186
m.c2.x = m1.c0.x * m2.c2.x + m1.c1.x * m2.c2.y + m1.c2.x * m2.c2.z;
187
m.c2.y = m1.c0.y * m2.c2.x + m1.c1.y * m2.c2.y + m1.c2.y * m2.c2.z;
188
m.c2.z = m1.c0.z * m2.c2.x + m1.c1.z * m2.c2.y + m1.c2.z * m2.c2.z;
189
190
return m;
191
}
192
193
matrix3x3 matrix3x3_transpose(matrix3x3 m)
194
{
195
matrix3x3 mt;
196
197
mt.c0.x = m.c0.x;
198
mt.c1.x = m.c0.y;
199
mt.c2.x = m.c0.z;
200
mt.c0.y = m.c1.x;
201
mt.c1.y = m.c1.y;
202
mt.c2.y = m.c1.z;
203
mt.c0.z = m.c2.x;
204
mt.c1.z = m.c2.y;
205
mt.c2.z = m.c2.z;
206
return mt;
207
}
208
209
number matrix3x3_determinant(matrix3x3 m)
210
{
211
return(m.c0.x*m.c1.y*m.c2.z - m.c2.x*m.c1.y*m.c0.z +
212
m.c1.x*m.c2.y*m.c0.z + m.c0.y*m.c1.z*m.c2.x -
213
m.c1.x*m.c0.y*m.c2.z - m.c2.y*m.c1.z*m.c0.x);
214
}
215
216
matrix3x3 matrix3x3_inverse(matrix3x3 m)
217
{
218
matrix3x3 minv;
219
number detinv = matrix3x3_determinant(m);
220
221
if (detinv == 0.0) {
222
fprintf(stderr, "error: singular matrix in matrix3x3_inverse!\n");
223
exit(EXIT_FAILURE);
224
}
225
detinv = 1.0/detinv;
226
227
minv.c0.x = detinv * (m.c1.y * m.c2.z - m.c2.y * m.c1.z);
228
minv.c1.y = detinv * (m.c0.x * m.c2.z - m.c2.x * m.c0.z);
229
minv.c2.z = detinv * (m.c1.y * m.c0.x - m.c0.y * m.c1.x);
230
231
minv.c0.z = detinv * (m.c0.y * m.c1.z - m.c1.y * m.c0.z);
232
minv.c0.y = -detinv * (m.c0.y * m.c2.z - m.c2.y * m.c0.z);
233
minv.c1.z = -detinv * (m.c0.x * m.c1.z - m.c1.x * m.c0.z);
234
235
minv.c2.x = detinv * (m.c1.x * m.c2.y - m.c1.y * m.c2.x);
236
minv.c1.x = -detinv * (m.c1.x * m.c2.z - m.c1.z * m.c2.x);
237
minv.c2.y = -detinv * (m.c0.x * m.c2.y - m.c0.y * m.c2.x);
238
239
return minv;
240
}
241
242
/**************************************************************************/
243
244
/* complex number utilities */
245
246
cnumber make_cnumber(number r, number i)
247
{
248
cnumber c;
249
c.re = r; c.im = i;
250
return c;
251
}
252
253
cnumber cnumber_conj(cnumber c)
254
{
255
return make_cnumber(c.re, -c.im);
256
}
257
258
vector3 cvector3_re(cvector3 cv)
259
{
260
vector3 v;
261
v.x = cv.x.re; v.y = cv.y.re; v.z = cv.z.re;
262
return v;
263
}
264
265
vector3 cvector3_im(cvector3 cv)
266
{
267
vector3 v;
268
v.x = cv.x.im; v.y = cv.y.im; v.z = cv.z.im;
269
return v;
270
}
271
272
cvector3 make_cvector3(vector3 vr, vector3 vi)
273
{
274
cvector3 cv;
275
cv.x = make_cnumber(vr.x, vi.x);
276
cv.y = make_cnumber(vr.y, vi.y);
277
cv.z = make_cnumber(vr.z, vi.z);
278
return cv;
279
}
280
281
matrix3x3 cmatrix3x3_re(cmatrix3x3 cm)
282
{
283
matrix3x3 m;
284
m.c0 = cvector3_re(cm.c0);
285
m.c1 = cvector3_re(cm.c1);
286
m.c2 = cvector3_re(cm.c2);
287
return m;
288
}
289
290
matrix3x3 cmatrix3x3_im(cmatrix3x3 cm)
291
{
292
matrix3x3 m;
293
m.c0 = cvector3_im(cm.c0);
294
m.c1 = cvector3_im(cm.c1);
295
m.c2 = cvector3_im(cm.c2);
296
return m;
297
}
298
299
cmatrix3x3 make_cmatrix3x3(matrix3x3 mr, matrix3x3 mi)
300
{
301
cmatrix3x3 cm;
302
cm.c0 = make_cvector3(mr.c0, mi.c0);
303
cm.c1 = make_cvector3(mr.c1, mi.c1);
304
cm.c2 = make_cvector3(mr.c2, mi.c2);
305
return cm;
306
}
307
308
cmatrix3x3 make_hermitian_cmatrix3x3(number m00, number m11, number m22,
309
cnumber m01, cnumber m02, cnumber m12)
310
{
311
cmatrix3x3 cm;
312
cm.c0.x = make_cnumber(m00, 0);
313
cm.c1.y = make_cnumber(m11, 0);
314
cm.c2.y = make_cnumber(m22, 0);
315
cm.c1.x = m01; cm.c0.y = cnumber_conj(m01);
316
cm.c2.x = m02; cm.c0.z = cnumber_conj(m02);
317
cm.c2.y = m12; cm.c1.z = cnumber_conj(m12);
318
return cm;
319
}
320
321
/**************************************************************************/
322
323
/* type conversion */
324
325
vector3 scm2vector3(SCM sv)
326
{
327
vector3 v;
328
329
v.x = gh_scm2double(gh_vector_ref(sv,gh_int2scm(0)));
330
v.y = gh_scm2double(gh_vector_ref(sv,gh_int2scm(1)));
331
v.z = gh_scm2double(gh_vector_ref(sv,gh_int2scm(2)));
332
return v;
333
}
334
335
matrix3x3 scm2matrix3x3(SCM sm)
336
{
337
matrix3x3 m;
338
339
m.c0 = scm2vector3(gh_vector_ref(sm,gh_int2scm(0)));
340
m.c1 = scm2vector3(gh_vector_ref(sm,gh_int2scm(1)));
341
m.c2 = scm2vector3(gh_vector_ref(sm,gh_int2scm(2)));
342
return m;
343
}
344
345
SCM vector32scm(vector3 v)
346
{
347
return(gh_call3(gh_lookup("vector3"),
348
gh_double2scm(v.x),
349
gh_double2scm(v.y),
350
gh_double2scm(v.z)));
351
}
352
353
SCM matrix3x32scm(matrix3x3 m)
354
{
355
return(gh_call3(gh_lookup("matrix3x3"),
356
vector32scm(m.c0),
357
vector32scm(m.c1),
358
vector32scm(m.c2)));
359
}
360
361
cnumber scm2cnumber(SCM sx)
362
{
363
if (scm_real_p(sx) && !(SCM_NIMP(sx) && SCM_INEXP(sx) && SCM_CPLXP(sx)))
364
return make_cnumber(gh_scm2double(sx), 0.0);
365
else
366
return make_cnumber(SCM_REALPART(sx), SCM_IMAG(sx));
367
}
368
369
SCM cnumber2scm(cnumber x)
370
{
371
if (x.im == 0.0)
372
return gh_double2scm(x.re);
373
else
374
return scm_makdbl(x.re, x.im);
375
}
376
377
cvector3 scm2cvector3(SCM sv)
378
{
379
cvector3 v;
380
381
v.x = scm2cnumber(gh_vector_ref(sv,gh_int2scm(0)));
382
v.y = scm2cnumber(gh_vector_ref(sv,gh_int2scm(1)));
383
v.z = scm2cnumber(gh_vector_ref(sv,gh_int2scm(2)));
384
return v;
385
}
386
387
cmatrix3x3 scm2cmatrix3x3(SCM sm)
388
{
389
cmatrix3x3 m;
390
391
m.c0 = scm2cvector3(gh_vector_ref(sm,gh_int2scm(0)));
392
m.c1 = scm2cvector3(gh_vector_ref(sm,gh_int2scm(1)));
393
m.c2 = scm2cvector3(gh_vector_ref(sm,gh_int2scm(2)));
394
return m;
395
}
396
397
SCM cvector32scm(cvector3 v)
398
{
399
return(gh_call3(gh_lookup("vector3"),
400
cnumber2scm(v.x),
401
cnumber2scm(v.y),
402
cnumber2scm(v.z)));
403
}
404
405
SCM cmatrix3x32scm(cmatrix3x3 m)
406
{
407
return(gh_call3(gh_lookup("matrix3x3"),
408
cvector32scm(m.c0),
409
cvector32scm(m.c1),
410
cvector32scm(m.c2)));
411
}
412
413
/**************************************************************************/
414
415
/* variable get/set functions */
416
417
/**** Getters ****/
418
419
integer ctl_get_integer(char *identifier)
420
{
421
return(gh_scm2int(gh_lookup(identifier)));
422
}
423
424
number ctl_get_number(char *identifier)
425
{
426
return(gh_scm2double(gh_lookup(identifier)));
427
}
428
429
cnumber ctl_get_cnumber(char *identifier)
430
{
431
return(scm2cnumber(gh_lookup(identifier)));
432
}
433
434
boolean ctl_get_boolean(char *identifier)
435
{
436
return(gh_scm2bool(gh_lookup(identifier)));
437
}
438
439
char* ctl_get_string(char *identifier)
440
{
441
return(gh_scm2newstr(gh_lookup(identifier), NULL));
442
}
443
444
vector3 ctl_get_vector3(char *identifier)
445
{
446
return(scm2vector3(gh_lookup(identifier)));
447
}
448
449
matrix3x3 ctl_get_matrix3x3(char *identifier)
450
{
451
return(scm2matrix3x3(gh_lookup(identifier)));
452
}
453
454
cvector3 ctl_get_cvector3(char *identifier)
455
{
456
return(scm2cvector3(gh_lookup(identifier)));
457
}
458
459
cmatrix3x3 ctl_get_cmatrix3x3(char *identifier)
460
{
461
return(scm2cmatrix3x3(gh_lookup(identifier)));
462
}
463
464
list ctl_get_list(char *identifier)
465
{
466
return(gh_lookup(identifier));
467
}
468
469
object ctl_get_object(char *identifier)
470
{
471
return(gh_lookup(identifier));
472
}
473
474
function ctl_get_function(char *identifier)
475
{
476
return(gh_lookup(identifier));
477
}
478
479
/**** Setters ****/
480
481
/* UGLY hack alert! There doesn't seem to be any clean way of setting
482
Scheme variables from C in Guile (e.g. no gh_* interface).
483
484
One option is to use scm_symbol_set_x (symbol-set! in Scheme), but
485
I'm not sure how to get this to work in Guile 1.3 because of the
486
%&*@^-ing module system (I need to pass some module for the first
487
parameter, but I don't know what to pass).
488
489
Instead, I hacked together the following my_symbol_set_x routine,
490
using the functions scm_symbol_value0 and scm_symbol_set_x from the
491
Guile 1.3 sources. (scm_symbol_value0 has the virtue of looking in
492
the correct module somehow; I also used this function to replace
493
gh_lookup, which broke in Guile 1.3 as well...sigh.)
494
495
Note that I can't call "set!" because it is really a macro.
496
497
All the ugliness is confined to the set_value() routine, though. */
498
499
#define USE_MY_SYMBOL_SET_X 1 /* use the hack */
500
501
#ifdef USE_MY_SYMBOL_SET_X
502
static SCM my_symbol_set_x(char *name, SCM v)
503
{
504
/* code swiped from scm_symbol_value0 and scm_symbol_set_x */
505
SCM symbol = scm_intern_obarray_soft(name, strlen (name), scm_symhash, 0);
506
SCM vcell = scm_sym2vcell (SCM_CAR (symbol),
507
SCM_CDR (scm_top_level_lookup_closure_var),
508
SCM_BOOL_F);
509
if (SCM_FALSEP (vcell))
510
return SCM_UNDEFINED;
511
SCM_SETCDR (vcell, v);
512
return SCM_UNSPECIFIED;
513
}
514
#endif
515
516
static void set_value(char *identifier, SCM value)
517
{
518
#if defined(USE_SCM_SYMBOL_SET_X) /* worked in Guile 1.1, 1.2 */
519
scm_symbol_set_x(SCM_BOOL_F, gh_symbol2scm(identifier), value);
520
#elif defined(USE_MY_SYMBOL_SET_X)
521
my_symbol_set_x(identifier, value);
522
#endif
523
}
524
525
void ctl_set_integer(char *identifier, integer value)
526
{
527
set_value(identifier, gh_int2scm(value));
528
}
529
530
void ctl_set_number(char *identifier, number value)
531
{
532
set_value(identifier, gh_double2scm(value));
533
}
534
535
void ctl_set_cnumber(char *identifier, cnumber value)
536
{
537
set_value(identifier, cnumber2scm(value));
538
}
539
540
void ctl_set_boolean(char *identifier, boolean value)
541
{
542
set_value(identifier, gh_bool2scm(value));
543
}
544
545
void ctl_set_string(char *identifier, char *value)
546
{
547
set_value(identifier, gh_str02scm(value));
548
}
549
550
void ctl_set_vector3(char *identifier, vector3 value)
551
{
552
set_value(identifier, vector32scm(value));
553
}
554
555
void ctl_set_matrix3x3(char *identifier, matrix3x3 value)
556
{
557
set_value(identifier, matrix3x32scm(value));
558
}
559
560
void ctl_set_cvector3(char *identifier, cvector3 value)
561
{
562
set_value(identifier, cvector32scm(value));
563
}
564
565
void ctl_set_cmatrix3x3(char *identifier, cmatrix3x3 value)
566
{
567
set_value(identifier, cmatrix3x32scm(value));
568
}
569
570
void ctl_set_list(char *identifier, list value)
571
{
572
set_value(identifier, value);
573
}
574
575
void ctl_set_object(char *identifier, object value)
576
{
577
set_value(identifier, value);
578
}
579
580
void ctl_set_function(char *identifier, function value)
581
{
582
set_value(identifier, value);
583
}
584
585
/**************************************************************************/
586
587
/* list traversal */
588
589
int list_length(list l)
590
{
591
return(gh_length(l));
592
}
593
594
integer integer_list_ref(list l, int index)
595
{
596
return(gh_scm2int(list_ref(l,index)));
597
}
598
599
number number_list_ref(list l, int index)
600
{
601
return(gh_scm2double(list_ref(l,index)));
602
}
603
604
cnumber cnumber_list_ref(list l, int index)
605
{
606
return(scm2cnumber(list_ref(l,index)));
607
}
608
609
boolean boolean_list_ref(list l, int index)
610
{
611
return(SCM_BOOL_F != list_ref(l,index));
612
}
613
614
char* string_list_ref(list l, int index)
615
{
616
return(gh_scm2newstr(list_ref(l,index),NULL));
617
}
618
619
vector3 vector3_list_ref(list l, int index)
620
{
621
return(scm2vector3(list_ref(l,index)));
622
}
623
624
matrix3x3 matrix3x3_list_ref(list l, int index)
625
{
626
return(scm2matrix3x3(list_ref(l,index)));
627
}
628
629
cvector3 cvector3_list_ref(list l, int index)
630
{
631
return(scm2cvector3(list_ref(l,index)));
632
}
633
634
cmatrix3x3 cmatrix3x3_list_ref(list l, int index)
635
{
636
return(scm2cmatrix3x3(list_ref(l,index)));
637
}
638
639
list list_list_ref(list l, int index)
640
{
641
return(list_ref(l,index));
642
}
643
644
object object_list_ref(list l, int index)
645
{
646
return(list_ref(l,index));
647
}
648
649
object function_list_ref(list l, int index)
650
{
651
return(list_ref(l,index));
652
}
653
654
/**************************************************************************/
655
656
/* list creation */
657
658
#define MAKE_LIST(conv) \
659
{ \
660
int i; \
661
list cur_list = SCM_EOL; \
662
for (i = num_items - 1; i >= 0; --i) \
663
cur_list = gh_cons(conv (items[i]), cur_list); \
664
return(cur_list); \
665
} \
666
667
list make_integer_list(int num_items, integer *items)
668
MAKE_LIST(gh_int2scm)
669
670
list make_number_list(int num_items, number *items)
671
MAKE_LIST(gh_double2scm)
672
673
list make_cnumber_list(int num_items, cnumber *items)
674
MAKE_LIST(cnumber2scm)
675
676
list make_boolean_list(int num_items, boolean *items)
677
MAKE_LIST(gh_bool2scm)
678
679
list make_string_list(int num_items, char **items)
680
MAKE_LIST(gh_str02scm)
681
682
list make_vector3_list(int num_items, vector3 *items)
683
MAKE_LIST(vector32scm)
684
685
list make_matrix3x3_list(int num_items, matrix3x3 *items)
686
MAKE_LIST(matrix3x32scm)
687
688
list make_cvector3_list(int num_items, cvector3 *items)
689
MAKE_LIST(cvector32scm)
690
691
list make_cmatrix3x3_list(int num_items, cmatrix3x3 *items)
692
MAKE_LIST(cmatrix3x32scm)
693
694
#define NO_CONVERSION
695
696
list make_list_list(int num_items, list *items)
697
MAKE_LIST(NO_CONVERSION)
698
699
list make_object_list(int num_items, object *items)
700
MAKE_LIST(NO_CONVERSION)
701
702
list make_function_list(int num_items, object *items)
703
MAKE_LIST(NO_CONVERSION)
704
705
706
/**************************************************************************/
707
708
/* object properties */
709
710
boolean object_is_member(char *type_name, object o)
711
{
712
return(SCM_BOOL_F != gh_call2(gh_lookup("object-member?"),
713
gh_symbol2scm(type_name),
714
o));
715
}
716
717
static SCM object_property_value(object o, char *property_name)
718
{
719
return(gh_call2(gh_lookup("object-property-value"),
720
o,
721
gh_symbol2scm(property_name)));
722
}
723
724
integer integer_object_property(object o, char *property_name)
725
{
726
return(gh_scm2int(object_property_value(o,property_name)));
727
}
728
729
number number_object_property(object o, char *property_name)
730
{
731
return(gh_scm2double(object_property_value(o,property_name)));
732
}
733
734
cnumber cnumber_object_property(object o, char *property_name)
735
{
736
return(scm2cnumber(object_property_value(o,property_name)));
737
}
738
739
boolean boolean_object_property(object o, char *property_name)
740
{
741
return(SCM_BOOL_F != object_property_value(o,property_name));
742
}
743
744
char* string_object_property(object o, char *property_name)
745
{
746
return(gh_scm2newstr(object_property_value(o,property_name),NULL));
747
}
748
749
vector3 vector3_object_property(object o, char *property_name)
750
{
751
return(scm2vector3(object_property_value(o,property_name)));
752
}
753
754
matrix3x3 matrix3x3_object_property(object o, char *property_name)
755
{
756
return(scm2matrix3x3(object_property_value(o,property_name)));
757
}
758
759
cvector3 cvector3_object_property(object o, char *property_name)
760
{
761
return(scm2cvector3(object_property_value(o,property_name)));
762
}
763
764
cmatrix3x3 cmatrix3x3_object_property(object o, char *property_name)
765
{
766
return(scm2cmatrix3x3(object_property_value(o,property_name)));
767
}
768
769
list list_object_property(object o, char *property_name)
770
{
771
return(object_property_value(o,property_name));
772
}
773
774
object object_object_property(object o, char *property_name)
775
{
776
return(object_property_value(o,property_name));
777
}
778
779
function function_object_property(object o, char *property_name)
780
{
781
return(object_property_value(o,property_name));
782
}
Loggerhead is a web-based interface for Breezy
Version: 2.0.1