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

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.17 by root, Sun Aug 27 17:59:26 2006 UTC vs.
Revision 1.36 by elmex, Thu Aug 31 10:15:14 2006 UTC

…		…
21	* You should have received a copy of the GNU General Public License	21	* You should have received a copy of the GNU General Public License
22	* along with this program; if not, write to the Free Software	22	* along with this program; if not, write to the Free Software
23	* Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA	23	* Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
24	*/	24	*/
25		25
26	#include <EXTERN.h>
27	#include <perl.h>
28	#include <XSUB.h>
29
30	#undef save_long // clashes with libproto.h
31
32	#define PLUGIN_NAME "perl"	26	#define PLUGIN_NAME "perl"
33	#define PLUGIN_VERSION "cfperl 0.5"	27	#define PLUGIN_VERSION "cfperl 0.5"
34
35	#ifndef __CEXTRACT__
36	#include <plugin.h>
37	#endif
38
39	#undef MODULEAPI
40	#ifdef WIN32
41	#else
42	#define MODULEAPI
43	#endif
44		28
45	#include <plugin_common.h>	29	#include <plugin_common.h>
46	#include <sounds.h>	30	#include <sounds.h>
47	#include <cstdarg>	31	#include <cstdarg>
48	#include <sproto.h>	32	#include <sproto.h>
49		33
50	#include "cfperl.h"	34	#include "cfperl.h"
51	#include "shstr.h"	35	#include "shstr.h"
52		36
		37	#include <EXTERN.h>
		38	#include <perl.h>
		39	#include <XSUB.h>
		40
53	#include "perlxsi.c"	41	#include "perlxsi.c"
54		42
55	extern sint64 *levels; // the experience table	43	extern sint64 *levels; // the experience table
56		44
57	typedef object object_ornull;	45	typedef object object_ornull;
…		…
59		47
60	typedef double val64;	48	typedef double val64;
61	#define newSVval64 newSVnv	49	#define newSVval64 newSVnv
62	#define SvVAL64 SvNV	50	#define SvVAL64 SvNV
63		51
64	static f_plug_api gethook;	52	static f_plug_api gethook = cfapi_get_hooks;
65	static f_plug_api systemDirectory;	53	static f_plug_api object_set_property = cfapi_object_set_property;
66	static f_plug_api object_set_property;	54	static f_plug_api object_insert = cfapi_object_insert;
67	static f_plug_api map_get_map;	55
68	static f_plug_api object_insert;	56	static bool perl_booted;
69		57
70	/* this is a stupid way to do things, and awkward to use for plug-in authors */	58	/* this is a stupid way to do things, and awkward to use for plug-in authors */
71	typedef struct	59	typedef struct
72	{	60	{
73	object* who;	61	object* who;
…		…
118	return &PL_sv_undef;	106	return &PL_sv_undef;
119		107
120	if (!obj->self)	108	if (!obj->self)
121	obj->self = newSVptr (obj, klass);	109	obj->self = newSVptr (obj, klass);
122		110
123	return newSVsv (static_cast<SV *>(obj->self));	111	return newSVsv (obj->self);
124	}	112	}
125		113
126	static void	114	static void
127	SVptr_cache_set (void ptr, SV sv)	115	SVptr_cache_set (void ptr, SV sv)
128	{	116	{
…		…
314	return newRV_inc ((SV *)ext->cb);	302	return newRV_inc ((SV *)ext->cb);
315	}	303	}
316		304
317	void attachable_base::clear ()	305	void attachable_base::clear ()
318	{	306	{
319	//if (self) fprintf (stderr, "free_ob_self %p %s (%p,%p)\n", this, ((object *)this)->name, self, cb);//D	307	if (self)
		308	{
		309	if (cb)
		310	if (SvROK (*av_fetch (cb, EVENT_OBJECT_DESTROY, 1)))
		311	INVOKE_OBJECT (DESTROY, static_cast<object *>(this));
		312	else if (SvROK (*av_fetch (cb, EVENT_MAP_DESTROY, 1)))
		313	INVOKE_MAP (DESTROY, static_cast<mapstruct *>(this));
320		314
		315	// disconnect Perl from C, to avoid crashes
		316	sv_unmagic (SvRV ((SV *)self), PERL_MAGIC_ext);
		317
		318	// clear the perl hash, might or might not be a good idea
		319	hv_clear ((HV )SvRV ((SV )self));
		320
321	if (self) SvREFCNT_dec (self);	321	SvREFCNT_dec (self);
		322	self = 0;
		323	}
		324
		325	if (cb)
		326	{
322	if (cb) SvREFCNT_dec (cb);	327	SvREFCNT_dec (cb);
		328	cb = 0;
		329	}
323		330
		331	if (attach)
		332	{
324	if (attach) free_string (attach);	333	free_string (attach);
325
326	self = 0;
327	cb = 0;
328	attach = 0;	334	attach = 0;
		335	}
329	}	336	}
330		337
331	void attachable_base::optimise ()	338	void attachable_base::optimise ()
332	{	339	{
333	if (!self)	340	if (!self)
…		…
342	SvREFCNT_dec ((SV *)self);	349	SvREFCNT_dec ((SV *)self);
343	self = 0;	350	self = 0;
344	}	351	}
345	}	352	}
346		353
347	void	354	void attachable_base::instantiate (data_type type, void *obj)
348	object::instantiate_ ()
349	{	355	{
350	dSP;	356	dSP;
351	ENTER;	357	ENTER;
352	SAVETMPS;	358	SAVETMPS;
353	PUSHMARK (SP);	359	PUSHMARK (SP);
354	EXTEND (SP, 2);	360	EXTEND (SP, 2);
355	PUSHs (sv_2mortal (newSVdt (DT_OBJECT, static_cast<object *>(this))));	361	PUSHs (sv_2mortal (newSVdt (type, obj)));
356	PUSHs (sv_2mortal (newSVpv (attach, 0)));	362	PUSHs (sv_2mortal (newSVpv (attach, 0)));
		363
		364	free_string (attach);
		365	attach = 0;
		366
357	PUTBACK;	367	PUTBACK;
358	call_pv ("cf::instantiate", G_DISCARD \| G_VOID \| G_EVAL);	368	call_pv ("cf::instantiate", G_DISCARD \| G_VOID \| G_EVAL);
359	FREETMPS;	369	FREETMPS;
360	LEAVE;	370	LEAVE;
361		371
362	INVOKE_OBJECT (INSTANTIATE, this);	372	switch (type)
		373	{
		374	case DT_OBJECT: INVOKE_OBJECT (INSTANTIATE, obj); break;
		375	case DT_MAP: INVOKE_MAP (INSTANTIATE, obj); break;
		376	}
363	}	377	}
364		378
365	/////////////////////////////////////////////////////////////////////////////	379	/////////////////////////////////////////////////////////////////////////////
366		380
367	object_freezer::object_freezer (const char *filename)
368	: filename (filename)
369	{
370	av = (AV *)newAV ();
371	idx = 0;
372	av_extend ((AV *)av, 1024);
373	}
374
375	object_freezer::~object_freezer ()
376	{
377	dSP;
378	ENTER;
379	SAVETMPS;
380	PUSHMARK (SP);
381	XPUSHs (sv_2mortal (newSVpv (filename, 0)));
382	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
383	PUTBACK;
384	call_pv ("cf::object_freezer_save", G_VOID \| G_DISCARD \| G_EVAL);
385	FREETMPS;
386	LEAVE;
387	}
388
389	void object_freezer::put (attachable_base *ext)
390	{
391	ext->optimise ();
392
393	if (ext->self)
394	av_store ((AV )av, idx, SvREFCNT_inc ((SV )ext->self));
395
396	++idx;
397	}
398
399	object_thawer::object_thawer (const char *filename)
400	{
401	av = 0;
402	idx = 0;
403
404	if (!filename)
405	return;
406
407	dSP;
408	ENTER;
409	SAVETMPS;
410	PUSHMARK (SP);
411	XPUSHs (sv_2mortal (newSVpv (filename, 0)));
412	PUTBACK;
413
414	if (0 < call_pv ("cf::object_thawer_load", G_SCALAR \| G_EVAL))
415	{
416	SPAGAIN;
417	SV *sv = POPs;
418	if (SvROK (sv))
419	av = SvREFCNT_inc (SvRV (sv));
420	}
421
422	FREETMPS;
423	LEAVE;
424	}
425
426	void reattach (data_type type, void *obj)	381	void reattach (data_type type, void *obj)
427	{	382	{
		383	//TODO only do this when the object has _attachment's
		384
428	dSP;	385	dSP;
429	ENTER;	386	ENTER;
430	SAVETMPS;	387	SAVETMPS;
431	PUSHMARK (SP);	388	PUSHMARK (SP);
432	XPUSHs (sv_2mortal (newSVdt (type, obj)));	389	XPUSHs (sv_2mortal (newSVdt (type, obj)));
…		…
447	void reattach (attachable<subclass> *obj)	404	void reattach (attachable<subclass> *obj)
448	{	405	{
449	obj->optimise ();	406	obj->optimise ();
450		407
451	if (obj->self)	408	if (obj->self)
452	reattach (subclass::get_dt (), (subclass *)obj);	409	reattach ((data_type) cftype<subclass>::dt, (subclass *)obj);
453	}	410	}
454		411
		412	#include "kw_hash.h"
		413
		414	object_freezer::object_freezer ()
		415	{
		416	av = newAV ();
		417	// TODO: fast dynbuf implementation... yeah, we need obstacks
		418	text = newSV (10 * 1024 * 1024); // only temporarily used, so be generous
		419	}
		420
		421	object_freezer::~object_freezer ()
		422	{
		423	SvREFCNT_dec (text);
		424	SvREFCNT_dec (av);
		425	}
		426
		427	void object_freezer::put (attachable_base *ext)
		428	{
		429	ext->optimise ();
		430
		431	if (ext->self)
		432	{
		433	int idx = AvFILLp ((AV *)av) + 1;
		434	av_store (av, idx, SvREFCNT_inc (ext->self));
		435
		436	sv_catpvf (text, "oid %d\n", idx);
		437	}
		438	}
		439
		440	void object_freezer::put (keyword k)
		441	{
		442	sv_catpv (text, keyword_str [k]);
		443	}
		444
		445	void object_freezer::put (const char *v)
		446	{
		447	sv_catpv (text, v);
		448	}
		449
		450	void object_freezer::put (int v)
		451	{
		452	sv_catpvf (text, "%d\n", v);
		453	}
		454
		455	bool object_freezer::save (const char *filename)
		456	{
		457	dSP;
		458	ENTER;
		459	SAVETMPS;
		460	PUSHMARK (SP);
		461	EXTEND (SP, 3);
		462	PUSHs (sv_2mortal (newSVpv (filename, 0)));
		463	PUSHs (sv_2mortal (newRV_inc (text)));
		464	PUSHs (sv_2mortal (newRV_inc ((SV *)av)));
		465	PUTBACK;
		466	call_pv ("cf::object_freezer_save", G_VOID \| G_DISCARD \| G_EVAL);
		467	FREETMPS;
		468	LEAVE;
		469	}
		470
		471	int fprintf (object_freezer &freezer, const char *format, ...)
		472	{
		473	va_list ap;
		474
		475	va_start (ap, format);
		476	sv_vcatpvfn (freezer.text, format, strlen (format), &ap, 0, 0, 0);
		477	va_end (ap);
		478	}
		479
		480	int fputs (const char *s, object_freezer &freezer)
		481	{
		482	sv_catpvn (freezer.text, s, strlen (s));
		483	}
		484
		485	object_thawer::object_thawer (const char *filename)
		486	{
		487	av = 0;
		488	fp = 0;
		489
		490	if (!filename)
		491	return;
		492
		493	fp = fopen (filename, "r");
		494	if (!fp)
		495	{
		496	LOG (llevError, "object_thawer: unable to open '%s': %s.\n", filename, strerror (errno));
		497	return;
		498	}
		499
		500	if (perl_booted)
		501	{
		502	dSP;
		503	ENTER;
		504	SAVETMPS;
		505	PUSHMARK (SP);
		506	XPUSHs (sv_2mortal (newSVpv (filename, 0)));
		507	PUTBACK;
		508
		509	if (0 < call_pv ("cf::object_thawer_load", G_SCALAR \| G_EVAL))
		510	{
		511	SPAGAIN;
		512	SV *sv = POPs;
		513	if (SvROK (sv))
		514	av = (AV *)SvREFCNT_inc (SvRV (sv));
		515	}
		516
		517	FREETMPS;
		518	LEAVE;
		519	}
		520	}
		521
455	void object_thawer::get (data_type type, void obj, attachable_base ext)	522	void object_thawer::get (data_type type, void obj, attachable_base ext, int oid)
456	{	523	{
457	if (!av)	524	if (!av \|\| oid < 0) // this is actually an error of sorts
458	return;	525	return;
459		526
460	// we have to "re-instantiate"/reattach to an object, so nuke ext->attach	527	// we have to "re-instantiate"/reattach to an object, so nuke ext->attach
461	ext->clear ();	528	ext->clear ();
462		529
463	SV *svp = av_fetch ((AV )av, idx, 0);	530	SV *svp = av_fetch ((AV )av, oid, 0);
464		531
465	++idx;
466
467	if (!svp)
468	return;
469
470	if (SvROK (*svp))	532	if (!svp \|\| !SvROK (*svp))
471	{	533	{
472	ext->self = SvREFCNT_inc (*svp);	534	printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid);
473	sv_magic (SvRV ((SV )ext->self), 0, PERL_MAGIC_ext, (char )obj, 0);	535	return;
474
475	reattach (type, obj);
476	}	536	}
		537
		538	ext->self = svp; svp = &PL_sv_undef;
		539	sv_magic (SvRV (ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0);
		540
		541	reattach (type, obj);
477	}	542	}
478		543
479	object_thawer::~object_thawer ()	544	object_thawer::~object_thawer ()
480	{	545	{
481	if (av)	546	if (fp) fclose (fp);
482	SvREFCNT_dec ((SV *)av);	547	if (av) SvREFCNT_dec ((AV *)av);
483	}	548	}
484		549
		550	token object_thawer::get_token ()
		551	{
		552	#if 0
		553	for (;;)
		554	{
		555	if (!fgets (line, sizeof (line), fp))
		556	return token (KW_eof);
		557
		558	unsigned char p = (unsigned char )line;
		559
		560	while (*p > ' ')
		561	p++;
		562
		563	int len = p - (unsigned char *)line;
		564
		565	while ((*p - 1) < ' ')
		566	p++;
		567
		568	if (*p)
		569	{
		570	char *v = p;
		571
		572	while (p && p != '\n')
		573	p++;
		574
		575	*p = 0;
		576
		577	return token (k, v);
		578	}
		579	else
		580	return token (k);
		581	}
		582	#endif
		583	}
		584
485	/////////////////////////////////////////////////////////////////////////////	585	/////////////////////////////////////////////////////////////////////////////
486		586
487	extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)	587	extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
488	{	588	{
489	gethook = gethooksptr;
490
491	return 0;	589	return 0;
492	}	590	}
493		591
494	static CommArray_s rtn_cmd;	592	static CommArray_s rtn_cmd;
495		593
…		…
575	extern "C" int cfperl_postInitPlugin ()	673	extern "C" int cfperl_postInitPlugin ()
576	{	674	{
577	int hooktype = 1;	675	int hooktype = 1;
578	int rtype = 0;	676	int rtype = 0;
579		677
580	systemDirectory = (void* ()(int, ...)) gethook (&rtype, hooktype, "cfapi_system_directory");
581	object_set_property = (void* ()(int, ...)) gethook (&rtype, hooktype, "cfapi_object_set_property");
582	map_get_map = (void* ()(int, ...)) gethook (&rtype, hooktype, "cfapi_map_get_map");
583	object_insert = (void* ()(int, ...)) gethook (&rtype, hooktype, "cfapi_object_insert");
584
585	cf_init_plugin (gethook);	678	cf_init_plugin (gethook);
586		679
587	return 0;	680	return 0;
588	}	681	}
589		682
…		…
593	}	686	}
594		687
595	void	688	void
596	cfperl_init ()	689	cfperl_init ()
597	{	690	{
		691	PERL_SYS_INIT3 (&settings.argc, &settings.argv, 0);
		692	perl = perl_alloc ();
		693	perl_construct (perl);
		694
		695	PL_exit_flags \|= PERL_EXIT_DESTRUCT_END;
		696
598	char *argv[] = {	697	char *argv[] = {
599	"",	698	"",
600	"-e"	699	"-e"
601	"BEGIN {"
602	" cf->bootstrap;"	700	"cf->bootstrap;"
603	" unshift @INC, cf::datadir ();"	701	"unshift @INC, cf::datadir ();"
604	"}"
605	""
606	"use cf;"
607	};	702	};
608
609	perl = perl_alloc ();
610	perl_construct (perl);
611
612	PL_exit_flags \|= PERL_EXIT_DESTRUCT_END;
613		703
614	if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) \|\| perl_run (perl))	704	if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) \|\| perl_run (perl))
615	{	705	{
616	printf ("unable to initialize perl-interpreter, aborting.\n");	706	printf ("unable to initialize perl-interpreter, aborting.\n");
617
618	exit (EXIT_FAILURE);	707	exit (EXIT_FAILURE);
619	//perl_destruct (perl);
620	//perl_free (perl);
621	//perl = 0;
622	//return;
623	}	708	}
624		709
625	obj_cache = newHV ();	710	obj_cache = newHV ();
		711	}
		712
		713	void cfperl_boot ()
		714	{
		715	perl_booted = true;
		716
		717	eval_pv ("require cf", 1);
626	}	718	}
627		719
628	void cfperl_main ()	720	void cfperl_main ()
629	{	721	{
630	dSP;	722	dSP;
…		…
637	static event_klass klass_of[NUM_EVENT_TYPES] = {	729	static event_klass klass_of[NUM_EVENT_TYPES] = {
638	# define def(type,name) KLASS_ ## type,	730	# define def(type,name) KLASS_ ## type,
639	# include "eventinc.h"	731	# include "eventinc.h"
640	# undef def	732	# undef def
641	};	733	};
		734
		735	#define KLASS_OF(event) (((unsigned int)event) < NUM_EVENT_TYPES ? klass_of [event] : KLASS_NONE)
642		736
643	static void	737	static void
644	gather_callbacks (AV &callbacks, AV registry, event_type event)	738	gather_callbacks (AV &callbacks, AV registry, event_type event)
645	{	739	{
646	// event must be in array	740	// event must be in array
…		…
689	// 2a. per-type callback	783	// 2a. per-type callback
690	// 4. global callbacks	784	// 4. global callbacks
691		785
692	gather_callbacks (callbacks, cb_global, event);	786	gather_callbacks (callbacks, cb_global, event);
693		787
694	switch (klass_of [event])	788	switch (KLASS_OF (event))
695	{	789	{
696	case KLASS_GLOBAL:	790	case KLASS_GLOBAL:
697	break;	791	break;
698		792
699	case KLASS_OBJECT:	793	case KLASS_OBJECT:
700	dt = (data_type) va_arg (ap, int);	794	dt = (data_type) va_arg (ap, int);
701	assert (("first argument must be of type object", dt == DT_OBJECT));	795	assert (("first argument must be of type object", dt == DT_OBJECT));
702	op = va_arg (ap, object *);	796	op = va_arg (ap, object *);
703		797
704	if (op->cb)	798	if (op->cb)
705	gather_callbacks (callbacks, (AV *)op->cb, event);	799	gather_callbacks (callbacks, op->cb, event);
706		800
707	if (op->type)	801	if (op->type)
708	{	802	{
709	if (op->subtype && op->type + op->subtype * NUM_SUBTYPES <= AvFILLp (cb_type))	803	if (op->subtype && op->type + op->subtype * NUM_SUBTYPES <= AvFILLp (cb_type))
710	{	804	{
…		…
731	dt = (data_type) va_arg (ap, int);	825	dt = (data_type) va_arg (ap, int);
732	assert (("first argument must be of type player", dt == DT_PLAYER));	826	assert (("first argument must be of type player", dt == DT_PLAYER));
733	pl = va_arg (ap, player *);	827	pl = va_arg (ap, player *);
734		828
735	if (pl->cb)	829	if (pl->cb)
736	gather_callbacks (callbacks, (AV *)pl->cb, event);	830	gather_callbacks (callbacks, pl->cb, event);
737		831
738	gather_callbacks (callbacks, cb_player, event);	832	gather_callbacks (callbacks, cb_player, event);
739	break;	833	break;
740		834
741	case KLASS_MAP:	835	case KLASS_MAP:
742	dt = (data_type) va_arg (ap, int);	836	dt = (data_type) va_arg (ap, int);
743	assert (("first argument must be of type object", dt == DT_MAP));	837	assert (("first argument must be of type object", dt == DT_MAP));
744	map = va_arg (ap, mapstruct *);	838	map = va_arg (ap, mapstruct *);
745		839
746	if (map->cb)	840	if (map->cb)
747	gather_callbacks (callbacks, (AV *)map->cb, event);	841	gather_callbacks (callbacks, map->cb, event);
748		842
749	gather_callbacks (callbacks, cb_map, event);	843	gather_callbacks (callbacks, cb_map, event);
750	break;	844	break;
751		845
752	default:	846	default:
…		…
765	EXTEND (SP, 3);	859	EXTEND (SP, 3);
766		860
767	PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays	861	PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays
768	PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks)));	862	PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks)));
769		863
770	switch (klass_of [event])	864	switch (KLASS_OF (event))
771	{	865	{
772	case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break;	866	case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break;
773	case KLASS_PLAYER: PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl))); break;	867	case KLASS_PLAYER: PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl))); break;
774	case KLASS_MAP: PUSHs (sv_2mortal (newSVdt (DT_MAP, map))); break;	868	case KLASS_MAP: PUSHs (sv_2mortal (newSVdt (DT_MAP, map))); break;
775	}	869	}
…		…
1372	prop (CFAPI_INT, MAP_PROP_WINDDIR)	1466	prop (CFAPI_INT, MAP_PROP_WINDDIR)
1373	prop (CFAPI_INT, MAP_PROP_SKY)	1467	prop (CFAPI_INT, MAP_PROP_SKY)
1374	prop (CFAPI_INT, MAP_PROP_WPARTX)	1468	prop (CFAPI_INT, MAP_PROP_WPARTX)
1375	prop (CFAPI_INT, MAP_PROP_WPARTY)	1469	prop (CFAPI_INT, MAP_PROP_WPARTY)
1376	prop (CFAPI_STRING, MAP_PROP_MESSAGE)	1470	prop (CFAPI_STRING, MAP_PROP_MESSAGE)
1377	prop (CFAPI_PMAP, MAP_PROP_NEXT)
1378	prop (CFAPI_PREGION, MAP_PROP_REGION)	1471	prop (CFAPI_PREGION, MAP_PROP_REGION)
1379	prop (CFAPI_POBJECT, OBJECT_PROP_OB_ABOVE)
1380	prop (CFAPI_POBJECT, OBJECT_PROP_OB_BELOW)
1381	prop (CFAPI_POBJECT, OBJECT_PROP_NEXT_ACTIVE_OB)	1472	prop (CFAPI_POBJECT, OBJECT_PROP_NEXT_ACTIVE_OB)
1382	prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB)	1473	prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB)
1383	prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY)	1474	prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY)
1384	prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT)	1475	prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT)
1385	prop (CFAPI_POBJECT, OBJECT_PROP_HEAD)
1386	prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER)	1476	prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER)
1387	prop (CFAPI_PMAP, OBJECT_PROP_MAP)	1477	prop (CFAPI_PMAP, OBJECT_PROP_MAP)
1388	prop (CFAPI_INT, OBJECT_PROP_COUNT)	1478	prop (CFAPI_INT, OBJECT_PROP_COUNT)
1389	prop (CFAPI_INT, OBJECT_PROP_REFCOUNT)	1479	prop (CFAPI_INT, OBJECT_PROP_REFCOUNT)
1390	prop (CFAPI_STRING, OBJECT_PROP_NAME)	1480	prop (CFAPI_STRING, OBJECT_PROP_NAME)
…		…
1522	PROTOTYPE: $$	1612	PROTOTYPE: $$
1523		1613
1524	char path_combine_and_normalize (char base, char *path)	1614	char path_combine_and_normalize (char base, char *path)
1525	PROTOTYPE: $$	1615	PROTOTYPE: $$
1526		1616
1527	char *	1617	const char *
1528	cf_get_maps_directory (char *path)	1618	get_maps_directory (char *path)
1529	PROTOTYPE: $	1619	PROTOTYPE: $
1530	ALIAS: maps_directory = 0	1620	ALIAS: maps_directory = 0
		1621	CODE:
		1622	RETVAL = create_pathname (path);
		1623	OUTPUT: RETVAL
1531		1624
1532	void	1625	void
1533	sub_generation_inc ()	1626	sub_generation_inc ()
1534	CODE:	1627	CODE:
1535	PL_sub_generation++;	1628	PL_sub_generation++;
…		…
1544	confdir = 3	1637	confdir = 3
1545	localdir = 4	1638	localdir = 4
1546	playerdir = 5	1639	playerdir = 5
1547	datadir = 6	1640	datadir = 6
1548	CODE:	1641	CODE:
1549	{	1642	switch (ix)
1550	int unused_type;	1643	{
1551	RETVAL = (char *)systemDirectory (&unused_type, ix);	1644	case 0: RETVAL = settings.mapdir ; break;
1552	}	1645	case 1: RETVAL = settings.uniquedir; break;
		1646	case 2: RETVAL = settings.tmpdir ; break;
		1647	case 3: RETVAL = settings.confdir ; break;
		1648	case 4: RETVAL = settings.localdir ; break;
		1649	case 5: RETVAL = settings.playerdir; break;
		1650	case 6: RETVAL = settings.datadir ; break;
		1651	}
1553	OUTPUT: RETVAL	1652	OUTPUT: RETVAL
1554		1653
1555	int	1654	int
1556	cf_find_animation (char *text)	1655	cf_find_animation (char *text)
1557	PROTOTYPE: $	1656	PROTOTYPE: $
1558		1657
1559	int random_roll(int min, int max, object *op, int goodbad);	1658	int random_roll(int min, int max, object *op, int goodbad);
1560		1659
1561	const char *cost_string_from_value(uint64 cost, int approx = 0)	1660	const char *cost_string_from_value(uint64 cost, int approx = 0)
1562		1661
1563	int invoke (int event, SV *arg1, ...)	1662	int invoke (int event, ...)
1564	CODE:	1663	CODE:
1565	{	1664	if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL");
1566	// parse first arg and call invoke_object etc as seen fit	1665	AV av = (AV )sv_2mortal ((SV *)newAV ());
1567	//TODO	1666	for (int i = 1; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1568	//cfperl_invoke (event,	1667	RETVAL = INVOKE_((event_type)event, ARG_AV (av));
1569	}	1668	OUTPUT: RETVAL
1570		1669
1571	int	1670	int
1572	exp_to_level (val64 exp)	1671	exp_to_level (val64 exp)
1573	CODE:	1672	CODE:
1574	{	1673	{
…		…
1605	RETVAL = newSVpv (resist_plus[atnr], 0);	1704	RETVAL = newSVpv (resist_plus[atnr], 0);
1606	else	1705	else
1607	XSRETURN_UNDEF;	1706	XSRETURN_UNDEF;
1608	OUTPUT: RETVAL	1707	OUTPUT: RETVAL
1609		1708
		1709	int
		1710	_valid (SV *obj)
		1711	CODE:
		1712	RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
		1713	OUTPUT:
		1714	RETVAL
		1715
1610	MODULE = cf PACKAGE = cf::object PREFIX = cf_object_	1716	MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
		1717
		1718	int invoke (object *op, int event, ...)
		1719	CODE:
		1720	if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");
		1721	AV av = (AV )sv_2mortal ((SV *)newAV ());
		1722	for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
		1723	RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av));
		1724	OUTPUT: RETVAL
		1725
		1726	SV registry (object op)
		1727	CODE:
		1728	RETVAL = registry_of (op);
		1729	OUTPUT:
		1730	RETVAL
		1731
		1732	object head (object op)
		1733	PROTOTYPE: $
		1734	ALIAS:
		1735	more = 1
		1736	above = 2
		1737	below = 3
		1738	CODE:
		1739	switch (ix)
		1740	{
		1741	case 0: RETVAL = op->head ? op->head : op; break; // DOH!
		1742	case 1: RETVAL = op->more; break;
		1743	case 2: RETVAL = op->above; break;
		1744	case 3: RETVAL = op->below; break;
		1745	}
		1746	OUTPUT:
		1747	RETVAL
