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

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.19 by root, Mon Aug 28 07:54:11 2006 UTC vs.
Revision 1.50 by root, Mon Sep 11 01:16:20 2006 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@schmorpd.e>	9	* Copyright (C) 2006 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.
…		…
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;
…		…
61	#define newSVval64 newSVnv	49	#define newSVval64 newSVnv
62	#define SvVAL64 SvNV	50	#define SvVAL64 SvNV
63		51
64	static f_plug_api gethook = cfapi_get_hooks;	52	static f_plug_api gethook = cfapi_get_hooks;
65	static f_plug_api object_set_property = cfapi_object_set_property;	53	static f_plug_api object_set_property = cfapi_object_set_property;
66	static f_plug_api map_get_map = cfapi_map_get_map;
67	static f_plug_api object_insert = cfapi_object_insert;	54	static f_plug_api object_insert = cfapi_object_insert;
68
69	/* this is a stupid way to do things, and awkward to use for plug-in authors */
70	typedef struct
71	{
72	object* who;
73	object* activator;
74	object* third;
75	object* event;
76	mapstruct* map;
77	char message[1024];
78	int fix; // seems to be python-only, and should not be part of the API
79	int event_code;
80	char extension[1024]; // name field, should invoke specific perl extension
81	char options[1024]; // slaying field of event_connectors
82	int returnvalue;
83	} CFPContext;
84		55
85	static HV *obj_cache;	56	static HV *obj_cache;
86	static PerlInterpreter *perl;	57	static PerlInterpreter *perl;
87		58
88	static AV cb_global, cb_object, cb_player, cb_type, *cb_map;	59	static AV cb_global, cb_object, cb_player, cb_type, *cb_map;
…		…
117	return &PL_sv_undef;	88	return &PL_sv_undef;
118		89
119	if (!obj->self)	90	if (!obj->self)
120	obj->self = newSVptr (obj, klass);	91	obj->self = newSVptr (obj, klass);
121		92
122	return newSVsv (static_cast<SV *>(obj->self));	93	return newSVsv (obj->self);
123	}	94	}
124		95
125	static void	96	static void
126	SVptr_cache_set (void ptr, SV sv)	97	SVptr_cache_set (void ptr, SV sv)
127	{	98	{
…		…
188	if (SvOK (sv))	159	if (SvOK (sv))
189	return SvPTR (sv, klass);	160	return SvPTR (sv, klass);
190	else	161	else
191	return 0;	162	return 0;
192	}	163	}
		164
		165	inline SV to_sv (const shstr & v) { return v ? newSVpvn ((const char )v, v.length ()) : &PL_sv_undef; }
		166	inline SV to_sv (const char v) { return newSVpv (v, 0); }
		167	inline SV *to_sv (bool v) { return newSViv (v); }
		168	inline SV *to_sv ( signed char v) { return newSViv (v); }
		169	inline SV *to_sv (unsigned char v) { return newSViv (v); }
		170	inline SV *to_sv ( signed short v) { return newSViv (v); }
		171	inline SV *to_sv (unsigned short v) { return newSVuv (v); }
		172	inline SV *to_sv ( signed int v) { return newSViv (v); }
		173	inline SV *to_sv (unsigned int v) { return newSVuv (v); }
		174	inline SV *to_sv ( signed long v) { return newSViv (v); }
		175	inline SV *to_sv (unsigned long v) { return newSVuv (v); }
		176	inline SV *to_sv ( signed long long v) { return newSVval64 (v); }
		177	inline SV *to_sv (unsigned long long v) { return newSVval64 (v); }
		178	inline SV *to_sv (float v) { return newSVnv (v); }
		179	inline SV *to_sv (double v) { return newSVnv (v); }
		180	inline SV to_sv (player v) { return newSVattachable (v, "cf::player::wrap"); }
		181	inline SV to_sv (object v) { return newSVattachable (v, v && v->type == PLAYER ? "cf::object::player::wrap" : "cf::object::wrap"); }
		182	inline SV to_sv (mapstruct v) { return newSVattachable (v, "cf::map::wrap"); }
		183	inline SV to_sv (archetype v) { return newSVptr (v, "cf::arch::wrap"); }
		184	inline SV to_sv (partylist v) { return newSVptr (v, "cf::party::wrap"); }
		185	inline SV to_sv (region v) { return newSVptr (v, "cf::region::wrap"); }
		186	inline SV to_sv (living v) { return newSVptr (v, "cf::living::wrap"); }
		187
		188	inline SV *to_sv (object & v) { return to_sv (&v); }
		189	inline SV *to_sv (living & v) { return to_sv (&v); }
		190
		191	//TODO:
		192	inline SV to_sv (New_Face v) { return to_sv (v->name); }
		193	inline SV to_sv (treasurelist v) { return to_sv (v->name); }
		194
		195	inline void sv_to (SV *sv, shstr &v) { v = SvPV_nolen (sv); }
		196	inline void sv_to (SV sv, char &v) { free (v); v = strdup (SvPV_nolen (sv)); } //TODO: verify that all simple pointers are strdup-managed
		197	inline void sv_to (SV *sv, bool &v) { v = SvIV (sv); }
		198	inline void sv_to (SV *sv, signed char &v) { v = SvIV (sv); }
		199	inline void sv_to (SV *sv, unsigned char &v) { v = SvIV (sv); }
		200	inline void sv_to (SV *sv, signed short &v) { v = SvIV (sv); }
		201	inline void sv_to (SV *sv, unsigned short &v) { v = SvIV (sv); }
		202	inline void sv_to (SV *sv, signed int &v) { v = SvIV (sv); }
		203	inline void sv_to (SV *sv, unsigned int &v) { v = SvUV (sv); }
		204	inline void sv_to (SV *sv, signed long &v) { v = SvIV (sv); }
		205	inline void sv_to (SV *sv, unsigned long &v) { v = SvUV (sv); }
		206	inline void sv_to (SV *sv, signed long long &v) { v = SvVAL64 (sv); }
		207	inline void sv_to (SV *sv, unsigned long long &v) { v = SvVAL64 (sv); }
		208	inline void sv_to (SV *sv, float &v) { v = SvNV (sv); }
		209	inline void sv_to (SV *sv, double &v) { v = SvNV (sv); }
		210	inline void sv_to (SV sv, player &v) { v = (player *)SvPTR_ornull (sv, "cf::player"); }
		211	inline void sv_to (SV sv, object &v) { v = (object *)SvPTR_ornull (sv, "cf::object"); }
		212	inline void sv_to (SV sv, archetype &v) { v = (archetype *)SvPTR_ornull (sv, "cf::arch"); }
		213	inline void sv_to (SV sv, mapstruct &v) { v = (mapstruct *)SvPTR_ornull (sv, "cf::map"); }
		214	inline void sv_to (SV sv, partylist &v) { v = (partylist *)SvPTR_ornull (sv, "cf::party"); }
		215	inline void sv_to (SV sv, region &v) { v = (region *)SvPTR_ornull (sv, "cf::region"); }
		216	inline void sv_to (SV sv, living &v) { v = (living *)SvPTR_ornull (sv, "cf::living"); }
		217
		218	inline void sv_to (SV sv, New_Face &v) { v = &new_faces[FindFace (SvPV_nolen (sv), 0)]; } //TODO
		219	inline void sv_to (SV sv, treasurelist &v) { v = find_treasurelist (SvPV_nolen (sv)); } // TODO
		220
		221	template<int N>
		222	inline void sv_to (SV *sv, char (&v)[N]) { snprintf (v, N, "%s", SvPV_nolen (sv)); }
193		223
194	static SV *	224	static SV *
195	newSVdt_va (va_list &ap, data_type type)	225	newSVdt_va (va_list &ap, data_type type)
196	{	226	{
197	SV *sv;	227	SV *sv;
…		…
224	sv = str ? newSVpv (str, len) : &PL_sv_undef;	254	sv = str ? newSVpv (str, len) : &PL_sv_undef;
225	}	255	}
226	break;	256	break;
227		257
228	case DT_OBJECT:	258	case DT_OBJECT:
229	{	259	sv = to_sv (va_arg (ap, object *));
230	object obj = va_arg (ap, object );
231	sv = newSVattachable (obj, obj && obj->type == PLAYER ? "cf::object::player::wrap" : "cf::object::wrap");
232	}
233	break;	260	break;
234		261
235	case DT_MAP:	262	case DT_MAP:
236	// va_arg (object ) when void is passed is an XSI extension	263	// va_arg (object ) when void is passed is an XSI extension
237	sv = newSVattachable (va_arg (ap, mapstruct *), "cf::map::wrap");	264	sv = to_sv (va_arg (ap, mapstruct *));
238	break;	265	break;
239		266
240	case DT_PLAYER:	267	case DT_PLAYER:
241	sv = newSVattachable (va_arg (ap, player *), "cf::player::wrap");	268	sv = to_sv (va_arg (ap, player *));
242	break;	269	break;
243		270
244	case DT_ARCH:	271	case DT_ARCH:
245	sv = newSVptr (va_arg (ap, archetype *), "cf::arch::wrap");	272	sv = to_sv (va_arg (ap, archetype *));
246	break;	273	break;
247		274
248	case DT_PARTY:	275	case DT_PARTY:
249	sv = newSVptr (va_arg (ap, partylist *), "cf::party::wrap");	276	sv = to_sv (va_arg (ap, partylist *));
250	break;	277	break;
251		278
252	case DT_REGION:	279	case DT_REGION:
253	sv = newSVptr (va_arg (ap, region *), "cf::region::wrap");	280	sv = to_sv (va_arg (ap, region *));
254	break;	281	break;
255		282
256	default:	283	default:
257	assert (("unhandled type in newSVdt_va", 0));	284	assert (("unhandled type in newSVdt_va", 0));
258	}	285	}
…		…
313	return newRV_inc ((SV *)ext->cb);	340	return newRV_inc ((SV *)ext->cb);
314	}	341	}
315		342
316	void attachable_base::clear ()	343	void attachable_base::clear ()
317	{	344	{
318	//if (self) fprintf (stderr, "free_ob_self %p %s (%p,%p)\n", this, ((object *)this)->name, self, cb);//D	345	if (self)
		346	{
		347	if (cb)
		348	if (SvROK (*av_fetch (cb, EVENT_OBJECT_DESTROY, 1)))
		349	INVOKE_OBJECT (DESTROY, static_cast<object *>(this));
		350	else if (SvROK (*av_fetch (cb, EVENT_MAP_DESTROY, 1)))
		351	INVOKE_MAP (DESTROY, static_cast<mapstruct *>(this));
319		352
		353	// disconnect Perl from C, to avoid crashes
		354	sv_unmagic (SvRV ((SV *)self), PERL_MAGIC_ext);
		355
		356	// clear the perl hash, might or might not be a good idea
		357	hv_clear ((HV )SvRV ((SV )self));
		358
320	if (self) SvREFCNT_dec (self);	359	SvREFCNT_dec (self);
		360	self = 0;
		361	}
		362
		363	if (cb)
		364	{
321	if (cb) SvREFCNT_dec (cb);	365	SvREFCNT_dec (cb);
		366	cb = 0;
		367	}
322		368
323	if (attach) free_string (attach);
324
325	self = 0;
326	cb = 0;
327	attach = 0;	369	attach = 0;
328	}	370	}
329		371
330	void attachable_base::optimise ()	372	void attachable_base::optimise ()
331	{	373	{
332	if (!self)	374	if (!self)
…		…
341	SvREFCNT_dec ((SV *)self);	383	SvREFCNT_dec ((SV *)self);
342	self = 0;	384	self = 0;
343	}	385	}
344	}	386	}
345		387
346	void	388	void attachable_base::instantiate (data_type type, void *obj)
347	object::instantiate_ ()
348	{	389	{
349	dSP;	390	dSP;
350	ENTER;	391	ENTER;
351	SAVETMPS;	392	SAVETMPS;
352	PUSHMARK (SP);	393	PUSHMARK (SP);
353	EXTEND (SP, 2);	394	EXTEND (SP, 2);
354	PUSHs (sv_2mortal (newSVdt (DT_OBJECT, static_cast<object *>(this))));	395	PUSHs (sv_2mortal (newSVdt (type, obj)));
355	PUSHs (sv_2mortal (newSVpv (attach, 0)));	396	PUSHs (sv_2mortal (newSVpv (attach, 0)));
		397
		398	attach = 0;
		399
356	PUTBACK;	400	PUTBACK;
357	call_pv ("cf::instantiate", G_DISCARD \| G_VOID \| G_EVAL);	401	call_pv ("cf::instantiate", G_DISCARD \| G_VOID \| G_EVAL);
358	FREETMPS;	402	FREETMPS;
359	LEAVE;	403	LEAVE;
360		404
361	INVOKE_OBJECT (INSTANTIATE, this);	405	switch (type)
		406	{
		407	case DT_OBJECT: INVOKE_OBJECT (INSTANTIATE, obj); break;
		408	case DT_MAP: INVOKE_MAP (INSTANTIATE, obj); break;
		409	}
362	}	410	}
363		411
364	/////////////////////////////////////////////////////////////////////////////	412	/////////////////////////////////////////////////////////////////////////////
365		413
366	void reattach (data_type type, void *obj)	414	void reattach (data_type type, void *obj)
367	{	415	{
		416	//TODO only do this when the object has _attachment's
		417
368	dSP;	418	dSP;
369	ENTER;	419	ENTER;
370	SAVETMPS;	420	SAVETMPS;
371	PUSHMARK (SP);	421	PUSHMARK (SP);
372	XPUSHs (sv_2mortal (newSVdt (type, obj)));	422	XPUSHs (sv_2mortal (newSVdt (type, obj)));
…		…
387	void reattach (attachable<subclass> *obj)	437	void reattach (attachable<subclass> *obj)
388	{	438	{
389	obj->optimise ();	439	obj->optimise ();
390		440
391	if (obj->self)	441	if (obj->self)
392	reattach (subclass::get_dt (), (subclass *)obj);	442	reattach ((data_type) cftype<subclass>::dt, (subclass *)obj);
393	}	443	}
394		444
		445	#include "kw_hash.h"
		446
395	object_freezer::object_freezer (const char *filename)	447	object_freezer::object_freezer ()
396	: filename (filename)	448	: dynbuf (128 * 1024, 64 * 1024)
397	{	449	{
398	av = (AV *)newAV ();	450	av = newAV ();
399	}	451	}
400		452
401	object_freezer::~object_freezer ()	453	object_freezer::~object_freezer ()
		454	{
		455	SvREFCNT_dec (av);
		456	}
		457
		458	void object_freezer::put (attachable_base *ext)
		459	{
		460	ext->optimise ();
		461
		462	if (ext->self)
		463	{
		464	int idx = AvFILLp ((AV *)av) + 1;
		465	av_store (av, idx, SvREFCNT_inc (ext->self));
		466
		467	add ((void *)"oid ", 4);
		468	add ((sint32)idx);
		469	add ('\n');
		470	}
		471	}
		472
		473	bool object_freezer::save (const char *filename)
402	{	474	{
403	dSP;	475	dSP;
404	ENTER;	476	ENTER;
405	SAVETMPS;	477	SAVETMPS;
406	PUSHMARK (SP);	478	PUSHMARK (SP);
		479	EXTEND (SP, 3);
407	XPUSHs (sv_2mortal (newSVpv (filename, 0)));	480	PUSHs (sv_2mortal (newSVpv (filename, 0)));
		481	PUSHs (sv_2mortal (newRV_noinc (newSVpvn ((char *)linearise (), size ()))));
408	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));	482	PUSHs (sv_2mortal (newRV_inc ((SV *)av)));
409	PUTBACK;	483	PUTBACK;
410	call_pv ("cf::object_freezer_save", G_VOID \| G_DISCARD \| G_EVAL);	484	call_pv ("cf::object_freezer_save", G_VOID \| G_DISCARD \| G_EVAL);
411	FREETMPS;	485	FREETMPS;
412	LEAVE;	486	LEAVE;
413	}	487	}
414		488
415	void object_freezer::put (FILE fp, attachable_base ext)	489	int fprintf (object_freezer &freezer, const char *format, ...)
416	{	490	{
417	ext->optimise ();	491	va_list ap;
418		492
419	if (ext->self)	493	va_start (ap, format);
420	{	494
421	int idx = AvFILLp ((AV *)av) + 1;	495	int len = vsnprintf ((char *)freezer.force (1024), 1024, format, ap);
422	av_store ((AV )av, idx, SvREFCNT_inc ((SV )ext->self));	496
423	fprintf (fp, "oid %d\n", idx);	497	if (len >= 0)
424	}	498	freezer.alloc (len);
		499
		500	va_end (ap);
		501	}
		502
		503	int fputs (const char *s, object_freezer &freezer)
		504	{
		505	freezer.add (s);
425	}	506	}
426		507
427	object_thawer::object_thawer (const char *filename)	508	object_thawer::object_thawer (const char *filename)
428	{	509	{
		510	static const char eof[] = "\n\n\n\0\0\0";
		511
429	av = 0;	512	av = 0;
		513	text = 0;
		514	line = 0;
430		515
431	if (!filename)	516	if (filename)
432	return;	517	{
433
434	dSP;	518	dSP;
435	ENTER;	519	ENTER;
436	SAVETMPS;	520	SAVETMPS;
437	PUSHMARK (SP);	521	PUSHMARK (SP);
438	XPUSHs (sv_2mortal (newSVpv (filename, 0)));	522	XPUSHs (sv_2mortal (newSVpv (filename, 0)));
439	PUTBACK;	523	PUTBACK;
440		524
441	if (0 < call_pv ("cf::object_thawer_load", G_SCALAR \| G_EVAL))	525	if (2 == call_pv ("cf::object_thawer_load", G_ARRAY \| G_EVAL))
442	{	526	{
443	SPAGAIN;	527	SPAGAIN;
		528
		529	// second value - perl objects
		530	{
444	SV *sv = POPs;	531	SV *sv = POPs;
445	if (SvROK (sv))	532	if (SvROK (sv))
446	av = SvREFCNT_inc (SvRV (sv));	533	av = (AV *)SvREFCNT_inc (SvRV (sv));
447	}	534	}
448		535
		536	// first value - text part, pad with 3 zeroes
		537	{
		538	SV *sv = POPs;
		539	STRLEN len;
		540	char *sv_ = SvPVbyte (sv, len);
		541	text = newSV (len + sizeof (eof));
		542	SvCUR_set (text, len);
		543	memcpy (SvPVX (text), sv_, len);
		544	memcpy (SvEND (text), eof, sizeof (eof)); // just to be sure
		545
		546	line = SvPVX (text);
		547	}
		548	}
		549
		550	PUTBACK;
449	FREETMPS;	551	FREETMPS;
450	LEAVE;	552	LEAVE;
		553	}
451	}	554	}
452		555
453	void object_thawer::get (data_type type, void obj, attachable_base ext, int oid)	556	void object_thawer::get (data_type type, void obj, attachable_base ext, int oid)
454	{	557	{
455	if (!av \|\| oid < 0) // this is actually an error of sorts	558	if (!av \|\| oid < 0) // this is actually an error of sorts
…		…
465	printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid);	568	printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid);
466	return;	569	return;
467	}	570	}
468		571
469	ext->self = svp; svp = &PL_sv_undef;	572	ext->self = svp; svp = &PL_sv_undef;
470	sv_magic (SvRV ((SV )ext->self), 0, PERL_MAGIC_ext, (char )obj, 0);	573	sv_magic (SvRV (ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0);
471		574
472	reattach (type, obj);	575	reattach (type, obj);
473	}	576	}
474		577
475	object_thawer::~object_thawer ()	578	object_thawer::~object_thawer ()
476	{	579	{
		580	if (text) SvREFCNT_dec (text);
		581	if (av) SvREFCNT_dec (av);
		582	}
		583
		584	char fgets (char s, int n, object_thawer &thawer)
		585	{
		586	char *p = thawer.line;
		587	char *q = s;
		588
477	if (av)	589	if (!p)
478	SvREFCNT_dec ((SV *)av);	590	return 0;
		591
		592	while (--n)
		593	{
		594	if (!*p)
		595	break;
		596
		597	q++ = p;
		598
		599	if (*p++ == '\n')
		600	break;
		601	}
		602
		603	*q = 0;
		604	thawer.line = p;
		605
		606	return s == q ? 0 : s;
		607	}
		608
		609	keyword object_thawer::get_kv ()
		610	{
		611	if (!line)
		612	return KW_EOF;
		613
		614	for (;;)
		615	{
		616	char *p = line;
		617
		618	if (!*p)
		619	return KW_EOF;
		620
		621	// parse keyword
		622	while (*p > ' ')
		623	p++;
		624
		625	int klen = p - line;
		626
		627	if (*p++ != '\n')
		628	{
		629	// parse value
		630	while ((unsigned char )p <= ' ' && *p != '\n') // skip 0x01 .. 0x20
		631	++p;
		632
		633	last_value = p;
		634
		635	while (*p != '\n')
		636	p++;
		637
		638	*p++ = 0;
		639	}
		640	else
		641	last_value = 0;
		642
		643	line [klen] = 0;
		644	keyword_idx *kw = kw_lex::match (line, klen);
		645
		646	//printf ("KV %d<%s,%s>\n", kw ? kw->index : 0, line, last_value);//D
		647
		648	if (kw)
		649	{
		650	line = p;
		651	return kw->index;
		652	}
		653	else if (!line \|\| line == '#')
		654	{
		655	// empty/comment line
		656	line = p;
		657	}
		658	else
		659	return KW_ERROR;
		660	}
		661	}
		662
		663	void object_thawer::get (shstr &sh) const
		664	{
		665	if (last_value)
		666	sh = last_value;
		667	else
		668	{
		669	sh = "<value missing>";
		670	LOG (llevError, "keyword requires value: <%s>\n", line);//TODO: add filename
		671	}
		672	}
		673
		674	void object_thawer::get_ml (keyword kend, shstr &sh)
		675	{
		676	char kw[128];
		677
		678	int klen = keyword_len [kend];
		679
		680	kw [0] = '\n';
		681	memcpy (kw + 1, keyword_str [kend], klen);
		682	kw [klen + 1] = '\n';
		683	kw [klen + 2] = 0;
		684
		685	// first test for completely empty msg... "endXXX\n"
		686	if (!strncmp (line, kw + 1, klen + 1))
		687	{
		688	sh = 0;
		689
		690	line += klen + 1;
		691
		692	return;
		693	}
		694	else
		695	{
		696	// multi-line strings are delimited by "\nendXXX\n" or "endXXX\n" (NULL)
		697
		698	char *end = strstr (line, kw);
		699
		700	if (!end)
		701	{
		702	sh = 0;
		703	return;
		704	}
		705
		706	*end = 0;
		707	sh = line;
		708
		709	line = end + keyword_len [kend] + 1;
		710
		711	while (*line++ != '\n')
		712	;
		713	}
		714	}
		715
		716	sint32 object_thawer::get_sint32 () const
		717	{
		718	char *p = last_value;
		719
		720	if (!p)
		721	return 0;
		722
		723	sint32 val = 0;
		724	bool negate;
		725
		726	if (*p == '-')
		727	{
		728	negate = true;
		729	++p;
		730	}
		731	else
		732	negate = false;
		733
		734	do
		735	{
		736	val *= 10;
		737	val += *p++ - '0';
		738	}
		739	while (*p);
		740
		741	return negate ? -val : val;
		742	}
		743
		744	sint64 object_thawer::get_sint64 () const
		745	{
		746	return last_value ? atoll (last_value) : 0;
		747	}
		748
		749	double object_thawer::get_double () const
		750	{
		751	return last_value ? atof (last_value) : 0;
479	}	752	}
480		753
481	/////////////////////////////////////////////////////////////////////////////	754	/////////////////////////////////////////////////////////////////////////////
482		755
483	extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)	756	extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
…		…
582	}	855	}
583		856
584	void	857	void
585	cfperl_init ()	858	cfperl_init ()
586	{	859	{
		860	PERL_SYS_INIT3 (&settings.argc, &settings.argv, 0);
		861	perl = perl_alloc ();
		862	perl_construct (perl);
		863
		864	PL_exit_flags \|= PERL_EXIT_DESTRUCT_END;
		865
587	char *argv[] = {	866	char *argv[] = {
588	"",	867	"",
589	"-e"	868	"-e"
590	"BEGIN {"
591	" cf->bootstrap;"	869	"cf->bootstrap;"
592	" unshift @INC, cf::datadir ();"	870	"unshift @INC, cf::datadir ();"
593	"}"
594	""
595	"use cf;"	871	"require cf;"
596	};	872	};
597		873
598	perl = perl_alloc ();
599	perl_construct (perl);
600
601	PL_exit_flags \|= PERL_EXIT_DESTRUCT_END;
602
603	if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) \|\| perl_run (perl))	874	if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) \|\| perl_run (perl))
604	{	875	{
605	printf ("unable to initialize perl-interpreter, aborting.\n");	876	printf ("unable to initialize perl-interpreter, aborting.\n");
606
607	exit (EXIT_FAILURE);	877	exit (EXIT_FAILURE);
608	//perl_destruct (perl);
609	//perl_free (perl);
610	//perl = 0;
611	//return;
612	}	878	}
613		879
614	obj_cache = newHV ();	880	obj_cache = newHV ();
615	}	881	}
616		882
…		…
691	dt = (data_type) va_arg (ap, int);	957	dt = (data_type) va_arg (ap, int);
692	assert (("first argument must be of type object", dt == DT_OBJECT));	958	assert (("first argument must be of type object", dt == DT_OBJECT));
693	op = va_arg (ap, object *);	959	op = va_arg (ap, object *);
694		960
695	if (op->cb)	961	if (op->cb)
696	gather_callbacks (callbacks, (AV *)op->cb, event);	962	gather_callbacks (callbacks, op->cb, event);
697		963
698	if (op->type)	964	if (op->type)
699	{	965	{
700	if (op->subtype && op->type + op->subtype * NUM_SUBTYPES <= AvFILLp (cb_type))	966	if (op->subtype && op->type + op->subtype * NUM_SUBTYPES <= AvFILLp (cb_type))
701	{	967	{
…		…
722	dt = (data_type) va_arg (ap, int);	988	dt = (data_type) va_arg (ap, int);
723	assert (("first argument must be of type player", dt == DT_PLAYER));	989	assert (("first argument must be of type player", dt == DT_PLAYER));
724	pl = va_arg (ap, player *);	990	pl = va_arg (ap, player *);
725		991
726	if (pl->cb)	992	if (pl->cb)
727	gather_callbacks (callbacks, (AV *)pl->cb, event);	993	gather_callbacks (callbacks, pl->cb, event);
728		994
729	gather_callbacks (callbacks, cb_player, event);	995	gather_callbacks (callbacks, cb_player, event);
730	break;	996	break;
731		997
732	case KLASS_MAP:	998	case KLASS_MAP:
733	dt = (data_type) va_arg (ap, int);	999	dt = (data_type) va_arg (ap, int);
734	assert (("first argument must be of type object", dt == DT_MAP));	1000	assert (("first argument must be of type object", dt == DT_MAP));
735	map = va_arg (ap, mapstruct *);	1001	map = va_arg (ap, mapstruct *);
736		1002
737	if (map->cb)	1003	if (map->cb)
738	gather_callbacks (callbacks, (AV *)map->cb, event);	1004	gather_callbacks (callbacks, map->cb, event);
739		1005
740	gather_callbacks (callbacks, cb_map, event);	1006	gather_callbacks (callbacks, cb_map, event);
741	break;	1007	break;
742		1008
743	default:	1009	default:
…		…
1195		1461
1196	const_iv (SK_EXP_ADD_SKILL)	1462	const_iv (SK_EXP_ADD_SKILL)
1197	const_iv (SK_EXP_TOTAL)	1463	const_iv (SK_EXP_TOTAL)
1198	const_iv (SK_EXP_NONE)	1464	const_iv (SK_EXP_NONE)
1199	const_iv (SK_SUBTRACT_SKILL_EXP)	1465	const_iv (SK_SUBTRACT_SKILL_EXP)
		1466	const_iv (SK_EXP_SKILL_ONLY)
1200		1467
1201	const_iv (SK_LOCKPICKING)	1468	const_iv (SK_LOCKPICKING)
1202	const_iv (SK_HIDING)	1469	const_iv (SK_HIDING)
1203	const_iv (SK_SMITHERY)	1470	const_iv (SK_SMITHERY)
1204	const_iv (SK_BOWYER)	1471	const_iv (SK_BOWYER)
…		…
1335	av_push (event, newSViv (eiv->klass));	1602	av_push (event, newSViv (eiv->klass));
1336	av_store (av, eiv->iv, newRV_noinc ((SV *)event));	1603	av_store (av, eiv->iv, newRV_noinc ((SV *)event));
1337	newCONSTSUB (stash, (char *)eiv->name, newSViv (eiv->iv));	1604	newCONSTSUB (stash, (char *)eiv->name, newSViv (eiv->iv));
1338	}	1605	}
1339		1606
1340	static const struct {
1341	int dtype;
1342	const char *name;
1343	IV idx;
1344	} *cprop, prop_table[] = {
1345	# define prop(type, name) { type, # name, (IV) CFAPI_ ## name },
1346	prop (CFAPI_INT, MAP_PROP_FLAGS)
1347	prop (CFAPI_INT, MAP_PROP_DIFFICULTY)
1348	prop (CFAPI_STRING, MAP_PROP_PATH)
1349	prop (CFAPI_STRING, MAP_PROP_TMPNAME)
1350	prop (CFAPI_STRING, MAP_PROP_NAME)
1351	prop (CFAPI_INT, MAP_PROP_RESET_TIME)
1352	prop (CFAPI_INT, MAP_PROP_RESET_TIMEOUT)
1353	prop (CFAPI_INT, MAP_PROP_PLAYERS)
1354	prop (CFAPI_INT, MAP_PROP_DARKNESS)
1355	prop (CFAPI_INT, MAP_PROP_WIDTH)
1356	prop (CFAPI_INT, MAP_PROP_HEIGHT)
1357	prop (CFAPI_INT, MAP_PROP_ENTER_X)
1358	prop (CFAPI_INT, MAP_PROP_ENTER_Y)
1359	prop (CFAPI_INT, MAP_PROP_TEMPERATURE)
1360	prop (CFAPI_INT, MAP_PROP_PRESSURE)
1361	prop (CFAPI_INT, MAP_PROP_HUMIDITY)
1362	prop (CFAPI_INT, MAP_PROP_WINDSPEED)
1363	prop (CFAPI_INT, MAP_PROP_WINDDIR)
1364	prop (CFAPI_INT, MAP_PROP_SKY)
1365	prop (CFAPI_INT, MAP_PROP_WPARTX)
1366	prop (CFAPI_INT, MAP_PROP_WPARTY)
1367	prop (CFAPI_STRING, MAP_PROP_MESSAGE)
1368	prop (CFAPI_PMAP, MAP_PROP_NEXT)
1369	prop (CFAPI_PREGION, MAP_PROP_REGION)
1370	prop (CFAPI_POBJECT, OBJECT_PROP_OB_ABOVE)
1371	prop (CFAPI_POBJECT, OBJECT_PROP_OB_BELOW)
1372	prop (CFAPI_POBJECT, OBJECT_PROP_NEXT_ACTIVE_OB)
1373	prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB)
1374	prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY)
1375	prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT)
1376	prop (CFAPI_POBJECT, OBJECT_PROP_HEAD)
1377	prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER)
1378	prop (CFAPI_PMAP, OBJECT_PROP_MAP)
1379	prop (CFAPI_INT, OBJECT_PROP_COUNT)
1380	prop (CFAPI_INT, OBJECT_PROP_REFCOUNT)
1381	prop (CFAPI_STRING, OBJECT_PROP_NAME)
1382	prop (CFAPI_STRING, OBJECT_PROP_NAME_PLURAL)
1383	prop (CFAPI_STRING, OBJECT_PROP_TITLE)
1384	prop (CFAPI_STRING, OBJECT_PROP_RACE)
1385	prop (CFAPI_STRING, OBJECT_PROP_SLAYING)
1386	prop (CFAPI_STRING, OBJECT_PROP_SKILL)
1387	prop (CFAPI_STRING, OBJECT_PROP_MESSAGE)
1388	prop (CFAPI_STRING, OBJECT_PROP_LORE)
1389	prop (CFAPI_INT, OBJECT_PROP_X)
1390	prop (CFAPI_INT, OBJECT_PROP_Y)
1391	prop (CFAPI_DOUBLE, OBJECT_PROP_SPEED)
1392	prop (CFAPI_DOUBLE, OBJECT_PROP_SPEED_LEFT)
1393	prop (CFAPI_INT, OBJECT_PROP_NROF)
1394	prop (CFAPI_INT, OBJECT_PROP_DIRECTION)
1395	prop (CFAPI_INT, OBJECT_PROP_FACING)
1396	prop (CFAPI_INT, OBJECT_PROP_TYPE)
1397	prop (CFAPI_INT, OBJECT_PROP_SUBTYPE)
1398	prop (CFAPI_INT, OBJECT_PROP_CLIENT_TYPE)
1399	prop (CFAPI_INT, OBJECT_PROP_ATTACK_TYPE)
1400	prop (CFAPI_INT, OBJECT_PROP_PATH_ATTUNED)
1401	prop (CFAPI_INT, OBJECT_PROP_PATH_REPELLED)
1402	prop (CFAPI_INT, OBJECT_PROP_PATH_DENIED)
1403	prop (CFAPI_INT, OBJECT_PROP_MATERIAL)
1404	prop (CFAPI_STRING, OBJECT_PROP_MATERIAL_NAME)
1405	prop (CFAPI_INT, OBJECT_PROP_MAGIC)
1406	prop (CFAPI_INT, OBJECT_PROP_VALUE)
1407	prop (CFAPI_INT, OBJECT_PROP_LEVEL)
1408	prop (CFAPI_INT, OBJECT_PROP_LAST_HEAL)
1409	prop (CFAPI_INT, OBJECT_PROP_LAST_SP)
1410	prop (CFAPI_INT, OBJECT_PROP_LAST_GRACE)
1411	prop (CFAPI_INT, OBJECT_PROP_LAST_EAT)
1412	prop (CFAPI_INT, OBJECT_PROP_INVISIBLE_TIME)
1413	prop (CFAPI_INT, OBJECT_PROP_PICK_UP)
1414	prop (CFAPI_INT, OBJECT_PROP_ITEM_POWER)
1415	prop (CFAPI_INT, OBJECT_PROP_GEN_SP_ARMOUR)
1416	prop (CFAPI_INT, OBJECT_PROP_WEIGHT)
1417	prop (CFAPI_INT, OBJECT_PROP_WEIGHT_LIMIT)
1418	prop (CFAPI_INT, OBJECT_PROP_CARRYING)
1419	prop (CFAPI_INT, OBJECT_PROP_GLOW_RADIUS)
1420	prop (CFAPI_LONG, OBJECT_PROP_PERM_EXP)
1421	prop (CFAPI_POBJECT, OBJECT_PROP_CURRENT_WEAPON)
1422	prop (CFAPI_POBJECT, OBJECT_PROP_ENEMY)
1423	prop (CFAPI_POBJECT, OBJECT_PROP_ATTACKED_BY)
1424	prop (CFAPI_INT, OBJECT_PROP_RUN_AWAY)
1425	prop (CFAPI_POBJECT, OBJECT_PROP_CHOSEN_SKILL)
1426	prop (CFAPI_INT, OBJECT_PROP_HIDDEN)
1427	prop (CFAPI_INT, OBJECT_PROP_MOVE_STATUS)
1428	prop (CFAPI_INT, OBJECT_PROP_MOVE_TYPE)
1429	prop (CFAPI_POBJECT, OBJECT_PROP_SPELL_ITEM)
1430	prop (CFAPI_DOUBLE, OBJECT_PROP_EXP_MULTIPLIER)
1431	prop (CFAPI_PARCH, OBJECT_PROP_ARCHETYPE)
1432	prop (CFAPI_PARCH, OBJECT_PROP_OTHER_ARCH)
1433	prop (CFAPI_STRING, OBJECT_PROP_CUSTOM_NAME)
1434	prop (CFAPI_INT, OBJECT_PROP_ANIM_SPEED)
1435	prop (CFAPI_INT, OBJECT_PROP_FRIENDLY)
1436	prop (CFAPI_STRING, OBJECT_PROP_SHORT_NAME)
1437	prop (CFAPI_INT, OBJECT_PROP_MAGICAL)
1438	prop (CFAPI_INT, OBJECT_PROP_LUCK)
1439	prop (CFAPI_POBJECT, OBJECT_PROP_OWNER)
1440	prop (CFAPI_POBJECT, OBJECT_PROP_PRESENT)
1441	prop (CFAPI_INT, OBJECT_PROP_CHEATER)
1442	prop (CFAPI_INT, OBJECT_PROP_MERGEABLE)
1443	prop (CFAPI_INT, OBJECT_PROP_PICKABLE)
1444	prop (CFAPI_INT, OBJECT_PROP_STR)
1445	prop (CFAPI_INT, OBJECT_PROP_DEX)
1446	prop (CFAPI_INT, OBJECT_PROP_CON)
1447	prop (CFAPI_INT, OBJECT_PROP_WIS)
1448	prop (CFAPI_INT, OBJECT_PROP_INT)
1449	prop (CFAPI_INT, OBJECT_PROP_POW)
1450	prop (CFAPI_INT, OBJECT_PROP_CHA)
1451	prop (CFAPI_INT, OBJECT_PROP_WC)
1452	prop (CFAPI_INT, OBJECT_PROP_AC)
1453	prop (CFAPI_INT, OBJECT_PROP_HP)
1454	prop (CFAPI_INT, OBJECT_PROP_SP)
1455	prop (CFAPI_INT, OBJECT_PROP_GP)
1456	prop (CFAPI_INT, OBJECT_PROP_FP)
1457	prop (CFAPI_INT, OBJECT_PROP_MAXHP)
1458	prop (CFAPI_INT, OBJECT_PROP_MAXSP)
1459	prop (CFAPI_INT, OBJECT_PROP_MAXGP)
1460	prop (CFAPI_INT, OBJECT_PROP_DAM)
1461	prop (CFAPI_STRING, OBJECT_PROP_GOD)
1462	prop (CFAPI_STRING, OBJECT_PROP_ARCH_NAME)
1463	prop (CFAPI_INT, OBJECT_PROP_INVISIBLE)
1464	prop (CFAPI_INT, OBJECT_PROP_FACE)
1465	};
1466
1467	HV *prop_type = get_hv ("cf::PROP_TYPE", 1);
1468	HV *prop_idx = get_hv ("cf::PROP_IDX", 1);
1469
1470	for (cprop = prop_table + sizeof (prop_table) / sizeof (prop_table [0]); cprop-- > prop_table; )
1471	{
1472	hv_store (prop_type, cprop->name, strlen (cprop->name), newSViv (cprop->dtype), 0);
1473	hv_store (prop_idx, cprop->name, strlen (cprop->name), newSViv (cprop->idx ), 0);
1474	}
1475
1476	//I_EVENT_API (PACKAGE);	1607	//I_EVENT_API (PACKAGE);
1477	}	1608	}
1478		1609
1479	void _reload_1 ()	1610	void _init_vars ()
1480	CODE:	1611	CODE:
1481	cb_global = get_av ("cf::CB_GLOBAL", 1);	1612	cb_global = get_av ("cf::CB_GLOBAL", 1);
1482	cb_object = get_av ("cf::CB_OBJECT", 1);	1613	cb_object = get_av ("cf::CB_OBJECT", 1);
1483	cb_player = get_av ("cf::CB_PLAYER", 1);	1614	cb_player = get_av ("cf::CB_PLAYER", 1);
1484	cb_type = get_av ("cf::CB_TYPE" , 1);	1615	cb_type = get_av ("cf::CB_TYPE" , 1);
1485	cb_map = get_av ("cf::CB_MAP" , 1);	1616	cb_map = get_av ("cf::CB_MAP" , 1);
1486		1617
1487	void _reload_2 ()	1618	void _global_reattach ()
1488	CODE:	1619	CODE:
1489	{	1620	{
1490	// reattach to all attachable objects in the game.	1621	// reattach to all attachable objects in the game.
1491	for (player *pl = first_player; pl; pl = pl->next)	1622	for (player *pl = first_player; pl; pl = pl->next)
1492	reattach (pl);	1623	reattach (pl);
…		…
1561	const char *cost_string_from_value(uint64 cost, int approx = 0)	1692	const char *cost_string_from_value(uint64 cost, int approx = 0)
1562		1693
1563	int invoke (int event, ...)	1694	int invoke (int event, ...)
1564	CODE:	1695	CODE:
1565	if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL");	1696	if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL");
1566	AV av = (AV )sv_2mortal ((SV *)newAV ()); for (int i = 1; i < items; i++) av_push (av, ST (i));	1697	AV av = (AV )sv_2mortal ((SV *)newAV ());
		1698	for (int i = 1; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1567	RETVAL = INVOKE_((event_type)event, ARG_AV (av));	1699	RETVAL = INVOKE_((event_type)event, ARG_AV (av));
1568	OUTPUT: RETVAL	1700	OUTPUT: RETVAL
1569		1701
1570	int	1702	int
1571	exp_to_level (val64 exp)	1703	exp_to_level (val64 exp)
…		…
1604	RETVAL = newSVpv (resist_plus[atnr], 0);	1736	RETVAL = newSVpv (resist_plus[atnr], 0);
1605	else	1737	else
1606	XSRETURN_UNDEF;	1738	XSRETURN_UNDEF;
1607	OUTPUT: RETVAL	1739	OUTPUT: RETVAL
1608		1740
		1741	int
		1742	_valid (SV *obj)
		1743	CODE:
		1744	RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
		1745	OUTPUT:
		1746	RETVAL
		1747
1609	MODULE = cf PACKAGE = cf::object PREFIX = cf_object_	1748	MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
1610		1749
1611	int invoke (object *op, int event, ...)	1750	int invoke (object *op, int event, ...)
1612	CODE:	1751	CODE:
1613	if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");	1752	if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");
1614	AV av = (AV )sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i));	1753	AV av = (AV )sv_2mortal ((SV *)newAV ());
		1754	for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1615	RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av));	1755	RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av));
