[ViewVC] Diff of: cvs/deliantra/server/server/cfperl.xs

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.1 by root, Tue Aug 15 17:10:46 2006 UTC vs.
Revision 1.14 by root, Sun Aug 27 13:02:04 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
55	static void globalEventListener (int type, ...);
56		54
57	extern sint64 *levels; // the experience table	55	extern sint64 *levels; // the experience table
58		56
59	typedef object object_ornull;	57	typedef object object_ornull;
60	typedef mapstruct mapstruct_ornull;	58	typedef mapstruct mapstruct_ornull;
…		…
62	typedef double val64;	60	typedef double val64;
63	#define newSVval64 newSVnv	61	#define newSVval64 newSVnv
64	#define SvVAL64 SvNV	62	#define SvVAL64 SvNV
65		63
66	static f_plug_api gethook;	64	static f_plug_api gethook;
67	static f_plug_api registerGlobalEvent;
68	static f_plug_api unregisterGlobalEvent;
69	static f_plug_api systemDirectory;	65	static f_plug_api systemDirectory;
70	static f_plug_api object_set_property;	66	static f_plug_api object_set_property;
71	static f_plug_api map_get_map;	67	static f_plug_api map_get_map;
72	static f_plug_api object_insert;	68	static f_plug_api object_insert;
73		69
…		…
88	} CFPContext;	84	} CFPContext;
89		85
90	static HV *obj_cache;	86	static HV *obj_cache;
91	static PerlInterpreter *perl;	87	static PerlInterpreter *perl;
92		88
		89	static 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.
106	static void
107	clean_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
138	static SV *	101	static SV *
139	newSVptr (void ptr, const char klass)	102	newSVptr (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
		113	template<class extendable>
		114	SV *
		115	newSVextendable (extendable 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
151	static void	126	static void
152	SVptr_cache_set (void ptr, SV sv)	127	SVptr_cache_set (void ptr, SV sv)
153	{	128	{
…		…
216	else	191	else
217	return 0;	192	return 0;
218	}	193	}
219		194
220	static SV *	195	static SV *
221	newSVcfapi (int type, ...)	196	newSVdt_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 = newSVextendable (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 = newSVextendable (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 = newSVextendable (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
		264	static SV *
		265	newSVdt (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
		276	static SV *
		277	newSVcfapi (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;
		304	}
		305
		306	//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
		307
		308	SV *
		309	registry_of (extendable_base *ext)
		310	{
		311	if (!ext->cb)
		312	ext->cb = newAV ();
		313
		314	return newRV_inc ((SV *)ext->cb);
		315	}
		316
		317	void extendable_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
		331	void extendable_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
		347	void
		348	object::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
		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 reattach (data_type type, void *obj)
		425	{
		426	dSP;
		427	ENTER;
		428	SAVETMPS;
		429	PUSHMARK (SP);
		430	XPUSHs (sv_2mortal (newSVdt (type, obj)));
		431	PUTBACK;
		432	call_pv ("cf::reattach", G_DISCARD \| G_VOID \| G_EVAL);
		433	FREETMPS;
		434	LEAVE;
		435
		436	switch (type)
		437	{
		438	case DT_OBJECT: INVOKE_OBJECT (REATTACH, obj); break;
		439	case DT_PLAYER: INVOKE_PLAYER (REATTACH, obj); break;
		440	case DT_MAP: INVOKE_MAP (REATTACH, obj); break;
		441	}
		442	}
		443
		444	template<class subclass>
		445	void reattach (extendable<subclass> *obj)
		446	{
		447	if (obj->self)
		448	reattach (subclass::get_dt (), (subclass *)obj);
		449	}
		450
		451	void object_thawer::get (data_type type, void obj, extendable_base ext)
		452	{
		453	if (!av)
		454	return;
		455
		456	// we have to "re-instantiate"/reattach to an object, so nuke ext->attach
		457	ext->clear ();
		458
		459	SV *svp = av_fetch ((AV )av, idx, 0);
		460
		461	++idx;
		462
		463	if (!svp)
		464	return;
		465
		466	if (SvROK (*svp))
		467	{
		468	ext->self = SvREFCNT_inc (*svp);
		469	sv_magic (SvRV ((SV )ext->self), 0, PERL_MAGIC_ext, (char )obj, 0);
		470
		471	reattach (type, obj);
		472	}
		473	}
		474
		475	object_thawer::~object_thawer ()
		476	{
		477	if (av)
		478	SvREFCNT_dec ((SV *)av);
306	}	479	}
307		480
308	/////////////////////////////////////////////////////////////////////////////	481	/////////////////////////////////////////////////////////////////////////////
309		482
310	extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)	483	extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
…		…
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");	577	printf (PLUGIN_VERSION " post init\n");
405		578
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");	579	systemDirectory = (void* ()(int, ...)) gethook (&rtype, hooktype, "cfapi_system_directory");
409	object_set_property = (void* ()(int, ...)) gethook (&rtype, hooktype, "cfapi_object_set_property");	580	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");	581	map_get_map = (void* ()(int, ...)) gethook (&rtype, hooktype, "cfapi_map_get_map");
411	object_insert = (void* ()(int, ...)) gethook (&rtype, hooktype, "cfapi_object_insert");	582	object_insert = (void* ()(int, ...)) gethook (&rtype, hooktype, "cfapi_object_insert");
412		583
413	cf_init_plugin (gethook);	584	cf_init_plugin (gethook);
414		585
415	/* Pick the global events you want to monitor from this plugin */	586	return 0;
416	registerGlobalEvent (NULL, EVENT_BORN, PLUGIN_NAME, globalEventListener);	587	}
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		588
		589	extern "C" int cfperl_closePlugin ()
		590	{
		591	return 0;
		592	}
		593
		594	void
		595	cfperl_init ()
		596	{
444	char *argv[] = {	597	char *argv[] = {
445	"",	598	"",
446	"-e"	599	"-e"
447	"BEGIN {"	600	"BEGIN {"
448	" cf->bootstrap;"	601	" cf->bootstrap;"
…		…
457		610
458	PL_exit_flags \|= PERL_EXIT_DESTRUCT_END;	611	PL_exit_flags \|= PERL_EXIT_DESTRUCT_END;
459		612
460	if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) \|\| perl_run (perl))	613	if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) \|\| perl_run (perl))
461	{	614	{
462	printf ("unable to initialize perl-interpreter, continuing without.\n");	615	printf ("unable to initialize perl-interpreter, aborting.\n");
463		616
		617	exit (EXIT_FAILURE);
464	perl_destruct (perl);	618	//perl_destruct (perl);
465	perl_free (perl);	619	//perl_free (perl);
466	perl = 0;	620	//perl = 0;
		621	//return;
467	}	622	}
468	else	623
		624	obj_cache = newHV ();
		625	}
		626
		627	void cfperl_main ()
		628	{
		629	dSP;
		630
		631	PUSHMARK (SP);
		632	PUTBACK;
		633	call_pv ("cf::main", G_DISCARD \| G_VOID);
		634	}
		635
		636	static event_klass klass_of[NUM_EVENT_TYPES] = {
		637	# define def(type,name) KLASS_ ## type,
		638	# include "eventinc.h"
		639	# undef def
		640	};
		641
		642	static void
		643	gather_callbacks (AV &callbacks, AV registry, event_type event)
		644	{
		645	// event must be in array
		646	if (event >= 0 && event <= AvFILLp (registry))
469	{	647	{
470	obj_cache = newHV ();	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	}
471	}	669	}
472
473	return 0;
474	}	670	}
475		671
476	static void *	672	bool cfperl_invoke (event_type event, ...)
477	globalEventListener (int *type, ...)
478	{	673	{
		674	data_type dt;
479	va_list args;	675	va_list ap;
480	static int rv;
481	int event_code;
482		676
483	if (!perl)
484	return NULL;
485
486	va_start (args, type);	677	va_start (ap, event);
487	event_code = va_arg (args, int);
488		678
489	if (event_code == EVENT_FREE_OB)	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])
490	{	694	{
491	player *pl;	695	case KLASS_GLOBAL:
492	object *op;	696	break;
493	SV *sv;
494		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));
495	op = va_arg (args, object *);	701	op = va_arg (ap, object *);
496	sv = hv_delete (obj_cache, (char )&op, sizeof (void ), 0);
497		702
498	if (sv)	703	if (op->cb)
499	clearSVptr (sv);	704	gather_callbacks (callbacks, (AV *)op->cb, event);
500		705
501	rv = 0;	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));
502	}	753	}
503	else if (event_code == EVENT_CLOCK)	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])
504	{	770	{
505	dSP;	771	case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break;
506	int i, count;	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	}
507		775
508	clean_obj_cache ();	776	for (;;)
		777	{
		778	dt = (data_type) va_arg (ap, int);
509		779
510	ENTER;	780	if (dt == DT_END)
511	SAVETMPS;	781	break;
512		782
513	// service up to 8 events per tick better would be	783	if (dt == DT_AV)
514	// to check for elapsed time and stop processing after
515	// 0.25 * server_tick or so
516	for (i = 9; --i; )
517	{	784	{
518	PUSHMARK (SP);	785	AV av = va_arg (ap, AV );
519	XPUSHs (sv_2mortal (newSViv (0)));
520	PUTBACK;
521	count = call_pv ("Event::one_event", G_SCALAR \| G_EVAL);
522	SPAGAIN;
523		786
524	if (!count \|\| !POPi)	787	for (int i = 0; i <= av_len (av); ++i)
525	break;	788	XPUSHs (*av_fetch (av, i, 1));
526	}	789	}
527		790	else
528	FREETMPS;	791	XPUSHs (sv_2mortal (newSVdt_va (ap, dt)));
529	LEAVE;
530	}	792	}
531	else
532	{
533	dSP;
534		793
535	ENTER;
536	SAVETMPS;
537
538	PUSHMARK (SP);
539
540	EXTEND (SP, 10);
541	PUSHs (sv_2mortal (newSViv (event_code)));
542
543	switch (event_code)
544	{
545	case EVENT_CRASH:
546	break;
547
548	case EVENT_PLAYER_LOAD:
549	case EVENT_PLAYER_SAVE:
550	PUSH_OB;
551	PUSH_PV;
552	break;
553
554	case EVENT_MAPLOAD:
555	case EVENT_MAPOUT:
556	case EVENT_MAPIN:
557	case EVENT_MAPCLEAN:
558	case EVENT_MAPRESET:
559	PUSH_MAP;
560	break;
561
562	case EVENT_MAPENTER:
563	case EVENT_MAPLEAVE:
564	case EVENT_BORN:
565	case EVENT_REMOVE:
566	case EVENT_PLAYER_DEATH:
567	PUSH_OB;
568	break;
569
570	case EVENT_GKILL:
571	PUSH_OB;
572	PUSH_OB;
573	break;
574
575	case EVENT_LOGIN:
576	case EVENT_LOGOUT:
577	PUSH_PL;
578	PUSH_PV;
579	break;
580
581	case EVENT_SHOUT:
582	case EVENT_MUZZLE:
583	case EVENT_KICK:
584	PUSH_OB;
585	PUSH_PV;
586	break;
587
588	case EVENT_FIND_UNARMED_SKILL:
589	PUSH_OB;
590	break;
591
592	case EVENT_PLAYER_USE_SKILL:
593	case EVENT_MONSTER_USE_SKILL:
594	case EVENT_CAST_SPELL:
595	PUSH_OB;
596	PUSH_OB;
597	PUSH_OB;
598	PUSH_IV;
599	PUSH_PV;
600	break;
601
602	case EVENT_EXTCMD:
603	PUSH_PL;
604	{
605	char buf = va_arg (args, char );
606	int len = va_arg (args, int);
607	PUSHs (sv_2mortal (newSVpvn (buf, len)));
608	}
609	break;
610
611	case EVENT_TELL:
612	break;
613	}
614
615	va_end (args);
616
617	PUTBACK;
618	int count = call_pv ("cf::inject_global_event", G_SCALAR \| G_EVAL);
619	SPAGAIN;
620
621	if (SvTRUE (ERRSV))
622	LOG (llevError, "global event '%d' callback evaluation error: %s", event_code, SvPV_nolen (ERRSV));
623
624	rv = count > 0 ? POPi : 0;
625
626	PUTBACK;
627	FREETMPS;
628	LEAVE;
629	}
630
631	return &rv;
632	}
633
634	extern "C" void cfperl_eventListener (int type, ...)
635	{
636	static int rv;
637	va_list args;
638	int event_code;
639	object who, activator, third, event;
640	char message, extension, *options;
641
642	if (!perl)
643	return NULL;
644
645	va_start (args, type);
646	who = va_arg (args, object *);
647	event_code = va_arg (args, int);
648	activator = va_arg (args, object *);
649	third = va_arg (args, object *);
650	message = va_arg (args, char *);
651	va_arg (args, int); // fix yourself
652	extension = va_arg (args, char *);
653	options = va_arg (args, char *);
654	event = va_arg (args, object *);
655	va_end (args);	794	va_end (ap);
656		795
657	{
658	dSP;
659
660	ENTER;
661	SAVETMPS;
662
663	PUSHMARK (SP);
664	EXTEND (SP, 10);
665
666	PUSHcfapi (STRING, extension);
667	PUSHs (sv_2mortal (newSViv (event_code)));
668
669	PUSHcfapi (POBJECT, event);
670	PUSHcfapi (POBJECT, who);
671
672	switch (event_code)
673	{
674	case EVENT_STOP: // $ob (e.g. arrow)
675	case EVENT_TIME: // $ob
676	case EVENT_TIMER: // $ob
677	break;
678
679	case EVENT_APPLY: // $ob, $who
680	case EVENT_DROP: // $ob, $who
681	case EVENT_CLOSE: // $ob, $who
682	case EVENT_DEATH: // $ob[, $killer]
683	case EVENT_MOVE: // $ob, $enemy
684	case EVENT_THROW: // $ob, $thrower
685	PUSHcfapi (POBJECT, activator);
686	break;
687
688	case EVENT_DROP_ON: // $ob, $who, $what
689	case EVENT_ATTACK: // $ob, $who, $victim (?? please god enlighten me)
690	PUSHcfapi (POBJECT, activator);
691	PUSHcfapi (POBJECT, third);
692	break;
693
694	case EVENT_TRIGGER: // $ob, $originator, [$victim], [$msg]
695	PUSHcfapi (POBJECT, activator);
696	PUSHcfapi (POBJECT, third);
697	PUSHcfapi (POBJECT, message);
698	break;
699
700	case EVENT_SAY: // $ob, $who, $msg
701	PUSHcfapi (POBJECT, activator);
702	PUSHcfapi (STRING, message);
703	break;
704
705	default:
706	LOG (llevError, "perl plugin called for unsupported event type %d", event_code);
707	break;
708	}
709
710	PUTBACK;	796	PUTBACK;
711	int count = call_pv ("cf::inject_event", G_SCALAR \| G_EVAL);	797	int count = call_pv ("cf::do_invoke", G_SCALAR \| G_EVAL);
712	SPAGAIN;	798	SPAGAIN;
713		799
714	if (SvTRUE (ERRSV))
715	LOG (llevError, "event '%d' callback evaluation error: %s", event_code, SvPV_nolen (ERRSV));
716
717	rv = count > 0 ? POPi : 0;	800	count = count > 0 ? POPi : 0;
718		801
719	PUTBACK;
720	FREETMPS;	802	FREETMPS;
721	LEAVE;	803	LEAVE;
722	}	804
723		805	return count;
		806	}
		807
		808	SV *
		809	cfperl_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
724	return &rv;	819	return *sv;
725	}	820	}
726		821
727	extern "C" int cfperl_closePlugin ()	822	int
		823	cfperl_result_INT (int idx)
728	{	824	{
729	printf (PLUGIN_VERSION " closing\n");	825	return SvIV (cfperl_result (idx));
730
731	if (perl)
732	{
733	perl_destruct (perl);
734	perl_free (perl);
735	perl = 0;
736	}
737
738	return 0;
739	}	826	}
740		827
741	MODULE = cf PACKAGE = cf PREFIX = cf_	828	MODULE = cf PACKAGE = cf PREFIX = cf_
742		829
743	BOOT:	830	BOOT:
…		…
752	const_iv (llevError)	839	const_iv (llevError)
753	const_iv (llevInfo)	840	const_iv (llevInfo)
754	const_iv (llevDebug)	841	const_iv (llevDebug)
755	const_iv (llevMonster)	842	const_iv (llevMonster)
756		843
		844	const_iv (MAX_TIME)
757	const_iv (PLAYER)	845	const_iv (PLAYER)
758	const_iv (TRANSPORT)	846	const_iv (TRANSPORT)
759	const_iv (ROD)	847	const_iv (ROD)
760	const_iv (TREASURE)	848	const_iv (TREASURE)
761	const_iv (POTION)	849	const_iv (POTION)
…		…
876	const_iv (BUILDER)	964	const_iv (BUILDER)
877	const_iv (MATERIAL)	965	const_iv (MATERIAL)
878	const_iv (ITEM_TRANSFORMER)	966	const_iv (ITEM_TRANSFORMER)
879	const_iv (QUEST)	967	const_iv (QUEST)
880		968
		969	const_iv (NUM_SUBTYPES)
		970