1611		1748
1612	SV *	1749	SV *
1613	get_property (object *obj, int type, int idx)	1750	get_property (object *obj, int type, int idx)
1614	CODE:	1751	CODE:
1615	RETVAL = newSVcfapi (type, cf_object_get_property (obj, idx));	1752	RETVAL = newSVcfapi (type, cf_object_get_property (obj, idx));
…		…
1694		1831
1695	int need_identify (const object *obj);	1832	int need_identify (const object *obj);
1696		1833
1697	int apply_shop_mat (object shop_mat, object op);	1834	int apply_shop_mat (object shop_mat, object op);
1698		1835
1699	void cf_object_move (object op, int dir, object originator = op)	1836	int move (object op, int dir, object originator = op)
		1837	CODE:
		1838	RETVAL = move_ob (op, dir, originator);
		1839	OUTPUT:
		1840	RETVAL
1700		1841
1701	void cf_object_apply (object op, object author, int flags = 0)	1842	void cf_object_apply (object op, object author, int flags = 0)
1702		1843
1703	void cf_object_apply_below (object *op)	1844	void cf_object_apply_below (object *op)
1704		1845
…		…
1745	int cf_object_out_of_map (object *op, int x, int y)	1886	int cf_object_out_of_map (object *op, int x, int y)
1746		1887
1747	void cf_object_drop (object op, object author)	1888	void cf_object_drop (object op, object author)
1748		1889
1749	void cf_object_take (object op, object author)	1890	void cf_object_take (object op, object author)
1750
1751	void cf_object_say (object op, char msg)
1752
1753	void cf_object_speak (object op, char msg)
1754		1891
1755	object cf_object_insert_object (object op, object *container)	1892	object cf_object_insert_object (object op, object *container)
1756		1893
1757	const char cf_object_get_msg (object ob)	1894	const char cf_object_get_msg (object ob)
1758	ALIAS: msg = 0	1895	ALIAS: msg = 0
…		…
1812	CODE:	1949	CODE:
1813	{	1950	{
1814	int unused_type;	1951	int unused_type;
1815	RETVAL = (object *)object_insert (&unused_type, ob, 0, where, orig, flag, x, y);	1952	RETVAL = (object *)object_insert (&unused_type, ob, 0, where, orig, flag, x, y);
1816	}	1953	}
1817
1818	SV registry (object op)
1819	CODE:
1820	RETVAL = registry_of (op);
1821	OUTPUT:
1822	RETVAL
1823		1954
1824	# syntatic sugar for easier use in event callbacks.	1955	# syntatic sugar for easier use in event callbacks.
1825	const char options (object op)	1956	const char options (object op)
1826	CODE:	1957	CODE:
1827	RETVAL = op->name;	1958	RETVAL = op->name;
…		…
1900		2031
1901	void kill_player (object *op)	2032	void kill_player (object *op)
1902		2033
1903	MODULE = cf PACKAGE = cf::player PREFIX = cf_player_	2034	MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
1904		2035
		2036	int invoke (player *pl, int event, ...)
		2037	CODE:
		2038	if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");
		2039	AV av = (AV )sv_2mortal ((SV *)newAV ());
		2040	for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
		2041	RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av));
		2042	OUTPUT: RETVAL
		2043