1616	OUTPUT: RETVAL	1756	OUTPUT: RETVAL
1617		1757
1618	SV registry (object op)	1758	SV registry (object op)
1619	CODE:	1759	CODE:
1620	RETVAL = registry_of (op);	1760	RETVAL = registry_of (op);
1621	OUTPUT:	1761	OUTPUT:
1622	RETVAL	1762	RETVAL
1623		1763
1624	SV *	1764	INCLUDE: $PERL genacc object ../include/object.h \|
1625	get_property (object *obj, int type, int idx)
1626	CODE:
1627	RETVAL = newSVcfapi (type, cf_object_get_property (obj, idx));
1628	OUTPUT: RETVAL
1629
1630	SV *
1631	set_property (object obj, int type, int idx, SV newval)
1632	CODE:
1633	switch (type)
1634	{
1635	case CFAPI_INT:
1636	cf_object_set_int_property (obj, idx, SvIV (newval));
1637	break;
1638	case CFAPI_LONG:
1639	cf_object_set_long_property (obj, idx, (long) SvVAL64 (newval));
1640	break;
1641	case CFAPI_DOUBLE:
1642	{
1643	int unused_type;
1644	object_set_property (&unused_type, obj, idx, (double)SvNV (newval));
1645	}
1646	break;
1647	case CFAPI_STRING:
1648	cf_object_set_string_property (obj, idx, SvOK (newval) ? SvPV_nolen (newval) : 0);
1649	break;
1650	case CFAPI_POBJECT:
1651	{
1652	int unused_type;
1653	object_set_property (&unused_type, obj, idx, (object *)SvPTR_ornull (newval, "cf::object"));
1654	}
1655	break;
1656	default:
1657	croak ("unhandled type '%d' in set_property '%d'", type, idx);
1658	}
1659		1765
1660	# missing properties	1766	# missing properties
1661		1767
1662	void	1768	int flag (object *op, int flag, int value = 1)
1663	set_attacktype (object *obj, U32 attacktype)	1769	PROTOTYPE: $$;$
1664	CODE:	1770	CODE:
1665	obj->attacktype = attacktype;	1771	RETVAL = QUERY_FLAG (op, flag);
1666		1772	if (items >= 3)
1667	U32	1773	if (value)
1668	get_attacktype (object *obj)	1774	SET_FLAG (op, flag);
1669	ALIAS:	1775	else
1670	attacktype = 0	1776	CLEAR_FLAG (op, flag);
1671	CODE:
1672	RETVAL = obj->attacktype;
1673	OUTPUT: RETVAL	1777	OUTPUT: RETVAL
1674
1675	# missing in plug-in api, of course
1676	void
1677	set_food (object *obj, int food)
1678	CODE:
1679	obj->stats.food = food;
1680
1681	int
1682	get_food (object *obj)
1683	ALIAS:
1684	food = 0
1685	CODE:
1686	RETVAL = obj->stats.food;
1687	OUTPUT: RETVAL
1688		1778
1689	void	1779	void
1690	inv (object *obj)	1780	inv (object *obj)
1691	PROTOTYPE: $	1781	PROTOTYPE: $
1692	PPCODE:	1782	PPCODE:
…		…
1697	}	1787	}
1698		1788
1699	int cf_object_get_resistance (object *op, int rtype)	1789	int cf_object_get_resistance (object *op, int rtype)
1700	ALIAS: resistance = 0	1790	ALIAS: resistance = 0
1701		1791
1702	int cf_object_get_flag (object *op, int flag)
1703	ALIAS: flag = 0
1704
1705	void cf_object_set_flag (object *op, int flag, int value)
1706
1707	int need_identify (const object *obj);	1792	int need_identify (const object *obj);
1708		1793
1709	int apply_shop_mat (object shop_mat, object op);	1794	int apply_shop_mat (object shop_mat, object op);
1710		1795
1711	void cf_object_move (object op, int dir, object originator = op)	1796	int move (object op, int dir, object originator = op)
		1797	CODE:
		1798	RETVAL = move_ob (op, dir, originator);
		1799	OUTPUT:
		1800	RETVAL