881	const_iv (ST_BD_BUILD)	971	const_iv (ST_BD_BUILD)
882	const_iv (ST_BD_REMOVE)	972	const_iv (ST_BD_REMOVE)
883		973
884	const_iv (ST_MAT_FLOOR)	974	const_iv (ST_MAT_FLOOR)
885	const_iv (ST_MAT_WALL)	975	const_iv (ST_MAT_WALL)
…		…
1221		1311
1222	const_iv (MAP_IN_MEMORY)	1312	const_iv (MAP_IN_MEMORY)
1223	const_iv (MAP_SWAPPED)	1313	const_iv (MAP_SWAPPED)
1224	const_iv (MAP_LOADING)	1314	const_iv (MAP_LOADING)
1225	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)
1226	};	1321	};
1227		1322
1228	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; )
1229	newCONSTSUB (stash, (char *)civ->name, newSViv (civ->iv));	1324	newCONSTSUB (stash, (char *)civ->name, newSViv (civ->iv));
1230		1325
1231	static const struct {	1326	static const struct {
1232	const char *name;	1327	const char *name;
		1328	int skip;
		1329	IV klass;
1233	IV iv;	1330	IV iv;
1234	} *event, event_list[] = {	1331	} *eiv, event_iv[] = {
1235	# 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 },
1236	const_event (NONE)	1333	# include "eventinc.h"
1237	const_event (APPLY)	1334	# undef def
1238	const_event (ATTACK)
1239	const_event (DEATH)
1240	const_event (DROP)
1241	const_event (DROP_ON)
1242	const_event (PICKUP)
1243	const_event (SAY)
1244	const_event (STOP)
1245	const_event (TIME)
1246	const_event (THROW)
1247	const_event (TRIGGER)
1248	const_event (CLOSE)
1249	const_event (TIMER)
1250	const_event (MOVE)
1251
1252	const_event (BORN)
1253	//const_event (CLOCK)
1254	const_event (CRASH)
1255	const_event (PLAYER_DEATH)
1256	const_event (PLAYER_LOAD)
1257	const_event (PLAYER_SAVE)
1258	const_event (GKILL)
1259	const_event (LOGIN)
1260	const_event (LOGOUT)
1261	const_event (MAPENTER)
1262	const_event (MAPLEAVE)
1263	const_event (MAPRESET)
1264	const_event (MAPLOAD)
1265	const_event (MAPOUT)
1266	const_event (MAPIN)
1267	const_event (MAPCLEAN)
1268	const_event (REMOVE)
1269	const_event (SHOUT)
1270	const_event (TELL)
1271	const_event (MUZZLE)
1272	const_event (KICK)
1273	const_event (PLAYER_USE_SKILL)
1274	const_event (MONSTER_USE_SKILL)
1275	const_event (CAST_SPELL)
1276	const_event (FIND_UNARMED_SKILL)
1277	const_event (EXTCMD)
1278	//const_event (FREE_OB)
1279	};	1335	};
1280		1336
1281	AV *av = get_av ("cf::EVENT", 1);	1337	AV *av = get_av ("cf::EVENT", 1);
1282		1338
1283	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; )
1284	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	}
1285		1347
1286	static const struct {	1348	static const struct {
1287	int dtype;	1349	int dtype;
1288	const char *name;	1350	const char *name;
1289	IV idx;	1351	IV idx;
…		…
1420	}	1482	}
1421		1483
1422	//I_EVENT_API (PACKAGE);	1484	//I_EVENT_API (PACKAGE);
1423	}	1485	}
1424		1486
		1487	void _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
		1495	void _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
