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

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.149 by root, Mon Jan 22 03:44:41 2007 UTC vs.
Revision 1.181 by root, Tue Apr 3 00:21:38 2007 UTC

…		…
4		4
5	/*	5	/*
6	* This code is placed under the GNU General Public Licence (GPL)	6	* This code is placed under the GNU General Public Licence (GPL)
7	*	7	*
8	* Copyright (C) 2001-2005 by Chachkoff Yann	8	* Copyright (C) 2001-2005 by Chachkoff Yann
9	* Copyright (C) 2006 by Marc Lehmann <cf@schmorp.de>	9	* Copyright (C) 2006,2007 by Marc Lehmann <cf@schmorp.de>
10	*	10	*
11	* This program is free software; you can redistribute it and/or modify	11	* This program is free software; you can redistribute it and/or modify
12	* it under the terms of the GNU General Public License as published by	12	* it under the terms of the GNU General Public License as published by
13	* the Free Software Foundation; either version 2 of the License, or	13	* the Free Software Foundation; either version 2 of the License, or
14	* (at your option) any later version.	14	* (at your option) any later version.
…		…
29	#include <plugin_common.h>	29	#include <plugin_common.h>
30	#include <sounds.h>	30	#include <sounds.h>
31	#include <cstdarg>	31	#include <cstdarg>
32	#include <sproto.h>	32	#include <sproto.h>
33		33
		34	#include "loader.h"
34	#include "cfperl.h"	35	#include "cfperl.h"
35	#include "shstr.h"	36	#include "shstr.h"
36		37
37	#include <unistd.h>	38	#include <unistd.h>
38	#if _POSIX_MEMLOCK	39	#if _POSIX_MEMLOCK
…		…
101		102
102	unordered_vector<attachable *> attachable::mortals;	103	unordered_vector<attachable *> attachable::mortals;
103		104
104	attachable::~attachable ()	105	attachable::~attachable ()
105	{	106	{
		107	flags \|=0x3300;//D
106	assert (!self);	108	assert (!self);
		109	assert (!cb);
107	}	110	}
108		111
109	int	112	int
110	attachable::refcnt_cnt () const	113	attachable::refcnt_cnt () const
111	{	114	{
112	return refcnt + (self ? SvREFCNT (self) : 0);	115	return refcnt + (self ? SvREFCNT (self) - 1 : 0);
		116	}
		117
		118	void
		119	attachable::sever_self ()
		120	{
		121	if (HV *self = this->self)
		122	{
		123	// keep a refcount because sv_unmagic might call attachable_free,
		124	// which might clear self, causing sv_unmagic to crash on a now
		125	// invalid object.
		126	SvREFCNT_inc (self);
		127	hv_clear (self);
		128	sv_unmagic ((SV *)self, PERL_MAGIC_ext);
		129	SvREFCNT_dec (self);
		130
		131	// self must be null now because thats sv_unmagic's job.
		132	assert (!this->self);
		133	flags \|= 0x80; // severed //D
		134	}
113	}	135	}
114		136
115	void	137	void
116	attachable::optimise ()	138	attachable::optimise ()
117	{	139	{
118	if (self	140	if (self
119	&& SvREFCNT (self) == 1	141	&& SvREFCNT (self) == 1
120	&& !HvTOTALKEYS (self))	142	&& !HvTOTALKEYS (self))
		143	flags \|= 0x40,//D
		144	sever_self ();
		145	}
		146
		147	// check wether the object really is dead
		148	void
		149	attachable::do_check ()
		150	{
		151	if (refcnt_cnt () > 0)
		152	return;
		153
		154	destroy ();
		155	}
		156
		157	void
		158	attachable::do_destroy ()
		159	{
		160	invoke (EVENT_ATTACHABLE_DESTROY, DT_END);
		161
		162	if (cb)
121	{	163	{
122	refcnt_inc ();
123	SvREFCNT_dec ((SV *)self);	164	SvREFCNT_dec (cb);
		165	cb = 0;
124	}	166	}
125	}
126
127	// check wether the object really is dead
128	void
129	attachable::do_check ()
130	{
131	if (refcnt > 0 \|\| refcnt_cnt () > 0)
132	return;
133
134	destroy ();
135		167
136	if (self)	168	if (self)
137	{	169	sever_self ();
138	hv_clear (self);
139	sv_unmagic ((SV *)self, PERL_MAGIC_ext);
140	SvREFCNT_dec (self);
141	self = 0;
142	}
143	}
144		170
145	void	171	flags \|= 0x20; //D
146	attachable::do_destroy ()
147	{
148	invoke (EVENT_ATTACHABLE_DESTROY, DT_END);
149
150	if (self)
151	hv_clear (self);
152
153	mortals.push_back (this);	172	mortals.push_back (this);
154	}	173	}
155		174
156	void	175	void
157	attachable::destroy ()	176	attachable::destroy ()
…		…
164	}	183	}
165		184
166	void	185	void
167	attachable::check_mortals ()	186	attachable::check_mortals ()
168	{	187	{
169	for (int i = 0; i < mortals.size (); )	188	static int i = 0;
		189
		190	for (;;)
170	{	191	{
		192	if (i >= mortals.size ())
		193	{
		194	i = 0;
		195
		196	if (mortals.size () > 1000)
		197	fprintf (stderr, "mortal queue size (%d) exceeds 1000.\n", (int)mortals.size ());
		198
		199	break;
		200	}
		201
171	attachable *obj = mortals [i];	202	attachable *obj = mortals [i];
172		203
173	obj->refcnt_chk (); // unborrow from perl, if necessary	204	obj->refcnt_chk (); // unborrow from perl, if necessary
174		205
		206	//if (obj->refcnt > 0 \|\| obj->self)
175	if (obj->refcnt \|\| obj->self)	207	if (obj->refcnt \|\| obj->self)
176	{	208	{
177	#if 0	209	//printf ("%p rc %d\n", obj, obj->refcnt_cnt ());//D
178	if (mortals.size() > 5)fprintf (stderr, "%d delaying %d:%p:%s %d (self %p:%d)\n", time(0),i, obj, typeid (*obj).name (),
179	obj->refcnt, obj->self, obj->self ? SvREFCNT(obj->self): - 1);//D
180	#endif
181
182	++i; // further delay freeing	210	++i; // further delay freeing
		211
		212	if (!(i & 0x3ff))
		213	break;
183	}//D	214	}
184	else	215	else
185	{	216	{
186	//Dfprintf (stderr, "deleteing %d:%p:%s\n", i, obj,typeid (*obj).name ());//D
187	mortals.erase (i);	217	mortals.erase (i);
188	delete obj;	218	delete obj;
189	}	219	}
190	}	220	}
191	}	221	}
…		…
216		246
217	static int	247	static int
218	attachable_free (pTHX_ SV sv, MAGIC mg)	248	attachable_free (pTHX_ SV sv, MAGIC mg)
219	{	249	{
220	attachable at = (attachable )mg->mg_ptr;	250	attachable at = (attachable )mg->mg_ptr;
		251
		252	//TODO: check if transaction behaviour is really required here
		253	if (SV self = (SV )at->self)
		254	{
221	at->self = 0;	255	at->self = 0;
		256	SvREFCNT_dec (self);
		257	}
		258
222	// next line makes sense, but most objects still have refcnt 0 by default	259	// next line makes sense, but most objects still have refcnt 0 by default
223	//at->refcnt_chk ();	260	//at->refcnt_chk ();
224	return 0;	261	return 0;
225	}	262	}
226		263
…		…
234		271
235	if (!obj->self)	272	if (!obj->self)
236	{	273	{
237	obj->self = newHV ();	274	obj->self = newHV ();
238	sv_magicext ((SV )obj->self, 0, PERL_MAGIC_ext, &attachable::vtbl, (char )obj, 0);	275	sv_magicext ((SV )obj->self, 0, PERL_MAGIC_ext, &attachable::vtbl, (char )obj, 0);
239		276	obj->flags \|= (obj->flags & 0xc0) << 8;
240	// borrow the refcnt from the object	277	obj->flags &= ~0xc0;//D
241	// it is important thta no refcnt_chk is being executed here	278	obj->flags \|= 0x10;//D
242	obj->refcnt_dec ();
243		279
244	// now bless the object _once_	280	// now bless the object _once_
245	return sv_bless (newRV_inc ((SV *)obj->self), stash);	281	return sv_bless (newRV_inc ((SV *)obj->self), stash);
246	}	282	}
247	else	283	else
…		…
313	inline SV to_sv (living v) { return newSVptr (v, stash_cf_living_wrap); }	349	inline SV to_sv (living v) { return newSVptr (v, stash_cf_living_wrap); }
314		350
315	inline SV *to_sv (object & v) { return to_sv (&v); }	351	inline SV *to_sv (object & v) { return to_sv (&v); }
316	inline SV *to_sv (living & v) { return to_sv (&v); }	352	inline SV *to_sv (living & v) { return to_sv (&v); }
317		353
318	inline SV to_sv (facetile v) { return to_sv (v->name); }	354	//inline SV to_sv (faceinfo v) { return to_sv (v->name); }
319	inline SV to_sv (treasurelist v) { return to_sv (v->name); }	355	inline SV to_sv (treasurelist v) { return to_sv (v->name); }
		356	inline SV *to_sv (std::string & v) { return newSVpvn (v.data (), v.size ()); }
320		357
321	inline SV *to_sv (UUID v)	358	inline SV *to_sv (UUID v)
322	{	359	{
323	char buf[128];	360	char buf[128];
324	snprintf (buf, 128, "<1,%" PRIx64 ">", v.seq);	361	snprintf (buf, 128, "<1.%" PRIx64 ">", v.seq);
325	return newSVpv (buf, 0);	362	return newSVpv (buf, 0);
326	}	363	}
327		364
328	inline void sv_to (SV *sv, shstr &v) { v = SvOK (sv) ? SvPV_nolen (sv) : 0; }	365	inline void sv_to (SV *sv, shstr &v) { v = SvOK (sv) ? SvPV_nolen (sv) : 0; }
329	inline void sv_to (SV sv, char &v) { free (v); v = SvOK (sv) ? strdup (SvPV_nolen (sv)) : 0; }	366	inline void sv_to (SV sv, char &v) { free (v); v = SvOK (sv) ? strdup (SvPV_nolen (sv)) : 0; }
…		…
348	inline void sv_to (SV sv, attachable &v) { v = (attachable *)SvPTR_ornull (sv, "cf::attachable"); }	385	inline void sv_to (SV sv, attachable &v) { v = (attachable *)SvPTR_ornull (sv, "cf::attachable"); }
349	inline void sv_to (SV sv, partylist &v) { v = (partylist *)SvPTR_ornull (sv, "cf::party"); }	386	inline void sv_to (SV sv, partylist &v) { v = (partylist *)SvPTR_ornull (sv, "cf::party"); }
350	inline void sv_to (SV sv, region &v) { v = (region *)SvPTR_ornull (sv, "cf::region"); }	387	inline void sv_to (SV sv, region &v) { v = (region *)SvPTR_ornull (sv, "cf::region"); }
351	inline void sv_to (SV sv, living &v) { v = (living *)SvPTR_ornull (sv, "cf::living"); }	388	inline void sv_to (SV sv, living &v) { v = (living *)SvPTR_ornull (sv, "cf::living"); }
352		389
353	inline void sv_to (SV sv, facetile &v) { v = &new_faces[FindFace (SvPV_nolen (sv), 0)]; }	390	//inline void sv_to (SV sv, faceinfo &v) { v = &faces [face_find (SvPV_nolen (sv), 0)]; }
354	inline void sv_to (SV sv, treasurelist &v) { v = find_treasurelist (SvPV_nolen (sv)); }	391	inline void sv_to (SV sv, treasurelist &v) { v = find_treasurelist (SvPV_nolen (sv)); }
355		392
356	template<class T>	393	template<class T>
357	inline void sv_to (SV sv, refptr<T> &v) { T tmp; sv_to (sv, tmp); v = tmp; }	394	inline void sv_to (SV sv, refptr<T> &v) { T tmp; sv_to (sv, tmp); v = tmp; }
358		395
…		…
362	inline void sv_to (SV *sv, rangetype &v) { v = (rangetype) SvIV (sv); }	399	inline void sv_to (SV *sv, rangetype &v) { v = (rangetype) SvIV (sv); }
363	inline void sv_to (SV *sv, bowtype_t &v) { v = (bowtype_t) SvIV (sv); }	400	inline void sv_to (SV *sv, bowtype_t &v) { v = (bowtype_t) SvIV (sv); }
364	inline void sv_to (SV *sv, petmode_t &v) { v = (petmode_t) SvIV (sv); }	401	inline void sv_to (SV *sv, petmode_t &v) { v = (petmode_t) SvIV (sv); }
365	inline void sv_to (SV *sv, usekeytype &v) { v = (usekeytype) SvIV (sv); }	402	inline void sv_to (SV *sv, usekeytype &v) { v = (usekeytype) SvIV (sv); }
366	inline void sv_to (SV *sv, unapplymode &v) { v = (unapplymode) SvIV (sv); }	403	inline void sv_to (SV *sv, unapplymode &v) { v = (unapplymode) SvIV (sv); }
		404
		405	inline void sv_to (SV *sv, std::string &v)
		406	{
		407	STRLEN len;
		408	char *data = SvPVbyte (sv, len);
		409	v.assign (data, len);
		410	}
367		411
368	inline void sv_to (SV *sv, UUID &v)	412	inline void sv_to (SV *sv, UUID &v)
369	{	413	{
370	unsigned int version;	414	unsigned int version;
371		415
…		…
562	perl = perl_alloc ();	606	perl = perl_alloc ();
563	perl_construct (perl);	607	perl_construct (perl);
564		608
565	PL_exit_flags \|= PERL_EXIT_DESTRUCT_END;	609	PL_exit_flags \|= PERL_EXIT_DESTRUCT_END;
566		610
567	char *argv[] = {	611	const char *argv[] = {
568	"",	612	"",
569	"-e"	613	"-e"
570	"use Event; use Coro;" // required for bootstrap	614	"use Event; use Coro;" // required for bootstrap
571	"cf->bootstrap;" // required for datadir :*>	615	"cf->bootstrap;" // required for datadir :*>
572	"unshift @INC, cf::datadir ();"	616	"unshift @INC, cf::datadir ();"
573	"require cf;"	617	"require cf;"
574	};	618	};
575		619
576	if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) \|\| perl_run (perl))	620	if (perl_parse (perl, xs_init, 2, (char )argv, (char )NULL)
		621	\|\| perl_run (perl))
577	{	622	{
578	printf ("unable to initialize perl-interpreter, aborting.\n");	623	printf ("unable to initialize perl-interpreter, aborting.\n");
579	exit (EXIT_FAILURE);	624	exit (EXIT_FAILURE);
580	}	625	}
		626
		627	{
		628	dSP;
		629
		630	PUSHMARK (SP);
		631	PUTBACK;
		632	call_pv ("cf::init", G_DISCARD \| G_VOID);
		633	}
581	}	634	}
582		635
583	void cfperl_main ()	636	void cfperl_main ()
584	{	637	{
585	dSP;	638	dSP;
…		…
806	CALL_BEGIN (0);	859	CALL_BEGIN (0);
807	CALL_CALL ("cf::emergency_save", G_VOID);	860	CALL_CALL ("cf::emergency_save", G_VOID);
808	CALL_END;	861	CALL_END;
809	}	862	}
810		863
		864	void
		865	cfperl_cleanup (int make_core)
		866	{
		867	CALL_BEGIN (1);
		868	CALL_ARG (make_core);
		869	CALL_CALL ("cf::post_cleanup", G_VOID);
		870	CALL_END;
		871	}
		872
811	maptile *	873	maptile *
812	maptile::find_sync (const char path, maptile origin)	874	maptile::find_sync (const char path, maptile origin)
813	{	875	{
814	CALL_BEGIN (2);	876	CALL_BEGIN (2);
815	CALL_ARG (path);	877	CALL_ARG (path);
…		…
895	void	957	void
896	iw::alloc ()	958	iw::alloc ()
897	{	959	{
898	pe = GEventAPI->new_idle (0, 0);	960	pe = GEventAPI->new_idle (0, 0);
899		961
		962	WaREENTRANT_off (pe);
900	pe->base.callback = (void *)iw_dispatch;	963	pe->base.callback = (void *)iw_dispatch;
901	pe->base.ext_data = (void *)this;	964	pe->base.ext_data = (void *)this;
902	}	965	}
903		966
904	static void iow_dispatch (pe_event *ev)	967	static void iow_dispatch (pe_event *ev)
…		…
910	void	973	void
911	iow::alloc ()	974	iow::alloc ()
912	{	975	{
913	pe = GEventAPI->new_io (0, 0);	976	pe = GEventAPI->new_io (0, 0);
914		977
		978	WaREENTRANT_off (pe);
915	pe->base.callback = (void *)iow_dispatch;	979	pe->base.callback = (void *)iow_dispatch;
916	pe->base.ext_data = (void *)this;	980	pe->base.ext_data = (void *)this;
917		981
918	pe->fd = -1;	982	pe->fd = -1;
919	pe->poll = 0;	983	pe->poll = 0;
…		…
987	# define const_iv(name) { # name, (IV)name },	1051	# define const_iv(name) { # name, (IV)name },
988	const_iv (llevError)	1052	const_iv (llevError)
989	const_iv (llevInfo)	1053	const_iv (llevInfo)
990	const_iv (llevDebug)	1054	const_iv (llevDebug)
991	const_iv (llevMonster)	1055	const_iv (llevMonster)
		1056
		1057	const_iv (Map0Cmd)
		1058	const_iv (Map1Cmd)
		1059	const_iv (Map1aCmd)
		1060
		1061	const_iv (MAP_CLIENT_X)
		1062	const_iv (MAP_CLIENT_Y)
992		1063
993	const_iv (MAX_TIME)	1064	const_iv (MAX_TIME)
994	const_iv (PLAYER)	1065	const_iv (PLAYER)
995	const_iv (TRANSPORT)	1066	const_iv (TRANSPORT)
996	const_iv (ROD)	1067	const_iv (ROD)
…		…
1531	{	1602	{
1532	// reattach to all attachable objects in the game.	1603	// reattach to all attachable objects in the game.
1533	for_all_clients (ns)	1604	for_all_clients (ns)
1534	ns->reattach ();	1605	ns->reattach ();
1535		1606
1536	for_all_players (pl)
1537	pl->reattach ();
1538
1539	//TODO
1540	//for (map_container::iterator i = maps.begin (); i != maps.end (); ++i)
1541	// i->second->reattach ();
1542
1543	for_all_objects (op)	1607	for_all_objects (op)
1544	op->reattach ();	1608	op->reattach ();
1545	}	1609	}
1546		1610
1547	NV floor (NV x)	1611	NV floor (NV x)
…		…
1587	void	1651	void
1588	sub_generation_inc ()	1652	sub_generation_inc ()
1589	CODE:	1653	CODE:
1590	PL_sub_generation++;	1654	PL_sub_generation++;
1591		1655
1592	char *	1656	const char *
1593	mapdir ()	1657	mapdir ()
1594	PROTOTYPE:	1658	PROTOTYPE:
1595	ALIAS:	1659	ALIAS:
1596	mapdir = 0	1660	mapdir = 0
1597	uniquedir = 1	1661	uniquedir = 1
…		…
1619		1683
1620	void cleanup (const char *cause, bool make_core = false)	1684	void cleanup (const char *cause, bool make_core = false)
1621		1685
1622	void emergency_save ()	1686	void emergency_save ()
1623		1687
		1688	void _exit (int status = EXIT_SUCCESS)
		1689
1624	UV sv_2watcher (SV *w)	1690	UV sv_2watcher (SV *w)
1625	CODE:	1691	CODE:
1626	RETVAL = (UV)GEventAPI->sv_2watcher (w);	1692	RETVAL = (UV)GEventAPI->sv_2watcher (w);
1627	OUTPUT:	1693	OUTPUT:
1628	RETVAL	1694	RETVAL
1629
1630	void _exit (int status = 0)
1631		1695
1632	#if _POSIX_MEMLOCK	1696	#if _POSIX_MEMLOCK
1633		1697
1634	int mlockall (int flags = MCL_CURRENT \| MCL_FUTURE)	1698	int mlockall (int flags = MCL_CURRENT \| MCL_FUTURE)
1635		1699
…		…
1681	RETVAL = newSVpv (resist_plus[atnr], 0);	1745	RETVAL = newSVpv (resist_plus[atnr], 0);
1682	else	1746	else
1683	XSRETURN_UNDEF;	1747	XSRETURN_UNDEF;
1684	OUTPUT: RETVAL	1748	OUTPUT: RETVAL
1685		1749
		1750	bool
		1751	load_resource_file (const char *filename)
		1752
1686	MODULE = cf PACKAGE = cf::attachable	1753	MODULE = cf PACKAGE = cf::attachable
1687		1754
1688	int	1755	int
1689	valid (SV *obj)	1756	valid (SV *obj)
1690	CODE:	1757	CODE:
1691	RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);	1758	RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
1692	OUTPUT:	1759	OUTPUT:
1693	RETVAL	1760	RETVAL
1694		1761
		1762	void
		1763	debug_trace (attachable *obj, bool on = true)
		1764	CODE:
		1765	obj->flags &= ~attachable::F_DEBUG_TRACE;
		1766	if (on)
		1767	obj->flags \|= attachable::F_DEBUG_TRACE;
		1768
		1769	int mortals_size ()
		1770	CODE:
		1771	RETVAL = attachable::mortals.size ();
		1772	OUTPUT: RETVAL
		1773
		1774	#object *mortals (U32 index)
		1775	# CODE:
		1776	# RETVAL = index < attachable::mortals.size () ? attachable::mortals [index] : 0;
		1777	# OUTPUT: RETVAL
		1778
1695	INCLUDE: $PERL genacc attachable ../include/cfperl.h \|	1779	INCLUDE: $PERL $srcdir/genacc attachable ../include/cfperl.h \|
1696		1780
1697	MODULE = cf PACKAGE = cf::global	1781	MODULE = cf PACKAGE = cf::global
1698		1782
1699	int invoke (SV *klass, int event, ...)	1783	int invoke (SV *klass, int event, ...)
1700	CODE:	1784	CODE:
…		…
1704	RETVAL = gbl_ev.invoke ((event_type)event, ARG_AV (av), DT_END);	1788	RETVAL = gbl_ev.invoke ((event_type)event, ARG_AV (av), DT_END);
1705	OUTPUT: RETVAL	1789	OUTPUT: RETVAL
1706		1790
1707	MODULE = cf PACKAGE = cf::object PREFIX = cf_object_	1791	MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
1708		1792
1709	INCLUDE: $PERL genacc object ../include/object.h \|	1793	INCLUDE: $PERL $srcdir/genacc object ../include/object.h \|
1710		1794
1711	int invoke (object *op, int event, ...)	1795	int invoke (object *op, int event, ...)
1712	CODE:	1796	CODE:
1713	if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");	1797	if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");
1714	AV av = (AV )sv_2mortal ((SV *)newAV ());	1798	AV av = (AV )sv_2mortal ((SV *)newAV ());
…		…
1716	RETVAL = op->invoke ((event_type)event, ARG_AV (av), DT_END);	1800	RETVAL = op->invoke ((event_type)event, ARG_AV (av), DT_END);
1717	OUTPUT: RETVAL	1801	OUTPUT: RETVAL
1718		1802
1719	SV registry (object op)	1803	SV registry (object op)
1720		1804
1721	void mortals ()
1722	PPCODE:
1723	EXTEND (SP, object::mortals.size ());
1724	for (AUTODECL (i, object::mortals.begin ()); i != object::mortals.end (); ++i)
1725	PUSHs (to_sv (*i));
1726
1727	int objects_size ()	1805	int objects_size ()
1728	CODE:	1806	CODE:
1729	RETVAL = objects.size ();	1807	RETVAL = objects.size ();
1730	OUTPUT: RETVAL	1808	OUTPUT: RETVAL
1731		1809
…		…
1771	void	1849	void
1772	set_animation (object *op, int idx)	1850	set_animation (object *op, int idx)
1773	CODE:	1851	CODE:
1774	SET_ANIMATION (op, idx);	1852	SET_ANIMATION (op, idx);
1775		1853
		1854	int
		1855	num_animations (object *op)
		1856	CODE:
		1857	RETVAL = NUM_ANIMATIONS (op);
		1858	OUTPUT: RETVAL
		1859
1776	object find_best_object_match (object op, const char *match)	1860	object find_best_object_match (object op, const char *match)
1777		1861
1778	object find_marked_object (object op)	1862	object find_marked_object (object op)
1779		1863
1780	int need_identify (object *obj);	1864	int need_identify (object *obj);
1781		1865
1782	int apply_shop_mat (object shop_mat, object op);	1866	int apply_shop_mat (object shop_mat, object op);
		1867
		1868	int move_player (object *op, int dir)
		1869	CODE:
		1870	RETVAL = move_player (op, dir);
		1871	OUTPUT:
		1872	RETVAL
1783		1873
1784	int move (object op, int dir, object originator = op)	1874	int move (object op, int dir, object originator = op)
1785	CODE:	1875	CODE:
1786	RETVAL = move_ob (op, dir, originator);	1876	RETVAL = move_ob (op, dir, originator);
1787	OUTPUT:	1877	OUTPUT:
…		…
1792	manual_apply (applied, applier, flags);	1882	manual_apply (applied, applier, flags);
1793		1883
1794	void apply_below (object *op)	1884	void apply_below (object *op)
1795	CODE:	1885	CODE:
1796	player_apply_below (op);	1886	player_apply_below (op);
		1887
		1888	int cast_heal (object op, object caster, object *spell, int dir = 0)
1797		1889
1798	object cf_object_present_archname_inside (object op, char *whatstr)	1890	object cf_object_present_archname_inside (object op, char *whatstr)
1799		1891
1800	int cf_object_transfer (object op, int x, int y, int r = 0, object_ornull orig = 0)	1892	int cf_object_transfer (object op, int x, int y, int r = 0, object_ornull orig = 0)
1801		1893
…		…
1986		2078
1987	int command_summon (object op, char params)	2079	int command_summon (object op, char params)
1988		2080
1989	int command_arrest (object op, char params)	2081	int command_arrest (object op, char params)
1990		2082
1991	int command_kick (object op, char params)
1992
1993	int command_banish (object op, char params)
1994
1995		2083
1996	MODULE = cf PACKAGE = cf::player PREFIX = cf_player_	2084	MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
1997		2085
1998	INCLUDE: $PERL genacc player ../include/player.h \|	2086	INCLUDE: $PERL $srcdir/genacc player ../include/player.h \|
1999		2087
2000	int invoke (player *pl, int event, ...)	2088	int invoke (player *pl, int event, ...)
2001	CODE:	2089	CODE:
2002	if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");	2090	if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");
2003	AV av = (AV )sv_2mortal ((SV *)newAV ());	2091	AV av = (AV )sv_2mortal ((SV *)newAV ());
…		…
2016	pl->orig_stats = pl->ob->stats;	2104	pl->orig_stats = pl->ob->stats;
2017		2105
2018	void cf_player_move (player *pl, int dir)	2106	void cf_player_move (player *pl, int dir)
2019		2107
2020	void play_sound_player_only (player *pl, int soundnum, int x = 0, int y = 0);	2108	void play_sound_player_only (player *pl, int soundnum, int x = 0, int y = 0);
2021
2022	player *first ()
2023	CODE:
2024	RETVAL = first_player;
2025	OUTPUT: RETVAL
2026		2109
2027	bool	2110	bool
2028	cell_visible (player *pl, int dx, int dy)	2111	cell_visible (player *pl, int dx, int dy)
2029	CODE:	2112	CODE:
2030	RETVAL = FABS (dx) <= pl->ns->mapx / 2 && FABS (dy) <= pl->ns->mapy / 2	2113	RETVAL = FABS (dx) <= pl->ns->mapx / 2 && FABS (dy) <= pl->ns->mapy / 2
…		…
2083	RETVAL = map->invoke ((event_type)event, ARG_AV (av), DT_END);	2166	RETVAL = map->invoke ((event_type)event, ARG_AV (av), DT_END);
2084	OUTPUT: RETVAL	2167	OUTPUT: RETVAL
2085		2168
2086	SV registry (maptile map)	2169	SV registry (maptile map)
2087		2170
2088	INCLUDE: $PERL genacc maptile ../include/map.h \|	2171	INCLUDE: $PERL $srcdir/genacc maptile ../include/map.h \|
2089		2172
2090	void	2173	void
2091	maptile::instantiate ()	2174	maptile::instantiate ()
2092		2175
2093	maptile *new ()	2176	maptile *new ()
…		…
2107	EXTEND (SP, THIS->players);	2190	EXTEND (SP, THIS->players);
2108	for_all_players (pl)	2191	for_all_players (pl)
2109	if (pl->ob && pl->ob->map == THIS)	2192	if (pl->ob && pl->ob->map == THIS)
2110	PUSHs (sv_2mortal (to_sv (pl->ob)));	2193	PUSHs (sv_2mortal (to_sv (pl->ob)));
2111	}	2194	}
		2195
		2196	void
		2197	maptile::add_underlay (SV data, int offset, int stride, SV palette)
		2198	CODE:
		2199	{
		2200	if (!SvROK (palette) \|\| SvTYPE (SvRV (palette)) != SVt_PVAV)
		2201	croak ("maptile::add_underlay: palette must be arrayref");
		2202
		2203	palette = SvRV (palette);
		2204
		2205	STRLEN idxlen;
		2206	const uint8_t idx = (const uint8_t )SvPVbyte (data, idxlen);
		2207
		2208	for (int x = 0; x < THIS->width; ++x)
		2209	for (int y = 0; y < THIS->height; ++y)
		2210	{
		2211	for (object *op = THIS->at (x, y).bot; op; op = op->above)
		2212	if (op->flag [FLAG_IS_FLOOR])
		2213	goto skip_space;
		2214
		2215	{
		2216	int offs = offset + y * stride + x;
		2217	if (IN_RANGE_EXC (offs, 0, idxlen))
		2218	{
		2219	if (SV *elem = av_fetch ((AV )palette, idx [offs], 0))
		2220	{
		2221	object ob = get_archetype (SvPVutf8_nolen (elem));
		2222	ob->flag [FLAG_NO_MAP_SAVE] = true;
		2223	THIS->insert (ob, x, y, 0, INS_ABOVE_FLOOR_ONLY);
		2224	}
		2225	}
		2226	}
		2227
		2228	skip_space: ;
		2229	}
		2230	}
		2231
		2232	void
		2233	maptile::set_regiondata (SV data, int offset, int stride, SV palette)
		2234	CODE:
		2235	{
		2236	if (!SvROK (palette) \|\| SvTYPE (SvRV (palette)) != SVt_PVAV)
		2237	croak ("maptile::set_regiondata: palette must be arrayref");
		2238
		2239	palette = SvRV (palette);
		2240
		2241	STRLEN idxlen;
		2242	const uint8_t idx = (const uint8_t )SvPVbyte (data, idxlen);
		2243
		2244	region regionmap = (region )malloc (
		2245	(av_len ((AV )palette) + 1) sizeof (region *));
		2246	uint8_t *regions = salloc<uint8_t> (THIS->size ());
		2247
		2248	for (int i = av_len ((AV *)palette) + 1; i--; )
		2249	regionmap [i] = region::find (
		2250	SvPVutf8_nolen (av_fetch ((AV )palette, i, 1)));
		2251
		2252	for (int y = 0; y < THIS->height; ++y)
		2253	memcpy (regions + y * THIS->width, idx + offset + y * stride, THIS->width);
		2254
		2255	sfree (THIS->regions, THIS->size ());
		2256	free (THIS->regionmap);
		2257
		2258	THIS->regions = regions;
		2259	THIS->regionmap = regionmap;
		2260	}
2112		2261
2113	void play_sound_map (maptile *map, int x, int y, int sound_num)	2262	void play_sound_map (maptile *map, int x, int y, int sound_num)
2114		2263
2115	int out_of_map (maptile *map, int x, int y)	2264	int out_of_map (maptile *map, int x, int y)
2116		2265
…		…
2197	OUTPUT: RETVAL	2346	OUTPUT: RETVAL
2198		2347
2199	void fix_walls (maptile *map, int x, int y)	2348	void fix_walls (maptile *map, int x, int y)
2200		2349
2201	void fix_walls_around (maptile *map, int x, int y)	2350	void fix_walls_around (maptile *map, int x, int y)
2202
2203	const char *
2204	region_name (maptile *m)
2205	CODE:
2206	RETVAL = get_name_of_region_for_map (m);
2207	OUTPUT: RETVAL
2208		2351
2209	# worst xs function of my life	2352	# worst xs function of my life
2210	bool	2353	bool
2211	_create_random_map (\	2354	_create_random_map (\
2212	maptile *self,\	2355	maptile *self,\
…		…
2306	PROTOTYPE:	2449	PROTOTYPE:
2307	CODE:	2450	CODE:
2308	RETVAL = first_archetype;	2451	RETVAL = first_archetype;
2309	OUTPUT: RETVAL	2452	OUTPUT: RETVAL
2310		2453
2311	INCLUDE: $PERL genacc archetype ../include/object.h \|	2454	INCLUDE: $PERL $srcdir/genacc archetype ../include/object.h \|
2312		2455
2313	MODULE = cf PACKAGE = cf::party	2456	MODULE = cf PACKAGE = cf::party
2314		2457
2315	partylist *first ()	2458	partylist *first ()
2316	PROTOTYPE:	2459	PROTOTYPE:
2317	CODE:	2460	CODE:
2318	RETVAL = get_firstparty ();	2461	RETVAL = get_firstparty ();
2319	OUTPUT: RETVAL	2462	OUTPUT: RETVAL
2320		2463
2321	INCLUDE: $PERL genacc partylist ../include/player.h \|	2464	INCLUDE: $PERL $srcdir/genacc partylist ../include/player.h \|
2322		2465
2323	MODULE = cf PACKAGE = cf::region	2466	MODULE = cf PACKAGE = cf::region
2324		2467
2325	region *first ()	2468	void
2326	PROTOTYPE:	2469	list ()
2327	CODE:	2470	PPCODE:
2328	RETVAL = first_region;	2471	for_all_regions (rgn)
2329	OUTPUT: RETVAL	2472	XPUSHs (sv_2mortal (to_sv (rgn)));
2330		2473
2331	region find (char name)	2474	region find (char name)
2332	PROTOTYPE: $	2475	PROTOTYPE: $
2333	CODE:	2476	CODE:
2334	RETVAL = get_region_by_name (name);	2477	RETVAL = region::find (name);
2335	OUTPUT: RETVAL	2478	OUTPUT: RETVAL
2336		2479
		2480	region find_fuzzy (char name)
		2481	PROTOTYPE: $
		2482	CODE:
		2483	RETVAL = region::find_fuzzy (name);
		2484	OUTPUT: RETVAL
		2485
2337	INCLUDE: $PERL genacc region ../include/map.h \|	2486	INCLUDE: $PERL $srcdir/genacc region ../include/map.h \|
2338		2487
2339	MODULE = cf PACKAGE = cf::living	2488	MODULE = cf PACKAGE = cf::living
2340		2489
2341	INCLUDE: $PERL genacc living ../include/living.h \|	2490	INCLUDE: $PERL $srcdir/genacc living ../include/living.h \|
2342		2491
2343	MODULE = cf PACKAGE = cf::settings	2492	MODULE = cf PACKAGE = cf::settings
2344		2493
2345	INCLUDE: $PERL genacc Settings ../include/global.h \|	2494	INCLUDE: $PERL $srcdir/genacc Settings ../include/global.h \|
2346		2495
2347	MODULE = cf PACKAGE = cf::client	2496	MODULE = cf PACKAGE = cf::client
2348		2497
2349	INCLUDE: $PERL genacc client ../include/client.h \|	2498	INCLUDE: $PERL $srcdir/genacc client ../include/client.h \|
2350		2499
2351	int invoke (client *ns, int event, ...)	2500	int invoke (client *ns, int event, ...)
2352	CODE:	2501	CODE:
2353	if (KLASS_OF (event) != KLASS_CLIENT) croak ("event class must be CLIENT");	2502	if (KLASS_OF (event) != KLASS_CLIENT) croak ("event class must be CLIENT");
2354	AV av = (AV )sv_2mortal ((SV *)newAV ());	2503	AV av = (AV )sv_2mortal ((SV *)newAV ());
…		…
2373	char *buf = SvPVbyte (packet, len);	2522	char *buf = SvPVbyte (packet, len);
2374		2523
2375	THIS->send_packet (buf, len);	2524	THIS->send_packet (buf, len);
2376	}	2525	}
2377		2526
		2527	MODULE = cf PACKAGE = cf::face PREFIX = face_
		2528
		2529	INCLUDE: $PERL $srcdir/genacc faceset ../include/face.h \|
		2530
		2531	faceidx face_find (const char *name, faceidx defidx = 0)
		2532
		2533	faceidx alloc (const char *name)
		2534	CODE:
		2535	{
		2536	do
		2537	{
		2538	RETVAL = faces.size ();
		2539	faces.resize (RETVAL + 1);
		2540	}
		2541	while (!RETVAL); // crude way to leave index 0
		2542
		2543	faces [RETVAL].name = name;
		2544	facehash.insert (std::make_pair (faces [RETVAL].name, RETVAL));
		2545
		2546	if (!strcmp (name, BLANK_FACE_NAME)) blank_face = RETVAL;
		2547	if (!strcmp (name, EMPTY_FACE_NAME)) empty_face = RETVAL;
		2548	}
		2549	OUTPUT: RETVAL
		2550
		2551	void set (faceidx idx, int visibility, int magicmap)
		2552	CODE:
		2553	faceinfo *f = face_info (idx);
		2554	assert (f);
		2555	f->visibility = visibility;
		2556	f->magicmap = magicmap;
		2557
		2558	void set_smooth (faceidx idx, faceidx smooth)
		2559	CODE:
		2560	faceinfo *f = face_info (idx);
		2561	assert (f);
		2562	f->smooth = smooth;
		2563
		2564	void set_data (faceidx idx, int faceset, SV data, SV chksum)
		2565	CODE:
		2566	facedata *d = face_data (idx, faceset);
		2567	assert (d);
		2568	sv_to (data, d->data);
		2569	STRLEN clen;
		2570	char *cdata = SvPVbyte (chksum, clen);
		2571	memcpy (d->chksum, cdata, min (CHKSUM_SIZE, clen));
		2572
		2573	void invalidate (faceidx idx)
		2574	CODE:
		2575	for_all_clients (ns)
		2576	ns->faces_sent [idx] = false;
		2577
		2578	void invalidate_all ()
		2579	CODE:
		2580	for_all_clients (ns)
		2581	ns->faces_sent.reset ();
		2582

Diff Legend

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

Comparing deliantra/server/server/cfperl.xs (file contents): Revision 1.149 by root, Mon Jan 22 03:44:41 2007 UTC vs. Revision 1.181 by root, Tue Apr 3 00:21:38 2007 UTC

Diff Legend

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.149 by root, Mon Jan 22 03:44:41 2007 UTC vs.
Revision 1.181 by root, Tue Apr 3 00:21:38 2007 UTC