1712		1801
1713	void cf_object_apply (object op, object author, int flags = 0)	1802	void cf_object_apply (object op, object author, int flags = 0)
1714		1803
1715	void cf_object_apply_below (object *op)	1804	void cf_object_apply_below (object *op)
1716		1805
…		…
1758		1847
1759	void cf_object_drop (object op, object author)	1848	void cf_object_drop (object op, object author)
1760		1849
1761	void cf_object_take (object op, object author)	1850	void cf_object_take (object op, object author)
1762		1851
1763	void cf_object_say (object op, char msg)
1764
1765	void cf_object_speak (object op, char msg)
1766
1767	object cf_object_insert_object (object op, object *container)	1852	object cf_object_insert_object (object op, object *container)
1768
1769	const char cf_object_get_msg (object ob)
1770	ALIAS: msg = 0
1771		1853
1772	object cf_object_insert_in_ob (object ob, object *where)	1854	object cf_object_insert_in_ob (object ob, object *where)
1773		1855
1774	int cf_object_teleport (object op, mapstruct map, int x, int y)	1856	int cf_object_teleport (object op, mapstruct map, int x, int y)
1775		1857
…		…
1871	base_name (object *ob, int plural)	1953	base_name (object *ob, int plural)
1872	CODE:	1954	CODE:
1873	RETVAL = cf_query_base_name (ob, plural);	1955	RETVAL = cf_query_base_name (ob, plural);
1874	OUTPUT: RETVAL	1956	OUTPUT: RETVAL
1875		1957
1876	living *
1877	stats (object *ob)
1878	CODE:
1879	RETVAL = &ob->stats;
1880	OUTPUT: RETVAL
1881
1882
1883	MODULE = cf PACKAGE = cf::object::player PREFIX = cf_player_	1958	MODULE = cf PACKAGE = cf::object::player PREFIX = cf_player_
1884		1959
1885	player player (object op)	1960	player player (object op)
1886	CODE:	1961	CODE:
1887	RETVAL = op->contr;	1962	RETVAL = op->contr;
…		…
1909	MODULE = cf PACKAGE = cf::player PREFIX = cf_player_	1984	MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
1910		1985
1911	int invoke (player *pl, int event, ...)	1986	int invoke (player *pl, int event, ...)
1912	CODE:	1987	CODE:
1913	if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");	1988	if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");
1914	AV av = (AV )sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i));	1989	AV av = (AV )sv_2mortal ((SV *)newAV ());
		1990	for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1915	RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av));	1991	RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av));
