--- deliantra/server/plugins/cfperl/cfperl.xs 2006/02/04 00:33:07 1.8 +++ deliantra/server/plugins/cfperl/cfperl.xs 2006/03/16 21:08:20 1.33 @@ -30,8 +30,8 @@ #undef save_long // clashes with libproto.h -#define PLUGIN_NAME "cfperl" -#define PLUGIN_VERSION "cfperl 0.0" +#define PLUGIN_NAME "perl" +#define PLUGIN_VERSION "cfperl 0.2" #ifndef __CEXTRACT__ #include @@ -49,38 +49,119 @@ #include "perlxsi.c" +typedef object object_ornull; +typedef mapstruct mapstruct_ornull; + static f_plug_api gethook; static f_plug_api registerGlobalEvent; static f_plug_api unregisterGlobalEvent; static f_plug_api systemDirectory; +static f_plug_api object_set_property; +static f_plug_api map_get_map; +static f_plug_api object_insert; +/* this is a stupid way to do things, and awkward to use for plug-in authors */ typedef struct { object* who; object* activator; object* third; + mapstruct* map; char message[1024]; - int fix; + int fix; // seems to be python-only, and should not be part of the API int event_code; - char options[1024]; + char extension[1024]; // name field, should invoke specific perl extension + char options[1024]; // slaying field of event_connectors int returnvalue; } CFPContext; -//static int current_command = -999; - +static HV *obj_cache; static PerlInterpreter *perl; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// garbage collect some perl objects, if possible +// all objects no longer referenced and empty are +// eligible for destruction. +void +clean_obj_cache () +{ + static int count; + + if (++count & 7) + return; + + int todo = 1000; + do + { + I32 klen; + char *key; + HE *he = hv_iternext (obj_cache); + + if (he) + { + SV *sv = hv_iterval (obj_cache, he); + + // empty and unreferenced? nuke it + if (SvREFCNT (sv) == 1 && SvREFCNT (SvRV (sv)) == 1 && !HvFILL ((HV *)(SvRV (sv)))) + { + hv_delete (obj_cache, HeKEY (he), HeKLEN (he), G_DISCARD); + todo++; + } + } + else + break; + } + while (--todo); +} + static SV * newSVptr (void *ptr, const char *klass) { + SV *sv; + if (!ptr) return &PL_sv_undef; - HV *hv = newHV (); - sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0); - return sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); + sv = newSV (0); + sv_magic (sv, 0, PERL_MAGIC_ext, (char *)ptr, 0); + return sv_bless (newRV_noinc (sv), gv_stashpv (klass, 1)); +} + +static void +SVptr_cache_set (void *ptr, SV *sv) +{ + hv_store (obj_cache, (char *)&ptr, sizeof (ptr), sv, 0); +} + +static SV * +SVptr_cache_get (void *ptr) +{ + SV **he = hv_fetch (obj_cache, (char *)&ptr, sizeof (ptr), 0); + + return he ? *he : 0; +} + +static SV * +newSVptr_cached (void *ptr, const char *klass) +{ + SV *sv; + + if (!ptr) + return &PL_sv_undef; + + sv = SVptr_cache_get (ptr); + + if (!sv) + { + HV *hv = newHV (); + sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0); + sv = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); + + SVptr_cache_set (ptr, sv); + } + + return newSVsv (sv); } static void @@ -107,6 +188,15 @@ return (long)mg->mg_ptr; } +static long +SvPTR_ornull (SV *sv, const char *klass) +{ + if (SvOK (sv)) + return SvPTR (sv, klass); + else + return 0; +} + SV * newSVcfapi (int type, ...) { @@ -117,6 +207,12 @@ switch (type) { +#if 0 + case CFAPI_INT16: + sv = newSViv (*va_arg (args, sint16_t *)); + break; +#endif + case CFAPI_INT: sv = newSViv (*va_arg (args, int *)); break; @@ -146,15 +242,15 @@ switch (*(int *)cf_object_get_property (obj, CFAPI_OBJECT_PROP_TYPE)) { case MAP: - sv = newSVptr (obj, "cf::object::map"); + sv = newSVptr_cached (obj, "cf::object::map"); break; case PLAYER: - sv = newSVptr (obj, "cf::object::player"); + sv = newSVptr_cached (obj, "cf::object::player"); break; default: - sv = newSVptr (obj, "cf::object"); + sv = newSVptr_cached (obj, "cf::object"); break; } } @@ -192,7 +288,7 @@ ///////////////////////////////////////////////////////////////////////////// void -inject_event (CFPContext *context) +inject_event (const char *func, CFPContext *context) { dSP; @@ -201,23 +297,22 @@ PUSHMARK (SP); - EXTEND (SP, 2); - //PUSHs (sv_2mortal (newSViv (type))); - HV *hv = newHV (); #define hv_context(type,addr,expr) hv_store (hv, #expr, sizeof (#expr) - 1, newSVcfapi (type, addr context->expr), 0) hv_context (CFAPI_POBJECT, ,who); hv_context (CFAPI_POBJECT, ,activator); hv_context (CFAPI_POBJECT, ,third); + hv_context (CFAPI_PMAP, ,map); hv_context (CFAPI_STRING , ,message); hv_context (CFAPI_INT ,&,fix); hv_context (CFAPI_INT ,&,event_code); hv_context (CFAPI_STRING , ,options); + hv_context (CFAPI_STRING , ,extension); - PUSHs (sv_2mortal (newRV_noinc ((SV *)hv))); + XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv))); PUTBACK; - int count = call_pv ("cf::inject_event", G_SCALAR | G_EVAL); + int count = call_pv (func, G_SCALAR | G_EVAL); SPAGAIN; if (SvTRUE (ERRSV)) @@ -336,6 +431,10 @@ registerGlobalEvent = gethook (&rtype, hooktype, "cfapi_system_register_global_event"); unregisterGlobalEvent = gethook (&rtype, hooktype, "cfapi_system_unregister_global_event"); systemDirectory = gethook (&rtype, hooktype, "cfapi_system_directory"); + object_set_property = gethook (&rtype, hooktype, "cfapi_object_set_property"); + map_get_map = gethook (&rtype, hooktype, "cfapi_map_get_map"); + object_insert = gethook (&rtype, hooktype, "cfapi_object_insert"); + cf_init_plugin (gethook); /* Pick the global events you want to monitor from this plugin */ @@ -349,11 +448,18 @@ registerGlobalEvent (NULL, EVENT_MAPENTER, PLUGIN_NAME, globalEventListener); registerGlobalEvent (NULL, EVENT_MAPLEAVE, PLUGIN_NAME, globalEventListener); registerGlobalEvent (NULL, EVENT_MAPRESET, PLUGIN_NAME, globalEventListener); + registerGlobalEvent (NULL, EVENT_MAPLOAD, PLUGIN_NAME, globalEventListener); + registerGlobalEvent (NULL, EVENT_MAPOUT, PLUGIN_NAME, globalEventListener); + registerGlobalEvent (NULL, EVENT_MAPIN, PLUGIN_NAME, globalEventListener); + registerGlobalEvent (NULL, EVENT_MAPCLEAN, PLUGIN_NAME, globalEventListener); registerGlobalEvent (NULL, EVENT_REMOVE, PLUGIN_NAME, globalEventListener); registerGlobalEvent (NULL, EVENT_SHOUT, PLUGIN_NAME, globalEventListener); registerGlobalEvent (NULL, EVENT_TELL, PLUGIN_NAME, globalEventListener); registerGlobalEvent (NULL, EVENT_MUZZLE, PLUGIN_NAME, globalEventListener); registerGlobalEvent (NULL, EVENT_KICK, PLUGIN_NAME, globalEventListener); + registerGlobalEvent (NULL, EVENT_FREE_OB, PLUGIN_NAME, globalEventListener); + registerGlobalEvent (NULL, EVENT_PLAYER_LOAD, PLUGIN_NAME, globalEventListener); + registerGlobalEvent (NULL, EVENT_PLAYER_SAVE, PLUGIN_NAME, globalEventListener); char *argv[] = { "", @@ -377,6 +483,10 @@ perl_free (perl); perl = 0; } + else + { + obj_cache = newHV (); + } return 0; } @@ -405,7 +515,26 @@ printf ("Unimplemented for now\n"); break; + case EVENT_PLAYER_LOAD: + case EVENT_PLAYER_SAVE: + context.who = va_arg (args, object *); + buf = va_arg (args, char *); + if (buf != 0) + strncpy (context.message, buf, sizeof (context.message)); + break; + + case EVENT_MAPLOAD: + case EVENT_MAPOUT: + case EVENT_MAPIN: + case EVENT_MAPCLEAN: + context.map = va_arg (args, mapstruct *); + break; + + case EVENT_MAPENTER: + case EVENT_MAPLEAVE: + case EVENT_FREE_OB: case EVENT_BORN: + case EVENT_REMOVE: context.activator = va_arg (args, object *); break; @@ -419,70 +548,49 @@ break; case EVENT_LOGIN: - pl = va_arg (args, player *); - context.activator = pl->ob; - buf = va_arg (args, char *); - if (buf != 0) - strcpy (context.message, buf); - break; - case EVENT_LOGOUT: pl = va_arg (args, player *); context.activator = pl->ob; buf = va_arg (args, char *); if (buf != 0) - strcpy (context.message, buf); - break; - - case EVENT_REMOVE: - context.activator = va_arg (args, object *); + strncpy (context.message, buf, sizeof (context.message)); break; case EVENT_SHOUT: - context.activator = va_arg (args, object *); - buf = va_arg (args, char *); - if (buf != 0) - strcpy (context.message, buf); - break; - case EVENT_MUZZLE: - context.activator = va_arg (args, object *); - buf = va_arg (args, char *); - if (buf != 0) - strcpy (context.message, buf); - break; - case EVENT_KICK: context.activator = va_arg (args, object *); buf = va_arg (args, char *); if (buf != 0) - strcpy (context.message, buf); + strncpy (context.message, buf, sizeof (context.message)); break; - case EVENT_MAPENTER: - context.activator = va_arg (args, object *); - break; - - case EVENT_MAPLEAVE: - context.activator = va_arg (args, object *); + case EVENT_CLOCK: + clean_obj_cache (); break; - case EVENT_CLOCK: + case EVENT_TELL: break; case EVENT_MAPRESET: + /* stupid, should be the map itself, not "message"??? */ buf = va_arg (args, char *); if (buf != 0) - strcpy (context.message, buf); - break; - - case EVENT_TELL: + strncpy (context.message, buf, sizeof (context.message)); break; } va_end (args); - inject_event (&context); + if (context.event_code == EVENT_FREE_OB) + { + SV *sv = hv_delete (obj_cache, (char *)&context.activator, sizeof (void *), 0); + + if (sv) + clearSVptr (sv); + } + else + inject_event ("cf::inject_global_event", &context); rv = context.returnvalue; @@ -508,17 +616,18 @@ context.event_code = va_arg (args, int); context.activator = va_arg (args, object *); context.third = va_arg (args, object *); - buf = va_arg (args, char *); + buf = va_arg (args, char *); if (buf != 0) - strcpy (context.message, buf); + strncpy (context.message, buf, sizeof (context.message)); context.fix = va_arg (args, int); - strcpy (context.options, va_arg (args, char *)); + strncpy (context.extension, va_arg (args, char *), sizeof (context.extension)); + strncpy (context.options, va_arg (args, char *), sizeof (context.options)); context.returnvalue = 0; va_end (args); - inject_event (&context); + inject_event ("cf::inject_event", &context); rv = context.returnvalue; return &rv; @@ -545,7 +654,7 @@ { HV *stash = gv_stashpv ("cf", 1); - const struct { + static const struct { const char *name; IV iv; } *civ, const_iv[] = { @@ -556,6 +665,7 @@ const_iv (llevMonster) const_iv (PLAYER) + const_iv (TRANSPORT) const_iv (ROD) const_iv (TREASURE) const_iv (POTION) @@ -570,7 +680,6 @@ const_iv (ARMOUR) const_iv (PEDESTAL) const_iv (ALTAR) - const_iv (CONFUSION) const_iv (LOCKED_DOOR) const_iv (SPECIAL_KEY) const_iv (MAP) @@ -681,10 +790,38 @@ const_iv (ST_BD_BUILD) const_iv (ST_BD_REMOVE) + const_iv (ST_MAT_FLOOR) const_iv (ST_MAT_WALL) const_iv (ST_MAT_ITEM) + const_iv (AT_PHYSICAL) + const_iv (AT_MAGIC) + const_iv (AT_FIRE) + const_iv (AT_ELECTRICITY) + const_iv (AT_COLD) + const_iv (AT_CONFUSION) + const_iv (AT_ACID) + const_iv (AT_DRAIN) + const_iv (AT_WEAPONMAGIC) + const_iv (AT_GHOSTHIT) + const_iv (AT_POISON) + const_iv (AT_SLOW) + const_iv (AT_PARALYZE) + const_iv (AT_TURN_UNDEAD) + const_iv (AT_FEAR) + const_iv (AT_CANCELLATION) + const_iv (AT_DEPLETE) + const_iv (AT_DEATH) + const_iv (AT_CHAOS) + const_iv (AT_COUNTERSPELL) + const_iv (AT_GODPOWER) + const_iv (AT_HOLYWORD) + const_iv (AT_BLIND) + const_iv (AT_INTERNAL) + const_iv (AT_LIFE_STEALING) + const_iv (AT_DISEASE) + const_iv (QUEST_IN_PROGRESS) const_iv (QUEST_DONE_QUEST) const_iv (QUEST_DONE_TASK) @@ -834,12 +971,42 @@ const_iv (F_OPEN) const_iv (F_NOPICK) const_iv (F_LOCKED) + + const_iv (P_BLOCKSVIEW) + const_iv (P_NO_MAGIC) + const_iv (P_IS_ALIVE) + const_iv (P_NO_CLERIC) + const_iv (P_NEED_UPDATE) + const_iv (P_NO_ERROR) + const_iv (P_OUT_OF_MAP) + const_iv (P_NEW_MAP) + + const_iv (UP_OBJ_INSERT) + const_iv (UP_OBJ_REMOVE) + const_iv (UP_OBJ_CHANGE) + const_iv (UP_OBJ_FACE) + + const_iv (INS_NO_MERGE) + const_iv (INS_ABOVE_FLOOR_ONLY) + const_iv (INS_NO_WALK_ON) + const_iv (INS_ON_TOP) + const_iv (INS_BELOW_ORIGINATOR) + const_iv (INS_MAP_LOAD) + + const_iv (WILL_APPLY_HANDLE) + const_iv (WILL_APPLY_TREASURE) + const_iv (WILL_APPLY_EARTHWALL) + const_iv (WILL_APPLY_DOOR) + const_iv (WILL_APPLY_FOOD) + + const_iv (SAVE_MODE) + const_iv (SAVE_DIR_MODE) }; for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ-- > const_iv; ) newCONSTSUB (stash, (char *)civ->name, newSViv (civ->iv)); - const struct { + static const struct { const char *name; IV iv; } *event, event_list[] = { @@ -857,22 +1024,30 @@ const_event (TRIGGER) const_event (CLOSE) const_event (TIMER) + const_event (MOVE) const_event (BORN) const_event (CLOCK) const_event (CRASH) const_event (PLAYER_DEATH) + const_event (PLAYER_LOAD) + const_event (PLAYER_SAVE) const_event (GKILL) const_event (LOGIN) const_event (LOGOUT) const_event (MAPENTER) const_event (MAPLEAVE) const_event (MAPRESET) + const_event (MAPLOAD) + const_event (MAPOUT) + const_event (MAPIN) + const_event (MAPCLEAN) const_event (REMOVE) const_event (SHOUT) const_event (TELL) const_event (MUZZLE) const_event (KICK) + //const_event (FREE_OB) }; AV *av = get_av ("cf::EVENT", 1); @@ -880,7 +1055,7 @@ for (event = event_list + sizeof (event_list) / sizeof (event_list [0]); event-- > event_list; ) av_store (av, event->iv, newSVpv ((char *)event->name, 0)); - const struct { + static const struct { int dtype; const char *name; IV idx; @@ -1069,13 +1244,63 @@ case CFAPI_LONG: cf_object_set_long_property (obj, idx, SvNV (newval)); break; + case CFAPI_DOUBLE: + { + int unused_type; + object_set_property (&unused_type, obj, idx, (double)SvNV (newval)); + } + break; case CFAPI_STRING: - cf_object_set_string_property (obj, idx, SvPV_nolen (newval)); + cf_object_set_string_property (obj, idx, SvOK (newval) ? SvPV_nolen (newval) : 0); + break; + case CFAPI_POBJECT: + { + int unused_type; + object_set_property (&unused_type, obj, idx, (object *)SvPTR_ornull (newval, "cf::object")); + } break; default: croak ("unhandled type '%d' in set_property '%d'", type, idx); } +# missing properties + +void +set_attacktype (object *obj, U32 attacktype) + CODE: + obj->attacktype = attacktype; + +U32 +get_attacktype (object *obj) + ALIAS: + attacktype = 0 + CODE: + RETVAL = obj->attacktype; + OUTPUT: RETVAL + +void +set_food (object *obj, int food) + CODE: + obj->stats.food = food; + +int +get_food (object *obj) + ALIAS: + food = 0 + CODE: + RETVAL = obj->stats.food; + OUTPUT: RETVAL + +void +inv (object *obj) + PROTOTYPE: $ + PPCODE: +{ + object *o; + for (o = obj->inv; o; o = o->below) + XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, o))); +} + int cf_object_get_resistance (object *op, int rtype) ALIAS: resistance = 0 @@ -1084,9 +1309,9 @@ void cf_object_set_flag (object *op, int flag, int value) -void cf_object_move (object *op, object *originator, int dir) +void cf_object_move (object *op, int dir, object *originator = op) -void cf_object_apply (object *op, object *author, int flags) +void cf_object_apply (object *op, object *author, int flags = 0) void cf_object_apply_below (object *op) @@ -1100,15 +1325,15 @@ int cf_object_change_map (object *op, int x, int y, mapstruct *map) -object *cf_object_clone (object *op, int clonetype) +object *cf_object_clone (object *op, int clonetype = 0) int cf_object_pay_item (object *op, object *buyer) int cf_object_pay_amount (object *op, double amount) -int cf_object_cast_spell (object *caster, object *ctoo, int dir, object *sp_, char *flags) +int cf_object_cast_spell (object *caster, object *ctoo, int dir, object *spell_ob, char *stringarg = 0) -int cf_object_cast_ability (object *caster, object *ctoo, int dir, object *sp_, char *flags) +int cf_object_cast_ability (object *caster, object *ctoo, int dir, object *sp_, char *stringarg = 0) void cf_object_learn_spell (object *op, object *sp) @@ -1154,28 +1379,62 @@ void cf_object_set_key (object *op, char *keyname, char *value) -char * -base_name (object *ob, int plural) - CODE: - RETVAL = cf_query_base_name (ob, plural); - OUTPUT: RETVAL +object *cf_create_object_by_name (const char *name) -MODULE = cf PACKAGE = cf::object PREFIX = cf_object_ +MODULE = cf PACKAGE = cf::object PREFIX = cf_ -object *cf_create_object_by_name (const char *name = 0) +void cf_fix_object (object *pl) + ALIAS: fix = 0 + +object *cf_insert_ob_in_ob (object *ob, object *where) + +# no clean way to get an object from an archetype - stupid idiotic +# dumb kludgy misdesigned plug-in api slowly gets on my nerves. + +object *new (const char *archetype = 0) PROTOTYPE: ;$ - ALIAS: - create_object = 0 - new = 0 CODE: - RETVAL = name ? cf_create_object_by_name (name) : cf_create_object (); + RETVAL = archetype ? get_archetype (archetype) : cf_create_object (); OUTPUT: RETVAL -void cf_fix_object (object *pl) - ALIAS: fix = 0 +object *insert_ob_in_map_at (object *ob, mapstruct *where, object_ornull *orig, int flag, int x, int y) + PROTOTYPE: $$$$$$ + CODE: +{ + int unused_type; + RETVAL = (object *)object_insert (&unused_type, ob, 0, where, orig, flag, x, y); +} -object *cf_insert_ob_in_ob (object *ob, object *where) +object *get_nearest_player (object *ob) + ALIAS: nearest_player = 0 + PREINIT: + extern object *get_nearest_player (object *); + +void rangevector (object *ob, object *other, int flags = 0) + PROTOTYPE: $$;$ + PPCODE: +{ + rv_vector rv; + get_rangevector (ob, other, &rv, flags); + EXTEND (SP, 5); + PUSHs (newSVuv (rv.distance)); + PUSHs (newSViv (rv.distance_x)); + PUSHs (newSViv (rv.distance_y)); + PUSHs (newSViv (rv.direction)); + PUSHs (newSVcfapi (CFAPI_POBJECT, rv.part)); +} + +bool on_same_map_as (object *ob, object *other) + CODE: + RETVAL = on_same_map (ob, other); + OUTPUT: RETVAL + +char * +base_name (object *ob, int plural) + CODE: + RETVAL = cf_query_base_name (ob, plural); + OUTPUT: RETVAL MODULE = cf PACKAGE = cf::object::player PREFIX = cf_player_ @@ -1189,6 +1448,11 @@ object *cf_player_send_inventory (object *op) +player *contr (object *op) + CODE: + RETVAL = op->contr; + OUTPUT: RETVAL + char *cf_player_get_ip (object *op) ALIAS: ip = 0 @@ -1212,12 +1476,33 @@ void cf_player_move (player *pl, int dir) +void MapNewmapCmd (player *pl) + # nonstandard object *ob (player *pl) CODE: RETVAL = pl->ob; OUTPUT: RETVAL +player *first () + CODE: + RETVAL = first_player; + OUTPUT: RETVAL + +player *next (player *pl) + CODE: + RETVAL = pl->next; + OUTPUT: RETVAL + +void +list () + PPCODE: +{ + player *pl; + for (pl = first_player; pl; pl = pl->next) + XPUSHs (newSVcfapi (CFAPI_PPLAYER, pl)); +} + MODULE = cf PACKAGE = cf::map PREFIX = cf_map_ @@ -1239,6 +1524,16 @@ croak ("unhandled type '%d' in set_property '%d'", type, idx); } +mapstruct *new (int width, int height) + PROTOTYPE: + CODE: +{ + int unused_type; + RETVAL = map_get_map (&unused_type, 0, width, height); +} + OUTPUT: + RETVAL + mapstruct *cf_map_get_map (char *name) PROTOTYPE: $ ALIAS: map = 0 @@ -1256,11 +1551,122 @@ #int cf_map_get_flags (mapstruct* map, mapstruct** nmap, I16 x, I16 y, I16 *nx, I16 *ny) +void +at (mapstruct *obj, unsigned int x, unsigned int y) + PROTOTYPE: $$$ + INIT: + if (x >= MAP_WIDTH (obj) || y >= MAP_HEIGHT (obj)) XSRETURN_EMPTY; + PPCODE: +{ + object *o; + + for (o = GET_MAP_OB (obj, x, y); o; o = o->above) + XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, o))); +} + +SV * +bot_at (mapstruct *obj, unsigned int x, unsigned int y) + PROTOTYPE: $$$ + ALIAS: + top_at = 1 + flags_at = 2 + light_at = 3 + move_block_at = 4 + move_slow_at = 5 + move_on_at = 6 + move_off_at = 7 + INIT: + if (x >= MAP_WIDTH (obj) || y >= MAP_HEIGHT (obj)) XSRETURN_UNDEF; + CODE: + switch (ix) + { + case 0: RETVAL = newSVcfapi (CFAPI_POBJECT, GET_MAP_OB (obj, x, y)); break; + case 1: RETVAL = newSVcfapi (CFAPI_POBJECT, GET_MAP_TOP (obj, x, y)); break; + case 2: RETVAL = newSVuv ( GET_MAP_FLAGS (obj, x, y)); break; + case 3: RETVAL = newSViv ( GET_MAP_LIGHT (obj, x, y)); break; + case 4: RETVAL = newSVuv ( GET_MAP_MOVE_BLOCK (obj, x, y)); break; + case 5: RETVAL = newSVuv ( GET_MAP_MOVE_SLOW (obj, x, y)); break; + case 6: RETVAL = newSVuv ( GET_MAP_MOVE_ON (obj, x, y)); break; + case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; + } + OUTPUT: + RETVAL + +# "serialise" map perl data into a ref +void +_get_obs (mapstruct *map) + PPCODE: +{ + object *o; + int x, y; + AV *obs = newAV (); + int nonnull = 0; + + for (y = 0; y < MAP_HEIGHT (map); y++) + for (x = 0; x < MAP_WIDTH (map); x++) + { + AV *av = newAV (); + + for (o = GET_MAP_OB (map, x, y); o; o = o->above) + { + SV *sv = SVptr_cache_get (o); + + if (sv && HvFILL (SvRV (sv))) + { + nonnull = 1; + sv = newSVsv (sv); + } + else + sv = &PL_sv_undef; + + av_push (av, sv); + } + + av_store (obs, x + y * MAP_HEIGHT (map), newRV_noinc ((SV *)av)); + } + + if (nonnull) + XPUSHs (sv_2mortal (newRV_noinc ((SV *)obs))); + else + SvREFCNT_dec (obs); +} +# "deserialise" perl map data into the map +void +_set_obs (mapstruct *map, SV *sv) + CODE: +{ + object *o; + AV *av; + int x, y; + AV *obs = (AV *)SvRV (sv); + + for (y = 0; y < MAP_HEIGHT (map); y++) + for (x = 0; x < MAP_WIDTH (map); x++) + { + sv = *av_fetch (obs, x + y * MAP_HEIGHT (map), 1); + + if (!SvROK (sv)) + continue; + + av = (AV *)SvRV (sv); + + for (o = GET_MAP_OB (map, x, y); o; o = o->above) + { + sv = av_shift (av); + + if (SvROK (sv)) + { + sv_magic ((SV *)SvRV (sv), 0, PERL_MAGIC_ext, (char *)o, 0); + SVptr_cache_set (o, sv); + } + } + } +} MODULE = cf PACKAGE = cf::arch PREFIX = cf_archetype_ -archetype*cf_archetype_get_first() +archetype *cf_archetype_get_first() PROTOTYPE: ALIAS: first = 0