… | |
… | |
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 | |
… | |
… | |
97 | #define PUSH_IV PUSHs (sv_2mortal (newSViv (va_arg (args, int)))) |
97 | #define PUSH_IV PUSHs (sv_2mortal (newSViv (va_arg (args, int)))) |
98 | |
98 | |
99 | ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
99 | ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
100 | |
100 | |
101 | static SV * |
101 | static SV * |
102 | newSVptr (void *ptr, const char *klass) |
102 | newSVptr (void *ptr, const char *klass, HV *hv = newHV ()) |
103 | { |
103 | { |
104 | SV *sv; |
104 | SV *sv; |
105 | |
105 | |
106 | if (!ptr) |
106 | if (!ptr) |
107 | return &PL_sv_undef; |
107 | return &PL_sv_undef; |
108 | |
108 | |
109 | sv = (SV *)newHV (); |
|
|
110 | sv_magic (sv, 0, PERL_MAGIC_ext, (char *)ptr, 0); |
109 | sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0); |
111 | return sv_bless (newRV_noinc (sv), gv_stashpv (klass, 1)); |
110 | return sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); |
112 | } |
111 | } |
113 | |
112 | |
114 | template<class extendable> |
113 | template<class extendable> |
115 | SV * |
114 | SV * |
116 | newSVextendable (extendable *obj, const char *klass) |
115 | newSVextendable (extendable *obj, const char *klass) |
… | |
… | |
305 | } |
304 | } |
306 | |
305 | |
307 | ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
306 | ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
308 | |
307 | |
309 | SV * |
308 | SV * |
310 | registry_of (extendable_base *obj) |
309 | registry_of (extendable_base *ext) |
311 | { |
310 | { |
312 | if (!obj->cb) |
311 | if (!ext->cb) |
313 | obj->cb = newAV (); |
312 | ext->cb = newAV (); |
314 | |
313 | |
315 | return newRV_inc ((SV *)obj->cb); |
314 | return newRV_inc ((SV *)ext->cb); |
316 | } |
315 | } |
317 | |
316 | |
318 | void extendable_base::clear () |
317 | void extendable_base::clear () |
319 | { |
318 | { |
320 | //if (self) fprintf (stderr, "free_ob_self %p %s (%p,%p)\n", this, ((object *)this)->name, self, cb);//D |
319 | //if (self) fprintf (stderr, "free_ob_self %p %s (%p,%p)\n", this, ((object *)this)->name, self, cb);//D |
… | |
… | |
329 | attach = 0; |
328 | attach = 0; |
330 | } |
329 | } |
331 | |
330 | |
332 | void extendable_base::optimise () |
331 | void extendable_base::optimise () |
333 | { |
332 | { |
334 | // optional, and not used yet anyways |
333 | if (!self) |
335 | // // empty and unreferenced? nuke it |
334 | return; |
336 | // if (SvREFCNT (sv) == 1 && SvREFCNT (SvRV (sv)) == 1 && !HvFILL ((HV *)(SvRV (sv)))) |
|
|
337 | // { |
|
|
338 | // hv_delete (obj_cache, HeKEY (he), HeKLEN (he), G_DISCARD); |
|
|
339 | // todo++; |
|
|
340 | // } |
|
|
341 | |
335 | |
342 | } |
336 | HV *hv = (HV *)SvRV ((SV *)self); |
343 | |
337 | |
344 | void extendable_base::reattach (data_type type, void *self) |
338 | if (SvREFCNT ((SV *)self) == 1 |
345 | { |
339 | && SvREFCNT ((SV *)hv) == 1 |
346 | dSP; |
340 | && !HvKEYS (hv)) |
347 | ENTER; |
341 | { |
348 | SAVETMPS; |
342 | SvREFCNT_dec ((SV *)self); |
349 | PUSHMARK (SP); |
343 | self = 0; |
350 | EXTEND (SP, 1); |
344 | } |
351 | PUSHs (sv_2mortal (newSVdt (type, self))); |
|
|
352 | PUTBACK; |
|
|
353 | call_pv ("cf::reattach", G_DISCARD | G_VOID | G_EVAL); |
|
|
354 | FREETMPS; |
|
|
355 | LEAVE; |
|
|
356 | |
|
|
357 | if (cb && type == DT_OBJECT) |
|
|
358 | INVOKE_OBJECT (LOAD, (object *)self); |
|
|
359 | } |
345 | } |
360 | |
346 | |
361 | void |
347 | void |
362 | object::instantiate_ () |
348 | object::instantiate_ () |
363 | { |
349 | { |
… | |
… | |
370 | PUSHs (sv_2mortal (newSVpv (attach, 0))); |
356 | PUSHs (sv_2mortal (newSVpv (attach, 0))); |
371 | PUTBACK; |
357 | PUTBACK; |
372 | call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL); |
358 | call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL); |
373 | FREETMPS; |
359 | FREETMPS; |
374 | LEAVE; |
360 | LEAVE; |
|
|
361 | } |
|
|
362 | |
|
|
363 | ///////////////////////////////////////////////////////////////////////////// |
|
|
364 | |
|
|
365 | object_freezer::object_freezer (const char *filename) |
|
|
366 | : filename (filename) |
|
|
367 | { |
|
|
368 | av = (AV *)newAV (); |
|
|
369 | idx = 0; |
|
|
370 | av_extend ((AV *)av, 1024); |
|
|
371 | } |
|
|
372 | |
|
|
373 | object_freezer::~object_freezer () |
|
|
374 | { |
|
|
375 | dSP; |
|
|
376 | ENTER; |
|
|
377 | SAVETMPS; |
|
|
378 | PUSHMARK (SP); |
|
|
379 | XPUSHs (sv_2mortal (newSVpv (filename, 0))); |
|
|
380 | XPUSHs (sv_2mortal (newRV_noinc ((SV *)av))); |
|
|
381 | PUTBACK; |
|
|
382 | call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL); |
|
|
383 | FREETMPS; |
|
|
384 | LEAVE; |
|
|
385 | } |
|
|
386 | |
|
|
387 | void object_freezer::put (extendable_base *ext) |
|
|
388 | { |
|
|
389 | ext->optimise (); |
|
|
390 | |
|
|
391 | if (ext->self) |
|
|
392 | av_store ((AV *)av, idx, SvREFCNT_inc ((SV *)ext->self)); |
|
|
393 | |
|
|
394 | ++idx; |
|
|
395 | } |
|
|
396 | |
|
|
397 | object_thawer::object_thawer (const char *filename) |
|
|
398 | { |
|
|
399 | av = 0; |
|
|
400 | idx = 0; |
|
|
401 | |
|
|
402 | if (!filename) |
|
|
403 | return; |
|
|
404 | |
|
|
405 | dSP; |
|
|
406 | ENTER; |
|
|
407 | SAVETMPS; |
|
|
408 | PUSHMARK (SP); |
|
|
409 | XPUSHs (sv_2mortal (newSVpv (filename, 0))); |
|
|
410 | PUTBACK; |
|
|
411 | |
|
|
412 | if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL)) |
|
|
413 | { |
|
|
414 | SPAGAIN; |
|
|
415 | SV *sv = POPs; |
|
|
416 | if (SvROK (sv)) |
|
|
417 | av = SvREFCNT_inc (SvRV (sv)); |
|
|
418 | } |
|
|
419 | |
|
|
420 | FREETMPS; |
|
|
421 | LEAVE; |
|
|
422 | } |
|
|
423 | |
|
|
424 | void object_thawer::get (data_type type, void *obj, extendable_base *ext) |
|
|
425 | { |
|
|
426 | if (!av) |
|
|
427 | return; |
|
|
428 | |
|
|
429 | // we have to "re-instantiate"/reattach to an object, so nuke ext->attach |
|
|
430 | ext->clear (); |
|
|
431 | |
|
|
432 | SV **svp = av_fetch ((AV *)av, idx, 0); |
|
|
433 | |
|
|
434 | ++idx; |
|
|
435 | |
|
|
436 | if (!svp) |
|
|
437 | return; |
|
|
438 | |
|
|
439 | if (SvROK (*svp)) |
|
|
440 | { |
|
|
441 | ext->self = SvREFCNT_inc (*svp); |
|
|
442 | sv_magic (SvRV ((SV *)ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0); |
|
|
443 | |
|
|
444 | dSP; |
|
|
445 | ENTER; |
|
|
446 | SAVETMPS; |
|
|
447 | PUSHMARK (SP); |
|
|
448 | EXTEND (SP, 1); |
|
|
449 | PUSHs (sv_2mortal (newSVdt (type, obj))); |
|
|
450 | PUTBACK; |
|
|
451 | call_pv ("cf::reattach", G_DISCARD | G_VOID | G_EVAL); |
|
|
452 | FREETMPS; |
|
|
453 | LEAVE; |
|
|
454 | |
|
|
455 | if (ext->cb && type == DT_OBJECT) |
|
|
456 | INVOKE_OBJECT (REATTACH, (object *)obj); |
|
|
457 | } |
|
|
458 | } |
|
|
459 | |
|
|
460 | object_thawer::~object_thawer () |
|
|
461 | { |
|
|
462 | if (av) |
|
|
463 | SvREFCNT_dec ((SV *)av); |
375 | } |
464 | } |
376 | |
465 | |
377 | ///////////////////////////////////////////////////////////////////////////// |
466 | ///////////////////////////////////////////////////////////////////////////// |
378 | |
467 | |
379 | extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) |
468 | extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) |
… | |
… | |
614 | case KLASS_PLAYER: |
703 | case KLASS_PLAYER: |
615 | dt = (data_type) va_arg (ap, int); |
704 | dt = (data_type) va_arg (ap, int); |
616 | assert (("first argument must be of type player", dt == DT_PLAYER)); |
705 | assert (("first argument must be of type player", dt == DT_PLAYER)); |
617 | pl = va_arg (ap, player *); |
706 | pl = va_arg (ap, player *); |
618 | |
707 | |
619 | if (op->cb) |
708 | if (pl->cb) |
620 | gather_callbacks (callbacks, (AV *)op->cb, event); |
709 | gather_callbacks (callbacks, (AV *)pl->cb, event); |
621 | |
710 | |
622 | gather_callbacks (callbacks, cb_player, event); |
711 | gather_callbacks (callbacks, cb_player, event); |
623 | break; |
712 | break; |
624 | |
713 | |
625 | case KLASS_MAP: |
714 | case KLASS_MAP: |
626 | dt = (data_type) va_arg (ap, int); |
715 | dt = (data_type) va_arg (ap, int); |
627 | assert (("first argument must be of type object", dt == DT_MAP)); |
716 | assert (("first argument must be of type object", dt == DT_MAP)); |
628 | map = va_arg (ap, mapstruct *); |
717 | map = va_arg (ap, mapstruct *); |
629 | |
718 | |
630 | if (op->cb) |
719 | if (map->cb) |
631 | gather_callbacks (callbacks, (AV *)op->cb, event); |
720 | gather_callbacks (callbacks, (AV *)map->cb, event); |
632 | |
721 | |
633 | gather_callbacks (callbacks, cb_map, event); |
722 | gather_callbacks (callbacks, cb_map, event); |
634 | break; |
723 | break; |
635 | |
724 | |
636 | default: |
725 | default: |
… | |
… | |
2057 | case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; |
2146 | case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; |
2058 | } |
2147 | } |
2059 | OUTPUT: |
2148 | OUTPUT: |
2060 | RETVAL |
2149 | RETVAL |
2061 | |
2150 | |
2062 | # "serialise" map perl data into a ref |
2151 | # "deserialise" perl map data into the map # TODO# compatibility cruft, remove |
2063 | void |
|
|
2064 | _get_obs (mapstruct *map) |
|
|
2065 | PPCODE: |
|
|
2066 | { |
|
|
2067 | object *o; |
|
|
2068 | int x, y; |
|
|
2069 | AV *obs = newAV (); |
|
|
2070 | int nonnull = 0; |
|
|
2071 | |
|
|
2072 | for (y = 0; y < MAP_HEIGHT (map); y++) |
|
|
2073 | for (x = 0; x < MAP_WIDTH (map); x++) |
|
|
2074 | { |
|
|
2075 | AV *av = newAV (); |
|
|
2076 | |
|
|
2077 | for (o = GET_MAP_OB (map, x, y); o; o = o->above) |
|
|
2078 | { |
|
|
2079 | SV *sv = SVptr_cache_get (o); |
|
|
2080 | |
|
|
2081 | if (sv && HvFILL (SvRV (sv))) |
|
|
2082 | { |
|
|
2083 | nonnull = 1; |
|
|
2084 | sv = newSVsv (sv); |
|
|
2085 | } |
|
|
2086 | else |
|
|
2087 | sv = &PL_sv_undef; |
|
|
2088 | |
|
|
2089 | av_push (av, sv); |
|
|
2090 | } |
|
|
2091 | |
|
|
2092 | av_store (obs, x + y * MAP_HEIGHT (map), newRV_noinc ((SV *)av)); |
|
|
2093 | } |
|
|
2094 | |
|
|
2095 | if (nonnull) |
|
|
2096 | XPUSHs (sv_2mortal (newRV_noinc ((SV *)obs))); |
|
|
2097 | else |
|
|
2098 | SvREFCNT_dec (obs); |
|
|
2099 | } |
|
|
2100 | |
|
|
2101 | # "deserialise" perl map data into the map |
|
|
2102 | void |
2152 | void |
2103 | _set_obs (mapstruct *map, SV *sv) |
2153 | _set_obs (mapstruct *map, SV *sv) |
2104 | CODE: |
2154 | CODE: |
2105 | { |
2155 | { |
2106 | object *o; |
2156 | object *o; |