1916	OUTPUT: RETVAL	1992	OUTPUT: RETVAL
1917		1993
1918	SV registry (player pl)	1994	SV registry (player pl)
1919	CODE:	1995	CODE:
…		…
1997	if (new_value >= 0)	2073	if (new_value >= 0)
1998	pl->listening = new_value;	2074	pl->listening = new_value;
1999	OUTPUT:	2075	OUTPUT:
2000	RETVAL	2076	RETVAL
2001		2077
2002	void get_savebed (player *pl)	2078	void savebed (player pl, SV map_path = 0, SV x = 0, SV y = 0)
2003	ALIAS:	2079	PROTOTYPE: $;$$$
2004	savebed = 0
2005	PPCODE:	2080	PPCODE:
		2081	if (GIMME_V != G_VOID)
		2082	{
2006	EXTEND (SP, 3);	2083	EXTEND (SP, 3);
2007	PUSHs (sv_2mortal (newSVpv (pl->savebed_map, 0)));	2084	PUSHs (sv_2mortal (newSVpv (pl->savebed_map, 0)));
2008	PUSHs (sv_2mortal (newSViv (pl->bed_x)));	2085	PUSHs (sv_2mortal (newSViv (pl->bed_x)));
2009	PUSHs (sv_2mortal (newSViv (pl->bed_y)));	2086	PUSHs (sv_2mortal (newSViv (pl->bed_y)));
2010		2087	}
2011	void set_savebed (player pl, char map_path, int x, int y)	2088	if (map_path) sv_to (map_path, pl->savebed_map);
2012	CODE:	2089	if (x) sv_to (x, pl->bed_x);
2013	strcpy (pl->savebed_map, map_path);	2090	if (y) sv_to (y, pl->bed_y);
2014	pl->bed_x = x;
2015	pl->bed_y = y;
2016		2091
2017	void	2092	void
2018	list ()	2093	list ()
2019	PPCODE:	2094	PPCODE:
2020	{	2095	{
…		…
2046	OUTPUT: RETVAL	2121	OUTPUT: RETVAL
2047		2122
2048		2123
2049	MODULE = cf PACKAGE = cf::map PREFIX = cf_map_	2124	MODULE = cf PACKAGE = cf::map PREFIX = cf_map_
2050		2125
		2126	mapstruct *first ()
		2127	PROTOTYPE:
		2128	CODE:
		2129	RETVAL = first_map;
		2130	OUTPUT: RETVAL
		2131
2051	int invoke (mapstruct *map, int event, ...)	2132	int invoke (mapstruct *map, int event, ...)
2052	CODE:	2133	CODE:
2053	if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP");	2134	if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP");
2054	AV av = (AV )sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i));	2135	AV av = (AV )sv_2mortal ((SV *)newAV ());
		2136	for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
