ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/server/cfperl.xs
(Generate patch)

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.5 by root, Thu Aug 24 13:13:49 2006 UTC vs.
Revision 1.18 by root, Mon Aug 28 07:07:42 2006 UTC

… …
28#include <XSUB.h> 28#include <XSUB.h>
29 29
30#undef save_long // clashes with libproto.h 30#undef save_long // clashes with libproto.h
31 31
32#define PLUGIN_NAME "perl" 32#define PLUGIN_NAME "perl"
33#define PLUGIN_VERSION "cfperl 0.3" 33#define PLUGIN_VERSION "cfperl 0.5"
34 34
35#ifndef __CEXTRACT__ 35#ifndef __CEXTRACT__
36#include <plugin.h> 36#include <plugin.h>
37#endif 37#endif
38 38
… …
42#define MODULEAPI 42#define MODULEAPI
43#endif 43#endif
44 44
45#include <plugin_common.h> 45#include <plugin_common.h>
46#include <sounds.h> 46#include <sounds.h>
47
48#include <stdarg.h> 47#include <cstdarg>
49
50#include <sproto.h> 48#include <sproto.h>
51 49
52//#include "EventAPI.h" 50#include "cfperl.h"
51#include "shstr.h"
52
53#include "perlxsi.c" 53#include "perlxsi.c"
54
55static void *globalEventListener (int *type, ...);
56 54
57extern sint64 *levels; // the experience table 55extern sint64 *levels; // the experience table
58 56
59typedef object object_ornull; 57typedef object object_ornull;
60typedef mapstruct mapstruct_ornull; 58typedef mapstruct mapstruct_ornull;
… …
62typedef double val64; 60typedef double val64;
63#define newSVval64 newSVnv 61#define newSVval64 newSVnv
64#define SvVAL64 SvNV 62#define SvVAL64 SvNV
65 63
66static f_plug_api gethook; 64static f_plug_api gethook;
67static f_plug_api registerGlobalEvent;
68static f_plug_api unregisterGlobalEvent;
69static f_plug_api systemDirectory; 65static f_plug_api systemDirectory;
70static f_plug_api object_set_property; 66static f_plug_api object_set_property;
71static f_plug_api map_get_map; 67static f_plug_api map_get_map;
72static f_plug_api object_insert; 68static f_plug_api object_insert;
73 69
… …
88} CFPContext; 84} CFPContext;
89 85
90static HV *obj_cache; 86static HV *obj_cache;
91static PerlInterpreter *perl; 87static PerlInterpreter *perl;
92 88
89static AV *cb_global, *cb_object, *cb_player, *cb_type, *cb_map;
90
93#define PUSHcfapi(type,value) PUSHs (sv_2mortal (newSVcfapi (CFAPI_ ## type, (value)))) 91#define PUSHcfapi(type,value) PUSHs (sv_2mortal (newSVcfapi (CFAPI_ ## type, (value))))
94#define PUSHcfapi_va(type,ctype) PUSHcfapi (type, va_arg (args, ctype)) 92#define PUSHcfapi_va(type,ctype) PUSHcfapi (type, va_arg (args, ctype))
95#define PUSH_OB PUSHcfapi_va(POBJECT, object *) 93#define PUSH_OB PUSHcfapi_va(POBJECT, object *)
96#define PUSH_PL PUSHcfapi_va(PPLAYER, player *) 94#define PUSH_PL PUSHcfapi_va(PPLAYER, player *)
97#define PUSH_MAP PUSHcfapi_va(PMAP, mapstruct *) 95#define PUSH_MAP PUSHcfapi_va(PMAP, mapstruct *)
98#define PUSH_PV PUSHcfapi_va(STRING, const char *) 96#define PUSH_PV PUSHcfapi_va(STRING, const char *)
99#define PUSH_IV PUSHs (sv_2mortal (newSViv (va_arg (args, int)))) 97#define PUSH_IV PUSHs (sv_2mortal (newSViv (va_arg (args, int))))
100 98
101////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 99//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
102 100
103// garbage collect some perl objects, if possible
104// all objects no longer referenced and empty are
105// eligible for destruction.
106static void
107clean_obj_cache ()
108{
109 static int count;
110
111 if (++count & 7)
112 return;
113
114 int todo = 1000;
115 do
116 {
117 I32 klen;
118 char *key;
119 HE *he = hv_iternext (obj_cache);
120
121 if (he)
122 {
123 SV *sv = hv_iterval (obj_cache, he);
124
125 // empty and unreferenced? nuke it
126 if (SvREFCNT (sv) == 1 && SvREFCNT (SvRV (sv)) == 1 && !HvFILL ((HV *)(SvRV (sv))))
127 {
128 hv_delete (obj_cache, HeKEY (he), HeKLEN (he), G_DISCARD);
129 todo++;
130 }
131 }
132 else
133 break;
134 }
135 while (--todo);
136}
137
138static SV * 101static SV *
139newSVptr (void *ptr, const char *klass) 102newSVptr (void *ptr, const char *klass, HV *hv = newHV ())
140{ 103{
141 SV *sv; 104 SV *sv;
142 105
143 if (!ptr) 106 if (!ptr)
144 return &PL_sv_undef; 107 return &PL_sv_undef;
145 108
146 sv = newSV (0);
147 sv_magic (sv, 0, PERL_MAGIC_ext, (char *)ptr, 0); 109 sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0);
148 return sv_bless (newRV_noinc (sv), gv_stashpv (klass, 1)); 110 return sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
111}
112
113template<class attachable>
114SV *
115newSVattachable (attachable *obj, const char *klass)
116{
117 if (!obj)
118 return &PL_sv_undef;
119
120 if (!obj->self)
121 obj->self = newSVptr (obj, klass);
122
123 return newSVsv (static_cast<SV *>(obj->self));
149} 124}
150 125
151static void 126static void
152SVptr_cache_set (void *ptr, SV *sv) 127SVptr_cache_set (void *ptr, SV *sv)
153{ 128{
… …
216 else 191 else
217 return 0; 192 return 0;
218} 193}
219 194
220static SV * 195static SV *
221newSVcfapi (int type, ...) 196newSVdt_va (va_list &ap, data_type type)
222{ 197{
223 SV *sv; 198 SV *sv;
224
225 va_list args;
226 va_start (args, type);
227 199
228 switch (type) 200 switch (type)
229 { 201 {
230#if 0
231 case CFAPI_INT16: 202 case DT_INT:
232 sv = newSViv (*va_arg (args, sint16_t *)); 203 sv = newSViv (va_arg (ap, int));
233 break; 204 break;
234#endif
235 205
236 case CFAPI_INT: 206 case DT_INT64:
237 sv = newSViv (*va_arg (args, int *)); 207 sv = newSVval64 ((val64)va_arg (ap, sint64));
238 break; 208 break;
239 209
240 case CFAPI_LONG: 210 case DT_DOUBLE:
241 sv = newSVval64 ((val64)*va_arg (args, sint64 *)); 211 sv = newSVnv (va_arg (ap, double));
242 break; 212 break;
243 213
244 case CFAPI_DOUBLE:
245 sv = newSVnv (*va_arg (args, double *));
246 break;
247
248 case CFAPI_STRING: 214 case DT_STRING:
249 { 215 {
250 char *str = va_arg (args, char *); 216 char *str = (char *)va_arg (ap, const char *);
251 sv = str ? newSVpv (str, 0) : &PL_sv_undef; 217 sv = str ? newSVpv (str, 0) : &PL_sv_undef;
252 } 218 }
253 break; 219 break;
254 220
255 case CFAPI_POBJECT: 221 case DT_DATA:
256 { 222 {
257 object *obj = va_arg (args, object *); 223 char *str = (char *)va_arg (ap, const void *);
258 224 int len = va_arg (ap, int);
259 if (!obj) 225 sv = str ? newSVpv (str, len) : &PL_sv_undef;
260 sv = &PL_sv_undef;
261 else
262 switch (obj->type)
263 {
264 case MAP:
265 sv = newSVptr_cached (obj, "cf::object::map::wrap");
266 break;
267
268 case PLAYER:
269 sv = newSVptr_cached (obj, "cf::object::player::wrap");
270 break;
271
272 default:
273 sv = newSVptr_cached (obj, "cf::object::wrap");
274 break;
275 }
276 } 226 }
277 break; 227 break;
278 228
279 case CFAPI_PMAP: 229 case DT_OBJECT:
280 sv = newSVptr (va_arg (args, mapstruct *), "cf::map::wrap"); 230 {
231 object *obj = va_arg (ap, object *);
232 sv = newSVattachable (obj, obj && obj->type == PLAYER ? "cf::object::player::wrap" : "cf::object::wrap");
233 }
281 break; 234 break;
282 235
283 case CFAPI_PPLAYER: 236 case DT_MAP:
284 sv = newSVptr (va_arg (args, player *), "cf::player::wrap"); 237 // va_arg (object *) when void * is passed is an XSI extension
238 sv = newSVattachable (va_arg (ap, mapstruct *), "cf::map::wrap");
285 break; 239 break;
286 240
287 case CFAPI_PARCH: 241 case DT_PLAYER:
288 sv = newSVptr (va_arg (args, archetype *), "cf::arch::wrap"); 242 sv = newSVattachable (va_arg (ap, player *), "cf::player::wrap");
289 break; 243 break;
290 244
291 case CFAPI_PPARTY: 245 case DT_ARCH:
292 sv = newSVptr (va_arg (args, partylist *), "cf::party::wrap"); 246 sv = newSVptr (va_arg (ap, archetype *), "cf::arch::wrap");
293 break; 247 break;
294 248
295 case CFAPI_PREGION: 249 case DT_PARTY:
296 sv = newSVptr (va_arg (args, region *), "cf::region::wrap"); 250 sv = newSVptr (va_arg (ap, partylist *), "cf::party::wrap");
297 break; 251 break;
252
253 case DT_REGION:
254 sv = newSVptr (va_arg (ap, region *), "cf::region::wrap");
255 break;
256
257 default:
258 assert (("unhandled type in newSVdt_va", 0));
259 }
260
261 return sv;
262}
263
264static SV *
265newSVdt (data_type type, ...)
266{
267 va_list ap;
268
269 va_start (ap, type);
270 SV *sv = newSVdt_va (ap, type);
271 va_end (ap);
272
273 return sv;
274}
275
276static SV *
277newSVcfapi (int type, ...)
278{
279 SV *sv;
280
281 va_list ap;
282 va_start (ap, type);
283
284 switch (type)
285 {
286 case CFAPI_INT: sv = newSViv (*va_arg (ap, int * )); break;
287 case CFAPI_LONG: sv = newSVval64 (*va_arg (ap, sint64 *)); break;
288 case CFAPI_DOUBLE: sv = newSVnv (*va_arg (ap, double *)); break;
289 case CFAPI_STRING: sv = newSVdt_va (ap, DT_STRING); break;
290 case CFAPI_POBJECT: sv = newSVdt_va (ap, DT_OBJECT); break;
291 case CFAPI_PMAP: sv = newSVdt_va (ap, DT_MAP ); break;
292 case CFAPI_PPLAYER: sv = newSVdt_va (ap, DT_PLAYER); break;
293 case CFAPI_PARCH: sv = newSVdt_va (ap, DT_ARCH ); break;
294 case CFAPI_PPARTY: sv = newSVdt_va (ap, DT_PARTY ); break;
295 case CFAPI_PREGION: sv = newSVdt_va (ap, DT_REGION); break;
298 296
299 default: 297 default:
300 assert (("unhandled type in newSVcfapi", 0)); 298 assert (("unhandled type in newSVcfapi", 0));
301 } 299 }
302 300
303 va_end (args); 301 va_end (ap);
304 302
305 return sv; 303 return sv;
306} 304}
307 305
306//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
307
308SV *
309registry_of (attachable_base *ext)
310{
311 if (!ext->cb)
312 ext->cb = newAV ();
313
314 return newRV_inc ((SV *)ext->cb);
315}
316
317void attachable_base::clear ()
318{
319 //if (self) fprintf (stderr, "free_ob_self %p %s (%p,%p)\n", this, ((object *)this)->name, self, cb);//D
320
321 if (self) SvREFCNT_dec (self);
322 if (cb) SvREFCNT_dec (cb);
323
324 if (attach) free_string (attach);
325
326 self = 0;
327 cb = 0;
328 attach = 0;
329}
330
331void attachable_base::optimise ()
332{
333 if (!self)
334 return;
335
336 HV *hv = (HV *)SvRV ((SV *)self);
337
338 if (SvREFCNT ((SV *)self) == 1
339 && SvREFCNT ((SV *)hv) == 1
340 && !HvKEYS (hv))
341 {
342 SvREFCNT_dec ((SV *)self);
343 self = 0;
344 }
345}
346
347void
348object::instantiate_ ()
349{
350 dSP;
351 ENTER;
352 SAVETMPS;
353 PUSHMARK (SP);
354 EXTEND (SP, 2);
355 PUSHs (sv_2mortal (newSVdt (DT_OBJECT, static_cast<object *>(this))));
356 PUSHs (sv_2mortal (newSVpv (attach, 0)));
357 PUTBACK;
358 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL);
359 FREETMPS;
360 LEAVE;
361
362 INVOKE_OBJECT (INSTANTIATE, this);
363}
364
308///////////////////////////////////////////////////////////////////////////// 365/////////////////////////////////////////////////////////////////////////////
309 366
367void reattach (data_type type, void *obj)
368{
369 dSP;
370 ENTER;
371 SAVETMPS;
372 PUSHMARK (SP);
373 XPUSHs (sv_2mortal (newSVdt (type, obj)));
374 PUTBACK;
375 call_pv ("cf::reattach", G_DISCARD | G_VOID | G_EVAL);
376 FREETMPS;
377 LEAVE;
378
379 switch (type)
380 {
381 case DT_OBJECT: INVOKE_OBJECT (REATTACH, obj); break;
382 case DT_PLAYER: INVOKE_PLAYER (REATTACH, obj); break;
383 case DT_MAP: INVOKE_MAP (REATTACH, obj); break;
384 }
385}
386
387template<class subclass>
388void reattach (attachable<subclass> *obj)
389{
390 obj->optimise ();
391
392 if (obj->self)
393 reattach (subclass::get_dt (), (subclass *)obj);
394}
395
396object_freezer::object_freezer (const char *filename)
397: filename (filename)
398{
399 av = (AV *)newAV ();
400}
401
402object_freezer::~object_freezer ()
403{
404 dSP;
405 ENTER;
406 SAVETMPS;
407 PUSHMARK (SP);
408 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
409 XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
410 PUTBACK;
411 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL);
412 FREETMPS;
413 LEAVE;
414}
415
416void object_freezer::put (FILE *fp, attachable_base *ext)
417{
418 ext->optimise ();
419
420 if (ext->self)
421 {
422 int idx = AvFILLp ((AV *)av) + 1;
423 av_store ((AV *)av, idx, SvREFCNT_inc ((SV *)ext->self));
424 fprintf (fp, "oid %d\n", idx);
425 }
426}
427
428object_thawer::object_thawer (const char *filename)
429{
430 av = 0;
431
432 if (!filename)
433 return;
434
435 dSP;
436 ENTER;
437 SAVETMPS;
438 PUSHMARK (SP);
439 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
440 PUTBACK;
441
442 if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL))
443 {
444 SPAGAIN;
445 SV *sv = POPs;
446 if (SvROK (sv))
447 av = SvREFCNT_inc (SvRV (sv));
448 }
449
450 FREETMPS;
451 LEAVE;
452}
453
454void object_thawer::get (data_type type, void *obj, attachable_base *ext, int oid)
455{
456 if (!av || oid < 0) // this is actually an error of sorts
457 return;
458
459 // we have to "re-instantiate"/reattach to an object, so nuke ext->attach
460 ext->clear ();
461
462 SV **svp = av_fetch ((AV *)av, oid, 0);
463
464 if (!svp || !SvROK (*svp))
465 {
466 printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid);
467 return;
468 }
469
470 ext->self = *svp; *svp = &PL_sv_undef;
471 sv_magic (SvRV ((SV *)ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0);
472
473 reattach (type, obj);
474}
475
476object_thawer::~object_thawer ()
477{
478 if (av)
479 SvREFCNT_dec ((SV *)av);
480}
481
482/////////////////////////////////////////////////////////////////////////////
483
310extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) 484extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
311{ 485{
312 gethook = gethooksptr; 486 gethook = gethooksptr;
313 printf (PLUGIN_VERSION " init\n");
314 487
315 return 0; 488 return 0;
316} 489}
317 490
318static CommArray_s rtn_cmd; 491static CommArray_s rtn_cmd;
… …
399extern "C" int cfperl_postInitPlugin () 572extern "C" int cfperl_postInitPlugin ()
400{ 573{
401 int hooktype = 1; 574 int hooktype = 1;
402 int rtype = 0; 575 int rtype = 0;
403 576
404 printf (PLUGIN_VERSION " post init\n");
405
406 registerGlobalEvent = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_register_global_event");
407 unregisterGlobalEvent = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_unregister_global_event");
408 systemDirectory = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_directory"); 577 systemDirectory = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_directory");
409 object_set_property = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_set_property"); 578 object_set_property = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_set_property");
410 map_get_map = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_map_get_map"); 579 map_get_map = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_map_get_map");
411 object_insert = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_insert"); 580 object_insert = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_insert");
412 581
413 cf_init_plugin (gethook); 582 cf_init_plugin (gethook);
414 583
415 /* Pick the global events you want to monitor from this plugin */ 584 return 0;
416 registerGlobalEvent (NULL, EVENT_BORN, PLUGIN_NAME, globalEventListener); 585}
417 registerGlobalEvent (NULL, EVENT_CLOCK, PLUGIN_NAME, globalEventListener);
418 //registerGlobalEvent (NULL, EVENT_CRASH, PLUGIN_NAME, globalEventListener);
419 registerGlobalEvent (NULL, EVENT_FIND_UNARMED_SKILL, PLUGIN_NAME, globalEventListener);
420 registerGlobalEvent (NULL, EVENT_PLAYER_USE_SKILL, PLUGIN_NAME, globalEventListener);
421 registerGlobalEvent (NULL, EVENT_CAST_SPELL, PLUGIN_NAME, globalEventListener);
422 registerGlobalEvent (NULL, EVENT_MONSTER_USE_SKILL, PLUGIN_NAME, globalEventListener);
423 registerGlobalEvent (NULL, EVENT_PLAYER_DEATH, PLUGIN_NAME, globalEventListener);
424 registerGlobalEvent (NULL, EVENT_GKILL, PLUGIN_NAME, globalEventListener);
425 registerGlobalEvent (NULL, EVENT_LOGIN, PLUGIN_NAME, globalEventListener);
426 registerGlobalEvent (NULL, EVENT_LOGOUT, PLUGIN_NAME, globalEventListener);
427 registerGlobalEvent (NULL, EVENT_MAPENTER, PLUGIN_NAME, globalEventListener);
428 registerGlobalEvent (NULL, EVENT_MAPLEAVE, PLUGIN_NAME, globalEventListener);
429 registerGlobalEvent (NULL, EVENT_MAPRESET, PLUGIN_NAME, globalEventListener);
430 registerGlobalEvent (NULL, EVENT_MAPLOAD, PLUGIN_NAME, globalEventListener);
431 registerGlobalEvent (NULL, EVENT_MAPOUT, PLUGIN_NAME, globalEventListener);
432 registerGlobalEvent (NULL, EVENT_MAPIN, PLUGIN_NAME, globalEventListener);
433 registerGlobalEvent (NULL, EVENT_MAPCLEAN, PLUGIN_NAME, globalEventListener);
434 registerGlobalEvent (NULL, EVENT_REMOVE, PLUGIN_NAME, globalEventListener);
435 registerGlobalEvent (NULL, EVENT_SHOUT, PLUGIN_NAME, globalEventListener);
436 registerGlobalEvent (NULL, EVENT_TELL, PLUGIN_NAME, globalEventListener);
437 registerGlobalEvent (NULL, EVENT_MUZZLE, PLUGIN_NAME, globalEventListener);
438 registerGlobalEvent (NULL, EVENT_KICK, PLUGIN_NAME, globalEventListener);
439 registerGlobalEvent (NULL, EVENT_FREE_OB, PLUGIN_NAME, globalEventListener);
440 registerGlobalEvent (NULL, EVENT_PLAYER_LOAD, PLUGIN_NAME, globalEventListener);
441 registerGlobalEvent (NULL, EVENT_PLAYER_SAVE, PLUGIN_NAME, globalEventListener);
442 registerGlobalEvent (NULL, EVENT_EXTCMD, PLUGIN_NAME, globalEventListener);
443 586
587extern "C" int cfperl_closePlugin ()
588{
589 return 0;
590}
591
592void
593cfperl_init ()
594{
444 char *argv[] = { 595 char *argv[] = {
445 "", 596 "",
446 "-e" 597 "-e"
447 "BEGIN {" 598 "BEGIN {"
448 " cf->bootstrap;" 599 " cf->bootstrap;"
… …
463 614
464 exit (EXIT_FAILURE); 615 exit (EXIT_FAILURE);
465 //perl_destruct (perl); 616 //perl_destruct (perl);
466 //perl_free (perl); 617 //perl_free (perl);
467 //perl = 0; 618 //perl = 0;
619 //return;
468 } 620 }
469 else 621
470 {
471 obj_cache = newHV (); 622 obj_cache = newHV ();
472 }
473
474 return 0;
475}
476
477static void *
478globalEventListener (int *type, ...)
479{
480 va_list args;
481 static int rv;
482 int event_code;
483
484 if (!perl)
485 return NULL;
486
487 va_start (args, type);
488 event_code = va_arg (args, int);
489
490 if (event_code == EVENT_FREE_OB)
491 {
492 player *pl;
493 object *op;
494 SV *sv;
495
496 op = va_arg (args, object *);
497 sv = hv_delete (obj_cache, (char *)&op, sizeof (void *), 0);
498
499 if (sv)
500 clearSVptr (sv);
501
502 rv = 0;
503 }
504 else if (event_code == EVENT_CLOCK)
505 {
506 clean_obj_cache ();
507 }
508 else
509 {
510 dSP;
511
512 ENTER;
513 SAVETMPS;
514
515 PUSHMARK (SP);
516
517 EXTEND (SP, 10);
518 PUSHs (sv_2mortal (newSViv (event_code)));
519
520 switch (event_code)
521 {
522 case EVENT_CRASH:
523 break;
524
525 case EVENT_PLAYER_LOAD:
526 case EVENT_PLAYER_SAVE:
527 PUSH_OB;
528 PUSH_PV;
529 break;
530
531 case EVENT_MAPLOAD:
532 case EVENT_MAPOUT:
533 case EVENT_MAPIN:
534 case EVENT_MAPCLEAN:
535 case EVENT_MAPRESET:
536 PUSH_MAP;
537 break;
538
539 case EVENT_MAPENTER:
540 case EVENT_MAPLEAVE:
541 case EVENT_BORN:
542 case EVENT_REMOVE:
543 case EVENT_PLAYER_DEATH:
544 PUSH_OB;
545 break;
546
547 case EVENT_GKILL:
548 PUSH_OB;
549 PUSH_OB;
550 break;
551
552 case EVENT_LOGIN:
553 case EVENT_LOGOUT:
554 PUSH_PL;
555 PUSH_PV;
556 break;
557
558 case EVENT_SHOUT:
559 case EVENT_MUZZLE:
560 case EVENT_KICK:
561 PUSH_OB;
562 PUSH_PV;
563 break;
564
565 case EVENT_FIND_UNARMED_SKILL:
566 PUSH_OB;
567 break;
568
569 case EVENT_PLAYER_USE_SKILL:
570 case EVENT_MONSTER_USE_SKILL:
571 case EVENT_CAST_SPELL:
572 PUSH_OB;
573 PUSH_OB;
574 PUSH_OB;
575 PUSH_IV;
576 PUSH_PV;
577 break;
578
579 case EVENT_EXTCMD:
580 PUSH_PL;
581 {
582 char *buf = va_arg (args, char *);
583 int len = va_arg (args, int);
584 PUSHs (sv_2mortal (newSVpvn (buf, len)));
585 }
586 break;
587
588 case EVENT_TELL:
589 break;
590 }
591
592 va_end (args);
593
594 PUTBACK;
595 int count = call_pv ("cf::inject_global_event", G_SCALAR | G_EVAL);
596 SPAGAIN;
597
598 if (SvTRUE (ERRSV))
599 LOG (llevError, "global event '%d' callback evaluation error: %s", event_code, SvPV_nolen (ERRSV));
600
601 rv = count > 0 ? POPi : 0;
602
603 PUTBACK;
604 FREETMPS;
605 LEAVE;
606 }
607
608 return &rv;
609}
610
611extern "C" void *cfperl_eventListener (int *type, ...)
612{
613 static int rv;
614 va_list args;
615 int event_code;
616 object *who, *activator, *third, *event;
617 char *message, *extension, *options;
618
619 if (!perl)
620 return NULL;
621
622 va_start (args, type);
623 who = va_arg (args, object *);
624 event_code = va_arg (args, int);
625 activator = va_arg (args, object *);
626 third = va_arg (args, object *);
627 message = va_arg (args, char *);
628 va_arg (args, int); // fix yourself
629 extension = va_arg (args, char *);
630 options = va_arg (args, char *);
631 event = va_arg (args, object *);
632 va_end (args);
633
634 {
635 dSP;
636
637 ENTER;
638 SAVETMPS;
639
640 PUSHMARK (SP);
641 EXTEND (SP, 10);
642
643 PUSHcfapi (STRING, extension);
644 PUSHs (sv_2mortal (newSViv (event_code)));
645
646 PUSHcfapi (POBJECT, event);
647 PUSHcfapi (POBJECT, who);
648
649 switch (event_code)
650 {
651 case EVENT_STOP: // $ob (e.g. arrow)
652 case EVENT_TIME: // $ob
653 case EVENT_TIMER: // $ob
654 break;
655
656 case EVENT_APPLY: // $ob, $who
657 case EVENT_DROP: // $ob, $who
658 case EVENT_CLOSE: // $ob, $who
659 case EVENT_DEATH: // $ob[, $killer]
660 case EVENT_MOVE: // $ob, $enemy
661 case EVENT_THROW: // $ob, $thrower
662 PUSHcfapi (POBJECT, activator);
663 break;
664
665 case EVENT_DROP_ON: // $ob, $who, $what
666 case EVENT_ATTACK: // $ob, $who, $victim (?? please god enlighten me)
667 PUSHcfapi (POBJECT, activator);
668 PUSHcfapi (POBJECT, third);
669 break;
670
671 case EVENT_TRIGGER: // $ob, $originator, [$victim], [$msg]
672 PUSHcfapi (POBJECT, activator);
673 PUSHcfapi (POBJECT, third);
674 PUSHcfapi (POBJECT, message);
675 break;
676
677 case EVENT_SAY: // $ob, $who, $msg
678 PUSHcfapi (POBJECT, activator);
679 PUSHcfapi (STRING, message);
680 break;
681
682 default:
683 LOG (llevError, "perl plugin called for unsupported event type %d", event_code);
684 break;
685 }
686
687 PUTBACK;
688 int count = call_pv ("cf::inject_event", G_SCALAR | G_EVAL);
689 SPAGAIN;
690
691 if (SvTRUE (ERRSV))
692 LOG (llevError, "event '%d' callback evaluation error: %s", event_code, SvPV_nolen (ERRSV));
693
694 rv = count > 0 ? POPi : 0;
695
696 PUTBACK;
697 FREETMPS;
698 LEAVE;
699 }
700
701 return &rv;
702}
703
704extern "C" int cfperl_closePlugin ()
705{
706 printf (PLUGIN_VERSION " closing\n");
707
708 if (perl)
709 {
710 perl_destruct (perl);
711 perl_free (perl);
712 perl = 0;
713 }
714
715 return 0;
716} 623}
717 624
718void cfperl_main () 625void cfperl_main ()
719{ 626{
720 dSP; 627 dSP;
721 628
722 PUSHMARK (SP); 629 PUSHMARK (SP);
723 PUTBACK; 630 PUTBACK;
724 call_pv ("cf::run", G_DISCARD | G_VOID); 631 call_pv ("cf::main", G_DISCARD | G_VOID);
632}
633
634static event_klass klass_of[NUM_EVENT_TYPES] = {
635# define def(type,name) KLASS_ ## type,
636# include "eventinc.h"
637# undef def
638};
639
640#define KLASS_OF(event) (((unsigned int)event) < NUM_EVENT_TYPES ? klass_of [event] : KLASS_NONE)
641
642static void
643gather_callbacks (AV *&callbacks, AV *registry, event_type event)
644{
645 // event must be in array
646 if (event >= 0 && event <= AvFILLp (registry))
647 {
648 SV *cbs_ = AvARRAY (registry)[event];
649
650 // element must be list of callback entries
651 if (cbs_ && SvROK (cbs_) && SvTYPE (SvRV (cbs_)) == SVt_PVAV)
652 {
653 AV *cbs = (AV *)SvRV (cbs_);
654
655 // no callback entries, no callbacks to call
656 if (AvFILLp (cbs) >= 0)
657 {
658 if (!callbacks)
659 {
660 callbacks = newAV ();
661 av_extend (callbacks, 16);
662 }
663
664 // never use SvREFCNT_inc to copy values, but its ok here :)
665 for (int i = 0; i <= AvFILLp (cbs); ++i)
666 av_push (callbacks, SvREFCNT_inc (AvARRAY (cbs)[i]));
667 }
668 }
669 }
670}
671
672bool cfperl_invoke (event_type event, ...)
673{
674 data_type dt;
675 va_list ap;
676
677 va_start (ap, event);
678
679 AV *callbacks = 0;
680
681 object *op;
682 player *pl;
683 mapstruct *map;
684
685 // callback call ordering is:
686 // 1. per-object callback (NYI)
687 // 2. per-class object
688 // 2a. per-type callback
689 // 4. global callbacks
690
691 gather_callbacks (callbacks, cb_global, event);
692
693 switch (KLASS_OF (event))
694 {
695 case KLASS_GLOBAL:
696 break;
697
698 case KLASS_OBJECT:
699 dt = (data_type) va_arg (ap, int);
700 assert (("first argument must be of type object", dt == DT_OBJECT));
701 op = va_arg (ap, object *);
702
703 if (op->cb)
704 gather_callbacks (callbacks, (AV *)op->cb, event);
705
706 if (op->type)
707 {
708 if (op->subtype && op->type + op->subtype * NUM_SUBTYPES <= AvFILLp (cb_type))
709 {
710 SV *registry = AvARRAY (cb_type)[op->type + op->subtype * NUM_SUBTYPES];
711
712 if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
713 gather_callbacks (callbacks, (AV *)SvRV (registry), event);
714 }
715
716 if (op->type <= AvFILLp (cb_type))
717 {
718 SV *registry = AvARRAY (cb_type)[op->type];
719
720 if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
721 gather_callbacks (callbacks, (AV *)SvRV (registry), event);
722 }
723 }
724
725 gather_callbacks (callbacks, cb_object, event);
726
727 break;
728
729 case KLASS_PLAYER:
730 dt = (data_type) va_arg (ap, int);
731 assert (("first argument must be of type player", dt == DT_PLAYER));
732 pl = va_arg (ap, player *);
733
734 if (pl->cb)
735 gather_callbacks (callbacks, (AV *)pl->cb, event);
736
737 gather_callbacks (callbacks, cb_player, event);
738 break;
739
740 case KLASS_MAP:
741 dt = (data_type) va_arg (ap, int);
742 assert (("first argument must be of type object", dt == DT_MAP));
743 map = va_arg (ap, mapstruct *);
744
745 if (map->cb)
746 gather_callbacks (callbacks, (AV *)map->cb, event);
747
748 gather_callbacks (callbacks, cb_map, event);
749 break;
750
751 default:
752 assert (("unsupported event klass in cfperl_invoke", 0));
753 }
754
755 // short-circuit processing if no callbacks found/defined
756 if (!callbacks)
757 return 0;
758
759 dSP;
760 ENTER;
761 SAVETMPS;
762
763 PUSHMARK (SP);
764 EXTEND (SP, 3);
765
766 PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays
767 PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks)));
768
769 switch (KLASS_OF (event))
770 {
771 case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break;
772 case KLASS_PLAYER: PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl))); break;
773 case KLASS_MAP: PUSHs (sv_2mortal (newSVdt (DT_MAP, map))); break;
774 }
775
776 for (;;)
777 {
778 dt = (data_type) va_arg (ap, int);
779
780 if (dt == DT_END)
781 break;
782
783 if (dt == DT_AV)
784 {
785 AV *av = va_arg (ap, AV *);
786
787 for (int i = 0; i <= av_len (av); ++i)
788 XPUSHs (*av_fetch (av, i, 1));
789 }
790 else
791 XPUSHs (sv_2mortal (newSVdt_va (ap, dt)));
792 }
793
794 va_end (ap);
795
796 PUTBACK;
797 int count = call_pv ("cf::do_invoke", G_SCALAR | G_EVAL);
725 SPAGAIN; 798 SPAGAIN;
726 PUTBACK; 799
800 count = count > 0 ? POPi : 0;
801
802 FREETMPS;
803 LEAVE;
804
805 return count;
806}
807
808SV *
809cfperl_result (int idx)
810{
811 AV *av = get_av ("cfperl::invoke_results", 0);
812 if (!av)
813 return &PL_sv_undef;
814
815 SV **sv = av_fetch (av, idx, 0);
816 if (!sv)
817 return &PL_sv_undef;
818
819 return *sv;
820}
821
822int
823cfperl_result_INT (int idx)
824{
825 return SvIV (cfperl_result (idx));
727} 826}
728 827
729MODULE = cf PACKAGE = cf PREFIX = cf_ 828MODULE = cf PACKAGE = cf PREFIX = cf_
730 829
731BOOT: 830BOOT:
… …
865 const_iv (BUILDER) 964 const_iv (BUILDER)
866 const_iv (MATERIAL) 965 const_iv (MATERIAL)
867 const_iv (ITEM_TRANSFORMER) 966 const_iv (ITEM_TRANSFORMER)
868 const_iv (QUEST) 967 const_iv (QUEST)
869 968
969 const_iv (NUM_SUBTYPES)
970
870 const_iv (ST_BD_BUILD) 971 const_iv (ST_BD_BUILD)
871 const_iv (ST_BD_REMOVE) 972 const_iv (ST_BD_REMOVE)
872 973
873 const_iv (ST_MAT_FLOOR) 974 const_iv (ST_MAT_FLOOR)
874 const_iv (ST_MAT_WALL) 975 const_iv (ST_MAT_WALL)
… …
1210 1311
1211 const_iv (MAP_IN_MEMORY) 1312 const_iv (MAP_IN_MEMORY)
1212 const_iv (MAP_SWAPPED) 1313 const_iv (MAP_SWAPPED)
1213 const_iv (MAP_LOADING) 1314 const_iv (MAP_LOADING)
1214 const_iv (MAP_SAVING) 1315 const_iv (MAP_SAVING)
1316
1317 const_iv (KLASS_GLOBAL)
1318 const_iv (KLASS_OBJECT)
1319 const_iv (KLASS_PLAYER)
1320 const_iv (KLASS_MAP)
1215 }; 1321 };
1216 1322
1217 for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ-- > const_iv; ) 1323 for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ-- > const_iv; )
1218 newCONSTSUB (stash, (char *)civ->name, newSViv (civ->iv)); 1324 newCONSTSUB (stash, (char *)civ->name, newSViv (civ->iv));
1219 1325
1220 static const struct { 1326 static const struct {
1221 const char *name; 1327 const char *name;
1328 int skip;
1329 IV klass;
1222 IV iv; 1330 IV iv;
1223 } *event, event_list[] = { 1331 } *eiv, event_iv[] = {
1224# define const_event(name) { # name, (IV)EVENT_ ## name }, 1332# define def(klass,name) { "EVENT_" # klass "_" # name, sizeof ("EVENT_" # klass), (IV)KLASS_ ## klass, (IV)EVENT_ ## klass ## _ ## name },
1225 const_event (NONE) 1333# include "eventinc.h"
1226 const_event (APPLY) 1334# undef def
1227 const_event (ATTACK)
1228 const_event (DEATH)
1229 const_event (DROP)
1230 const_event (DROP_ON)
1231 const_event (PICKUP)
1232 const_event (SAY)
1233 const_event (STOP)
1234 const_event (TIME)
1235 const_event (THROW)
1236 const_event (TRIGGER)
1237 const_event (CLOSE)
1238 const_event (TIMER)
1239 const_event (MOVE)
1240
1241 const_event (BORN)
1242 //const_event (CLOCK)
1243 const_event (CRASH)
1244 const_event (PLAYER_DEATH)
1245 const_event (PLAYER_LOAD)
1246 const_event (PLAYER_SAVE)
1247 const_event (GKILL)
1248 const_event (LOGIN)
1249 const_event (LOGOUT)
1250 const_event (MAPENTER)
1251 const_event (MAPLEAVE)
1252 const_event (MAPRESET)
1253 const_event (MAPLOAD)
1254 const_event (MAPOUT)
1255 const_event (MAPIN)
1256 const_event (MAPCLEAN)
1257 const_event (REMOVE)
1258 const_event (SHOUT)
1259 const_event (TELL)
1260 const_event (MUZZLE)
1261 const_event (KICK)
1262 const_event (PLAYER_USE_SKILL)
1263 const_event (MONSTER_USE_SKILL)
1264 const_event (CAST_SPELL)
1265 const_event (FIND_UNARMED_SKILL)
1266 const_event (EXTCMD)
1267 //const_event (FREE_OB)
1268 }; 1335 };
1269 1336
1270 AV *av = get_av ("cf::EVENT", 1); 1337 AV *av = get_av ("cf::EVENT", 1);
1271 1338
1272 for (event = event_list + sizeof (event_list) / sizeof (event_list [0]); event-- > event_list; ) 1339 for (eiv = event_iv + sizeof (event_iv) / sizeof (event_iv [0]); eiv-- > event_iv; )
1273 av_store (av, event->iv, newSVpv ((char *)event->name, 0)); 1340 {
1341 AV *event = newAV ();
1342 av_push (event, newSVpv ((char *)eiv->name + eiv->skip, 0));
1343 av_push (event, newSViv (eiv->klass));
1344 av_store (av, eiv->iv, newRV_noinc ((SV *)event));
1345 newCONSTSUB (stash, (char *)eiv->name, newSViv (eiv->iv));
1346 }
1274 1347
1275 static const struct { 1348 static const struct {
1276 int dtype; 1349 int dtype;
1277 const char *name; 1350 const char *name;
1278 IV idx; 1351 IV idx;
… …
1409 } 1482 }
1410 1483
1411 //I_EVENT_API (PACKAGE); 1484 //I_EVENT_API (PACKAGE);
1412} 1485}
1413 1486
1487void _reload_1 ()
1488 CODE:
1489 cb_global = get_av ("cf::CB_GLOBAL", 1);
1490 cb_object = get_av ("cf::CB_OBJECT", 1);
1491 cb_player = get_av ("cf::CB_PLAYER", 1);
1492 cb_type = get_av ("cf::CB_TYPE" , 1);
1493 cb_map = get_av ("cf::CB_MAP" , 1);
1494
1495void _reload_2 ()
1496 CODE:
1497{
1498 // reattach to all attachable objects in the game.
1499 for (player *pl = first_player; pl; pl = pl->next)
1500 reattach (pl);
1501
1502 for (mapstruct *map = first_map; map; map = map->next)
1503 reattach (map);
1504
1505 for (object *op = objects; op; op = op->next)
1506 reattach (op);
1507}
1508
1414NV floor (NV x) 1509NV floor (NV x)
1415 1510
1416NV ceil (NV x) 1511NV ceil (NV x)
1417 1512
1418void server_tick () 1513void server_tick ()
… …
1462 1557
1463int random_roll(int min, int max, object *op, int goodbad); 1558int random_roll(int min, int max, object *op, int goodbad);
1464 1559
1465const char *cost_string_from_value(uint64 cost, int approx = 0) 1560const char *cost_string_from_value(uint64 cost, int approx = 0)
1466 1561
1562int invoke (int event, ...)
1563 CODE:
1564 if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL");
1565 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 1; i < items; i++) av_push (av, ST (i));
1566 RETVAL = INVOKE_((event_type)event, ARG_AV (av));
1567 OUTPUT: RETVAL
1568
1467int 1569int
1468exp_to_level (val64 exp) 1570exp_to_level (val64 exp)
1469 CODE: 1571 CODE:
1470{ 1572{
1471 int i = 0; 1573 int i = 0;
… …
1502 else 1604 else
1503 XSRETURN_UNDEF; 1605 XSRETURN_UNDEF;
1504 OUTPUT: RETVAL 1606 OUTPUT: RETVAL
1505 1607
1506MODULE = cf PACKAGE = cf::object PREFIX = cf_object_ 1608MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
1609
1610int invoke (object *op, int event, ...)
1611 CODE:
1612 if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");
1613 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i));
1614 RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av));
1615 OUTPUT: RETVAL
1616
1617SV *registry (object *op)
1618 CODE:
1619 RETVAL = registry_of (op);
1620 OUTPUT:
1621 RETVAL
1507 1622
1508SV * 1623SV *
1509get_property (object *obj, int type, int idx) 1624get_property (object *obj, int type, int idx)
1510 CODE: 1625 CODE:
1511 RETVAL = newSVcfapi (type, cf_object_get_property (obj, idx)); 1626 RETVAL = newSVcfapi (type, cf_object_get_property (obj, idx));
… …
1788 1903
1789void cf_player_set_party (object *op, partylist *party) 1904void cf_player_set_party (object *op, partylist *party)
1790 1905
1791void kill_player (object *op) 1906void kill_player (object *op)
1792 1907
1793MODULE = cf PACKAGE = cf::object::map PREFIX = cf_
1794
1795MODULE = cf PACKAGE = cf::player PREFIX = cf_player_ 1908MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
1909
1910int invoke (player *pl, int event, ...)
1911 CODE:
1912 if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");
1913 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i));
1914 RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av));
1915 OUTPUT: RETVAL
1916
1917SV *registry (player *pl)
1918 CODE:
1919 RETVAL = registry_of (pl);
1920 OUTPUT:
1921 RETVAL
1796 1922
1797player *cf_player_find (char *name) 1923player *cf_player_find (char *name)
1798 PROTOTYPE: $ 1924 PROTOTYPE: $
1799 1925
1800void cf_player_move (player *pl, int dir) 1926void cf_player_move (player *pl, int dir)
… …
1827 1953
1828char * 1954char *
1829client (player *pl) 1955client (player *pl)
1830 CODE: 1956 CODE:
1831 RETVAL = pl->socket.client; 1957 RETVAL = pl->socket.client;
1958 OUTPUT:
1959 RETVAL
1960
1961char *
1962host (player *pl)
1963 CODE:
1964 RETVAL = pl->socket.host;
1965 OUTPUT:
1966 RETVAL
1967
1968char *
1969killer (player *pl, char *killer = 0)
1970 CODE:
1971 if (killer)
1972 snprintf (pl->killer, sizeof (pl->killer), "%s", killer);
1973 RETVAL = pl->killer;
1832 OUTPUT: 1974 OUTPUT:
1833 RETVAL 1975 RETVAL
1834 1976
1835void 1977void
1836buggy_mapscroll (player *pl, int value = 1) 1978buggy_mapscroll (player *pl, int value = 1)
… …
1902 RETVAL = &pl->last_stats; 2044 RETVAL = &pl->last_stats;
1903 OUTPUT: RETVAL 2045 OUTPUT: RETVAL
1904 2046
1905 2047
1906MODULE = cf PACKAGE = cf::map PREFIX = cf_map_ 2048MODULE = cf PACKAGE = cf::map PREFIX = cf_map_
2049
2050int invoke (mapstruct *map, int event, ...)
2051 CODE:
2052 if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP");
2053 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i));
2054 RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av));
2055 OUTPUT:
2056 RETVAL
2057
2058SV *registry (mapstruct *map)
2059 CODE:
2060 RETVAL = registry_of (map);
2061 OUTPUT:
2062 RETVAL
1907 2063
1908SV * 2064SV *
1909get_property (mapstruct *obj, int type, int idx) 2065get_property (mapstruct *obj, int type, int idx)
1910 CODE: 2066 CODE:
1911 RETVAL = newSVcfapi (type, cf_map_get_property (obj, idx)); 2067 RETVAL = newSVcfapi (type, cf_map_get_property (obj, idx));
… …
2055 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; 2211 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;
2056 } 2212 }
2057 OUTPUT: 2213 OUTPUT:
2058 RETVAL 2214 RETVAL
2059 2215
2060# "serialise" map perl data into a ref 2216# "deserialise" perl map data into the map # TODO# compatibility cruft, remove
2061void
2062_get_obs (mapstruct *map)
2063 PPCODE:
2064{
2065 object *o;
2066 int x, y;
2067 AV *obs = newAV ();
2068 int nonnull = 0;
2069
2070 for (y = 0; y < MAP_HEIGHT (map); y++)
2071 for (x = 0; x < MAP_WIDTH (map); x++)
2072 {
2073 AV *av = newAV ();
2074
2075 for (o = GET_MAP_OB (map, x, y); o; o = o->above)
2076 {
2077 SV *sv = SVptr_cache_get (o);
2078
2079 if (sv && HvFILL (SvRV (sv)))
2080 {
2081 nonnull = 1;
2082 sv = newSVsv (sv);
2083 }
2084 else
2085 sv = &PL_sv_undef;
2086
2087 av_push (av, sv);
2088 }
2089
2090 av_store (obs, x + y * MAP_HEIGHT (map), newRV_noinc ((SV *)av));
2091 }
2092
2093 if (nonnull)
2094 XPUSHs (sv_2mortal (newRV_noinc ((SV *)obs)));
2095 else
2096 SvREFCNT_dec (obs);
2097}
2098
2099# "deserialise" perl map data into the map
2100void 2217void
2101_set_obs (mapstruct *map, SV *sv) 2218_set_obs (mapstruct *map, SV *sv)
2102 CODE: 2219 CODE:
2103{ 2220{
2104 object *o; 2221 object *o;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines