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

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.146 by root, Fri Jan 19 22:24:10 2007 UTC vs.
Revision 1.173 by root, Mon Mar 5 19:54:49 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
…		…
319	inline SV to_sv (treasurelist v) { return to_sv (v->name); }	355	inline SV to_sv (treasurelist v) { return to_sv (v->name); }
320		356
321	inline SV *to_sv (UUID v)	357	inline SV *to_sv (UUID v)
322	{	358	{
323	char buf[128];	359	char buf[128];
324	snprintf (buf, 128, "<1,%" PRIx64 ">", v.seq);	360	snprintf (buf, 128, "<1.%" PRIx64 ">", v.seq);
325	return newSVpv (buf, 0);	361	return newSVpv (buf, 0);
326	}	362	}
327		363
328	inline void sv_to (SV *sv, shstr &v) { v = SvOK (sv) ? SvPV_nolen (sv) : 0; }	364	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; }	365	inline void sv_to (SV sv, char &v) { free (v); v = SvOK (sv) ? strdup (SvPV_nolen (sv)) : 0; }
…		…
576	if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) \|\| perl_run (perl))	612	if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) \|\| perl_run (perl))
577	{	613	{
578	printf ("unable to initialize perl-interpreter, aborting.\n");	614	printf ("unable to initialize perl-interpreter, aborting.\n");
579	exit (EXIT_FAILURE);	615	exit (EXIT_FAILURE);
580	}	616	}
		617
		618	{
		619	dSP;
		620
		621	PUSHMARK (SP);
		622	PUTBACK;
		623	call_pv ("cf::init", G_DISCARD \| G_VOID);
		624	}
581	}	625	}
582		626
583	void cfperl_main ()	627	void cfperl_main ()
584	{	628	{
585	dSP;	629	dSP;
…		…
806	CALL_BEGIN (0);	850	CALL_BEGIN (0);
807	CALL_CALL ("cf::emergency_save", G_VOID);	851	CALL_CALL ("cf::emergency_save", G_VOID);
808	CALL_END;	852	CALL_END;
809	}	853	}
810		854
		855	void
		856	cfperl_cleanup (int make_core)
		857	{
		858	CALL_BEGIN (1);
		859	CALL_ARG (make_core);
		860	CALL_CALL ("cf::post_cleanup", G_VOID);
		861	CALL_END;
		862	}
		863