2055	RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av));	2137	RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av));
2056	OUTPUT:	2138	OUTPUT: RETVAL
2057	RETVAL
2058		2139
2059	SV registry (mapstruct map)	2140	SV registry (mapstruct map)
2060	CODE:	2141	CODE:
2061	RETVAL = registry_of (map);	2142	RETVAL = registry_of (map);
2062	OUTPUT:	2143	OUTPUT:
2063	RETVAL	2144	RETVAL
2064		2145
2065	SV *	2146	INCLUDE: $PERL genacc mapstruct ../include/map.h \|
2066	get_property (mapstruct *obj, int type, int idx)
2067	CODE:
2068	RETVAL = newSVcfapi (type, cf_map_get_property (obj, idx));
2069	OUTPUT: RETVAL
2070
2071	SV *
2072	set_property (mapstruct obj, int type, int idx, SV newval)
2073	CODE:
2074	switch (type)
2075	{
2076	case CFAPI_INT:
2077	cf_map_set_int_property (obj, idx, SvIV (newval));
2078	break;
2079	default:
2080	croak ("unhandled type '%d' in set_property '%d'", type, idx);
2081	}
2082		2147
2083	mapstruct *new (int width, int height)	2148	mapstruct *new (int width, int height)
2084	PROTOTYPE:	2149	PROTOTYPE:
2085	CODE:	2150	CODE:
2086	{	2151	{
2087	int unused_type;	2152	RETVAL = get_empty_map (width, height);
2088	RETVAL = (mapstruct*) map_get_map (&unused_type, 0, width, height);
2089	}	2153	}
2090	OUTPUT:	2154	OUTPUT:
2091	RETVAL	2155	RETVAL
2092		2156
2093	void delete_map (mapstruct *map)	2157	void delete_map (mapstruct *map)
…		…
2108	XSRETURN_UNDEF;	2172	XSRETURN_UNDEF;
2109	RETVAL = map->tile_path [dir];	2173	RETVAL = map->tile_path [dir];
2110	OUTPUT:	2174	OUTPUT:
2111	RETVAL	2175	RETVAL
2112		2176
2113	mapstruct cf_map_get_map (char name)	2177	mapstruct ready_map_name (char name, int flags = 0)
2114	PROTOTYPE: $	2178	PROTOTYPE: $;$
2115	ALIAS: map = 0	2179	ALIAS:
		2180	find = 0
		2181	get_map = 1