1905	SV registry (player pl)	2044	SV registry (player pl)
1906	CODE:	2045	CODE:
1907	RETVAL = registry_of (pl);	2046	RETVAL = registry_of (pl);
1908	OUTPUT:	2047	OUTPUT:
1909	RETVAL	2048	RETVAL
…		…
2033	OUTPUT: RETVAL	2172	OUTPUT: RETVAL
2034		2173
2035		2174
2036	MODULE = cf PACKAGE = cf::map PREFIX = cf_map_	2175	MODULE = cf PACKAGE = cf::map PREFIX = cf_map_
2037		2176
		2177	mapstruct *first ()
		2178	PROTOTYPE:
		2179	CODE:
		2180	RETVAL = first_map;
		2181	OUTPUT: RETVAL
		2182
		2183	mapstruct next (mapstruct map)
		2184	PROTOTYPE:
		2185	CODE:
		2186	RETVAL = map->next;
		2187	OUTPUT: RETVAL
		2188
		2189	int invoke (mapstruct *map, int event, ...)
		2190	CODE:
		2191	if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP");
		2192	AV av = (AV )sv_2mortal ((SV *)newAV ());
		2193	for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
		2194	RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av));
		2195	OUTPUT: RETVAL
		2196
2038	SV registry (mapstruct map)	2197	SV registry (mapstruct map)
2039	CODE:	2198	CODE:
2040	RETVAL = registry_of (map);	2199	RETVAL = registry_of (map);
2041	OUTPUT:	2200	OUTPUT:
2042	RETVAL	2201	RETVAL
…		…
2061		2220
2062	mapstruct *new (int width, int height)	2221	mapstruct *new (int width, int height)
2063	PROTOTYPE:	2222	PROTOTYPE:
2064	CODE:	2223	CODE:
2065	{	2224	{
2066	int unused_type;	2225	RETVAL = get_empty_map (width, height);
2067	RETVAL = (mapstruct*) map_get_map (&unused_type, 0, width, height);
2068	}	2226	}
2069	OUTPUT:	2227	OUTPUT:
2070	RETVAL	2228	RETVAL
2071		2229
2072	void delete_map (mapstruct *map)	2230	void delete_map (mapstruct *map)
…		…
2087	XSRETURN_UNDEF;	2245	XSRETURN_UNDEF;
2088	RETVAL = map->tile_path [dir];	2246	RETVAL = map->tile_path [dir];
2089	OUTPUT:	2247	OUTPUT:
2090	RETVAL	2248	RETVAL
2091		2249
2092	mapstruct cf_map_get_map (char name)	2250	mapstruct ready_map_name (char name, int flags = 0)
2093	PROTOTYPE: $	2251	PROTOTYPE: $;$
2094	ALIAS: map = 0	2252	ALIAS:
		2253	find = 0
		2254	get_map = 1
