1 /*
2 * Dr Genius
3 * (C) Copyright Hilaire Fernandes 2001-2003
4 * hilaire@ofset.org
5 *
6 *
7 *
8 *
9 * This program is free software; you can redistribute it and/or modify
10 * it under the terms of the GNU General Public Licences as by published
11 * by the Free Software Foundation; either version 2; or (at your option)
12 * any later version
13 *
14 * This program is distributed in the hope that it will entertaining,
15 * but WITHOUT ANY WARRANTY; without even the implied warranty of
16 * MERCHANTABILTY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
17 * Publis License for more details.
18 *
19 * You should have received a copy of the GNU General Public License along
20 * with this program; if not, write to the Free Software Foundation, Inc.
21 * 675 Mass Ave, Cambridge, MA 02139, USA.
22 */
23
24 /*
25 HERE, WE DEFINE THE API OF THE DrGeoScript
26 IT IS USED BY SCRIPT PLUGGUED IN A FIGURE
27 */
28
29
30
31 #include "drgeo_scm_api.h"
32 #include "drgeo_scm_helper.h"
33 #include "drgeo_geometricObject.h"
34 #include "drgeo_point.h"
35 #include "drgeo_vector.h"
36 #include "drgeo_segment.h"
37 #include "drgeo_circle.h"
38 #include "drgeo_arcCircle.h"
39 #include "drgeo_value.h"
40 #include <math.h>
41
42
43 /* each API function use it */
44 static geometricObject *item;
45
46
47
48 /*******************/
49 /* geometricObject */
50 /*******************/
51
52
53 /*
54 GET THE 'CURVILIGNE' ABSCISSA OF A POINT (A POINT ON A LINE) on [0 ; 1]
55 Usage:
56 (getAbscissa a1)
57 a1 : a point object on a curve
58 */
59 SCM
drgeo_scm_getAbscissa(SCM object)60 drgeo_scm_getAbscissa (SCM object)
61 {
62 static gdouble d;
63
64 item = (geometricObject *) gh_scm2ulong (object);
65 if (item->getCategory () & FREE_PT_ON_CURVE)
66 {
67 d = ((point *) item)->getAbscissa ();
68 return gh_double2scm (d);
69 }
70 /* This is not a point object */
71 return SCM_UNSPECIFIED;
72 }
73
74 /*
75 SET THE 'CURVILIGNE' ABSCISSA OF A POINT (A POINT ON A LINE) on [0 ; 1]
76 Usage:
77 (setAbscissa a1 x)
78 a1 : a point object on a curve
79 x : a value in the range [0 ; 1]
80 */
81
82 SCM
drgeo_scm_setAbscissa(SCM object,SCM x)83 drgeo_scm_setAbscissa (SCM object, SCM x)
84 {
85 item = (geometricObject *) gh_scm2ulong (object);
86 if (item->getCategory () & FREE_PT_ON_CURVE)
87 ((point *) item)->setAbscissa (gh_scm2double (x));
88 return SCM_UNSPECIFIED;
89 }
90
91
92 /*
93 GET THE COORDINATES OF A POINT OR VECTOR
94 Usage:
95 (getCoordinates a1)
96 a1 : a point or vector object
97 Returned value: A 2-upplet list containing the coordinates
98 */
99 SCM
drgeo_scm_getCoordinates(SCM object)100 drgeo_scm_getCoordinates (SCM object)
101 {
102 static drgeoPoint p;
103
104 item = (geometricObject *) gh_scm2ulong (object);
105 if (item->getCategory () & POINT)
106 {
107 p = ((point *) item)->getCoordinate ();
108 return drgeoPoint2scmList (p);
109 }
110 else if (item->getCategory () & VECTOR)
111 {
112 p = ((vector *) item)->getDirection ();
113 return drgeoPoint2scmList (p);
114 }
115 /* This is not a point object */
116 return SCM_UNSPECIFIED;
117 }
118
119 /*
120 GET THE COORDINATES OF THE UNIT VECTOR OF A DIRECTION
121 Usage:
122 (getUnit a1)
123 a1 : a direction object (line, half-line, segment, vector)
124 Returned value: A 2-upplet list containing the coordinates
125 */
126 SCM
drgeo_scm_getUnit(SCM object)127 drgeo_scm_getUnit (SCM object)
128 {
129 static drgeoVector v;
130
131 item = (geometricObject *) gh_scm2ulong (object);
132 if (item->getCategory () & DIRECTION)
133 {
134 v = ((direction *) item)->getDirection ();
135 v /= v.norm ();
136 return drgeoPoint2scmList (v);
137 }
138 /* This is not a direction object */
139 return SCM_UNSPECIFIED;
140 }
141
142 /*
143 GET THE COORDINATES OF THE NORMAL DIRECTION (A VECTOR)
144 Usage:
145 (getNormal a1)
146 a1 : a direction object (line, half-line, segment, vector)
147 Returned value: A 2-upplet list containing the coordinates
148 */
149 SCM
drgeo_scm_getNormal(SCM object)150 drgeo_scm_getNormal (SCM object)
151 {
152 static drgeoVector v;
153
154 item = (geometricObject *) gh_scm2ulong (object);
155 if (item->getCategory () & DIRECTION)
156 {
157 v = ((direction *) item)->getNormal ();
158 v /= v.norm ();
159 return drgeoPoint2scmList (v);
160 }
161 /* This is not a direction object */
162 return SCM_UNSPECIFIED;
163 }
164
165 /*
166 SET THE COORDINATES OF A POINT
167 Usage:
168 (setCoordinates a1 coord)
169 a1 : a point or vector object
170 coord : A 2-upplet list containing the coordinates
171 */
172 SCM
drgeo_scm_setCoordinates(SCM object,SCM coord)173 drgeo_scm_setCoordinates (SCM object, SCM coord)
174 {
175 item = (geometricObject *) gh_scm2ulong (object);
176 if (item->getCategory () & FREE_PT)
177 ((point *) item)->setCoordinate (scmList2drgeoVector (coord));
178 return SCM_UNSPECIFIED;
179 }
180
181 /*
182 GET THE SLOPE OF A DIRECTION
183 Usage:
184 (getSlope a1)
185 a1 : a direction object
186 Returns : the slope, a value
187 */
188 SCM
drgeo_scm_getSlope(SCM object)189 drgeo_scm_getSlope (SCM object)
190 {
191 static drgeoVector v;
192 static gdouble p;
193
194 item = (geometricObject *) gh_scm2ulong (object);
195 if (item->getCategory () & DIRECTION)
196 {
197 v = ((direction *) item)->getDirection ();
198 if (v.getX () != 0)
199 {
200 p = v.getY () / v.getX ();
201 return gh_double2scm (p);
202 }
203 }
204 return SCM_UNSPECIFIED;
205 }
206
207
208 /*
209 GET THE NORM OF A VECTOR
210 Usage:
211 (getNorm a1)
212 a1 : a vector object
213 Returns : a value, the norm of the vector
214 */
215 SCM
drgeo_scm_getNorm(SCM object)216 drgeo_scm_getNorm (SCM object)
217 {
218 static gdouble p;
219
220 item = (geometricObject *) gh_scm2ulong (object);
221 if (item->getCategory () & VECTOR)
222 {
223 p = ((vector *) item)->getDirection ().norm ();
224 return gh_double2scm (p);
225 }
226 return SCM_UNSPECIFIED;
227 }
228
229
230 /*
231 GET THE LENGTH OF A SEGMENT, CIRCLE, ARC-CIRCLE
232 Usage:
233 (getLength a1)
234 a1 : a segment, circle or arc-circle object
235 Returns : a value, the length of the object
236 */
237 SCM
drgeo_scm_getLength(SCM object)238 drgeo_scm_getLength (SCM object)
239 {
240 static gdouble l;
241
242 item = (geometricObject *) gh_scm2ulong (object);
243 if (item->getCategory () & SEGMENT)
244 {
245 l = ((segment *) item)->getDirection ().norm ();
246 return gh_double2scm (l);
247 }
248 else if (item->getCategory () & CIRCLE)
249 {
250 l = 2 * M_PI * ((circle *) item)->getRadius ();
251 return gh_double2scm (l);
252 }
253 else if (item->getCategory () & ARC_CIRCLE)
254 {
255 l = ABS (((arcCircle *) item)->getLength ()) *
256 ((arcCircle *) item)->getRadius ();
257 return gh_double2scm (l);
258 }
259 return SCM_UNSPECIFIED;
260 }
261
262 /*
263 GET THE CENTER OF A CIRCLE ARC-CIRCLE
264 Usage:
265 (getCenter a1)
266 a1 : a circle or arc-circle object
267 returns: a 2D list containing the center coordinates
268 */
269 SCM
drgeo_scm_getCenter(SCM object)270 drgeo_scm_getCenter (SCM object)
271 {
272 static drgeoPoint p;
273
274 item = (geometricObject *) gh_scm2ulong (object);
275 if (item->getCategory () & CIRCLE)
276 {
277 p = ((circle *) item)->getCenter ();
278 return drgeoPoint2scmList (p);
279 }
280 else if (item->getCategory () & ARC_CIRCLE)
281 {
282 p = ((arcCircle *) item)->getCenter ();
283 return drgeoPoint2scmList (p);
284 }
285 return SCM_UNSPECIFIED;
286 }
287
288 /*
289 GET THE RADIUS OF A CIRCLE ARC-CIRCLE
290 Usage:
291 (getRadius a1)
292 a1 : a circle or arc-circle object
293 returns: a value containing the radius
294 */
295 SCM
drgeo_scm_getRadius(SCM object)296 drgeo_scm_getRadius (SCM object)
297 {
298 static gdouble r;
299
300 item = (geometricObject *) gh_scm2ulong (object);
301 if (item->getCategory () & CIRCLE)
302 {
303 r = ((circle *) item)->getRadius ();
304 return gh_double2scm (r);
305 }
306 else if (item->getCategory () & ARC_CIRCLE)
307 {
308 r = ((arcCircle *) item)->getRadius ();
309 return gh_double2scm (r);
310 }
311 /* This is not a value object */
312 return SCM_UNSPECIFIED;
313 }
314
315
316 /*
317 GET THE VALUE OF A VALUE OBJECT
318 Usage:
319 (getValue a1)
320 a1 : a value object
321 */
322 SCM
drgeo_scm_getValue(SCM object)323 drgeo_scm_getValue (SCM object)
324 {
325 static gdouble d;
326
327 item = (geometricObject *) gh_scm2ulong (object);
328 if (item->getCategory () & VALUE)
329 {
330 d = ((value *) item)->getValue ();
331 return gh_double2scm (d);
332 }
333 /* This is not a value object */
334 return SCM_UNSPECIFIED;
335 }
336
337 /*
338 SET THE VALUE OF A VALUE OBJECT
339 Usage:
340 (setValue a1 v)
341 a1 : a value object
342 v: a value
343 */
344 SCM
drgeo_scm_setValue(SCM object,SCM v)345 drgeo_scm_setValue (SCM object, SCM v)
346 {
347 item = (geometricObject *) gh_scm2ulong (object);
348 if (item->getType () & FREE_VALUE)
349 ((value *) item)->setValue (gh_scm2double (v));
350 return SCM_UNSPECIFIED;
351 }
352
353
354 /*
355 GET THE ANGLE IN RADIAN OF A ANGLE OBJECT
356 Usage:
357 (getAngle a)
358 a1 : the angle
359 */
360 SCM
drgeo_scm_getAngle(SCM object)361 drgeo_scm_getAngle (SCM object)
362 {
363 static gdouble d;
364
365 item = (geometricObject *) gh_scm2ulong (object);
366 if (item->getCategory () & ANGLE)
367 {
368 d = 180 * ((value *) item)->getValue () / M_PI;
369 return (gh_double2scm (d));
370 }
371 /* This is not an angle object */
372 return SCM_UNSPECIFIED;
373 }
374
375
376 /*
377 TRANSLATE A GEOMETRIC OBJECT
378 Usage:
379 (move a1 t)
380 a1 : the geometric object reference to translate
381 t : a guile vector
382 */
383 SCM
drgeo_scm_move(SCM object,SCM t)384 drgeo_scm_move (SCM object, SCM t)
385 {
386 item = (geometricObject *) gh_scm2ulong (object);
387 item->move (scmVector2drgeoVector (t));
388 return SCM_UNSPECIFIED;
389 }
390