2116		2182
2117	mapstruct has_been_loaded (char name)	2183	mapstruct has_been_loaded (char name)
2118	PROTOTYPE: $	2184	PROTOTYPE: $
2119
2120	mapstruct *cf_map_get_first ()
2121	PROTOTYPE:
2122	ALIAS: first = 0
2123
2124	# whoever "designed" the plug-in api should have wasted
2125	# his/her time with staying away from the project - would have
2126	# saved others a lot of time, without doubt.
2127	void set_path (mapstruct where, char path)
2128	CODE:
2129	strcpy (where->path, path);
2130		2185
2131	int in_memory (mapstruct *map)	2186	int in_memory (mapstruct *map)
2132	CODE:	2187	CODE:
2133	RETVAL = map->in_memory;	2188	RETVAL = map->in_memory;
2134	OUTPUT:	2189	OUTPUT:
2135	RETVAL	2190	RETVAL
2136		2191
2137	bool unique (mapstruct *map)	2192	void
2138	CODE:	2193	trigger (mapstruct *map, long connection, bool state = true)
2139	RETVAL = map->unique;	2194	CODE:
2140	OUTPUT:	2195	activate_connection (map, connection, state);
2141	RETVAL
2142		2196
2143	void set_unique (mapstruct *map, bool unique)	2197	void
2144	CODE:	2198	get_connection (mapstruct *map, long connection)
2145	map->unique = unique;	2199	PPCODE:
		2200	oblinkpt *obp = get_connection_links (map, connection);
		2201	if (obp)
		2202	for (objectlink *ol = obp->link; ol; ol = ol->next)
		2203	XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, ol->ob)));
