1 /* guile.cc
2    Handles the interface to guile (ie. initialization of callbacks)
3 
4    Copyright (C) 2000  Mathias Broxvall
5                        Yannick Perret
6 
7    This program is free software; you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation; either version 2 of the License, or
10    (at your option) any later version.
11 
12    This program 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
15    GNU General Public License for more details.
16 
17    You should have received a copy of the GNU General Public License
18    along with this program; if not, write to the Free Software
19    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
20 */
21 
22 #include "guile.h"
23 
24 #include "animator.h"
25 #include "baby.h"
26 #include "bird.h"
27 #include "black.h"
28 #include "cactus.h"
29 #include "colorModifier.h"
30 #include "cyclicPlatform.h"
31 #include "diamond.h"
32 #include "flag.h"
33 #include "forcefield.h"
34 #include "fountain.h"
35 #include "game.h"
36 #include "general.h"
37 #include "goal.h"
38 #include "heightModifier.h"
39 #include "mainMode.h"
40 #include "map.h"
41 #include "modPill.h"
42 #include "pipe.h"
43 #include "pipeConnector.h"
44 #include "player.h"
45 #include "settings.h"
46 #include "sideSpike.h"
47 #include "sign.h"
48 #include "smartTrigger.h"
49 #include "sound.h"
50 #include "spike.h"
51 #include "switch.h"
52 #include "teleport.h"
53 #include "trigger.h"
54 #include "weather.h"
55 
56 #include <zlib.h>
57 #include <cstdlib>
58 #include <cstring>
59 
60 /* Object coordinates are shifted by DX/DY relative to map coordinates in the API
61  * Thus, a flag, ball, etc. placed at (222,225) will appear at (222+DX,225+DY)
62  * This makes it much more convienient to place objects */
63 #define DX 0.5
64 #define DY 0.5
65 
66 scm_t_bits smobAnimated_tag;
67 scm_t_bits smobGameHook_tag;
68 
69 #define IS_ANIMATED(x) (SCM_NIMP(x) && SCM_CELL_TYPE(x) == smobAnimated_tag)
70 #define IS_GAMEHOOK(x) \
71   (SCM_NIMP(x) &&      \
72    (SCM_CELL_TYPE(x) == smobGameHook_tag || SCM_CELL_TYPE(x) == smobAnimated_tag))
73 
smobAnimated_make(Animated * a)74 SCM smobAnimated_make(Animated *a) {
75   SCM smob;
76   SCM_NEWSMOB(smob, smobAnimated_tag, a);
77   return smob;
78 }
smobGameHook_make(GameHook * h)79 SCM smobGameHook_make(GameHook *h) {
80   SCM smob;
81   SCM_NEWSMOB(smob, smobGameHook_tag, h);
82   return smob;
83 }
smobAnimated_free(SCM)84 size_t smobAnimated_free(SCM /*smob*/) { return 0; }
smobGameHook_free(SCM)85 size_t smobGameHook_free(SCM /*smob*/) { return 0; }
86 
load_proc(void * body_data)87 static SCM load_proc(void *body_data) {
88   const char *scmname = (const char *)body_data;
89   scm_c_primitive_load(scmname);
90   return SCM_UNSPECIFIED;
91 }
92 
preunwind_proc(void * handler_data,SCM,SCM)93 static SCM preunwind_proc(void *handler_data, SCM, SCM) {
94   *(SCM *)handler_data = scm_make_stack(SCM_BOOL_T, SCM_EOL);
95   return SCM_UNSPECIFIED;
96 }
97 
error_proc(void *,SCM key,SCM parameters)98 static SCM error_proc(void *, SCM key, SCM parameters) {
99   SCM display = scm_variable_ref(scm_c_lookup("display"));
100   SCM keystr = scm_object_to_string(key, display);
101   SCM parameterstr = scm_object_to_string(parameters, display);
102   char *ckey = scm_to_utf8_string(keystr);
103   char *cparameter = scm_to_utf8_string(parameterstr);
104 
105   warning("Script error: %s", ckey);
106   warning("error details: %s", cparameter);
107 
108   free(ckey);
109   free(cparameter);
110 
111   return SCM_UNSPECIFIED;
112 }
113 
handleError(SCM stack)114 static void handleError(SCM stack) {
115   SCM oport = scm_open_output_string();
116   scm_display_backtrace(stack, oport, SCM_BOOL_F, SCM_BOOL_F);
117   SCM stackstr = scm_get_output_string(oport);
118   scm_close_port(oport);
119   char *cstack = scm_to_utf8_string(stackstr);
120   warning("stack trace: %s", cstack);
121   free(cstack);
122 }
123 
sub_loadScript(void * data)124 static void *sub_loadScript(void *data) {
125   const char *path = (const char *)data;
126   SCM stack = SCM_BOOL_F;
127   scm_c_catch(SCM_BOOL_T, load_proc, (void *)path, error_proc, NULL, preunwind_proc, &stack);
128   if (stack != SCM_BOOL_F) {
129     warning("Loading script %s failed", path);
130     handleError(stack);
131   }
132   return NULL;
133 }
134 
loadScript(const char * path)135 void loadScript(const char *path) { scm_with_guile(sub_loadScript, (void *)path); }
136 
sub_call_n(void * body_data)137 static SCM sub_call_n(void *body_data) {
138   void **data = (void **)body_data;
139   SCM fun = (SCM)data[0];
140   SCM *args = (SCM *)data[1];
141   int n = *(int *)data[2];
142   return scm_call_n(fun, args, n);
143 }
scm_catch_call_n(SCM func,SCM args[],int n)144 SCM scm_catch_call_n(SCM func, SCM args[], int n) {
145   void *input[3] = {(void *)func, (void *)args, (void *)&n};
146   SCM stack = SCM_BOOL_F;
147   SCM ret = scm_c_catch(SCM_BOOL_T, sub_call_n, (void *)input, error_proc, NULL,
148                         preunwind_proc, &stack);
149   if (stack != SCM_BOOL_F) {
150     handleError(stack);
151     return SCM_UNSPECIFIED;
152   }
153   return ret;
154 }
scm_catch_call_0(SCM func)155 SCM scm_catch_call_0(SCM func) {
156   SCM args[1] = {NULL};
157   return scm_catch_call_n(func, args, 0);
158 }
scm_catch_call_1(SCM func,SCM arg1)159 SCM scm_catch_call_1(SCM func, SCM arg1) {
160   SCM args[1] = {arg1};
161   return scm_catch_call_n(func, args, 1);
162 }
scm_catch_call_2(SCM func,SCM arg1,SCM arg2)163 SCM scm_catch_call_2(SCM func, SCM arg1, SCM arg2) {
164   SCM args[2] = {arg1, arg2};
165   return scm_catch_call_n(func, args, 2);
166 }
167 
scm_port_from_gzip(const char * path,int maxsize)168 SCM scm_port_from_gzip(const char *path, int maxsize) {
169   gzFile gp = gzopen(path, "rb");
170   if (!gp) {
171     warning("Warning. Could not find file %s", path);
172     return SCM_EOF_VAL;
173   }
174   char *ebuf = new char[maxsize + 1];
175   int len = gzread(gp, ebuf, maxsize);
176   gzclose(gp);
177   if (len == maxsize) {
178     delete[] ebuf;
179     warning("Warning. File '%s' unusually large", path);
180     return SCM_EOF_VAL;
181   }
182   ebuf[len] = '\0';
183   SCM str = scm_from_utf8_string(ebuf);
184   delete[] ebuf;
185   return scm_open_input_string(str);
186 }
187 
ascm_format(const char * str)188 char *ascm_format(const char *str) {
189   SCM write = scm_variable_ref(scm_c_lookup("write"));
190   SCM ostr = scm_from_utf8_string(str);
191   SCM keystr = scm_object_to_string(ostr, write);
192   return scm_to_utf8_string(keystr);
193 }
194 
195 /******************** _ a.k.a. gettext  ********************/
196 SCM_DEFINE(underscore, "_", 1, 0, 0, (SCM str),
197            "Mark string visible for translation and return it (see 'translate')")
198 #define FUNC_NAME s_underscore
199 {
200   SCM_ASSERT(scm_is_string(str), str, SCM_ARG1, FUNC_NAME);
201   return str;
202 }
203 #undef FUNC_NAME
204 
205 SCM_DEFINE(translate_string, "translate", 1, 0, 0, (SCM str),
206            "Translate string argument if possible (see '_')")
207 #define FUNC_NAME s_underscore
208 {
209   SCM_ASSERT(scm_is_string(str), str, SCM_ARG1, FUNC_NAME);
210   char *text = scm_to_utf8_string(str);
211   char *trans = gettext(text);
212   SCM out = scm_from_utf8_string(trans);
213   free(text);
214   return out;
215 }
216 #undef FUNC_NAME
217 
218 /*=======================================================*/
219 /*===========   creating ANIMATED objects    ============*/
220 /*=======================================================*/
221 
222 /******************** player ********************/
223 SCM_DEFINE(player, "player", 0, 0, 0, (),
224            "Returns the current player as an 'animated' object.")
225 #define FUNC_NAME s_player
226 {
227   if (!Game::current || !Game::current->player1) { return SCM_UNSPECIFIED; }
228   return smobAnimated_make(Game::current->player1);
229 }
230 #undef FUNC_NAME
231 
232 /************* new_mr_black ***********/
233 SCM_DEFINE(new_mr_black, "new-mr-black", 2, 0, 0, (SCM x, SCM y),
234            "Creates an opponend ball at specified position. Returns an 'animated' object.")
235 #define FUNC_NAME s_new_mr_black
236 {
237   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
238   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
239   if (!Game::current) { return SCM_UNSPECIFIED; }
240   Black *black = new Black(*Game::current, scm_to_double(x) + DX, scm_to_double(y) + DY);
241   Game::current->add(black);
242   return smobAnimated_make(black);
243 }
244 #undef FUNC_NAME
245 
246 /************** new_baby *****************/
247 SCM_DEFINE(new_baby, "new-baby", 2, 0, 0, (SCM x, SCM y),
248            "Creates a baby ball at specified position. Returns an 'animated' object.")
249 #define FUNC_NAME s_new_baby
250 {
251   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
252   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
253   if (!Game::current) { return SCM_UNSPECIFIED; }
254   Baby *baby = new Baby(*Game::current, scm_to_double(x) + DX, scm_to_double(y) + DY);
255   Game::current->add(baby);
256   return smobAnimated_make(baby);
257 }
258 #undef FUNC_NAME
259 
260 /************* add_teleport ***********/
261 SCM_DEFINE(add_teleport, "add-teleport", 5, 0, 0, (SCM x, SCM y, SCM dx, SCM dy, SCM radius),
262            "Creates a teleporter at specified position, with specified destination. Returns "
263            "an 'animated' object.")
264 #define FUNC_NAME s_add_teleport
265 {
266   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
267   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
268   SCM_ASSERT(scm_is_real(dx), dx, SCM_ARG3, FUNC_NAME);
269   SCM_ASSERT(scm_is_real(dy), dy, SCM_ARG4, FUNC_NAME);
270   SCM_ASSERT(scm_is_real(radius), radius, SCM_ARG5, FUNC_NAME);
271   if (!Game::current) { return SCM_UNSPECIFIED; }
272   Teleport *teleport =
273       new Teleport(*Game::current, scm_to_double(x) + DX, scm_to_double(y) + DY,
274                    scm_to_double(dx) + DX, scm_to_double(dy) + DY, scm_to_double(radius));
275   Game::current->add(teleport);
276   return smobAnimated_make(teleport);
277 }
278 #undef FUNC_NAME
279 
280 /************* add_bird ***********/
281 SCM_DEFINE(add_bird, "add-bird", 6, 0, 0, (SCM x, SCM y, SCM dx, SCM dy, SCM size, SCM speed),
282            "Creates a bird at specified position, with specified destination. Returns an "
283            "'animated' object")
284 #define FUNC_NAME s_add_bird
285 {
286   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
287   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
288   SCM_ASSERT(scm_is_real(dx), dx, SCM_ARG3, FUNC_NAME);
289   SCM_ASSERT(scm_is_real(dy), dy, SCM_ARG4, FUNC_NAME);
290   SCM_ASSERT(scm_is_real(size), size, SCM_ARG5, FUNC_NAME);
291   SCM_ASSERT(scm_is_real(speed), speed, SCM_ARG5, FUNC_NAME);
292   if (!Game::current) { return SCM_UNSPECIFIED; }
293   Bird *bird = new Bird(*Game::current, scm_to_double(x) + DX, scm_to_double(y) + DY,
294                         scm_to_double(dx) + DX, scm_to_double(dy) + DY, scm_to_double(size),
295                         scm_to_double(speed));
296   Game::current->add(bird);
297   return smobAnimated_make(bird);
298 }
299 #undef FUNC_NAME
300 
301 /**************** add_flag *************/
302 SCM_DEFINE(add_flag, "add-flag", 5, 0, 0, (SCM x, SCM y, SCM points, SCM visible, SCM radius),
303            "Creates a flag giving points when captured. Returns an 'animated' object.")
304 #define FUNC_NAME s_add_flag
305 {
306   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
307   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
308   SCM_ASSERT(scm_is_integer(points), points, SCM_ARG3, FUNC_NAME);
309   SCM_ASSERT(scm_is_bool(visible), visible, SCM_ARG4, FUNC_NAME);
310   SCM_ASSERT(scm_is_real(radius), radius, SCM_ARG5, FUNC_NAME);
311   if (!Game::current) { return SCM_UNSPECIFIED; }
312   Flag *flag = new Flag(*Game::current, scm_to_double(x) + DX, scm_to_double(y) + DY,
313                         scm_to_int(points), scm_to_bool(visible), scm_to_double(radius));
314   Game::current->add(flag);
315   return smobAnimated_make(flag);
316 }
317 #undef FUNC_NAME
318 
319 /**************** add_colormodifier *************/
320 SCM_DEFINE(add_colormodifier, "add-colormodifier", 7, 0, 0,
321            (SCM col, SCM x, SCM y, SCM min, SCM max, SCM freq, SCM phase),
322            "Allow to modify the color(s) of a cell. Returns an 'animated' object")
323 #define FUNC_NAME s_add_colormodifier
324 {
325   SCM_ASSERT(scm_is_integer(col), col, SCM_ARG1, FUNC_NAME);
326   SCM_ASSERT(scm_is_integer(x), x, SCM_ARG2, FUNC_NAME);
327   SCM_ASSERT(scm_is_integer(y), y, SCM_ARG3, FUNC_NAME);
328   SCM_ASSERT(scm_is_real(min), min, SCM_ARG4, FUNC_NAME);
329   SCM_ASSERT(scm_is_real(max), max, SCM_ARG5, FUNC_NAME);
330   SCM_ASSERT(scm_is_real(freq), freq, SCM_ARG6, FUNC_NAME);
331   SCM_ASSERT(scm_is_real(phase), phase, SCM_ARG7, FUNC_NAME);
332   if (!Game::current) { return SCM_UNSPECIFIED; }
333   ColorModifier *colormodifier = new ColorModifier(
334       *Game::current, scm_to_int(col), scm_to_int(x), scm_to_int(y), scm_to_double(min),
335       scm_to_double(max), scm_to_double(freq), scm_to_double(phase));
336   Game::current->add(colormodifier);
337   return smobGameHook_make(colormodifier);
338 }
339 #undef FUNC_NAME
340 
341 /**************** add_heightmodifier *************/
342 SCM_DEFINE(add_heightmodifier, "add-heightmodifier", 7, 3, 0,
343            (SCM corner, SCM x, SCM y, SCM min, SCM max, SCM freq, SCM phase, SCM n1, SCM n2,
344             SCM n3),
345            "Allow to modify the height of a cell's corner. Returns an 'animated' object")
346 #define FUNC_NAME s_add_heightmodifier
347 {
348   SCM_ASSERT(scm_is_integer(corner), corner, SCM_ARG1, FUNC_NAME);
349   SCM_ASSERT(scm_is_integer(x), x, SCM_ARG2, FUNC_NAME);
350   SCM_ASSERT(scm_is_integer(y), y, SCM_ARG3, FUNC_NAME);
351   SCM_ASSERT(scm_is_real(min), min, SCM_ARG4, FUNC_NAME);
352   SCM_ASSERT(scm_is_real(max), max, SCM_ARG5, FUNC_NAME);
353   SCM_ASSERT(scm_is_real(freq), freq, SCM_ARG6, FUNC_NAME);
354   SCM_ASSERT(scm_is_real(phase), phase, SCM_ARG7, FUNC_NAME);
355   if (!Game::current) { return SCM_UNSPECIFIED; }
356 
357   int not1 = -1, not2 = -1, not3 = -1;
358   if (scm_is_real(n1)) not1 = scm_to_int(n1);
359   if (scm_is_real(n2)) not2 = scm_to_int(n2);
360   if (scm_is_real(n3)) not3 = scm_to_int(n3);
361 
362   HeightModifier *heightmodifier = new HeightModifier(
363       *Game::current, scm_to_int(corner), scm_to_int(x), scm_to_int(y), scm_to_double(min),
364       scm_to_double(max), scm_to_double(freq), scm_to_double(phase), not1, not2, not3);
365   Game::current->add(heightmodifier);
366   return smobGameHook_make(heightmodifier);
367 }
368 #undef FUNC_NAME
369 
370 /**************** add_cactus *************/
371 SCM_DEFINE(add_cactus, "add-cactus", 3, 0, 0, (SCM x, SCM y, SCM radius),
372            "Creates a cactus at given position.")
373 #define FUNC_NAME s_add_cactus
374 {
375   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
376   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
377   SCM_ASSERT(scm_is_real(radius), radius, SCM_ARG5, FUNC_NAME);
378   if (!Game::current) { return SCM_UNSPECIFIED; }
379   Cactus *cactus = new Cactus(*Game::current, scm_to_double(x) + DX, scm_to_double(y) + DY,
380                               scm_to_double(radius));
381   Game::current->add(cactus);
382   return smobAnimated_make(cactus);
383 }
384 #undef FUNC_NAME
385 
386 /**************** add_spike *************/
387 SCM_DEFINE(add_spike, "add-spike", 4, 0, 0, (SCM x, SCM y, SCM speed, SCM phase),
388            "Creates a lethal spike. Returns an 'animated' object.")
389 #define FUNC_NAME s_add_spike
390 {
391   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
392   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
393   SCM_ASSERT(scm_is_real(speed), speed, SCM_ARG3, FUNC_NAME);
394   SCM_ASSERT(scm_is_real(phase), phase, SCM_ARG4, FUNC_NAME);
395   if (!Game::current) { return SCM_UNSPECIFIED; }
396 
397   Coord3d pos;
398   pos[0] = scm_to_double(x) + DX;
399   pos[1] = scm_to_double(y) + DY;
400 
401   Spike *spike = new Spike(*Game::current, pos, scm_to_double(speed), scm_to_double(phase));
402   Game::current->add(spike);
403   return smobAnimated_make(spike);
404 }
405 #undef FUNC_NAME
406 
407 /**************** add_spike *************/
408 SCM_DEFINE(add_sidespike, "add-sidespike", 5, 0, 0,
409            (SCM x, SCM y, SCM speed, SCM phase, SCM side),
410            "Creates a lethal spike (comming from side). Returns an 'animated' object.")
411 #define FUNC_NAME s_add_sidespike
412 {
413   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
414   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
415   SCM_ASSERT(scm_is_real(speed), speed, SCM_ARG3, FUNC_NAME);
416   SCM_ASSERT(scm_is_real(phase), phase, SCM_ARG4, FUNC_NAME);
417   SCM_ASSERT(scm_is_integer(side), side, SCM_ARG5, FUNC_NAME);
418   if (!Game::current) { return SCM_UNSPECIFIED; }
419   Coord3d pos;
420   pos[0] = scm_to_double(x) + DX;
421   pos[1] = scm_to_double(y) + DY;
422   SideSpike *sidespike = new SideSpike(*Game::current, pos, scm_to_double(speed),
423                                        scm_to_double(phase), scm_to_int(side));
424   Game::current->add(sidespike);
425   return smobAnimated_make(sidespike);
426 }
427 #undef FUNC_NAME
428 
429 /**************** add_goal **************/
430 SCM_DEFINE(add_goal, "add-goal", 4, 0, 0, (SCM x, SCM y, SCM rotate, SCM nextLevel),
431            "Adds a new goal to the map. Returns an 'animated' object.")
432 #define FUNC_NAME s_add_goal
433 {
434   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
435   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
436   SCM_ASSERT(scm_is_bool(rotate), rotate, SCM_ARG3, FUNC_NAME);
437   SCM_ASSERT(scm_is_string(nextLevel), nextLevel, SCM_ARG4, FUNC_NAME);
438   if (!Game::current) { return SCM_UNSPECIFIED; }
439   char *sname = scm_to_utf8_string(nextLevel);
440   if (!sname) { return SCM_UNSPECIFIED; }
441   Goal *goal = new Goal(*Game::current, scm_to_double(x) + DX, scm_to_double(y) + DY,
442                         scm_is_true(rotate), sname);
443   Game::current->add(goal);
444   free(sname);
445   return smobAnimated_make(goal);
446 }
447 #undef FUNC_NAME
448 
449 /************* sign ************/
450 SCM_DEFINE(sign, "sign", 6, 1, 0,
451            (SCM text, SCM scale, SCM rotation, SCM duration, SCM x, SCM y, SCM z),
452            "Creates a new sign. Text is translated if possible. duration<0 lasts forever. "
453            "Returns an 'animated' object")
454 #define FUNC_NAME s_sign
455 {
456   SCM_ASSERT(scm_is_string(text), text, SCM_ARG1, FUNC_NAME);
457   if (!Game::current) { return SCM_UNSPECIFIED; }
458   char *sname = scm_to_utf8_string(text);
459   if (!sname) { return SCM_UNSPECIFIED; }
460   Coord3d pos;
461   pos[0] = scm_to_double(x) + DX;
462   pos[1] = scm_to_double(y) + DY;
463   if (scm_is_real(z))
464     pos[2] = scm_to_double(z);
465   else
466     pos[2] = Game::current->map->getHeight(pos[0], pos[1]) + 2.0;
467   Sign *sign = new Sign(*Game::current, gettext(sname), scm_to_double(duration),
468                         scm_to_double(scale), scm_to_double(rotation), pos);
469   Game::current->add(sign);
470   free(sname);
471   return smobAnimated_make(sign);
472 }
473 #undef FUNC_NAME
474 
475 /*********** add_modpill ***********/
476 SCM_DEFINE(add_modpill, "add-modpill", 5, 0, 0,
477            (SCM x, SCM y, SCM kind, SCM length, SCM resurrecting),
478            "Adds a new modpill to level at x,y with given kind and resurrection state. "
479            "Returns an 'animated' object")
480 #define FUNC_NAME s_add_modpill
481 {
482   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
483   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
484   SCM_ASSERT(scm_is_real(kind), kind, SCM_ARG3, FUNC_NAME);
485   SCM_ASSERT(scm_is_real(length), length, SCM_ARG4, FUNC_NAME);
486   SCM_ASSERT(scm_is_real(resurrecting), resurrecting, SCM_ARG5, FUNC_NAME);
487   if (!Game::current) { return SCM_UNSPECIFIED; }
488   ModPill *modpill =
489       new ModPill(*Game::current, scm_to_double(x) + DX, scm_to_double(y) + DY,
490                   scm_to_int(kind), scm_to_int(length), scm_to_int(resurrecting));
491   Game::current->add(modpill);
492   return smobAnimated_make(modpill);
493 }
494 #undef FUNC_NAME
495 
496 /*********** forcefield ***********/
497 SCM_DEFINE(forcefield, "forcefield", 8, 0, 0,
498            (SCM x, SCM y, SCM z, SCM dx, SCM dy, SCM dz, SCM height, SCM allow),
499            "Creats a forcefield. Returns an 'animated' object")
500 #define FUNC_NAME s_forcefield
501 {
502   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
503   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
504   SCM_ASSERT(scm_is_real(z), z, SCM_ARG3, FUNC_NAME);
505   SCM_ASSERT(scm_is_real(dx), dx, SCM_ARG4, FUNC_NAME);
506   SCM_ASSERT(scm_is_real(dy), dy, SCM_ARG5, FUNC_NAME);
507   SCM_ASSERT(scm_is_real(dz), dz, SCM_ARG6, FUNC_NAME);
508   SCM_ASSERT(scm_is_real(height), height, SCM_ARG7, FUNC_NAME);
509   SCM_ASSERT(scm_is_real(allow), allow, SCM_ARG7, FUNC_NAME);
510   if (!Game::current) { return SCM_UNSPECIFIED; }
511   Coord3d pos, dir;
512   pos[0] = scm_to_double(x) + DX;
513   pos[1] = scm_to_double(y) + DY;
514   pos[2] = Game::current->map->getHeight(pos[0], pos[1]) + scm_to_double(z);
515   dir[0] = scm_to_double(dx);
516   dir[1] = scm_to_double(dy);
517   dir[2] = scm_to_double(dz);
518 
519   ForceField *ff =
520       new ForceField(*Game::current, pos, dir, scm_to_double(height), scm_to_int(allow));
521   Game::current->add(ff);
522   return smobAnimated_make(ff);
523 }
524 #undef FUNC_NAME
525 
526 /*********** switch ***********/
527 SCM_DEFINE(fun_switch, "switch", 4, 0, 0, (SCM x, SCM y, SCM on, SCM off),
528            "Creates a switch. Returns an 'animated' object")
529 #define FUNC_NAME s_fun_switch
530 {
531   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
532   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
533   SCM_ASSERT(scm_is_true(scm_procedure_p(on)), on, SCM_ARG3, FUNC_NAME);
534   SCM_ASSERT(scm_is_true(scm_procedure_p(off)), off, SCM_ARG3, FUNC_NAME);
535   if (!Game::current) { return SCM_UNSPECIFIED; }
536   CSwitch *sw =
537       new CSwitch(*Game::current, scm_to_double(x) + DX, scm_to_double(y) + DY, on, off);
538   Game::current->add(sw);
539   return smobAnimated_make(sw);
540 }
541 #undef FUNC_NAME
542 
543 /*********** pipe **********/
544 SCM_DEFINE(new_pipe, "pipe", 7, 0, 0,
545            (SCM x0, SCM y0, SCM z0, SCM x1, SCM y1, SCM z1, SCM radius),
546            "Creates a new pipe. Returns an 'animated' object")
547 #define FUNC_NAME s_new_pipe
548 {
549   SCM_ASSERT(scm_is_real(x0), x0, SCM_ARG1, FUNC_NAME);
550   SCM_ASSERT(scm_is_real(y0), y0, SCM_ARG2, FUNC_NAME);
551   SCM_ASSERT(scm_is_real(z0), z0, SCM_ARG3, FUNC_NAME);
552   SCM_ASSERT(scm_is_real(x1), x1, SCM_ARG4, FUNC_NAME);
553   SCM_ASSERT(scm_is_real(y1), y1, SCM_ARG5, FUNC_NAME);
554   SCM_ASSERT(scm_is_real(z1), z1, SCM_ARG6, FUNC_NAME);
555   SCM_ASSERT(scm_is_real(radius), radius, SCM_ARG6, FUNC_NAME);
556   if (!Game::current) { return SCM_UNSPECIFIED; }
557   Coord3d from, to;
558   from[0] = scm_to_double(x0) + DX;
559   from[1] = scm_to_double(y0) + DY;
560   from[2] = scm_to_double(z0);
561   to[0] = scm_to_double(x1) + DX;
562   to[1] = scm_to_double(y1) + DY;
563   to[2] = scm_to_double(z1);
564   Pipe *pipe = new Pipe(*Game::current, from, to, scm_to_double(radius));
565   Game::current->add(pipe);
566   return smobAnimated_make(pipe);
567 }
568 #undef FUNC_NAME
569 
570 /*********** pipe-connector **********/
571 SCM_DEFINE(pipe_connector, "pipe-connector", 4, 0, 0, (SCM x0, SCM y0, SCM z0, SCM radius),
572            "Creates a new pipe connector. Returns an 'animated' object")
573 #define FUNC_NAME s_pipe_connector
574 {
575   SCM_ASSERT(scm_is_real(x0), x0, SCM_ARG1, FUNC_NAME);
576   SCM_ASSERT(scm_is_real(y0), y0, SCM_ARG2, FUNC_NAME);
577   SCM_ASSERT(scm_is_real(z0), z0, SCM_ARG3, FUNC_NAME);
578   SCM_ASSERT(scm_is_real(radius), radius, SCM_ARG4, FUNC_NAME);
579   if (!Game::current) { return SCM_UNSPECIFIED; }
580   Coord3d pos;
581   pos[0] = scm_to_double(x0) + DX;
582   pos[1] = scm_to_double(y0) + DY;
583   pos[2] = scm_to_double(z0);
584   PipeConnector *pipeConnector = new PipeConnector(*Game::current, pos, scm_to_double(radius));
585   Game::current->add(pipeConnector);
586   return smobAnimated_make(pipeConnector);
587 }
588 #undef FUNC_NAME
589 
590 /************* diamond ************/
591 SCM_DEFINE(diamond, "diamond", 2, 1, 0, (SCM x, SCM y, SCM z),
592            "Creates a new diamond 'save point'. Returns an 'animated' object")
593 #define FUNC_NAME s_diamond
594 {
595   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
596   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
597   if (!Game::current) { return SCM_UNSPECIFIED; }
598   Coord3d pos;
599   pos[0] = scm_to_double(x) + DX;
600   pos[1] = scm_to_double(y) + DY;
601   pos[2] = Game::current->map->getHeight(pos[0], pos[1]) + 0.4;
602   if (scm_is_real(z)) pos[2] = scm_to_double(z);
603 
604   Diamond *diamond = new Diamond(*Game::current, pos);
605   Game::current->add(diamond);
606   return smobAnimated_make(diamond);
607 }
608 #undef FUNC_NAME
609 
610 /************ fountain **************/
611 SCM_DEFINE(fountain, "fountain", 6, 0, 0,
612            (SCM x, SCM y, SCM z, SCM randomSpeed, SCM radius, SCM strength),
613            "Creates a new fountain object. Returns an 'animated' object")
614 #define FUNC_NAME s_fountain
615 {
616   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
617   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
618   SCM_ASSERT(scm_is_real(z), z, SCM_ARG3, FUNC_NAME);
619   SCM_ASSERT(scm_is_real(randomSpeed), randomSpeed, SCM_ARG4, FUNC_NAME);
620   SCM_ASSERT(scm_is_real(radius), radius, SCM_ARG5, FUNC_NAME);
621   SCM_ASSERT(scm_is_real(strength), strength, SCM_ARG6, FUNC_NAME);
622   if (!Game::current) { return SCM_UNSPECIFIED; }
623   Coord3d position(scm_to_double(x) + DX, scm_to_double(y) + DY, scm_to_double(z));
624   Fountain *fountain = new Fountain(*Game::current, position, scm_to_double(randomSpeed),
625                                     scm_to_double(radius), scm_to_double(strength));
626   Game::current->add(fountain);
627   return smobAnimated_make(fountain);
628 }
629 #undef FUNC_NAME
630 
631 /*=======================================================*/
632 /*=========== operations on ANIMATED objects ============*/
633 /*=======================================================*/
634 
635 /**************** set_position *************/
636 SCM_DEFINE(set_position, "set-position", 3, 1, 0, (SCM obj, SCM x, SCM y, SCM z),
637            "Sets the position of specified 'animated' object. Accepts optional z-coordinate.")
638 #define FUNC_NAME s_set_position
639 {
640   SCM_ASSERT(IS_ANIMATED(obj), obj, SCM_ARG1, FUNC_NAME);
641   SCM_ASSERT(scm_is_real(x), x, SCM_ARG2, FUNC_NAME);
642   SCM_ASSERT(scm_is_real(y), y, SCM_ARG3, FUNC_NAME);
643   Animated *anim = (Animated *)SCM_CDR(obj);
644   anim->position[0] = scm_to_double(x) + DX;
645   anim->position[1] = scm_to_double(y) + DY;
646   if (scm_is_real(z)) anim->position[2] = scm_to_double(z);
647   anim->drawChanged = true;
648   return SCM_UNSPECIFIED;
649 }
650 #undef FUNC_NAME
651 
652 /************** get-position-x ****************/
653 SCM_DEFINE(get_position_x, "get-position-x", 1, 0, 0, (SCM obj),
654            "Gets the X position of the specified 'animed' object. Object must be of type "
655            "animated, eg. a player, ball, etc.")
656 #define FUNC_NAME s_get_position_x
657 {
658   SCM_ASSERT(IS_ANIMATED(obj), obj, SCM_ARG1, FUNC_NAME);
659   Animated *anim = (Animated *)SCM_CDR(obj);
660   return scm_from_double(anim->position[0] - DX);
661 }
662 #undef FUNC_NAME
663 
664 /************** get-position-y ****************/
665 SCM_DEFINE(get_position_y, "get-position-y", 1, 0, 0, (SCM obj),
666            "Gets the Y position of the specified 'animated' object. Object must be of type "
667            "animated, eg. a player, ball, etc.")
668 #define FUNC_NAME s_get_position_y
669 {
670   SCM_ASSERT(IS_ANIMATED(obj), obj, SCM_ARG1, FUNC_NAME);
671   Animated *anim = (Animated *)SCM_CDR(obj);
672   return scm_from_double(anim->position[1] - DY);
673 }
674 #undef FUNC_NAME
675 
676 /************** get-position-z ****************/
677 SCM_DEFINE(get_position_z, "get-position-z", 1, 0, 0, (SCM obj),
678            "Gets the Z position of the specified 'animated' object. Object must be of type "
679            "animated, eg. a player, ball, etc.")
680 #define FUNC_NAME s_get_position_z
681 {
682   SCM_ASSERT(IS_ANIMATED(obj), obj, SCM_ARG1, FUNC_NAME);
683   Animated *anim = (Animated *)SCM_CDR(obj);
684   return scm_from_double(anim->position[2]);
685 }
686 #undef FUNC_NAME
687 
688 /**************** set_modtime *************/
689 SCM_DEFINE(set_modtime, "set-modtime", 3, 0, 0, (SCM s_obj, SCM s_mod, SCM s_time),
690            "Alters time left for object (must be a ball) to have the given modification.")
691 #define FUNC_NAME s_set_modtime
692 {
693   SCM_ASSERT(IS_ANIMATED(s_obj), s_obj, SCM_ARG1, FUNC_NAME);
694   SCM_ASSERT(scm_is_real(s_mod), s_mod, SCM_ARG2, FUNC_NAME);
695   SCM_ASSERT(scm_is_real(s_time), s_time, SCM_ARG3, FUNC_NAME);
696   int mod = scm_to_int(s_mod);
697   SCM_ASSERT(mod >= 0 && mod < NUM_MODS, s_mod, SCM_ARG2, FUNC_NAME);
698   double time = scm_to_double(s_time);
699   Animated *anim = (Animated *)SCM_CDR(s_obj);
700   Ball *ball = dynamic_cast<Ball *>(anim);
701   if (ball) {
702     ball->modTimeLeft[mod] = time;
703     ball->drawChanged = true;
704   }
705   return s_obj;
706 }
707 #undef FUNC_NAME
708 
709 /**************** set_acceleration *************/
710 SCM_DEFINE(set_acceleration, "set-acceleration", 2, 0, 0, (SCM obj, SCM accel),
711            "Sets acceleration of given computer controlled ball object (mr black or baby)")
712 #define FUNC_NAME s_set_acceleration
713 {
714   SCM_ASSERT(IS_ANIMATED(obj), obj, SCM_ARG1, FUNC_NAME);
715   SCM_ASSERT(scm_is_real(accel), accel, SCM_ARG2, FUNC_NAME);
716   Animated *anim = (Animated *)SCM_CDR(obj);
717   Black *black = dynamic_cast<Black *>(anim);
718   if (black) {
719     black->acceleration = scm_to_double(accel);
720     return obj;
721   } else
722     return SCM_BOOL(false);
723 }
724 #undef FUNC_NAME
725 
726 /**************** set_horizon *************/
727 SCM_DEFINE(set_horizon, "set-horizon", 2, 0, 0, (SCM obj, SCM horizon),
728            "Sets AI horizon of given computer controlled ball object (mr black or baby)")
729 #define FUNC_NAME s_set_horizon
730 {
731   SCM_ASSERT(IS_ANIMATED(obj), obj, SCM_ARG1, FUNC_NAME);
732   SCM_ASSERT(scm_is_real(horizon), horizon, SCM_ARG2, FUNC_NAME);
733   Animated *anim = (Animated *)SCM_CDR(obj);
734   Black *black = dynamic_cast<Black *>(anim);
735   if (black) {
736     black->horizon = scm_to_double(horizon);
737     return obj;
738   } else
739     return SCM_BOOL(false);
740 }
741 #undef FUNC_NAME
742 
743 /******************* set_primary_color *************/
744 SCM_DEFINE(set_primary_color, "set-primary-color", 4, 1, 0,
745            (SCM obj, SCM r, SCM g, SCM b, SCM a),
746            "Sets the primary color of given 'animated' object.")
747 #define FUNC_NAME s_set_primary_color
748 {
749   SCM_ASSERT(IS_ANIMATED(obj), obj, SCM_ARG1, FUNC_NAME);
750   SCM_ASSERT(scm_is_real(r), r, SCM_ARG2, FUNC_NAME);
751   SCM_ASSERT(scm_is_real(g), g, SCM_ARG3, FUNC_NAME);
752   SCM_ASSERT(scm_is_real(b), b, SCM_ARG4, FUNC_NAME);
753   Animated *anim = (Animated *)SCM_CDR(obj);
754   anim->primaryColor = Color(scm_to_double(r), scm_to_double(g), scm_to_double(b),
755                              scm_is_real(a) ? scm_to_double(a) : 1.0);
756   anim->drawChanged = true;
757   return obj;
758 }
759 #undef FUNC_NAME
760 
761 /******************* set_secondary_color *************/
762 SCM_DEFINE(set_secondary_color, "set-secondary-color", 4, 1, 0,
763            (SCM obj, SCM r, SCM g, SCM b, SCM a),
764            "Sets the secondary color (if applicable) of given 'animated' object.")
765 #define FUNC_NAME s_set_secondary_color
766 {
767   SCM_ASSERT(IS_ANIMATED(obj), obj, SCM_ARG1, FUNC_NAME);
768   SCM_ASSERT(scm_is_real(r), r, SCM_ARG2, FUNC_NAME);
769   SCM_ASSERT(scm_is_real(g), g, SCM_ARG3, FUNC_NAME);
770   SCM_ASSERT(scm_is_real(b), b, SCM_ARG4, FUNC_NAME);
771   Animated *anim = (Animated *)SCM_CDR(obj);
772   anim->secondaryColor = Color(scm_to_double(r), scm_to_double(g), scm_to_double(b),
773                                scm_is_real(a) ? scm_to_double(a) : 1.0);
774   anim->drawChanged = true;
775   return obj;
776 }
777 #undef FUNC_NAME
778 
779 /******************* set_specular_color *************/
780 SCM_DEFINE(set_specular_color, "set-specular-color", 4, 1, 0,
781            (SCM obj, SCM r, SCM g, SCM b, SCM a),
782            "Sets the specular color (if applicable) of given 'animated' object.")
783 #define FUNC_NAME s_set_specular_color
784 {
785   SCM_ASSERT(IS_ANIMATED(obj), obj, SCM_ARG1, FUNC_NAME);
786   SCM_ASSERT(scm_is_real(r), r, SCM_ARG2, FUNC_NAME);
787   SCM_ASSERT(scm_is_real(g), g, SCM_ARG3, FUNC_NAME);
788   SCM_ASSERT(scm_is_real(b), b, SCM_ARG4, FUNC_NAME);
789   Animated *anim = (Animated *)SCM_CDR(obj);
790   anim->specularColor = Color(scm_to_double(r), scm_to_double(g), scm_to_double(b),
791                               scm_is_real(a) ? scm_to_double(a) : 1.0);
792   anim->drawChanged = true;
793   return obj;
794 }
795 #undef FUNC_NAME
796 
797 /************** set-flag **********/
798 SCM_DEFINE(set_flag, "set-flag", 3, 0, 0, (SCM anim, SCM flag, SCM state),
799            "Adds or removes status flag to an 'animated' object.")
800 #define FUNC_NAME s_set_flag
801 {
802   SCM_ASSERT(IS_ANIMATED(anim), anim, SCM_ARG1, FUNC_NAME);
803   SCM_ASSERT(scm_is_integer(flag), flag, SCM_ARG2, FUNC_NAME);
804   SCM_ASSERT(scm_is_bool(state), state, SCM_ARG3, FUNC_NAME);
805   int iflag = scm_to_int(flag);
806   Animated *a = (Animated *)SCM_CDR(anim);
807   if (SCM_FALSEP(state))
808     a->flags = a->flags & (~iflag);
809   else
810     a->flags = a->flags | iflag;
811   a->drawChanged = true;
812   return anim;
813 }
814 #undef FUNC_NAME
815 
816 /*********** set_wind **********/
817 SCM_DEFINE(set_wind, "set-wind", 3, 0, 0, (SCM pipe, SCM forward, SCM backward),
818            "Sets the forward/backward wind of a pipe object.")
819 #define FUNC_NAME s_set_wind
820 {
821   SCM_ASSERT(IS_ANIMATED(pipe), pipe, SCM_ARG1, FUNC_NAME);
822   SCM_ASSERT(scm_is_real(forward), forward, SCM_ARG2, FUNC_NAME);
823   SCM_ASSERT(scm_is_real(backward), backward, SCM_ARG3, FUNC_NAME);
824   Pipe *p = dynamic_cast<Pipe *>((Animated *)SCM_CDR(pipe));
825   if (p) {
826     p->windForward = scm_to_double(forward);
827     p->windBackward = scm_to_double(backward);
828   }
829   return pipe;
830 }
831 #undef FUNC_NAME
832 
833 /************ set-speed ************/
834 SCM_DEFINE(set_speed, "set-speed", 2, 0, 0, (SCM obj, SCM speed),
835            "Alters the speed of platforms or spikes")
836 #define FUNC_NAME s_set_speed
837 {
838   SCM_ASSERT(IS_GAMEHOOK(obj), obj, SCM_ARG1, FUNC_NAME);
839   SCM_ASSERT(scm_is_real(speed), speed, SCM_ARG2, FUNC_NAME);
840   Spike *spike = dynamic_cast<Spike *>((Animated *)SCM_CDR(obj));
841   if (spike) {
842     spike->speed = scm_to_double(speed);
843   } else {
844     CyclicPlatform *platform = dynamic_cast<CyclicPlatform *>((GameHook *)SCM_CDR(obj));
845     if (platform) { platform->speed = scm_to_double(speed); }
846   }
847   return obj;
848 }
849 #undef FUNC_NAME
850 
851 /************* set-texture ************/
852 SCM_DEFINE(set_texture, "set-texture", 2, 0, 0, (SCM obj, SCM tname),
853            "Attempts to set the texture of an 'animated' object")
854 #define FUNC_NAME s_set_texture
855 {
856   SCM_ASSERT(IS_ANIMATED(obj), obj, SCM_ARG1, FUNC_NAME);
857   SCM_ASSERT(scm_is_string(tname), tname, SCM_ARG2, FUNC_NAME);
858   char *name = scm_to_utf8_string(tname);
859   for (int i = 0; i < numTextures; i++)
860     if (strcmp(name, textureNames[i]) == 0) {
861       Animated *anim = (Animated *)SCM_CDR(obj);
862       anim->texture = i;
863       anim->drawChanged = true;
864       return obj;
865     }
866   return SCM_BOOL(false);
867 }
868 #undef FUNC_NAME
869 
870 /************* set-fountain-strength *************/
871 SCM_DEFINE(set_fountain_strength, "set-fountain-strength", 2, 0, 0, (SCM obj, SCM str),
872            "Sets the strength of a fountain object")
873 #define FUNC_NAME s_set_fountain_strength
874 {
875   SCM_ASSERT(IS_ANIMATED(obj), obj, SCM_ARG1, FUNC_NAME);
876   SCM_ASSERT(scm_is_real(str), str, SCM_ARG2, FUNC_NAME);
877   Fountain *fountain = dynamic_cast<Fountain *>((Animated *)SCM_CDR(obj));
878   SCM_ASSERT(fountain, obj, SCM_ARG1, FUNC_NAME);
879   fountain->strength = scm_to_double(str);
880   return obj;
881 }
882 #undef FUNC_NAME
883 
884 /************* fountain-velocity *************/
885 SCM_DEFINE(set_fountain_velocity, "set-fountain-velocity", 4, 0, 0,
886            (SCM obj, SCM vx, SCM vy, SCM vz),
887            "Sets the velcity of outgoing droplets from a fountain object")
888 #define FUNC_NAME s_set_fountain_velocity
889 {
890   SCM_ASSERT(IS_ANIMATED(obj), obj, SCM_ARG1, FUNC_NAME);
891   SCM_ASSERT(scm_is_real(vx), vx, SCM_ARG2, FUNC_NAME);
892   SCM_ASSERT(scm_is_real(vy), vy, SCM_ARG3, FUNC_NAME);
893   SCM_ASSERT(scm_is_real(vz), vz, SCM_ARG4, FUNC_NAME);
894   Fountain *fountain = dynamic_cast<Fountain *>((Animated *)SCM_CDR(obj));
895   SCM_ASSERT(fountain, obj, SCM_ARG1, FUNC_NAME);
896   fountain->velocity[0] = scm_to_double(vx);
897   fountain->velocity[1] = scm_to_double(vy);
898   fountain->velocity[2] = scm_to_double(vz);
899   return obj;
900 }
901 #undef FUNC_NAME
902 
903 /************* score-on-death *************/
904 SCM_DEFINE(score_on_death, "score-on-death", 2, 0, 0, (SCM obj, SCM points),
905            "Score to award player when this object dies")
906 #define FUNC_NAME s_score_on_death
907 {
908   SCM_ASSERT(IS_ANIMATED(obj), obj, SCM_ARG1, FUNC_NAME);
909   SCM_ASSERT(scm_is_real(points), points, SCM_ARG2, FUNC_NAME);
910   Animated *animated = (Animated *)SCM_CDR(obj);
911   animated->scoreOnDeath = scm_to_double(points);
912   return SCM_UNSPECIFIED;
913 }
914 #undef FUNC_NAME
915 
916 /************* time-on-death *************/
917 SCM_DEFINE(time_on_death, "time-on-death", 2, 0, 0, (SCM obj, SCM points),
918            "Time to award player when this object dies")
919 #define FUNC_NAME s_time_on_death
920 {
921   SCM_ASSERT(IS_ANIMATED(obj), obj, SCM_ARG1, FUNC_NAME);
922   SCM_ASSERT(scm_is_real(points), points, SCM_ARG2, FUNC_NAME);
923   Animated *animated = (Animated *)SCM_CDR(obj);
924   animated->timeOnDeath = scm_to_double(points);
925   return SCM_UNSPECIFIED;
926 }
927 #undef FUNC_NAME
928 
929 /*=======================================================*/
930 /*===========      creating HOOK objects     ============*/
931 /*=======================================================*/
932 
933 /************** add_cyclic_platform *************/
934 
935 SCM_DEFINE(add_cyclic_platform, "add-cyclic-platform", 8, 0, 0,
936            (SCM x1, SCM y1, SCM x2, SCM y2, SCM low, SCM high, SCM offset, SCM speed),
937            "Creates a new cyclic platform. Returns a 'hook' object.")
938 #define FUNC_NAME s_add_cyclic_platform
939 {
940   const char *s_add_cyclic_platform = "add-cyclic-platform";
941   SCM_ASSERT(scm_is_integer(x1), x1, SCM_ARG1, s_add_cyclic_platform);
942   SCM_ASSERT(scm_is_integer(y1), y1, SCM_ARG2, s_add_cyclic_platform);
943   SCM_ASSERT(scm_is_integer(x2), x2, SCM_ARG3, s_add_cyclic_platform);
944   SCM_ASSERT(scm_is_integer(y2), y2, SCM_ARG4, s_add_cyclic_platform);
945   SCM_ASSERT(scm_is_real(low), low, SCM_ARG5, s_add_cyclic_platform);
946   SCM_ASSERT(scm_is_real(high), high, SCM_ARG6, s_add_cyclic_platform);
947   SCM_ASSERT(scm_is_real(offset), offset, SCM_ARG7, s_add_cyclic_platform);
948   SCM_ASSERT(scm_is_real(speed), speed, SCM_ARG7, s_add_cyclic_platform);
949   if (!Game::current) { return SCM_UNSPECIFIED; }
950   CyclicPlatform *platform = new CyclicPlatform(
951       *Game::current, scm_to_int(x1), scm_to_int(y1), scm_to_int(x2), scm_to_int(y2),
952       scm_to_double(low), scm_to_double(high), scm_to_double(offset), scm_to_double(speed));
953   Game::current->add(platform);
954   return smobGameHook_make(platform);
955 }
956 #undef FUNC_NAME
957 
958 /************* animator **************/
959 SCM_DEFINE(
960     animator, "animator", 7, 0, 0,
961     (SCM length, SCM position, SCM direction, SCM v0, SCM v1, SCM repeat, SCM fun),
962     "Creates an animator object (this is not of class animated!). Returns a 'hook' object")
963 #define FUNC_NAME s_animator
964 {
965   SCM_ASSERT(scm_is_real(length), length, SCM_ARG1, FUNC_NAME);
966   SCM_ASSERT(scm_is_real(position), position, SCM_ARG2, FUNC_NAME);
967   SCM_ASSERT(scm_is_real(direction), direction, SCM_ARG3, FUNC_NAME);
968   SCM_ASSERT(scm_is_real(v0), v0, SCM_ARG4, FUNC_NAME);
969   SCM_ASSERT(scm_is_real(v1), v1, SCM_ARG5, FUNC_NAME);
970   SCM_ASSERT(scm_is_integer(repeat), repeat, SCM_ARG6, FUNC_NAME);
971   SCM_ASSERT(scm_is_bool(fun) | scm_is_true(scm_procedure_p(fun)), fun, SCM_ARG7, FUNC_NAME);
972   if (!Game::current) { return SCM_UNSPECIFIED; }
973   Animator *a = new Animator(*Game::current, scm_to_double(length), scm_to_double(position),
974                              scm_to_double(direction), scm_to_double(v0), scm_to_double(v1),
975                              scm_to_int(repeat), scm_is_bool(fun) ? NULL : fun);
976   Game::current->add(a);
977   return smobGameHook_make(a);
978 }
979 #undef FUNC_NAME
980 
981 /*=======================================================*/
982 /*===========   operations on HOOK objects   ============*/
983 /*=======================================================*/
984 
985 /**************** set_onoff ************/
986 SCM_DEFINE(set_onoff, "set-onoff", 2, 0, 0, (SCM obj, SCM state),
987            "Turns a 'hook' object on/off.")
988 #define FUNC_NAME s_set_onoff
989 {
990   SCM_ASSERT(IS_GAMEHOOK(obj), obj, SCM_ARG1, FUNC_NAME);
991   SCM_ASSERT(scm_is_bool(state), state, SCM_ARG2, FUNC_NAME);
992   GameHook *h = (GameHook *)SCM_CDR(obj);
993   h->is_on = scm_is_true(state);
994   Animated *a = dynamic_cast<Animated *>(h);
995   if (a) { a->drawChanged = true; }
996   return obj;
997 }
998 #undef FUNC_NAME
999 
1000 /************* animator-value **********/
1001 SCM_DEFINE(animator_value, "animator-value", 1, 0, 0, (SCM animator),
1002            "Gets the value from an animator object")
1003 #define FUNC_NAME s_animator_value
1004 {
1005   SCM_ASSERT(IS_GAMEHOOK(animator), animator, SCM_ARG1, FUNC_NAME);
1006   Animator *a = dynamic_cast<Animator *>((GameHook *)SCM_CDR(animator));
1007   SCM_ASSERT(a, animator, SCM_ARG1, FUNC_NAME);
1008   return scm_from_double(a->getValue());
1009 }
1010 #undef FUNC_NAME
1011 
1012 /************* set-animator-direction **********/
1013 SCM_DEFINE(set_animator_direction, "set-animator-direction", 2, 0, 0,
1014            (SCM animator, SCM direction), "Sets the direction of an animator object")
1015 #define FUNC_NAME s_set_animator_direction
1016 {
1017   SCM_ASSERT(IS_GAMEHOOK(animator), animator, SCM_ARG1, FUNC_NAME);
1018   SCM_ASSERT(scm_is_real(direction), direction, SCM_ARG2, FUNC_NAME);
1019   Animator *a = dynamic_cast<Animator *>((GameHook *)SCM_CDR(animator));
1020   SCM_ASSERT(a, animator, SCM_ARG1, FUNC_NAME);
1021   a->direction = scm_to_double(direction);
1022   return animator;
1023 }
1024 #undef FUNC_NAME
1025 
1026 /************* set-animator-position **********/
1027 SCM_DEFINE(set_animator_position, "set-animator-position", 2, 0, 0,
1028            (SCM animator, SCM position), "Sets the position of an animator object")
1029 #define FUNC_NAME s_set_animator_position
1030 {
1031   SCM_ASSERT(IS_GAMEHOOK(animator), animator, SCM_ARG1, FUNC_NAME);
1032   SCM_ASSERT(scm_is_real(position), position, SCM_ARG2, FUNC_NAME);
1033   Animator *a = dynamic_cast<Animator *>((GameHook *)SCM_CDR(animator));
1034   SCM_ASSERT(a, animator, SCM_ARG1, FUNC_NAME);
1035   a->position = std::fmod(scm_to_double(position), a->length);
1036   return animator;
1037 }
1038 #undef FUNC_NAME
1039 
1040 /*=======================================================*/
1041 /*===========        GLOBAL operations       ============*/
1042 /*=======================================================*/
1043 
1044 /************* day / night **************/
1045 SCM_DEFINE(day, "day", 0, 0, 0, (), "Turns on the global light for this level.")
1046 #define FUNC_NAME s_day
1047 {
1048   Game::current->isNight = 0;
1049   Game::current->wantedFogThickness = 0;
1050   return SCM_UNSPECIFIED;
1051 }
1052 #undef FUNC_NAME
1053 
1054 SCM_DEFINE(night, "night", 0, 0, 0, (), "Turns off the global light for this level.")
1055 #define FUNC_NAME s_night
1056 {
1057   Game::current->isNight = 1;
1058   Game::current->wantedFogThickness = 0;
1059   return SCM_UNSPECIFIED;
1060 }
1061 #undef FUNC_NAME
1062 
1063 SCM_DEFINE(fog, "fog", 0, 1, 0, (SCM v), "Turns on a fog.")
1064 #define FUNC_NAME s_fog
1065 {
1066   SCM_ASSERT(scm_is_real(v) || SCM_UNBNDP(v), v, SCM_ARG1, FUNC_NAME);
1067   if (!(scm_is_real(v) && scm_to_double(v) == 0.0)) Game::current->isNight = 0;
1068   if (scm_is_real(v))
1069     Game::current->wantedFogThickness = scm_to_double(v);
1070   else
1071     Game::current->wantedFogThickness = 1.0;
1072   return SCM_UNSPECIFIED;
1073 }
1074 #undef FUNC_NAME
1075 
1076 SCM_DEFINE(thick_fog, "thick-fog", 0, 0, 0, (), "Turns on a thick fog.")
1077 #define FUNC_NAME s_thick_fog
1078 {
1079   Game::current->isNight = 0;
1080   Game::current->wantedFogThickness = 2.0;
1081   return SCM_UNSPECIFIED;
1082 }
1083 #undef FUNC_NAME
1084 
1085 /************* fog_color **************/
1086 SCM_DEFINE(fog_color, "fog-color", 3, 0, 0, (SCM r, SCM g, SCM b), "Specifies color of fog")
1087 #define FUNC_NAME s_fog_color
1088 {
1089   SCM_ASSERT(scm_is_real(r), r, SCM_ARG1, FUNC_NAME);
1090   SCM_ASSERT(scm_is_real(g), g, SCM_ARG2, FUNC_NAME);
1091   SCM_ASSERT(scm_is_real(b), b, SCM_ARG3, FUNC_NAME);
1092   Game::current->fogColor[0] = scm_to_double(r);
1093   Game::current->fogColor[1] = scm_to_double(g);
1094   Game::current->fogColor[2] = scm_to_double(b);
1095   return SCM_UNSPECIFIED;
1096 }
1097 #undef FUNC_NAME
1098 
1099 /************* set_bonus_level ************/
1100 SCM_DEFINE(set_bonus_level, "set-bonus-level", 1, 0, 0, (SCM name),
1101            "Makes level a bonus level and specified return level when this level is finished "
1102            "or player dies.")
1103 #define FUNC_NAME s_set_bonus_level
1104 {
1105   SCM_ASSERT(scm_is_string(name), name, SCM_ARG1, FUNC_NAME);
1106   if (!Game::current) { return SCM_UNSPECIFIED; }
1107   char *sname = scm_to_utf8_string(name);
1108   if (strlen(sname) > 0) {
1109     snprintf(Game::current->returnLevel, sizeof(Game::current->returnLevel), "%s", sname);
1110     Game::current->map->isBonus = 1;
1111   } else
1112     Game::current->map->isBonus = 0;
1113   return SCM_UNSPECIFIED;
1114 }
1115 #undef FUNC_NAME
1116 
1117 /**************** set_track_name **************/
1118 SCM_DEFINE(set_track_name, "set-track-name", 1, 0, 0, (SCM name),
1119            "Sets the name of this track.")
1120 #define FUNC_NAME s_set_track_name
1121 {
1122   SCM_ASSERT(scm_is_string(name), name, SCM_ARG1, s_set_track_name);
1123   if (!Game::current) { return SCM_UNSPECIFIED; }
1124   char *sname = scm_to_utf8_string(name);
1125   strncpy(Game::current->map->mapname, sname, 255);
1126   free(sname);
1127   return SCM_UNSPECIFIED;
1128 }
1129 #undef FUNC_NAME
1130 
1131 /***************** set_author ************/
1132 SCM_DEFINE(set_author, "set-author", 1, 0, 0, (SCM name),
1133            "Sets the name of the author for the current track.")
1134 #define FUNC_NAME s_set_author
1135 {
1136   SCM_ASSERT(scm_is_string(name), name, SCM_ARG1, s_set_author);
1137   if (!Game::current) { return SCM_UNSPECIFIED; }
1138   char *sname = scm_to_utf8_string(name);
1139   strncpy(Game::current->map->author, sname, 255);
1140   free(sname);
1141   return SCM_UNSPECIFIED;
1142 }
1143 #undef FUNC_NAME
1144 
1145 /*********** start_time ************/
1146 SCM_DEFINE(start_time, "start-time", 1, 0, 0, (SCM t),
1147            "Sets the starting time for this track.")
1148 #define FUNC_NAME s_start_time
1149 {
1150   SCM_ASSERT(scm_is_integer(t), t, SCM_ARG1, FUNC_NAME);
1151   int it = scm_to_int(t);
1152   if (Game::current) Game::current->startTime = it;
1153   return SCM_UNSPECIFIED;
1154 }
1155 #undef FUNC_NAME
1156 
1157 /*********** set_time ************/
1158 SCM_DEFINE(set_time, "set-time", 1, 0, 0, (SCM t), "Sets the time left for player.")
1159 #define FUNC_NAME s_set_time
1160 {
1161   SCM_ASSERT(scm_is_integer(t), t, SCM_ARG1, FUNC_NAME);
1162   int it = scm_to_int(t);
1163   if (Game::current && Game::current->player1) Game::current->player1->timeLeft = it;
1164   return SCM_UNSPECIFIED;
1165 }
1166 #undef FUNC_NAME
1167 
1168 /*********** get_time ************/
1169 SCM_DEFINE(get_time, "get-time", 0, 0, 0, (), "Returns how much time the player has left.")
1170 #define FUNC_NAME s_get_time
1171 {
1172   if (Game::current && Game::current->player1) {
1173     return scm_from_int(Game::current->player1->timeLeft);
1174   }
1175   return SCM_UNSPECIFIED;
1176 }
1177 #undef FUNC_NAME
1178 
1179 /*********** add time ************/
1180 SCM_DEFINE(add_time, "add-time", 1, 0, 0, (SCM t), "Adds time for the user.")
1181 #define FUNC_NAME s_add_time
1182 {
1183   SCM_ASSERT(scm_is_integer(t), t, SCM_ARG1, FUNC_NAME);
1184   int it = scm_to_int(t);
1185   if (Game::current && Game::current->player1) {
1186     Game::current->player1->timeLeft += it;
1187     return scm_from_int(Game::current->player1->timeLeft);
1188   } else
1189     return SCM_UNSPECIFIED;
1190 }
1191 #undef FUNC_NAME
1192 
1193 /*********** set_score ************/
1194 SCM_DEFINE(set_score, "set-score", 1, 0, 0, (SCM t), "Sets the score for player.")
1195 #define FUNC_NAME s_set_score
1196 {
1197   SCM_ASSERT(scm_is_integer(t), t, SCM_ARG1, FUNC_NAME);
1198   int it = scm_to_int(t);
1199   if (Game::current && Game::current->player1) Game::current->player1->score = it;
1200   return SCM_UNSPECIFIED;
1201 }
1202 #undef FUNC_NAME
1203 
1204 /*********** get_score ************/
1205 SCM_DEFINE(get_score, "get-score", 0, 0, 0, (), "Returns the players score.")
1206 #define FUNC_NAME s_get_score
1207 {
1208   if (Game::current && Game::current->player1)
1209     return scm_from_int(Game::current->player1->score);
1210   return SCM_UNSPECIFIED;
1211 }
1212 #undef FUNC_NAME
1213 
1214 /*********** add_score ************/
1215 SCM_DEFINE(add_score, "add-score", 1, 0, 0, (SCM t), "Adds points to the players score.")
1216 #define FUNC_NAME s_add_score
1217 {
1218   int it = scm_to_int(t);
1219   if (Game::current && Game::current->player1) {
1220     Game::current->player1->score += it;
1221     return scm_from_int(Game::current->player1->score);
1222   } else
1223     return SCM_UNSPECIFIED;
1224 }
1225 #undef FUNC_NAME
1226 
1227 /*********** set_start_position *************/
1228 SCM_DEFINE(set_start_position, "set-start-position", 2, 0, 0, (SCM x, SCM y),
1229            "Sets the players start position on this level.")
1230 #define FUNC_NAME s_set_start_position
1231 {
1232   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
1233   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
1234   if (!Game::current) { return SCM_UNSPECIFIED; }
1235   Map *map = Game::current->map;
1236   map->startPosition[0] = scm_to_double(x) + DX;
1237   map->startPosition[1] = scm_to_double(y) + DY;
1238   map->startPosition[2] = map->getHeight(map->startPosition[0], map->startPosition[1]);
1239   return SCM_UNSPECIFIED;
1240 }
1241 #undef FUNC_NAME
1242 
1243 /**************** snow *************/
1244 SCM_DEFINE(snow, "snow", 1, 0, 0, (SCM strength), "Turns on snow, 0 <= strength <= 1.0 ")
1245 #define FUNC_NAME s_snow
1246 {
1247   SCM_ASSERT(scm_is_real(strength), strength, SCM_ARG1, FUNC_NAME);
1248   if (Game::current && Game::current->weather)
1249     Game::current->weather->snow(scm_to_double(strength));
1250   return SCM_UNSPECIFIED;
1251 }
1252 #undef FUNC_NAME
1253 
1254 /**************** rain *************/
1255 SCM_DEFINE(rain, "rain", 1, 0, 0, (SCM strength), "Turns on rain, 0 <= strength <= 1.0 ")
1256 #define FUNC_NAME s_rain
1257 {
1258   SCM_ASSERT(scm_is_real(strength), strength, SCM_ARG1, FUNC_NAME);
1259   if (Game::current && Game::current->weather)
1260     Game::current->weather->rain(scm_to_double(strength));
1261   return SCM_UNSPECIFIED;
1262 }
1263 #undef FUNC_NAME
1264 
1265 /*********** difficulty ***********/
1266 SCM_DEFINE(difficulty, "difficulty", 0, 0, 0, (),
1267            "Returns the difficulty we are currently playing on.")
1268 #define FUNC_NAME s_difficulty
1269 {
1270   return scm_from_long(Settings::settings->difficulty);
1271 }
1272 #undef FUNC_NAME
1273 
1274 /*********** use-grid ************/
1275 SCM_DEFINE(use_grid, "use-grid", 1, 0, 0, (SCM v), "Turns the grid on/off")
1276 #define FUNC_NAME s_use_grid
1277 {
1278   warning(
1279       "(use-grid) is deprecated and has no effect; prefer (set-cell-flag) with *cell-nogrid*");
1280   return SCM_UNSPECIFIED;
1281 }
1282 #undef FUNC_NAME
1283 
1284 /*********** jump ************/
1285 SCM_DEFINE(jump, "jump", 1, 0, 0, (SCM v), "Scales maximum jump height of player.")
1286 #define FUNC_NAME s_jump
1287 {
1288   SCM_ASSERT(scm_is_real(v), v, SCM_ARG1, FUNC_NAME);
1289   if (Game::current) Game::current->jumpFactor = scm_to_double(v);
1290   return SCM_UNSPECIFIED;
1291 }
1292 #undef FUNC_NAME
1293 
1294 /*********** scale-oxygen ************/
1295 SCM_DEFINE(scale_oxygen, "scale-oxygen", 1, 0, 0, (SCM v),
1296            "Scales how long player can be under water")
1297 #define FUNC_NAME s_jump
1298 {
1299   SCM_ASSERT(scm_is_real(v), v, SCM_ARG1, FUNC_NAME);
1300   if (Game::current) Game::current->oxygenFactor = scm_to_double(v);
1301   return SCM_UNSPECIFIED;
1302 }
1303 #undef FUNC_NAME
1304 
1305 /************** set-cell-flag ************/
1306 SCM_DEFINE(set_cell_flag, "set-cell-flag", 6, 0, 0,
1307            (SCM x0, SCM y0, SCM x1, SCM y1, SCM flag, SCM state),
1308            "Modifies the flags in a cell")
1309 #define FUNC_NAME s_set_cell_flag
1310 {
1311   SCM_ASSERT(scm_is_integer(x0), x0, SCM_ARG1, FUNC_NAME);
1312   SCM_ASSERT(scm_is_integer(y0), y0, SCM_ARG2, FUNC_NAME);
1313   SCM_ASSERT(scm_is_integer(x1), x1, SCM_ARG3, FUNC_NAME);
1314   SCM_ASSERT(scm_is_integer(y1), y1, SCM_ARG4, FUNC_NAME);
1315   SCM_ASSERT(scm_is_integer(flag), flag, SCM_ARG5, FUNC_NAME);
1316   SCM_ASSERT(scm_is_bool(state), state, SCM_ARG6, FUNC_NAME);
1317   if (Game::current && Game::current->edit_mode) return SCM_UNSPECIFIED;
1318 
1319   int ix0 = scm_to_int(x0), iy0 = scm_to_int(y0), ix1 = scm_to_int(x1), iy1 = scm_to_int(y1),
1320       iflag = scm_to_int(flag);
1321   bool istate = SCM_FALSEP(state);
1322   for (int x = std::min(ix0, ix1); x <= std::max(ix0, ix1); x++) {
1323     for (int y = std::min(iy0, iy1); y <= std::max(iy0, iy1); y++) {
1324       Cell &c = Game::current->map->cell(x, y);
1325       if (istate)
1326         c.flags = c.flags & (~iflag);
1327       else
1328         c.flags = c.flags | iflag;
1329     }
1330   }
1331   Game::current->map->markCellsUpdated(ix0, iy0, ix1, iy1, false);
1332   return SCM_UNSPECIFIED;
1333 }
1334 #undef FUNC_NAME
1335 
1336 /************** get-cell-flag ************/
1337 SCM_DEFINE(get_cell_flag, "get-cell-flag", 3, 0, 0, (SCM x, SCM y, SCM flag),
1338            "Checks if a cell flag is active")
1339 #define FUNC_NAME s_get_cell_flag
1340 {
1341   SCM_ASSERT(scm_is_integer(x), x, SCM_ARG1, FUNC_NAME);
1342   SCM_ASSERT(scm_is_integer(y), y, SCM_ARG2, FUNC_NAME);
1343   SCM_ASSERT(scm_is_integer(flag), flag, SCM_ARG5, FUNC_NAME);
1344   Cell &c = Game::current->map->cell(scm_to_int(x), scm_to_int(y));
1345   if (c.flags & scm_to_int(flag))
1346     return SCM_BOOL_T;
1347   else
1348     return SCM_BOOL_F;
1349 }
1350 #undef FUNC_NAME
1351 
1352 /************** set-cell-velocity ************/
1353 SCM_DEFINE(set_cell_velocity, "set-cell-velocity", 6, 0, 0,
1354            (SCM x0, SCM y0, SCM x1, SCM y1, SCM vx, SCM vy), "Modifies the velocity of a cell")
1355 #define FUNC_NAME s_set_cell_velocity
1356 {
1357   SCM_ASSERT(scm_is_integer(x0), x0, SCM_ARG1, FUNC_NAME);
1358   SCM_ASSERT(scm_is_integer(y0), y0, SCM_ARG2, FUNC_NAME);
1359   SCM_ASSERT(scm_is_integer(x1), x1, SCM_ARG3, FUNC_NAME);
1360   SCM_ASSERT(scm_is_integer(y1), y1, SCM_ARG4, FUNC_NAME);
1361   SCM_ASSERT(scm_is_real(vx), vx, SCM_ARG5, FUNC_NAME);
1362   SCM_ASSERT(scm_is_real(vy), vy, SCM_ARG6, FUNC_NAME);
1363   if (Game::current && Game::current->edit_mode) return SCM_UNSPECIFIED;
1364 
1365   int ix0 = scm_to_int(x0), iy0 = scm_to_int(y0), ix1 = scm_to_int(x1), iy1 = scm_to_int(y1);
1366   float ivx = scm_to_double(vx), ivy = scm_to_double(vy);
1367   for (int x = std::min(ix0, ix1); x <= std::max(ix0, ix1); x++) {
1368     for (int y = std::min(iy0, iy1); y <= std::max(iy0, iy1); y++) {
1369       Cell &c = Game::current->map->cell(x, y);
1370       c.velocity[0] = ivx;
1371       c.velocity[1] = ivy;
1372     }
1373   }
1374   Game::current->map->markCellsUpdated(ix0, iy0, ix1, iy1, false);
1375   return SCM_UNSPECIFIED;
1376 }
1377 #undef FUNC_NAME
1378 
1379 /************** set-cell-heights ************/
1380 SCM_DEFINE(set_cell_heights, "set-cell-heights", 8, 1, 0,
1381            (SCM x0, SCM y0, SCM x1, SCM y1, SCM h0, SCM h1, SCM h2, SCM h3, SCM h4),
1382            "Modifies the heights of a cell")
1383 #define FUNC_NAME s_set_cell_heights
1384 {
1385   SCM_ASSERT(scm_is_integer(x0), x0, SCM_ARG1, FUNC_NAME);
1386   SCM_ASSERT(scm_is_integer(y0), y0, SCM_ARG2, FUNC_NAME);
1387   SCM_ASSERT(scm_is_integer(x1), x1, SCM_ARG3, FUNC_NAME);
1388   SCM_ASSERT(scm_is_integer(y1), y1, SCM_ARG4, FUNC_NAME);
1389   SCM_ASSERT(scm_is_real(h0), h0, SCM_ARG5, FUNC_NAME);
1390   SCM_ASSERT(scm_is_real(h1), h1, SCM_ARG6, FUNC_NAME);
1391   SCM_ASSERT(scm_is_real(h2), h2, SCM_ARG7, FUNC_NAME);
1392   SCM_ASSERT(scm_is_real(h3), h3, SCM_ARG7, FUNC_NAME);
1393   if (Game::current && Game::current->edit_mode) return SCM_UNSPECIFIED;
1394 
1395   int ix0 = scm_to_int(x0), iy0 = scm_to_int(y0), ix1 = scm_to_int(x1), iy1 = scm_to_int(y1);
1396   double ih0 = scm_to_double(h0), ih1 = scm_to_double(h1), ih2 = scm_to_double(h2),
1397          ih3 = scm_to_double(h3);
1398   double ih4;
1399   if (scm_is_real(h4)) {
1400     ih4 = scm_to_double(h4);
1401   } else {
1402     ih4 = (ih0 + ih1 + ih2 + ih3) / 4.;
1403   }
1404   for (int x = std::min(ix0, ix1); x <= std::max(ix0, ix1); x++) {
1405     for (int y = std::min(iy0, iy1); y <= std::max(iy0, iy1); y++) {
1406       Cell &c = Game::current->map->cell(x, y);
1407       c.heights[0] = ih0;
1408       c.heights[1] = ih1;
1409       c.heights[2] = ih2;
1410       c.heights[3] = ih3;
1411       c.heights[4] = ih4;
1412     }
1413   }
1414   Game::current->map->markCellsUpdated(ix0, iy0, ix1, iy1, true);
1415   return SCM_UNSPECIFIED;
1416 }
1417 #undef FUNC_NAME
1418 
1419 /************** set-cell-water-heights ************/
1420 SCM_DEFINE(set_cell_water_heights, "set-cell-water-heights", 8, 1, 0,
1421            (SCM x0, SCM y0, SCM x1, SCM y1, SCM h0, SCM h1, SCM h2, SCM h3, SCM h4),
1422            "Modifies the water heights of a cell")
1423 #define FUNC_NAME s_set_cell_water_heights
1424 {
1425   SCM_ASSERT(scm_is_integer(x0), x0, SCM_ARG1, FUNC_NAME);
1426   SCM_ASSERT(scm_is_integer(y0), y0, SCM_ARG2, FUNC_NAME);
1427   SCM_ASSERT(scm_is_integer(x1), x1, SCM_ARG3, FUNC_NAME);
1428   SCM_ASSERT(scm_is_integer(y1), y1, SCM_ARG4, FUNC_NAME);
1429   SCM_ASSERT(scm_is_real(h0), h0, SCM_ARG5, FUNC_NAME);
1430   SCM_ASSERT(scm_is_real(h1), h1, SCM_ARG6, FUNC_NAME);
1431   SCM_ASSERT(scm_is_real(h2), h2, SCM_ARG7, FUNC_NAME);
1432   SCM_ASSERT(scm_is_real(h3), h3, SCM_ARG7, FUNC_NAME);
1433   if (Game::current && Game::current->edit_mode) return SCM_UNSPECIFIED;
1434 
1435   int ix0 = scm_to_int(x0), iy0 = scm_to_int(y0), ix1 = scm_to_int(x1), iy1 = scm_to_int(y1);
1436   double ih0 = scm_to_double(h0), ih1 = scm_to_double(h1), ih2 = scm_to_double(h2),
1437          ih3 = scm_to_double(h3);
1438   double ih4;
1439   if (scm_is_real(h4)) {
1440     ih4 = scm_to_double(h4);
1441   } else {
1442     ih4 = (ih0 + ih1 + ih2 + ih3) / 4.;
1443   }
1444   for (int x = std::min(ix0, ix1); x <= std::max(ix0, ix1); x++) {
1445     for (int y = std::min(iy0, iy1); y <= std::max(iy0, iy1); y++) {
1446       Cell &c = Game::current->map->cell(x, y);
1447       c.waterHeights[0] = ih0;
1448       c.waterHeights[1] = ih1;
1449       c.waterHeights[2] = ih2;
1450       c.waterHeights[3] = ih3;
1451       c.waterHeights[4] = ih4;
1452     }
1453   }
1454   Game::current->map->markCellsUpdated(ix0, iy0, ix1, iy1, false);
1455   return SCM_UNSPECIFIED;
1456 }
1457 #undef FUNC_NAME
1458 
1459 /************** set-cell-colors ************/
1460 SCM_DEFINE(set_cell_colors, "set-cell-colors", 8, 1, 0,
1461            (SCM x0, SCM y0, SCM x1, SCM y1, SCM corner, SCM r, SCM g, SCM b, SCM a),
1462            "Modifies the colors of a cell")
1463 #define FUNC_NAME s_set_cell_colors
1464 {
1465   SCM_ASSERT(scm_is_integer(x0), x0, SCM_ARG1, FUNC_NAME);
1466   SCM_ASSERT(scm_is_integer(y0), y0, SCM_ARG2, FUNC_NAME);
1467   SCM_ASSERT(scm_is_integer(x1), x1, SCM_ARG3, FUNC_NAME);
1468   SCM_ASSERT(scm_is_integer(y1), y1, SCM_ARG4, FUNC_NAME);
1469   SCM_ASSERT(scm_is_integer(corner), corner, SCM_ARG5, FUNC_NAME);
1470   SCM_ASSERT(scm_is_real(r), r, SCM_ARG6, FUNC_NAME);
1471   SCM_ASSERT(scm_is_real(g), g, SCM_ARG7, FUNC_NAME);
1472   SCM_ASSERT(scm_is_real(b), b, SCM_ARG7, FUNC_NAME);
1473   int i = scm_to_int(corner);
1474   SCM_ASSERT(i >= 0 && i <= 5, corner, SCM_ARG5, FUNC_NAME);
1475   if (Game::current && Game::current->edit_mode) return SCM_UNSPECIFIED;
1476 
1477   int ix0 = scm_to_int(x0), iy0 = scm_to_int(y0), ix1 = scm_to_int(x1), iy1 = scm_to_int(y1);
1478   GLfloat ir = scm_to_double(r), ig = scm_to_double(g), ib = scm_to_double(r);
1479   GLfloat ia = scm_is_real(a) ? scm_to_double(a) : 1.0;
1480   Color color(ir, ig, ib, ia);
1481   for (int x = std::min(ix0, ix1); x <= std::max(ix0, ix1); x++) {
1482     for (int y = std::min(iy0, iy1); y <= std::max(iy0, iy1); y++) {
1483       Cell &c = Game::current->map->cell(x, y);
1484       c.colors[i] = color;
1485     }
1486   }
1487   Game::current->map->markCellsUpdated(ix0, iy0, ix1, iy1, false);
1488   return SCM_UNSPECIFIED;
1489 }
1490 #undef FUNC_NAME
1491 
1492 /************** set-cell-wall-colors ************/
1493 SCM_DEFINE(set_cell_wall_colors, "set-cell-wall-colors", 8, 1, 0,
1494            (SCM x0, SCM y0, SCM x1, SCM y1, SCM corner, SCM r, SCM g, SCM b, SCM a),
1495            "Modifies the wall colors of cells")
1496 #define FUNC_NAME s_set_cell_wall_colors
1497 {
1498   SCM_ASSERT(scm_is_integer(x0), x0, SCM_ARG1, FUNC_NAME);
1499   SCM_ASSERT(scm_is_integer(y0), y0, SCM_ARG2, FUNC_NAME);
1500   SCM_ASSERT(scm_is_integer(x1), x1, SCM_ARG3, FUNC_NAME);
1501   SCM_ASSERT(scm_is_integer(y1), y1, SCM_ARG4, FUNC_NAME);
1502   SCM_ASSERT(scm_is_integer(corner), corner, SCM_ARG5, FUNC_NAME);
1503   SCM_ASSERT(scm_is_real(r), r, SCM_ARG6, FUNC_NAME);
1504   SCM_ASSERT(scm_is_real(g), g, SCM_ARG7, FUNC_NAME);
1505   SCM_ASSERT(scm_is_real(b), b, SCM_ARG7, FUNC_NAME);
1506   int i = scm_to_int(corner);
1507   SCM_ASSERT(i >= 0 && i <= 4, corner, SCM_ARG5, FUNC_NAME);
1508   if (Game::current && Game::current->edit_mode) return SCM_UNSPECIFIED;
1509 
1510   int ix0 = scm_to_int(x0), iy0 = scm_to_int(y0), ix1 = scm_to_int(x1), iy1 = scm_to_int(y1);
1511   GLfloat ir = scm_to_double(r), ig = scm_to_double(g), ib = scm_to_double(r);
1512   GLfloat ia = scm_is_real(a) ? scm_to_double(a) : 1.0;
1513   Color color(ir, ig, ib, ia);
1514   for (int x = std::min(ix0, ix1); x <= std::max(ix0, ix1); x++) {
1515     for (int y = std::min(iy0, iy1); y <= std::max(iy0, iy1); y++) {
1516       Cell &c = Game::current->map->cell(x, y);
1517       c.wallColors[i] = color;
1518     }
1519   }
1520   Game::current->map->markCellsUpdated(ix0, iy0, ix1, iy1, true);
1521   return SCM_UNSPECIFIED;
1522 }
1523 #undef FUNC_NAME
1524 
1525 /************** copy-cells ************/
1526 SCM_DEFINE(copy_cells, "copy-cells", 9, 0, 0,
1527            (SCM x0, SCM y0, SCM x1, SCM y1, SCM x2, SCM y2, SCM flipx, SCM flipy, SCM transp),
1528            "Copies and reflects or rotates a rectangle of cells to new coordinates")
1529 #define FUNC_NAME s_copy_cells
1530 {
1531   SCM_ASSERT(scm_is_integer(x0), x0, SCM_ARG1, FUNC_NAME);
1532   SCM_ASSERT(scm_is_integer(y0), y0, SCM_ARG2, FUNC_NAME);
1533   SCM_ASSERT(scm_is_integer(x1), x1, SCM_ARG3, FUNC_NAME);
1534   SCM_ASSERT(scm_is_integer(y1), y1, SCM_ARG4, FUNC_NAME);
1535   SCM_ASSERT(scm_is_integer(x2), x2, SCM_ARG5, FUNC_NAME);
1536   SCM_ASSERT(scm_is_integer(y2), y2, SCM_ARG6, FUNC_NAME);
1537   SCM_ASSERT(scm_is_bool(flipx), flipx, SCM_ARG7, FUNC_NAME);
1538   SCM_ASSERT(scm_is_bool(flipy), flipy, 8, FUNC_NAME);
1539   SCM_ASSERT(scm_is_bool(transp), transp, 9, FUNC_NAME);
1540   if (Game::current && Game::current->edit_mode) return SCM_UNSPECIFIED;
1541 
1542   int ix0 = scm_to_int(x0), iy0 = scm_to_int(y0), ix1 = scm_to_int(x1), iy1 = scm_to_int(y1);
1543   int tx = scm_to_int(x2), ty = scm_to_int(y2);
1544   int fx = scm_to_bool(flipx), fy = scm_to_bool(flipy), fxy = scm_to_bool(transp);
1545   // Load region into memory
1546   Map *map = Game::current->map;
1547   int w = std::abs(ix0 - ix1) + 1;
1548   int h = std::abs(iy0 - iy1) + 1;
1549   int xs = ix1 > ix0 ? 1 : -1;
1550   int ys = iy1 > iy0 ? 1 : -1;
1551   Cell *buf = new Cell[w * h];
1552   for (int x = 0; x < w; x++) {
1553     for (int y = 0; y < h; y++) { buf[y * w + x] = map->cell(ix0 + xs * x, iy0 + ys * y); }
1554   }
1555   // Paste with transformation
1556   xs *= fx ? -1 : 1;
1557   ys *= fy ? -1 : 1;
1558   for (int x = 0; x < w; x++) {
1559     for (int y = 0; y < h; y++) {
1560       int dx, dy;
1561       if (fxy) {
1562         dx = tx + ys * y;
1563         dy = ty + xs * x;
1564       } else {
1565         dx = tx + xs * x;
1566         dy = ty + ys * y;
1567       }
1568       map->cell(dx, dy) = buf[y * w + x];
1569     }
1570   }
1571   if (fxy) {
1572     map->markCellsUpdated(tx, ty, tx + ys * h, ty + xs * w, true);
1573   } else {
1574     map->markCellsUpdated(tx, ty, tx + xs * w, ty + ys * h, true);
1575   }
1576   delete[] buf;
1577   return SCM_UNSPECIFIED;
1578 }
1579 #undef FUNC_NAME
1580 
1581 /************ play_effect ************/
1582 SCM_DEFINE(play_effect, "play-effect", 1, 0, 0, (SCM name), "Attempts to play a soundeffect")
1583 #define FUNC_NAME s_play_effect
1584 {
1585   SCM_ASSERT(scm_is_string(name), name, SCM_ARG1, FUNC_NAME);
1586   playEffect(scm_to_utf8_string(name));
1587   return SCM_UNSPECIFIED;
1588 }
1589 #undef FUNC_NAME
1590 
1591 /************* camera-angle ***********/
1592 SCM_DEFINE(camera_angle, "camera-angle", 2, 0, 0, (SCM xy, SCM z),
1593            "Sets camera xy and z-angle")
1594 #define FUNC_NAME s_camera_angle
1595 {
1596   SCM_ASSERT(scm_is_real(xy), xy, SCM_ARG1, FUNC_NAME);
1597   SCM_ASSERT(scm_is_real(z), z, SCM_ARG2, FUNC_NAME);
1598   ((MainMode *)GameMode::current)->wantedXYAngle = scm_to_double(xy);
1599   ((MainMode *)GameMode::current)->wantedZAngle = scm_to_double(z);
1600   return SCM_UNSPECIFIED;
1601 }
1602 #undef FUNC_NAME
1603 
1604 /************* camera-force-focus ***********/
1605 SCM_DEFINE(camera_force_focus, "camera-force-focus", 3, 0, 0, (SCM x, SCM y, SCM z),
1606            "Immediately set camera focus to new location. (Camera then drifts to player.)")
1607 #define FUNC_NAME s_camera_force_focus
1608 {
1609   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
1610   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
1611   SCM_ASSERT(scm_is_real(z), z, SCM_ARG3, FUNC_NAME);
1612   Coord3d &c = ((MainMode *)GameMode::current)->camFocus;
1613   c[0] = scm_to_double(x) + DX;
1614   c[1] = scm_to_double(y) + DY;
1615   c[2] = scm_to_double(z);
1616   return SCM_UNSPECIFIED;
1617 }
1618 #undef FUNC_NAME
1619 
1620 /************* restart-time ***********/
1621 /* DEPRECATED! */
1622 SCM_DEFINE(restart_time, "restart-time", 1, 0, 0, (SCM t), "Sets the timebonus after death.")
1623 #define FUNC_NAME s_restart_time
1624 {
1625   SCM_ASSERT(scm_is_real(t), t, SCM_ARG1, FUNC_NAME);
1626   if (Game::current && Game::current->player1)
1627     Game::current->player1->timeOnDeath = scm_to_double(t);
1628   return SCM_UNSPECIFIED;
1629 }
1630 #undef FUNC_NAME
1631 
1632 /************* clear-song-preferences ***********/
1633 SCM_DEFINE(clear_song_preferences, "clear-song-preferences", 0, 0, 0, (),
1634            "Removes all old music preferences")
1635 #define FUNC_NAME s_clear_song_preferences
1636 {
1637   clearMusicPreferences();
1638   return SCM_UNSPECIFIED;
1639 }
1640 #undef FUNC_NAME
1641 
1642 /************* force-next-song ***********/
1643 SCM_DEFINE(force_next_song, "force-next-song", 0, 0, 0, (), "Force a reload of songs")
1644 #define FUNC_NAME s_force_next_song
1645 {
1646   playNextSong();
1647   return SCM_UNSPECIFIED;
1648 }
1649 #undef FUNC_NAME
1650 
1651 /************* set-song-preferences ***********/
1652 SCM_DEFINE(set_song_preference, "set-song-preference", 2, 0, 0, (SCM song, SCM weight),
1653            "Set the weight for playing given song")
1654 #define FUNC_NAME s_set_song_preference
1655 {
1656   SCM_ASSERT(scm_is_string(song), song, SCM_ARG1, FUNC_NAME);
1657   SCM_ASSERT(scm_is_real(weight), weight, SCM_ARG2, FUNC_NAME);
1658 
1659   char *songName = scm_to_utf8_string(song);
1660   if (songName) { setMusicPreference(songName, scm_to_int(weight)); }
1661   return SCM_UNSPECIFIED;
1662 }
1663 #undef FUNC_NAME
1664 
1665 /*=======================================================*/
1666 /*===========             CALLBACKS          ============*/
1667 /*=======================================================*/
1668 
1669 /*********** trigger ************/
1670 SCM_DEFINE(trigger, "trigger", 4, 0, 0, (SCM x, SCM y, SCM r, SCM expr),
1671            "Call expr when player is within given radius.")
1672 #define FUNC_NAME s_trigger
1673 {
1674   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
1675   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
1676   SCM_ASSERT(scm_is_real(r), r, SCM_ARG3, FUNC_NAME);
1677   SCM_ASSERT(scm_is_true(scm_procedure_p(expr)), expr, SCM_ARG4, FUNC_NAME);
1678   if (!Game::current) { return SCM_UNSPECIFIED; }
1679   Trigger *trigger = new Trigger(*Game::current, scm_to_double(x) + DX, scm_to_double(y) + DY,
1680                                  scm_to_double(r), expr);
1681   Game::current->add(trigger);
1682   return smobGameHook_make(trigger);
1683 }
1684 #undef FUNC_NAME
1685 
1686 /*********** smart-trigger ************/
1687 SCM_DEFINE(smart_trigger, "smart-trigger", 5, 0, 0,
1688            (SCM x, SCM y, SCM r, SCM entering, SCM leaving),
1689            "Call expr when player is within given radius.")
1690 #define FUNC_NAME s_smart_trigger
1691 {
1692   SCM_ASSERT(scm_is_real(x), x, SCM_ARG1, FUNC_NAME);
1693   SCM_ASSERT(scm_is_real(y), y, SCM_ARG2, FUNC_NAME);
1694   SCM_ASSERT(scm_is_real(r), r, SCM_ARG3, FUNC_NAME);
1695   if (scm_is_false(entering))
1696     entering = NULL;
1697   else
1698     SCM_ASSERT(scm_is_true(scm_procedure_p(entering)), entering, SCM_ARG4, FUNC_NAME);
1699   if (scm_is_false(leaving))
1700     leaving = NULL;
1701   else
1702     SCM_ASSERT(scm_is_true(scm_procedure_p(leaving)), leaving, SCM_ARG5, FUNC_NAME);
1703   if (!Game::current) { return SCM_UNSPECIFIED; }
1704   SmartTrigger *st =
1705       new SmartTrigger(*Game::current, scm_to_double(x) + DX, scm_to_double(y) + DY,
1706                        scm_to_double(r), entering, leaving);
1707   Game::current->add(st);
1708   return smobGameHook_make(st);
1709 }
1710 #undef FUNC_NAME
1711 
1712 /************ hooks to arbitrary objects and events **********/
1713 SCM_DEFINE(on_event, "on-event", 3, 0, 0, (SCM event, SCM subject, SCM callback),
1714            "Register a callback to be triggered when the given event occurs for the given "
1715            "object. Callback must accept two arguments (subject and object). Subject must be "
1716            "of type 'animated' or of type 'gameHook', object is only used for some events and "
1717            "is otherwise false.")
1718 #define FUNC_NAME s_on_event
1719 {
1720   SCM_ASSERT(scm_is_real(event), event, SCM_ARG1, FUNC_NAME);
1721   SCM_ASSERT(IS_ANIMATED(subject) || IS_GAMEHOOK(subject), subject, SCM_ARG2, FUNC_NAME);
1722   SCM_ASSERT(scm_is_false(callback) || scm_is_true(scm_procedure_p(callback)), callback,
1723              SCM_ARG3, FUNC_NAME);
1724   /* It is safe to always cast pointer into a GameHook since Animated
1725      objects inherit from GameHook */
1726   GameHook *h = (GameHook *)SCM_CDR(subject);
1727   h->registerHook((GameHookEvent)(int)scm_to_double(event),
1728                   SCM_FALSEP(callback) ? NULL : callback);
1729   return subject;
1730 }
1731 #undef FUNC_NAME
1732 
1733 /*** Returns currently registered hook to an object for an event */
1734 SCM_DEFINE(get_event_callback, "get-event-callback", 2, 0, 0, (SCM event, SCM subject),
1735            "Returns the callback currently registerd to the given object and event.")
1736 #define FUNC_NAME s_get_event_callback
1737 {
1738   SCM_ASSERT(scm_is_real(event), event, SCM_ARG1, FUNC_NAME);
1739   SCM_ASSERT(IS_ANIMATED(subject) || IS_GAMEHOOK(subject), subject, SCM_ARG2, FUNC_NAME);
1740   /* It is safe to always cast pointer into a GameHook since Animated
1741      objects inherit from GameHook */
1742   GameHook *h = (GameHook *)SCM_CDR(subject);
1743   SCM callback = h->getHook((GameHookEvent)(int)scm_to_double(event));
1744   if (callback)
1745     return callback;
1746   else
1747     return SCM_BOOL_F;
1748 }
1749 #undef FUNC_NAME
1750 
1751 /*=======================================================*/
1752 /*===========             CONSTANTS          ============*/
1753 /*=======================================================*/
1754 
1755 SCM_GLOBAL_VARIABLE_INIT(s_mod_speed, "*mod-speed*", scm_from_long(MOD_SPEED));
1756 SCM_GLOBAL_VARIABLE_INIT(s_mod_jump, "*mod-jump*", scm_from_long(MOD_JUMP));
1757 SCM_GLOBAL_VARIABLE_INIT(s_mod_spike, "*mod-spike*", scm_from_long(MOD_SPIKE));
1758 SCM_GLOBAL_VARIABLE_INIT(s_mod_glass, "*mod-glass*", scm_from_long(MOD_GLASS));
1759 SCM_GLOBAL_VARIABLE_INIT(s_mod_dizzy, "*mod-dizzy*", scm_from_long(MOD_DIZZY));
1760 SCM_GLOBAL_VARIABLE_INIT(s_mod_frozen, "*mod-frozen*", scm_from_long(MOD_FROZEN));
1761 SCM_GLOBAL_VARIABLE_INIT(s_mod_float, "*mod-float*", scm_from_long(MOD_FLOAT));
1762 SCM_GLOBAL_VARIABLE_INIT(s_mod_extra_life, "*mod-extra-life*", scm_from_long(MOD_EXTRA_LIFE));
1763 SCM_GLOBAL_VARIABLE_INIT(s_mod_large, "*mod-large*", scm_from_long(MOD_LARGE));
1764 SCM_GLOBAL_VARIABLE_INIT(s_mod_small, "*mod-small*", scm_from_long(MOD_SMALL));
1765 SCM_GLOBAL_VARIABLE_INIT(s_mod_nitro, "*mod-nitro*", scm_from_long(MOD_NITRO));
1766 
1767 SCM_GLOBAL_VARIABLE_INIT(s_easy, "*easy*", scm_from_long(0));
1768 SCM_GLOBAL_VARIABLE_INIT(s_normal, "*normal*", scm_from_long(1));
1769 SCM_GLOBAL_VARIABLE_INIT(s_hard, "*hard*", scm_from_long(2));
1770 
1771 SCM_GLOBAL_VARIABLE_INIT(s_ff_nothing, "*ff-nothing*", scm_from_long(0));
1772 SCM_GLOBAL_VARIABLE_INIT(s_ff_kill1, "*ff-kill1*", scm_from_long(FF_KILL1));
1773 SCM_GLOBAL_VARIABLE_INIT(s_ff_bounce1, "*ff-bounce1*", scm_from_long(FF_BOUNCE1));
1774 SCM_GLOBAL_VARIABLE_INIT(s_ff_kill2, "*ff-kill2*", scm_from_long(FF_KILL2));
1775 SCM_GLOBAL_VARIABLE_INIT(s_ff_bounce2, "*ff-bounce2*", scm_from_long(FF_BOUNCE2));
1776 SCM_GLOBAL_VARIABLE_INIT(s_ff_bounce, "*ff-bounce*", scm_from_long(FF_BOUNCE1 + FF_BOUNCE2));
1777 SCM_GLOBAL_VARIABLE_INIT(s_ff_kill, "*ff-kill*", scm_from_long(FF_KILL1 + FF_KILL2));
1778 
1779 SCM_GLOBAL_VARIABLE_INIT(s_soft_enter, "*soft-enter*", scm_from_long(PIPE_SOFT_ENTER));
1780 SCM_GLOBAL_VARIABLE_INIT(s_soft_exit, "*soft-exit*", scm_from_long(PIPE_SOFT_EXIT));
1781 
1782 SCM_GLOBAL_VARIABLE_INIT(s_cell_ice, "*cell-ice*", scm_from_long(CELL_ICE));
1783 SCM_GLOBAL_VARIABLE_INIT(s_cell_acid, "*cell-acid*", scm_from_long(CELL_ACID));
1784 SCM_GLOBAL_VARIABLE_INIT(s_cell_sand, "*cell-sand*", scm_from_long(CELL_SAND));
1785 SCM_GLOBAL_VARIABLE_INIT(s_cell_kill, "*cell-kill*", scm_from_long(CELL_KILL));
1786 SCM_GLOBAL_VARIABLE_INIT(s_cell_trampoline, "*cell-trampoline*",
1787                          scm_from_long(CELL_TRAMPOLINE));
1788 SCM_GLOBAL_VARIABLE_INIT(s_cell_nogrid, "*cell-nogrid*", scm_from_long(CELL_NOGRID));
1789 SCM_GLOBAL_VARIABLE_INIT(s_cell_track, "*cell-track*", scm_from_long(CELL_TRACK));
1790 
1791 SCM_GLOBAL_VARIABLE_INIT(s_animator_0_remove, "*animator-0-remove*",
1792                          scm_from_long(ANIMATOR_0_REMOVE));
1793 SCM_GLOBAL_VARIABLE_INIT(s_animator_0_stop, "*animator-0-stop*",
1794                          scm_from_long(ANIMATOR_0_STOP));
1795 SCM_GLOBAL_VARIABLE_INIT(s_animator_0_bounce, "*animator-0-bounce*",
1796                          scm_from_long(ANIMATOR_0_BOUNCE));
1797 SCM_GLOBAL_VARIABLE_INIT(s_animator_0_wrap, "*animator-0-wrap*",
1798                          scm_from_long(ANIMATOR_0_WRAP));
1799 SCM_GLOBAL_VARIABLE_INIT(s_animator_1_remove, "*animator-1-remove*",
1800                          scm_from_long(ANIMATOR_1_REMOVE));
1801 SCM_GLOBAL_VARIABLE_INIT(s_animator_1_stop, "*animator-1-stop*",
1802                          scm_from_long(ANIMATOR_1_STOP));
1803 SCM_GLOBAL_VARIABLE_INIT(s_animator_1_bounce, "*animator-1-bounce*",
1804                          scm_from_long(ANIMATOR_1_BOUNCE));
1805 SCM_GLOBAL_VARIABLE_INIT(s_animator_1_wrap, "*animator-1-wrap*",
1806                          scm_from_long(ANIMATOR_1_WRAP));
1807 SCM_GLOBAL_VARIABLE_INIT(s_animator_remove, "*animator-remove*",
1808                          scm_from_long(ANIMATOR_0_REMOVE + ANIMATOR_1_REMOVE));
1809 SCM_GLOBAL_VARIABLE_INIT(s_animator_stop, "*animator-stop*",
1810                          scm_from_long(ANIMATOR_0_STOP + ANIMATOR_1_STOP));
1811 SCM_GLOBAL_VARIABLE_INIT(s_animator_wrap, "*animator-bounce*",
1812                          scm_from_long(ANIMATOR_0_BOUNCE + ANIMATOR_1_BOUNCE));
1813 SCM_GLOBAL_VARIABLE_INIT(s_animator_bounce, "*animator-wrap*",
1814                          scm_from_long(ANIMATOR_0_WRAP + ANIMATOR_1_WRAP));
1815 
1816 SCM_GLOBAL_VARIABLE_INIT(s_cell_ne, "*cell-ne*", scm_from_long(Cell::NORTH + Cell::EAST));
1817 SCM_GLOBAL_VARIABLE_INIT(s_cell_nw, "*cell-nw*", scm_from_long(Cell::NORTH + Cell::WEST));
1818 SCM_GLOBAL_VARIABLE_INIT(s_cell_se, "*cell-se*", scm_from_long(Cell::SOUTH + Cell::EAST));
1819 SCM_GLOBAL_VARIABLE_INIT(s_cell_sw, "*cell-sw*", scm_from_long(Cell::SOUTH + Cell::WEST));
1820 SCM_GLOBAL_VARIABLE_INIT(s_cell_center, "*cell-center*", scm_from_long(Cell::CENTER));
1821 
1822 /** flags for animated objects **/
1823 SCM_GLOBAL_VARIABLE_INIT(s_bird_ch, "*bird-constant-height*",
1824                          scm_from_long(BIRD_CONSTANT_HEIGHT));
1825 
1826 SCM_GLOBAL_VARIABLE_INIT(s_event_death, "*death*", scm_from_long(GameHookEvent_Death));
1827 SCM_GLOBAL_VARIABLE_INIT(s_event_spawn, "*spawn*", scm_from_long(GameHookEvent_Spawn));
1828 SCM_GLOBAL_VARIABLE_INIT(s_event_tick, "*tick*", scm_from_long(GameHookEvent_Tick));
1829 
1830 SCM_GLOBAL_VARIABLE_INIT(s_score_player, "*score-player*", scm_from_long(SCORE_PLAYER));
1831 SCM_GLOBAL_VARIABLE_INIT(s_score_black, "*score-black*", scm_from_long(SCORE_BLACK));
1832 SCM_GLOBAL_VARIABLE_INIT(s_score_baby, "*score-baby*", scm_from_long(SCORE_BABY));
1833 SCM_GLOBAL_VARIABLE_INIT(s_score_bird, "*score-bird*", scm_from_long(SCORE_BIRD));
1834 SCM_GLOBAL_VARIABLE_INIT(s_score_cactus, "*score-cactus*", scm_from_long(SCORE_CACTUS));
1835 SCM_GLOBAL_VARIABLE_INIT(s_score_flag, "*score-flag*", scm_from_long(SCORE_FLAG));
1836 
initGuileInterface()1837 void initGuileInterface() {
1838   smobAnimated_tag = scm_make_smob_type("Animated", 0);
1839   scm_set_smob_free(smobAnimated_tag, smobAnimated_free);
1840 
1841   smobGameHook_tag = scm_make_smob_type("GameHook", 0);
1842   scm_set_smob_free(smobGameHook_tag, smobGameHook_free);
1843 
1844 #include "guile.cc.x"
1845 }
1846