2095		2255
2096	mapstruct has_been_loaded (char name)	2256	mapstruct has_been_loaded (char name)
2097	PROTOTYPE: $	2257	PROTOTYPE: $
2098
2099	mapstruct *cf_map_get_first ()
2100	PROTOTYPE:
2101	ALIAS: first = 0
2102		2258
2103	# whoever "designed" the plug-in api should have wasted	2259	# whoever "designed" the plug-in api should have wasted
2104	# his/her time with staying away from the project - would have	2260	# his/her time with staying away from the project - would have
2105	# saved others a lot of time, without doubt.	2261	# saved others a lot of time, without doubt.
2106	void set_path (mapstruct where, char path)	2262	void set_path (mapstruct where, char path)
…		…
2121		2277
2122	void set_unique (mapstruct *map, bool unique)	2278	void set_unique (mapstruct *map, bool unique)
2123	CODE:	2279	CODE:
2124	map->unique = unique;	2280	map->unique = unique;
2125		2281
		2282	void
		2283	trigger (mapstruct *map, long connection, bool state = true)
		2284	CODE:
		2285	activate_connection (map, connection, state);
		2286
		2287	void
		2288	get_connection (mapstruct *map, long connection)
		2289	PPCODE:
		2290	oblinkpt *obp = get_connection_links (map, connection);
		2291	if (obp)
		2292	for (objectlink *ol = obp->link; ol; ol = ol->next)
		2293	XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, ol->ob)));
		2294