1425	NV floor (NV x)	1509	NV floor (NV x)
1426		1510
1427	NV ceil (NV x)	1511	NV ceil (NV x)
		1512
		1513	void server_tick ()
1428		1514
1429	void	1515	void
1430	LOG (int level, char *msg)	1516	LOG (int level, char *msg)
1431	PROTOTYPE: $$	1517	PROTOTYPE: $$
1432	C_ARGS: (LogLevel)level, "%s", msg	1518	C_ARGS: (LogLevel)level, "%s", msg
…		…
1470	PROTOTYPE: $	1556	PROTOTYPE: $
1471		1557
1472	int random_roll(int min, int max, object *op, int goodbad);	1558	int random_roll(int min, int max, object *op, int goodbad);
1473		1559
1474	const char *cost_string_from_value(uint64 cost, int approx = 0)	1560	const char *cost_string_from_value(uint64 cost, int approx = 0)
		1561
		1562	int invoke (int event, SV *arg1, ...)
		1563	CODE:
		1564	{
		1565	// parse first arg and call invoke_object etc as seen fit
		1566	//TODO
		1567	//cfperl_invoke (event,
		1568	}
1475		1569
1476	int	1570	int
1477	exp_to_level (val64 exp)	1571	exp_to_level (val64 exp)
1478	CODE:	1572	CODE:
1479	{	1573	{
…		…
1718	{	1812	{
1719	int unused_type;	1813	int unused_type;
1720	RETVAL = (object *)object_insert (&unused_type, ob, 0, where, orig, flag, x, y);	1814	RETVAL = (object *)object_insert (&unused_type, ob, 0, where, orig, flag, x, y);
1721	}	1815	}
1722		1816
		1817	SV registry (object op)
		1818	CODE:
		1819	RETVAL = registry_of (op);
		1820	OUTPUT:
		1821	RETVAL
		1822
1723	# syntatic sugar for easier use in event callbacks.	1823	# syntatic sugar for easier use in event callbacks.
1724	const char options (object op)	1824	const char options (object op)
1725	CODE:	1825	CODE:
1726	RETVAL = op->name;	1826	RETVAL = op->name;
1727	OUTPUT:	1827	OUTPUT:
…		…
1797		1897
1798	void cf_player_set_party (object op, partylist party)	1898	void cf_player_set_party (object op, partylist party)
1799		1899
1800	void kill_player (object *op)	1900	void kill_player (object *op)
1801		1901
1802	MODULE = cf PACKAGE = cf::object::map PREFIX = cf_
1803
1804	MODULE = cf PACKAGE = cf::player PREFIX = cf_player_	1902	MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
		1903
		1904	SV registry (player pl)
		1905	CODE:
		1906	RETVAL = registry_of (pl);
		1907	OUTPUT:
		1908	RETVAL
1805		1909
1806	player cf_player_find (char name)	1910	player cf_player_find (char name)
1807	PROTOTYPE: $	1911	PROTOTYPE: $
1808		1912
1809	void cf_player_move (player *pl, int dir)	1913	void cf_player_move (player *pl, int dir)
1810
1811	void MapNewmapCmd (player *pl)
1812		1914
1813	void play_sound_player_only (player *pl, int soundnum, int x = 0, int y = 0);	1915	void play_sound_player_only (player *pl, int soundnum, int x = 0, int y = 0);
1814		1916
1815	# nonstandard	1917	# nonstandard
1816	object ob (player pl)	1918	object ob (player pl)
…		…
1833	CODE:	1935	CODE:
1834	RETVAL = FABS (dx) <= pl->socket.mapx / 2 && FABS (dy) <= pl->socket.mapy / 2	1936	RETVAL = FABS (dx) <= pl->socket.mapx / 2 && FABS (dy) <= pl->socket.mapy / 2
1835	&& !pl->blocked_los [dx + pl->socket.mapx / 2][dy + pl->socket.mapy / 2];	1937	&& !pl->blocked_los [dx + pl->socket.mapx / 2][dy + pl->socket.mapy / 2];
1836	OUTPUT:	1938	OUTPUT:
1837	RETVAL	1939	RETVAL
		1940
		1941	char *
		1942	client (player *pl)
		1943	CODE:
		1944	RETVAL = pl->socket.client;
		1945	OUTPUT:
		1946	RETVAL
		1947
		1948	char *
		1949	host (player *pl)
		1950	CODE:
		1951	RETVAL = pl->socket.host;
		1952	OUTPUT:
		1953	RETVAL
		1954
		1955	char *
		1956	killer (player pl, char killer = 0)
		1957	CODE:
		1958	if (killer)
		1959	snprintf (pl->killer, sizeof (pl->killer), "%s", killer);
		1960	RETVAL = pl->killer;
		1961	OUTPUT:
		1962	RETVAL
		1963
		1964	void
		1965	buggy_mapscroll (player *pl, int value = 1)
		1966	CODE:
		1967	pl->socket.buggy_mapscroll = value;
1838		1968
1839	void	1969	void
1840	send (player pl, SV packet)	1970	send (player pl, SV packet)
1841	CODE:	1971	CODE:
1842	{	1972	{
…		…
1901	RETVAL = &pl->last_stats;	2031	RETVAL = &pl->last_stats;
1902	OUTPUT: RETVAL	2032	OUTPUT: RETVAL
1903		2033
1904		2034
1905	MODULE = cf PACKAGE = cf::map PREFIX = cf_map_	2035	MODULE = cf PACKAGE = cf::map PREFIX = cf_map_
		2036
		2037	SV registry (mapstruct map)
		2038	CODE:
		2039	RETVAL = registry_of (map);
		2040	OUTPUT:
		2041	RETVAL
1906		2042
1907	SV *	2043	SV *
1908	get_property (mapstruct *obj, int type, int idx)	2044	get_property (mapstruct *obj, int type, int idx)
1909	CODE:	2045	CODE:
1910	RETVAL = newSVcfapi (type, cf_map_get_property (obj, idx));	2046	RETVAL = newSVcfapi (type, cf_map_get_property (obj, idx));
…		…
2054	case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;	2190	case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;
2055	}	2191	}
2056	OUTPUT:	2192	OUTPUT:
2057	RETVAL	2193	RETVAL
2058		2194
2059	# "serialise" map perl data into a ref	2195	# "deserialise" perl map data into the map # TODO# compatibility cruft, remove
2060	void
2061	_get_obs (mapstruct *map)
2062	PPCODE:
2063	{
2064	object *o;
2065	int x, y;
2066	AV *obs = newAV ();
2067	int nonnull = 0;
2068
2069	for (y = 0; y < MAP_HEIGHT (map); y++)
2070	for (x = 0; x < MAP_WIDTH (map); x++)
2071	{
2072	AV *av = newAV ();
2073
2074	for (o = GET_MAP_OB (map, x, y); o; o = o->above)
2075	{
2076	SV *sv = SVptr_cache_get (o);
2077
2078	if (sv && HvFILL (SvRV (sv)))
2079	{
2080	nonnull = 1;
2081	sv = newSVsv (sv);
2082	}
2083	else
2084	sv = &PL_sv_undef;
2085
2086	av_push (av, sv);
2087	}
2088
2089	av_store (obs, x + y * MAP_HEIGHT (map), newRV_noinc ((SV *)av));
2090	}
2091
2092	if (nonnull)
2093	XPUSHs (sv_2mortal (newRV_noinc ((SV *)obs)));
2094	else
2095	SvREFCNT_dec (obs);
2096	}
2097
2098	# "deserialise" perl map data into the map
2099	void	2196	void
2100	_set_obs (mapstruct map, SV sv)	2197	_set_obs (mapstruct map, SV sv)
2101	CODE:	2198	CODE:
2102	{	2199	{
2103	object *o;	2200	object *o;

Diff Legend

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

Comparing deliantra/server/server/cfperl.xs (file contents): Revision 1.1 by root, Tue Aug 15 17:10:46 2006 UTC vs. Revision 1.14 by root, Sun Aug 27 13:02:04 2006 UTC

Diff Legend

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.1 by root, Tue Aug 15 17:10:46 2006 UTC vs.
Revision 1.14 by root, Sun Aug 27 13:02:04 2006 UTC