2146		2204
2147	object cf_map_insert_object_there (mapstruct where, object op, object originator, int flags)	2205	object cf_map_insert_object_there (mapstruct where, object op, object originator, int flags)
2148		2206
2149	object cf_map_insert_object (mapstruct where, object* op, int x, int y)	2207	object cf_map_insert_object (mapstruct where, object* op, int x, int y)
2150		2208
…		…
2212	case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;	2270	case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;
2213	}	2271	}
2214	OUTPUT:	2272	OUTPUT:
2215	RETVAL	2273	RETVAL
2216		2274
2217	# "deserialise" perl map data into the map # TODO# compatibility cruft, remove
2218	void
2219	_set_obs (mapstruct map, SV sv)
2220	CODE:
2221	{
2222	object *o;
2223	AV *av;
2224	int x, y;
2225	AV obs = (AV )SvRV (sv);
2226
2227	for (y = 0; y < MAP_HEIGHT (map); y++)
2228	for (x = 0; x < MAP_WIDTH (map); x++)
2229	{
2230	sv = av_fetch (obs, x + y MAP_HEIGHT (map), 1);
2231
2232	if (!SvROK (sv))
2233	continue;
2234
2235	av = (AV *)SvRV (sv);
2236
2237	for (o = GET_MAP_OB (map, x, y); o; o = o->above)
2238	{
2239	sv = av_shift (av);
2240
2241	if (SvROK (sv))
2242	{
2243	sv_magic ((SV )SvRV (sv), 0, PERL_MAGIC_ext, (char )o, 0);
2244	SVptr_cache_set (o, sv);
2245	}
2246	}
2247	}
2248	}
2249
2250		2275
2251	MODULE = cf PACKAGE = cf::arch	2276	MODULE = cf PACKAGE = cf::arch
		2277
		2278	archetype find (const char name)
		2279	CODE:
		2280	RETVAL = find_archetype (name);
		2281	OUTPUT:
		2282	RETVAL
2252		2283
2253	archetype *first()	2284	archetype *first()
2254	PROTOTYPE:	2285	PROTOTYPE:
2255	CODE:	2286	CODE:
2256	RETVAL = first_archetype;	2287	RETVAL = first_archetype;
2257	OUTPUT: RETVAL	2288	OUTPUT: RETVAL
2258		2289
2259	archetype next (archetype arch)	2290	INCLUDE: $PERL genacc archetype ../include/object.h \|
2260	CODE:
2261	RETVAL = arch->next;
2262	OUTPUT: RETVAL
2263
2264	archetype head (archetype arch)
2265	CODE:
2266	RETVAL = arch->head;
2267	OUTPUT: RETVAL
2268
2269	archetype more (archetype arch)
2270	CODE:
2271	RETVAL = arch->more;
2272	OUTPUT: RETVAL
2273
2274	const char name (archetype arch)
2275	CODE:
2276	RETVAL = arch->name;
2277	OUTPUT: RETVAL
2278
2279	object clone (archetype arch)
2280	CODE:
2281	RETVAL = &arch->clone;
2282	OUTPUT: RETVAL
2283		2291
2284	MODULE = cf PACKAGE = cf::party	2292	MODULE = cf PACKAGE = cf::party
2285		2293
2286	partylist *first ()	2294	partylist *first ()
2287	PROTOTYPE:	2295	PROTOTYPE:
…		…
2337	RETVAL = reg->msg;	2345	RETVAL = reg->msg;
2338	OUTPUT: RETVAL	2346	OUTPUT: RETVAL
2339		2347
2340	MODULE = cf PACKAGE = cf::living	2348	MODULE = cf PACKAGE = cf::living
2341		2349
2342	val64	2350	INCLUDE: $PERL genacc living ../include/living.h \|
2343	exp (living *liv, val64 new_val = 0)
2344	PROTOTYPE: $;$
2345	ALIAS:
2346	Str = 1
2347	Dex = 2
2348	Con = 3
2349	Wis = 4
2350	Cha = 5
2351	Int = 6
2352	Pow = 7
2353	wc = 8
2354	ac = 9
2355	hp = 10
2356	maxhp = 11
2357	sp = 12
2358	maxsp = 13
2359	grace = 14
2360	maxgrace = 15
2361	food = 16
2362	dam = 17
2363	luck = 18
2364	CODE:
2365	# define LIVING_ACC(acc,idx) case idx: RETVAL = liv->acc; if (items > 1) liv->acc = (sint64)new_val; break
2366	switch (ix)
2367	{
2368	LIVING_ACC (exp , 0);
2369	LIVING_ACC (Str , 1);
2370	LIVING_ACC (Dex , 2);
2371	LIVING_ACC (Con , 3);
2372	LIVING_ACC (Wis , 4);
2373	LIVING_ACC (Cha , 5);
2374	LIVING_ACC (Int , 6);
2375	LIVING_ACC (Pow , 7);
2376	LIVING_ACC (wc , 8);
2377	LIVING_ACC (ac , 9);
2378	LIVING_ACC (hp , 10);
2379	LIVING_ACC (maxhp , 11);
2380	LIVING_ACC (sp , 12);
2381	LIVING_ACC (maxsp , 13);
2382	LIVING_ACC (grace , 14);
2383	LIVING_ACC (maxgrace, 15);
2384	LIVING_ACC (food , 16);
2385	LIVING_ACC (dam , 17);
2386	LIVING_ACC (luck , 18);
2387	}
2388	# undef LIVING_ACC
2389	OUTPUT:
2390	RETVAL
2391		2351

Diff Legend

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

Comparing deliantra/server/server/cfperl.xs (file contents): Revision 1.19 by root, Mon Aug 28 07:54:11 2006 UTC vs. Revision 1.50 by root, Mon Sep 11 01:16:20 2006 UTC

Diff Legend

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.19 by root, Mon Aug 28 07:54:11 2006 UTC vs.
Revision 1.50 by root, Mon Sep 11 01:16:20 2006 UTC