811	maptile *	864	maptile *
812	maptile::find_sync (const char path, maptile origin)	865	maptile::find_sync (const char path, maptile origin)
813	{	866	{
814	CALL_BEGIN (2);	867	CALL_BEGIN (2);
815	CALL_ARG (path);	868	CALL_ARG (path);
…		…
895	void	948	void
896	iw::alloc ()	949	iw::alloc ()
897	{	950	{
898	pe = GEventAPI->new_idle (0, 0);	951	pe = GEventAPI->new_idle (0, 0);
899		952
		953	WaREENTRANT_off (pe);
900	pe->base.callback = (void *)iw_dispatch;	954	pe->base.callback = (void *)iw_dispatch;
901	pe->base.ext_data = (void *)this;	955	pe->base.ext_data = (void *)this;
902	}	956	}
903		957
904	static void iow_dispatch (pe_event *ev)	958	static void iow_dispatch (pe_event *ev)
…		…
910	void	964	void
911	iow::alloc ()	965	iow::alloc ()
912	{	966	{
913	pe = GEventAPI->new_io (0, 0);	967	pe = GEventAPI->new_io (0, 0);
914		968
		969	WaREENTRANT_off (pe);
915	pe->base.callback = (void *)iow_dispatch;	970	pe->base.callback = (void *)iow_dispatch;
916	pe->base.ext_data = (void *)this;	971	pe->base.ext_data = (void *)this;
917		972
918	pe->fd = -1;	973	pe->fd = -1;
919	pe->poll = 0;	974	pe->poll = 0;
…		…
1248	const_iv (FLAG_IS_WATER)	1303	const_iv (FLAG_IS_WATER)
1249	const_iv (FLAG_CONTENT_ON_GEN)	1304	const_iv (FLAG_CONTENT_ON_GEN)
1250	const_iv (FLAG_IS_A_TEMPLATE)	1305	const_iv (FLAG_IS_A_TEMPLATE)
1251	const_iv (FLAG_IS_BUILDABLE)	1306	const_iv (FLAG_IS_BUILDABLE)
1252	const_iv (FLAG_DESTROY_ON_DEATH)	1307	const_iv (FLAG_DESTROY_ON_DEATH)
1253	const_iv (FLAG_NO_SAVE)	1308	const_iv (FLAG_NO_MAP_SAVE)
1254		1309
1255	const_iv (NDI_BLACK)	1310	const_iv (NDI_BLACK)
1256	const_iv (NDI_WHITE)	1311	const_iv (NDI_WHITE)
1257	const_iv (NDI_NAVY)	1312	const_iv (NDI_NAVY)
1258	const_iv (NDI_RED)	1313	const_iv (NDI_RED)
…		…
1443	const_iv (ATNR_BLIND)	1498	const_iv (ATNR_BLIND)
1444	const_iv (ATNR_INTERNAL)	1499	const_iv (ATNR_INTERNAL)
1445	const_iv (ATNR_LIFE_STEALING)	1500	const_iv (ATNR_LIFE_STEALING)
1446	const_iv (ATNR_DISEASE)	1501	const_iv (ATNR_DISEASE)
1447		1502
1448	const_iv (MAP_FLUSH)
1449	const_iv (MAP_PLAYER_UNIQUE)
1450	const_iv (MAP_BLOCK)
1451	const_iv (MAP_STYLE)
1452	const_iv (MAP_OVERLAY)
1453
1454	const_iv (MAP_IN_MEMORY)	1503	const_iv (MAP_IN_MEMORY)
1455	const_iv (MAP_SWAPPED)	1504	const_iv (MAP_SWAPPED)
1456	const_iv (MAP_LOADING)	1505	const_iv (MAP_LOADING)
1457	const_iv (MAP_SAVING)	1506	const_iv (MAP_SAVING)
1458		1507
…		…
1625		1674
1626	void cleanup (const char *cause, bool make_core = false)	1675	void cleanup (const char *cause, bool make_core = false)
1627		1676
1628	void emergency_save ()	1677	void emergency_save ()
1629		1678
1630	void _exit (int status = 0)	1679	void _exit (int status = EXIT_SUCCESS)
		1680
		1681	UV sv_2watcher (SV *w)
		1682	CODE:
		1683	RETVAL = (UV)GEventAPI->sv_2watcher (w);
		1684	OUTPUT:
		1685	RETVAL
1631		1686
1632	#if _POSIX_MEMLOCK	1687	#if _POSIX_MEMLOCK
1633		1688
1634	int mlockall (int flags = MCL_CURRENT \| MCL_FUTURE)	1689	int mlockall (int flags = MCL_CURRENT \| MCL_FUTURE)
1635		1690
…		…
1681	RETVAL = newSVpv (resist_plus[atnr], 0);	1736	RETVAL = newSVpv (resist_plus[atnr], 0);
1682	else	1737	else
1683	XSRETURN_UNDEF;	1738	XSRETURN_UNDEF;
1684	OUTPUT: RETVAL	1739	OUTPUT: RETVAL
1685		1740
		1741	bool
		1742	load_resource_file (const char *filename)
		1743
1686	MODULE = cf PACKAGE = cf::attachable	1744	MODULE = cf PACKAGE = cf::attachable
1687		1745
1688	int	1746	int
1689	valid (SV *obj)	1747	valid (SV *obj)
1690	CODE:	1748	CODE:
1691	RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);	1749	RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
1692	OUTPUT:	1750	OUTPUT:
1693	RETVAL	1751	RETVAL
1694		1752
		1753	void
		1754	debug_trace (attachable *obj, bool on = true)
		1755	CODE:
		1756	obj->flags &= ~attachable::F_DEBUG_TRACE;
		1757	if (on)
		1758	obj->flags \|= attachable::F_DEBUG_TRACE;
		1759
		1760	int mortals_size ()
		1761	CODE:
		1762	RETVAL = attachable::mortals.size ();
		1763	OUTPUT: RETVAL
		1764
		1765	#object *mortals (U32 index)
		1766	# CODE:
		1767	# RETVAL = index < attachable::mortals.size () ? attachable::mortals [index] : 0;
		1768	# OUTPUT: RETVAL
		1769
1695	INCLUDE: $PERL genacc attachable ../include/cfperl.h \|	1770	INCLUDE: $PERL $srcdir/genacc attachable ../include/cfperl.h \|
1696		1771
1697	MODULE = cf PACKAGE = cf::global	1772	MODULE = cf PACKAGE = cf::global
1698		1773
1699	int invoke (SV *klass, int event, ...)	1774	int invoke (SV *klass, int event, ...)
1700	CODE:	1775	CODE:
…		…
1704	RETVAL = gbl_ev.invoke ((event_type)event, ARG_AV (av), DT_END);	1779	RETVAL = gbl_ev.invoke ((event_type)event, ARG_AV (av), DT_END);
1705	OUTPUT: RETVAL	1780	OUTPUT: RETVAL
1706		1781
1707	MODULE = cf PACKAGE = cf::object PREFIX = cf_object_	1782	MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
1708		1783
1709	INCLUDE: $PERL genacc object ../include/object.h \|	1784	INCLUDE: $PERL $srcdir/genacc object ../include/object.h \|
1710		1785
1711	int invoke (object *op, int event, ...)	1786	int invoke (object *op, int event, ...)
1712	CODE:	1787	CODE:
1713	if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");	1788	if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");
1714	AV av = (AV )sv_2mortal ((SV *)newAV ());	1789	AV av = (AV )sv_2mortal ((SV *)newAV ());
…		…
1716	RETVAL = op->invoke ((event_type)event, ARG_AV (av), DT_END);	1791	RETVAL = op->invoke ((event_type)event, ARG_AV (av), DT_END);
1717	OUTPUT: RETVAL	1792	OUTPUT: RETVAL
1718		1793
1719	SV registry (object op)	1794	SV registry (object op)
1720		1795
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 ()	1796	int objects_size ()
1728	CODE:	1797	CODE:
1729	RETVAL = objects.size ();	1798	RETVAL = objects.size ();
1730	OUTPUT: RETVAL	1799	OUTPUT: RETVAL
1731		1800
…		…
1771	void	1840	void
1772	set_animation (object *op, int idx)	1841	set_animation (object *op, int idx)
1773	CODE:	1842	CODE:
1774	SET_ANIMATION (op, idx);	1843	SET_ANIMATION (op, idx);
1775		1844
		1845	int
		1846	num_animations (object *op)
		1847	CODE:
		1848	RETVAL = NUM_ANIMATIONS (op);
		1849	OUTPUT: RETVAL
		1850
1776	object find_best_object_match (object op, const char *match)	1851	object find_best_object_match (object op, const char *match)
1777		1852
1778	object find_marked_object (object op)	1853	object find_marked_object (object op)
1779		1854
1780	int need_identify (object *obj);	1855	int need_identify (object *obj);
1781		1856
1782	int apply_shop_mat (object shop_mat, object op);	1857	int apply_shop_mat (object shop_mat, object op);
		1858
		1859	int move_player (object *op, int dir)
		1860	CODE:
		1861	RETVAL = move_player (op, dir);
		1862	OUTPUT:
		1863	RETVAL
1783		1864
1784	int move (object op, int dir, object originator = op)	1865	int move (object op, int dir, object originator = op)
1785	CODE:	1866	CODE:
1786	RETVAL = move_ob (op, dir, originator);	1867	RETVAL = move_ob (op, dir, originator);
1787	OUTPUT:	1868	OUTPUT:
…		…
1792	manual_apply (applied, applier, flags);	1873	manual_apply (applied, applier, flags);
1793		1874
1794	void apply_below (object *op)	1875	void apply_below (object *op)
1795	CODE:	1876	CODE:
1796	player_apply_below (op);	1877	player_apply_below (op);
		1878
		1879	int cast_heal (object op, object caster, object *spell, int dir = 0)
1797		1880
1798	object cf_object_present_archname_inside (object op, char *whatstr)	1881	object cf_object_present_archname_inside (object op, char *whatstr)
1799		1882
1800	int cf_object_transfer (object op, int x, int y, int r = 0, object_ornull orig = 0)	1883	int cf_object_transfer (object op, int x, int y, int r = 0, object_ornull orig = 0)
1801		1884
…		…
1986		2069
1987	int command_summon (object op, char params)	2070	int command_summon (object op, char params)
1988		2071
1989	int command_arrest (object op, char params)	2072	int command_arrest (object op, char params)
1990		2073
1991	int command_kick (object op, char params)
1992
1993	int command_banish (object op, char params)	2074	int command_banish (object op, char params)
1994		2075
1995		2076
1996	MODULE = cf PACKAGE = cf::player PREFIX = cf_player_	2077	MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
1997		2078
1998	INCLUDE: $PERL genacc player ../include/player.h \|	2079	INCLUDE: $PERL $srcdir/genacc player ../include/player.h \|
1999		2080
2000	int invoke (player *pl, int event, ...)	2081	int invoke (player *pl, int event, ...)
2001	CODE:	2082	CODE:
2002	if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");	2083	if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");
2003	AV av = (AV )sv_2mortal ((SV *)newAV ());	2084	AV av = (AV )sv_2mortal ((SV *)newAV ());
…		…
2016	pl->orig_stats = pl->ob->stats;	2097	pl->orig_stats = pl->ob->stats;
2017		2098
2018	void cf_player_move (player *pl, int dir)	2099	void cf_player_move (player *pl, int dir)
2019		2100
2020	void play_sound_player_only (player *pl, int soundnum, int x = 0, int y = 0);	2101	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		2102
2027	bool	2103	bool
2028	cell_visible (player *pl, int dx, int dy)	2104	cell_visible (player *pl, int dx, int dy)
2029	CODE:	2105	CODE:
2030	RETVAL = FABS (dx) <= pl->ns->mapx / 2 && FABS (dy) <= pl->ns->mapy / 2	2106	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);	2159	RETVAL = map->invoke ((event_type)event, ARG_AV (av), DT_END);
2084	OUTPUT: RETVAL	2160	OUTPUT: RETVAL
2085		2161
2086	SV registry (maptile map)	2162	SV registry (maptile map)
2087		2163
2088	INCLUDE: $PERL genacc maptile ../include/map.h \|	2164	INCLUDE: $PERL $srcdir/genacc maptile ../include/map.h \|
2089		2165
2090	void	2166	void
2091	maptile::instantiate ()	2167	maptile::instantiate ()
2092		2168
2093	maptile *new ()	2169	maptile *new ()
…		…
2107	EXTEND (SP, THIS->players);	2183	EXTEND (SP, THIS->players);
2108	for_all_players (pl)	2184	for_all_players (pl)
2109	if (pl->ob && pl->ob->map == THIS)	2185	if (pl->ob && pl->ob->map == THIS)
2110	PUSHs (sv_2mortal (to_sv (pl->ob)));	2186	PUSHs (sv_2mortal (to_sv (pl->ob)));
2111	}	2187	}
		2188
		2189	void
		2190	maptile::add_underlay (SV data, int offset, int stride, SV palette)
		2191	CODE:
		2192	{
		2193	if (!SvROK (palette) \|\| SvTYPE (SvRV (palette)) != SVt_PVAV)
		2194	croak ("maptile::add_underlay: palette must be arrayref");
		2195
		2196	palette = SvRV (palette);
		2197
		2198	STRLEN idxlen;
		2199	const uint8_t idx = (const uint8_t )SvPVbyte (data, idxlen);
		2200
		2201	for (int x = 0; x < THIS->width; ++x)
		2202	for (int y = 0; y < THIS->height; ++y)
		2203	{
		2204	for (object *op = THIS->at (x, y).bot; op; op = op->above)
		2205	if (op->flag [FLAG_IS_FLOOR])
		2206	goto skip_space;
		2207
		2208	{
		2209	int offs = offset + y * stride + x;
		2210	if (IN_RANGE_EXC (offs, 0, idxlen))
		2211	{
		2212	if (SV *elem = av_fetch ((AV )palette, idx [offs], 0))
		2213	{
		2214	object ob = get_archetype (SvPVutf8_nolen (elem));
		2215	ob->flag [FLAG_NO_MAP_SAVE] = true;
		2216	THIS->insert (ob, x, y, 0, INS_ABOVE_FLOOR_ONLY);
		2217	}
		2218	}
		2219	}
		2220
		2221	skip_space: ;
		2222	}
		2223	}
		2224
		2225	void
		2226	maptile::set_regiondata (SV data, int offset, int stride, SV palette)
		2227	CODE:
		2228	{
		2229	if (!SvROK (palette) \|\| SvTYPE (SvRV (palette)) != SVt_PVAV)
		2230	croak ("maptile::set_regiondata: palette must be arrayref");
		2231
		2232	palette = SvRV (palette);
		2233
		2234	STRLEN idxlen;
		2235	const uint8_t idx = (const uint8_t )SvPVbyte (data, idxlen);
		2236
		2237	region regionmap = (region )malloc (
		2238	(av_len ((AV )palette) + 1) sizeof (region *));
		2239	uint8_t *regions = salloc<uint8_t> (THIS->size ());
		2240
		2241	for (int i = av_len ((AV *)palette) + 1; i--; )
		2242	regionmap [i] = region::find (
		2243	SvPVutf8_nolen (av_fetch ((AV )palette, i, 1)));
		2244
		2245	for (int y = 0; y < THIS->height; ++y)
		2246	memcpy (regions + y * THIS->width, idx + offset + y * stride, THIS->width);
		2247
		2248	sfree (THIS->regions, THIS->size ());
		2249	free (THIS->regionmap);
		2250
		2251	THIS->regions = regions;
		2252	THIS->regionmap = regionmap;
		2253	}