2126	object cf_map_insert_object_there (mapstruct where, object op, object originator, int flags)	2295	object cf_map_insert_object_there (mapstruct where, object op, object originator, int flags)
2127		2296
2128	object cf_map_insert_object (mapstruct where, object* op, int x, int y)	2297	object cf_map_insert_object (mapstruct where, object* op, int x, int y)
2129		2298
2130	object* cf_map_present_arch_by_name (mapstruct map, const char str, int nx, int ny)	2299	object* cf_map_present_arch_by_name (mapstruct map, const char str, int nx, int ny)
…		…
2134	cf_map_normalise (mapstruct *map, int x, int y)	2303	cf_map_normalise (mapstruct *map, int x, int y)
2135	PPCODE:	2304	PPCODE:
2136	{	2305	{
2137	mapstruct *nmap = 0;	2306	mapstruct *nmap = 0;
2138	I16 nx = 0, ny = 0;	2307	I16 nx = 0, ny = 0;
2139	int flags = cf_map_get_flags (map, &nmap, x, y, &nx, &ny);	2308	int flags = get_map_flags (map, &nmap, x, y, &nx, &ny);
2140		2309
2141	EXTEND (SP, 4);	2310	EXTEND (SP, 4);
2142	PUSHs (sv_2mortal (newSViv (flags)));	2311	PUSHs (sv_2mortal (newSViv (flags)));
2143		2312
2144	if (GIMME_V == G_ARRAY)	2313	if (GIMME_V == G_ARRAY)
…		…
2156	{	2325	{
2157	object *o;	2326	object *o;
2158	mapstruct *nmap = 0;	2327	mapstruct *nmap = 0;
2159	I16 nx, ny;	2328	I16 nx, ny;
2160		2329
2161	cf_map_get_flags (map, &nmap, x, y, &nx, &ny);	2330	get_map_flags (map, &nmap, x, y, &nx, &ny);
2162		2331
2163	if (nmap)	2332	if (nmap)
2164	for (o = GET_MAP_OB (nmap, nx, ny); o; o = o->above)	2333	for (o = GET_MAP_OB (nmap, nx, ny); o; o = o->above)
2165	XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, o)));	2334	XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, o)));
2166	}	2335	}
…		…
2191	case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;	2360	case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;
2192	}	2361	}
2193	OUTPUT:	2362	OUTPUT:
2194	RETVAL	2363	RETVAL
2195		2364
2196	# "deserialise" perl map data into the map # TODO# compatibility cruft, remove
2197	void
2198	_set_obs (mapstruct map, SV sv)
2199	CODE:
2200	{
2201	object *o;
2202	AV *av;
2203	int x, y;
2204	AV obs = (AV )SvRV (sv);
2205		2365
2206	for (y = 0; y < MAP_HEIGHT (map); y++)	2366	MODULE = cf PACKAGE = cf::arch
2207	for (x = 0; x < MAP_WIDTH (map); x++)
2208	{
2209	sv = av_fetch (obs, x + y MAP_HEIGHT (map), 1);
2210		2367
2211	if (!SvROK (sv))	2368	archetype find (const char name)
2212	continue;	2369	CODE:
		2370	RETVAL = find_archetype (name);
		2371	OUTPUT:
		2372	RETVAL
2213		2373
2214	av = (AV *)SvRV (sv);	2374	archetype *first()
2215
2216	for (o = GET_MAP_OB (map, x, y); o; o = o->above)
2217	{
2218	sv = av_shift (av);
2219
2220	if (SvROK (sv))
2221	{
2222	sv_magic ((SV )SvRV (sv), 0, PERL_MAGIC_ext, (char )o, 0);
2223	SVptr_cache_set (o, sv);
2224	}
2225	}
2226	}
2227	}
2228
2229
2230	MODULE = cf PACKAGE = cf::arch PREFIX = cf_archetype_
2231
2232	archetype *cf_archetype_get_first()
2233	PROTOTYPE:	2375	PROTOTYPE:
2234	ALIAS: first = 0	2376	CODE:
		2377	RETVAL = first_archetype;
		2378	OUTPUT: RETVAL
2235		2379
2236	archetype cf_archetype_get_next (archetype arch)	2380	archetype next (archetype arch)
2237	ALIAS: next = 0	2381	CODE:
		2382	RETVAL = arch->next;
		2383	OUTPUT: RETVAL
2238		2384
2239	archetype cf_archetype_get_head (archetype arch)	2385	archetype head (archetype arch)
2240	ALIAS: head = 0	2386	CODE:
		2387	RETVAL = arch->head;
		2388	OUTPUT: RETVAL
2241		2389
2242	archetype cf_archetype_get_more (archetype arch)	2390	archetype more (archetype arch)
2243	ALIAS: more = 0	2391	CODE:
		2392	RETVAL = arch->more;
		2393	OUTPUT: RETVAL
2244		2394
2245	const char cf_archetype_get_name (archetype arch)	2395	const char name (archetype arch)
2246	ALIAS: name = 0	2396	CODE:
		2397	RETVAL = arch->name;
		2398	OUTPUT: RETVAL
2247		2399
2248	object cf_archetype_get_clone (archetype arch)	2400	object clone (archetype arch)
2249	ALIAS: clone = 0	2401	CODE:
		2402	RETVAL = &arch->clone;
		2403	OUTPUT: RETVAL
2250		2404
2251	MODULE = cf PACKAGE = cf::party PREFIX = cf_party_	2405	MODULE = cf PACKAGE = cf::party
2252		2406
2253	partylist *cf_party_get_first ()	2407	partylist *first ()
2254	PROTOTYPE:	2408	PROTOTYPE:
2255	ALIAS: first = 0	2409	CODE:
		2410	RETVAL = get_firstparty ();
		2411	OUTPUT: RETVAL
2256		2412
2257	partylist cf_party_get_next (partylist party)	2413	partylist next (partylist party)
2258	ALIAS: next = 0	2414	CODE:
		2415	RETVAL = party->next;
		2416	OUTPUT: RETVAL
2259		2417
2260	const char cf_party_get_name (partylist party)	2418	const char name (partylist party)
		2419	CODE:
		2420	RETVAL = party->partyname;
		2421	OUTPUT: RETVAL
2261		2422
2262	const char cf_party_get_password (partylist party)	2423	const char password (partylist party)
2263	ALIAS: password = 0	2424	CODE:
		2425	RETVAL = party->passwd;
		2426	OUTPUT: RETVAL
2264		2427
2265	player cf_party_get_first_player (partylist party)	2428	MODULE = cf PACKAGE = cf::region
2266	ALIAS: first_player = 0
2267		2429
2268	player cf_party_get_next_player (partylist party, player *op)	2430	region *first ()
2269	ALIAS: next_player = 0
2270
2271
2272	MODULE = cf PACKAGE = cf::region PREFIX = cf_region_
2273
2274	region *cf_region_get_first ()
2275	PROTOTYPE:	2431	PROTOTYPE:
2276	ALIAS: first = 0	2432	CODE:
		2433	RETVAL = first_region;
		2434	OUTPUT: RETVAL
2277		2435
		2436	region next (region reg)
		2437	CODE:
		2438	RETVAL = reg->next;
		2439	OUTPUT: RETVAL
		2440
		2441	const char name (region reg)
		2442	CODE:
		2443	RETVAL = reg->name;
		2444	OUTPUT: RETVAL
		2445
		2446	region parent (region reg)
		2447	CODE:
		2448	RETVAL = reg->parent;
		2449	OUTPUT: RETVAL
		2450
2278	const char cf_region_get_name (region reg)	2451	const char longname (region reg)
2279	ALIAS: name = 0	2452	CODE:
		2453	RETVAL = reg->longname;
		2454	OUTPUT: RETVAL
2280		2455
2281	region cf_region_get_next (region reg)	2456	const char msg (region reg)
2282	ALIAS: next = 0	2457	CODE:
		2458	RETVAL = reg->msg;
		2459	OUTPUT: RETVAL
2283		2460
2284	region cf_region_get_parent (region reg)	2461	MODULE = cf PACKAGE = cf::living
2285	ALIAS: parent = 0
2286
2287	const char cf_region_get_longname (region reg)
2288	ALIAS: longname = 0
2289
2290	const char cf_region_get_message (region reg)
2291	ALIAS: message = 0
2292
2293
2294	MODULE = cf PACKAGE = cf::living PREFIX = cf_living_
2295		2462
2296	val64	2463	val64
2297	exp (living *liv, val64 new_val = 0)	2464	exp (living *liv, val64 new_val = 0)
2298	PROTOTYPE: $;$	2465	PROTOTYPE: $;$
2299	ALIAS:	2466	ALIAS:

Diff Legend

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

Comparing deliantra/server/server/cfperl.xs (file contents): Revision 1.17 by root, Sun Aug 27 17:59:26 2006 UTC vs. Revision 1.36 by elmex, Thu Aug 31 10:15:14 2006 UTC

Diff Legend

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.17 by root, Sun Aug 27 17:59:26 2006 UTC vs.
Revision 1.36 by elmex, Thu Aug 31 10:15:14 2006 UTC