2112		2254
2113	void play_sound_map (maptile *map, int x, int y, int sound_num)	2255	void play_sound_map (maptile *map, int x, int y, int sound_num)
2114		2256
2115	int out_of_map (maptile *map, int x, int y)	2257	int out_of_map (maptile *map, int x, int y)
2116		2258
…		…
2197	OUTPUT: RETVAL	2339	OUTPUT: RETVAL
2198		2340
2199	void fix_walls (maptile *map, int x, int y)	2341	void fix_walls (maptile *map, int x, int y)
2200		2342
2201	void fix_walls_around (maptile *map, int x, int y)	2343	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		2344
2209	# worst xs function of my life	2345	# worst xs function of my life
2210	bool	2346	bool
2211	_create_random_map (\	2347	_create_random_map (\
2212	maptile *self,\	2348	maptile *self,\
…		…
2306	PROTOTYPE:	2442	PROTOTYPE:
2307	CODE:	2443	CODE:
2308	RETVAL = first_archetype;	2444	RETVAL = first_archetype;
2309	OUTPUT: RETVAL	2445	OUTPUT: RETVAL
2310		2446
2311	INCLUDE: $PERL genacc archetype ../include/object.h \|	2447	INCLUDE: $PERL $srcdir/genacc archetype ../include/object.h \|
2312		2448
2313	MODULE = cf PACKAGE = cf::party	2449	MODULE = cf PACKAGE = cf::party
2314		2450
2315	partylist *first ()	2451	partylist *first ()
2316	PROTOTYPE:	2452	PROTOTYPE:
2317	CODE:	2453	CODE:
2318	RETVAL = get_firstparty ();	2454	RETVAL = get_firstparty ();
2319	OUTPUT: RETVAL	2455	OUTPUT: RETVAL
2320		2456
2321	INCLUDE: $PERL genacc partylist ../include/player.h \|	2457	INCLUDE: $PERL $srcdir/genacc partylist ../include/player.h \|
2322		2458
2323	MODULE = cf PACKAGE = cf::region	2459	MODULE = cf PACKAGE = cf::region
2324		2460
2325	region *first ()	2461	void
2326	PROTOTYPE:	2462	list ()
2327	CODE:	2463	PPCODE:
2328	RETVAL = first_region;	2464	for_all_regions (rgn)
2329	OUTPUT: RETVAL	2465	XPUSHs (sv_2mortal (to_sv (rgn)));
2330		2466
2331	region find (char name)	2467	region find (char name)
2332	PROTOTYPE: $	2468	PROTOTYPE: $
2333	CODE:	2469	CODE:
2334	RETVAL = get_region_by_name (name);	2470	RETVAL = region::find (name);
2335	OUTPUT: RETVAL	2471	OUTPUT: RETVAL
2336		2472
		2473	region find_fuzzy (char name)
		2474	PROTOTYPE: $
		2475	CODE:
		2476	RETVAL = region::find_fuzzy (name);
		2477	OUTPUT: RETVAL
		2478
2337	INCLUDE: $PERL genacc region ../include/map.h \|	2479	INCLUDE: $PERL $srcdir/genacc region ../include/map.h \|
2338		2480
2339	MODULE = cf PACKAGE = cf::living	2481	MODULE = cf PACKAGE = cf::living
2340		2482
2341	INCLUDE: $PERL genacc living ../include/living.h \|	2483	INCLUDE: $PERL $srcdir/genacc living ../include/living.h \|
2342		2484
2343	MODULE = cf PACKAGE = cf::settings	2485	MODULE = cf PACKAGE = cf::settings
2344		2486
2345	INCLUDE: $PERL genacc Settings ../include/global.h \|	2487	INCLUDE: $PERL $srcdir/genacc Settings ../include/global.h \|
2346		2488
2347	MODULE = cf PACKAGE = cf::client	2489	MODULE = cf PACKAGE = cf::client
2348		2490
2349	INCLUDE: $PERL genacc client ../include/client.h \|	2491	INCLUDE: $PERL $srcdir/genacc client ../include/client.h \|
2350		2492
2351	int invoke (client *ns, int event, ...)	2493	int invoke (client *ns, int event, ...)
2352	CODE:	2494	CODE:
2353	if (KLASS_OF (event) != KLASS_CLIENT) croak ("event class must be CLIENT");	2495	if (KLASS_OF (event) != KLASS_CLIENT) croak ("event class must be CLIENT");
2354	AV av = (AV )sv_2mortal ((SV *)newAV ());	2496	AV av = (AV )sv_2mortal ((SV *)newAV ());

Diff Legend

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

Comparing deliantra/server/server/cfperl.xs (file contents): Revision 1.146 by root, Fri Jan 19 22:24:10 2007 UTC vs. Revision 1.173 by root, Mon Mar 5 19:54:49 2007 UTC

Diff Legend

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.146 by root, Fri Jan 19 22:24:10 2007 UTC vs.
Revision 1.173 by root, Mon Mar 5 19:54:49 2007 UTC