ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/server/cfperl.xs
(Generate patch)

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.131 by root, Mon Jan 8 18:18:35 2007 UTC vs.
Revision 1.174 by root, Tue Mar 6 03:06:00 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
102unordered_vector<attachable *> attachable::mortals; 103unordered_vector<attachable *> attachable::mortals;
103 104
104attachable::~attachable () 105attachable::~attachable ()
105{ 106{
106 assert (!(flags & F_BORROWED)); 107 flags |=0x3300;//D
108 assert (!self);
109 assert (!cb);
107} 110}
108 111
109int 112int
110attachable::refcnt_cnt () const 113attachable::refcnt_cnt () const
111{ 114{
112 return refcnt + (self ? SvREFCNT (self) : 0); 115 return refcnt + (self ? SvREFCNT (self) - 1 : 0);
116}
117
118void
119attachable::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
115void 137void
116attachable::optimise () 138attachable::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
148void
149attachable::do_check ()
150{
151 if (refcnt_cnt () > 0)
152 return;
153
154 destroy ();
155}
156
157void
158attachable::do_destroy ()
159{
160 invoke (EVENT_ATTACHABLE_DESTROY, DT_END);
161
162 if (cb)
121 { 163 {
122 flags &= ~F_BORROWED;
123 refcnt_inc ();
124 SvREFCNT_dec ((SV *)self); 164 SvREFCNT_dec (cb);
165 cb = 0;
125 } 166 }
126}
127
128// check wether the object really is dead
129void
130attachable::do_check ()
131{
132 if (refcnt > 0)
133 return;
134
135 optimise ();
136 167
137 if (self) 168 if (self)
138 { 169 sever_self ();
139 if (refcnt + SvREFCNT (self) > 0)
140 return;
141 170
142 assert (flags & F_BORROWED); 171 flags |= 0x20; //D
143
144 flags &= ~F_BORROWED;
145 refcnt_inc ();
146 SvREFCNT_dec (self);
147 self = 0;
148 }
149
150 if (refcnt > 0)
151 return;
152
153 destroy ();
154}
155
156void
157attachable::do_destroy ()
158{
159 invoke (EVENT_ATTACHABLE_DESTROY, DT_END);
160
161 if (self)
162 hv_clear (self);
163
164 mortals.push_back (this); 172 mortals.push_back (this);
165} 173}
166 174
167void 175void
168attachable::destroy () 176attachable::destroy ()
175} 183}
176 184
177void 185void
178attachable::check_mortals () 186attachable::check_mortals ()
179{ 187{
180 for (int i = 0; i < mortals.size (); ) 188 static int i = 0;
189
190 for (;;)
181 { 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
182 attachable *obj = mortals [i]; 202 attachable *obj = mortals [i];
183 203
184 obj->refcnt_chk (); // unborrow from perl, if necessary 204 obj->refcnt_chk (); // unborrow from perl, if necessary
185 205
206 //if (obj->refcnt > 0 || obj->self)
186 if (obj->refcnt || obj->self) 207 if (obj->refcnt || obj->self)
187 { 208 {
188#if 0 209//printf ("%p rc %d\n", obj, obj->refcnt_cnt ());//D
189 if (mortals.size() > 5)fprintf (stderr, "%d delaying %d:%p:%s %d (self %p:%d)\n", time(0),i, obj, typeid (*obj).name (),
190 obj->refcnt, obj->self, obj->self ? SvREFCNT(obj->self): - 1);//D
191#endif
192
193 ++i; // further delay freeing 210 ++i; // further delay freeing
211
212 if (!(i & 0x3ff))
213 break;
194 }//D 214 }
195 else 215 else
196 { 216 {
197 //Dfprintf (stderr, "deleteing %d:%p:%s\n", i, obj,typeid (*obj).name ());//D
198 mortals.erase (i); 217 mortals.erase (i);
199 delete obj; 218 delete obj;
200 } 219 }
201 } 220 }
202} 221}
227 246
228static int 247static int
229attachable_free (pTHX_ SV *sv, MAGIC *mg) 248attachable_free (pTHX_ SV *sv, MAGIC *mg)
230{ 249{
231 attachable *at = (attachable *)mg->mg_ptr; 250 attachable *at = (attachable *)mg->mg_ptr;
232 assert (!(at->flags & attachable::F_BORROWED)); 251
252 //TODO: check if transaction behaviour is really required here
253 if (SV *self = (SV *)at->self)
254 {
233 at->self = 0; 255 at->self = 0;
256 SvREFCNT_dec (self);
257 }
258
234 // 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
235 //at->refcnt_chk (); 260 //at->refcnt_chk ();
236 return 0; 261 return 0;
237} 262}
238 263
246 271
247 if (!obj->self) 272 if (!obj->self)
248 { 273 {
249 obj->self = newHV (); 274 obj->self = newHV ();
250 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);
251 276 obj->flags |= (obj->flags & 0xc0) << 8;
252 // borrow the refcnt from the object 277 obj->flags &= ~0xc0;//D
253 obj->flags |= attachable::F_BORROWED; 278 obj->flags |= 0x10;//D
254 obj->refcnt_dec ();
255 279
256 // now bless the object _once_ 280 // now bless the object _once_
257 return sv_bless (newRV_inc ((SV *)obj->self), stash); 281 return sv_bless (newRV_inc ((SV *)obj->self), stash);
258 } 282 }
259 else 283 else
284 {
260 return newRV_inc ((SV *)obj->self); 285 SV *sv = newRV_inc ((SV *)obj->self);
286
287 if (Gv_AMG (stash)) // handle overload correctly, as the perl core does not
288 SvAMAGIC_on (sv);
289
290 return sv;
291 }
261} 292}
262 293
263static void 294static void
264clearSVptr (SV *sv) 295clearSVptr (SV *sv)
265{ 296{
318inline SV *to_sv (living * v) { return newSVptr (v, stash_cf_living_wrap); } 349inline SV *to_sv (living * v) { return newSVptr (v, stash_cf_living_wrap); }
319 350
320inline SV *to_sv (object & v) { return to_sv (&v); } 351inline SV *to_sv (object & v) { return to_sv (&v); }
321inline SV *to_sv (living & v) { return to_sv (&v); } 352inline SV *to_sv (living & v) { return to_sv (&v); }
322 353
323//TODO:
324inline SV *to_sv (New_Face * v) { return to_sv (v->name); } 354inline SV *to_sv (facetile * v) { return to_sv (v->name); }
325inline SV *to_sv (treasurelist * v) { return to_sv (v->name); } 355inline SV *to_sv (treasurelist * v) { return to_sv (v->name); }
326 356
327inline SV *to_sv (UUID v) 357inline SV *to_sv (UUID v)
328{ 358{
329 char buf[128]; 359 char buf[128];
330 snprintf (buf, 128, "<1,%" PRIx64 ">", v.seq); 360 snprintf (buf, 128, "<1.%" PRIx64 ">", v.seq);
331 return newSVpv (buf, 0); 361 return newSVpv (buf, 0);
332} 362}
333 363
334inline void sv_to (SV *sv, shstr &v) { v = SvOK (sv) ? SvPV_nolen (sv) : 0; } 364inline void sv_to (SV *sv, shstr &v) { v = SvOK (sv) ? SvPV_nolen (sv) : 0; }
335inline void sv_to (SV *sv, char * &v) { free (v); v = SvOK (sv) ? strdup (SvPV_nolen (sv)) : 0; } 365inline void sv_to (SV *sv, char * &v) { free (v); v = SvOK (sv) ? strdup (SvPV_nolen (sv)) : 0; }
354inline void sv_to (SV *sv, attachable * &v) { v = (attachable *)SvPTR_ornull (sv, "cf::attachable"); } 384inline void sv_to (SV *sv, attachable * &v) { v = (attachable *)SvPTR_ornull (sv, "cf::attachable"); }
355inline void sv_to (SV *sv, partylist * &v) { v = (partylist *)SvPTR_ornull (sv, "cf::party"); } 385inline void sv_to (SV *sv, partylist * &v) { v = (partylist *)SvPTR_ornull (sv, "cf::party"); }
356inline void sv_to (SV *sv, region * &v) { v = (region *)SvPTR_ornull (sv, "cf::region"); } 386inline void sv_to (SV *sv, region * &v) { v = (region *)SvPTR_ornull (sv, "cf::region"); }
357inline void sv_to (SV *sv, living * &v) { v = (living *)SvPTR_ornull (sv, "cf::living"); } 387inline void sv_to (SV *sv, living * &v) { v = (living *)SvPTR_ornull (sv, "cf::living"); }
358 388
359inline void sv_to (SV *sv, New_Face * &v) { v = &new_faces[FindFace (SvPV_nolen (sv), 0)]; } //TODO 389inline void sv_to (SV *sv, facetile * &v) { v = &new_faces[FindFace (SvPV_nolen (sv), 0)]; }
360inline void sv_to (SV *sv, treasurelist * &v) { v = find_treasurelist (SvPV_nolen (sv)); } // TODO 390inline void sv_to (SV *sv, treasurelist * &v) { v = find_treasurelist (SvPV_nolen (sv)); }
361 391
362template<class T> 392template<class T>
363inline void sv_to (SV *sv, refptr<T> &v) { T *tmp; sv_to (sv, tmp); v = tmp; } 393inline void sv_to (SV *sv, refptr<T> &v) { T *tmp; sv_to (sv, tmp); v = tmp; }
364 394
365template<int N> 395template<int N>
501 if (!ext->cb) 531 if (!ext->cb)
502 ext->cb = newAV (); 532 ext->cb = newAV ();
503 533
504 return newRV_inc ((SV *)ext->cb); 534 return newRV_inc ((SV *)ext->cb);
505} 535}
506
507#if 0
508void attachable::clear ()
509{
510 if (self)
511 {
512 // disconnect Perl from C, to avoid crashes
513 sv_unmagic (SvRV ((SV *)self), PERL_MAGIC_ext);
514
515 // clear the perl hash, might or might not be a good idea
516 hv_clear ((HV *)SvRV ((SV *)self));
517
518 SvREFCNT_dec (self);
519 self = 0;
520 }
521
522 if (cb)
523 {
524 SvREFCNT_dec (cb);
525 cb = 0;
526 }
527
528 attach = 0;
529}
530#endif
531 536
532///////////////////////////////////////////////////////////////////////////// 537/////////////////////////////////////////////////////////////////////////////
533 538
534extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) 539extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
535{ 540{
607 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))
608 { 613 {
609 printf ("unable to initialize perl-interpreter, aborting.\n"); 614 printf ("unable to initialize perl-interpreter, aborting.\n");
610 exit (EXIT_FAILURE); 615 exit (EXIT_FAILURE);
611 } 616 }
617
618 {
619 dSP;
620
621 PUSHMARK (SP);
622 PUTBACK;
623 call_pv ("cf::init", G_DISCARD | G_VOID);
624 }
612} 625}
613 626
614void cfperl_main () 627void cfperl_main ()
615{ 628{
616 dSP; 629 dSP;
830} 843}
831 844
832///////////////////////////////////////////////////////////////////////////// 845/////////////////////////////////////////////////////////////////////////////
833 846
834void 847void
835maptile::emergency_save () 848cfperl_emergency_save ()
836{ 849{
837 CALL_BEGIN (0); 850 CALL_BEGIN (0);
838 CALL_CALL ("cf::map::emergency_save", G_VOID); 851 CALL_CALL ("cf::emergency_save", G_VOID);
852 CALL_END;
853}
854
855void
856cfperl_cleanup (int make_core)
857{
858 CALL_BEGIN (1);
859 CALL_ARG (make_core);
860 CALL_CALL ("cf::post_cleanup", G_VOID);
839 CALL_END; 861 CALL_END;
840} 862}
841 863
842maptile * 864maptile *
843maptile::find_sync (const char *path, maptile *origin) 865maptile::find_sync (const char *path, maptile *origin)
844{ 866{
845 CALL_BEGIN (2); 867 CALL_BEGIN (2);
846 CALL_ARG (path); 868 CALL_ARG (path);
847 CALL_ARG (origin); 869 CALL_ARG (origin);
848 CALL_CALL ("cf::map::find_sync", G_SCALAR); 870 CALL_CALL ("cf::map::find_sync", G_SCALAR);
871
872 maptile *retval;
873
874 if (count)
875 sv_to (POPs, retval);
876 else
877 retval = 0;
878
879 CALL_END;
880
881 return retval;
882}
883
884maptile *
885maptile::find_async (const char *path, maptile *origin)
886{
887 CALL_BEGIN (2);
888 CALL_ARG (path);
889 CALL_ARG (origin);
890 CALL_CALL ("cf::map::find_async", G_SCALAR);
849 891
850 maptile *retval; 892 maptile *retval;
851 893
852 if (count) 894 if (count)
853 sv_to (POPs, retval); 895 sv_to (POPs, retval);
906void 948void
907iw::alloc () 949iw::alloc ()
908{ 950{
909 pe = GEventAPI->new_idle (0, 0); 951 pe = GEventAPI->new_idle (0, 0);
910 952
953 WaREENTRANT_off (pe);
911 pe->base.callback = (void *)iw_dispatch; 954 pe->base.callback = (void *)iw_dispatch;
912 pe->base.ext_data = (void *)this; 955 pe->base.ext_data = (void *)this;
913} 956}
914 957
915static void iow_dispatch (pe_event *ev) 958static void iow_dispatch (pe_event *ev)
921void 964void
922iow::alloc () 965iow::alloc ()
923{ 966{
924 pe = GEventAPI->new_io (0, 0); 967 pe = GEventAPI->new_io (0, 0);
925 968
969 WaREENTRANT_off (pe);
926 pe->base.callback = (void *)iow_dispatch; 970 pe->base.callback = (void *)iow_dispatch;
927 pe->base.ext_data = (void *)this; 971 pe->base.ext_data = (void *)this;
928 972
929 pe->fd = -1; 973 pe->fd = -1;
930 pe->poll = 0; 974 pe->poll = 0;
1258 const_iv (FLAG_ACTIVATE_ON_RELEASE) 1302 const_iv (FLAG_ACTIVATE_ON_RELEASE)
1259 const_iv (FLAG_IS_WATER) 1303 const_iv (FLAG_IS_WATER)
1260 const_iv (FLAG_CONTENT_ON_GEN) 1304 const_iv (FLAG_CONTENT_ON_GEN)
1261 const_iv (FLAG_IS_A_TEMPLATE) 1305 const_iv (FLAG_IS_A_TEMPLATE)
1262 const_iv (FLAG_IS_BUILDABLE) 1306 const_iv (FLAG_IS_BUILDABLE)
1307 const_iv (FLAG_DESTROY_ON_DEATH)
1308 const_iv (FLAG_NO_MAP_SAVE)
1263 1309
1264 const_iv (NDI_BLACK) 1310 const_iv (NDI_BLACK)
1265 const_iv (NDI_WHITE) 1311 const_iv (NDI_WHITE)
1266 const_iv (NDI_NAVY) 1312 const_iv (NDI_NAVY)
1267 const_iv (NDI_RED) 1313 const_iv (NDI_RED)
1452 const_iv (ATNR_BLIND) 1498 const_iv (ATNR_BLIND)
1453 const_iv (ATNR_INTERNAL) 1499 const_iv (ATNR_INTERNAL)
1454 const_iv (ATNR_LIFE_STEALING) 1500 const_iv (ATNR_LIFE_STEALING)
1455 const_iv (ATNR_DISEASE) 1501 const_iv (ATNR_DISEASE)
1456 1502
1457 const_iv (MAP_FLUSH)
1458 const_iv (MAP_PLAYER_UNIQUE)
1459 const_iv (MAP_BLOCK)
1460 const_iv (MAP_STYLE)
1461 const_iv (MAP_OVERLAY)
1462
1463 const_iv (MAP_IN_MEMORY) 1503 const_iv (MAP_IN_MEMORY)
1464 const_iv (MAP_SWAPPED) 1504 const_iv (MAP_SWAPPED)
1465 const_iv (MAP_LOADING) 1505 const_iv (MAP_LOADING)
1466 const_iv (MAP_SAVING) 1506 const_iv (MAP_SAVING)
1467 1507
1546{ 1586{
1547 // reattach to all attachable objects in the game. 1587 // reattach to all attachable objects in the game.
1548 for_all_clients (ns) 1588 for_all_clients (ns)
1549 ns->reattach (); 1589 ns->reattach ();
1550 1590
1551 for_all_players (pl)
1552 pl->reattach ();
1553
1554 //TODO
1555 //for (map_container::iterator i = maps.begin (); i != maps.end (); ++i)
1556 // i->second->reattach ();
1557
1558 for_all_objects (op) 1591 for_all_objects (op)
1559 op->reattach (); 1592 op->reattach ();
1560} 1593}
1561 1594
1562NV floor (NV x) 1595NV floor (NV x)
1563 1596
1564NV ceil (NV x) 1597NV ceil (NV x)
1598
1599NV rndm (...)
1600 CODE:
1601 switch (items)
1602 {
1603 case 0: RETVAL = rndm (); break;
1604 case 1: RETVAL = rndm (SvUV (ST (0))); break;
1605 case 2: RETVAL = rndm (SvIV (ST (0)), SvIV (ST (1))); break;
1606 default: croak ("cf::rndm requires none, one or two parameters."); break;
1607 }
1608 OUTPUT:
1609 RETVAL
1565 1610
1566void server_tick () 1611void server_tick ()
1567 CODE: 1612 CODE:
1568 runtime = SvNVx (sv_runtime); 1613 runtime = SvNVx (sv_runtime);
1569 server_tick (); 1614 server_tick ();
1616 } 1661 }
1617 OUTPUT: RETVAL 1662 OUTPUT: RETVAL
1618 1663
1619void abort () 1664void abort ()
1620 1665
1666void fork_abort (char *cause = "cf::fork_abort")
1667
1668void cleanup (const char *cause, bool make_core = false)
1669
1621void emergency_save () 1670void emergency_save ()
1622 1671
1623void _exit (int status = 0) 1672void _exit (int status = EXIT_SUCCESS)
1673
1674UV sv_2watcher (SV *w)
1675 CODE:
1676 RETVAL = (UV)GEventAPI->sv_2watcher (w);
1677 OUTPUT:
1678 RETVAL
1624 1679
1625#if _POSIX_MEMLOCK 1680#if _POSIX_MEMLOCK
1626 1681
1627int mlockall (int flags = MCL_CURRENT | MCL_FUTURE) 1682int mlockall (int flags = MCL_CURRENT | MCL_FUTURE)
1628 1683
1674 RETVAL = newSVpv (resist_plus[atnr], 0); 1729 RETVAL = newSVpv (resist_plus[atnr], 0);
1675 else 1730 else
1676 XSRETURN_UNDEF; 1731 XSRETURN_UNDEF;
1677 OUTPUT: RETVAL 1732 OUTPUT: RETVAL
1678 1733
1734bool
1735load_resource_file (const char *filename)
1736
1679MODULE = cf PACKAGE = cf::attachable 1737MODULE = cf PACKAGE = cf::attachable
1680 1738
1681int 1739int
1682valid (SV *obj) 1740valid (SV *obj)
1683 CODE: 1741 CODE:
1684 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext); 1742 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
1685 OUTPUT: 1743 OUTPUT:
1686 RETVAL 1744 RETVAL
1687 1745
1746void
1747debug_trace (attachable *obj, bool on = true)
1748 CODE:
1749 obj->flags &= ~attachable::F_DEBUG_TRACE;
1750 if (on)
1751 obj->flags |= attachable::F_DEBUG_TRACE;
1752
1753int mortals_size ()
1754 CODE:
1755 RETVAL = attachable::mortals.size ();
1756 OUTPUT: RETVAL
1757
1758#object *mortals (U32 index)
1759# CODE:
1760# RETVAL = index < attachable::mortals.size () ? attachable::mortals [index] : 0;
1761# OUTPUT: RETVAL
1762
1688INCLUDE: $PERL genacc attachable ../include/cfperl.h | 1763INCLUDE: $PERL $srcdir/genacc attachable ../include/cfperl.h |
1689 1764
1690MODULE = cf PACKAGE = cf::global 1765MODULE = cf PACKAGE = cf::global
1691 1766
1692int invoke (SV *klass, int event, ...) 1767int invoke (SV *klass, int event, ...)
1693 CODE: 1768 CODE:
1697 RETVAL = gbl_ev.invoke ((event_type)event, ARG_AV (av), DT_END); 1772 RETVAL = gbl_ev.invoke ((event_type)event, ARG_AV (av), DT_END);
1698 OUTPUT: RETVAL 1773 OUTPUT: RETVAL
1699 1774
1700MODULE = cf PACKAGE = cf::object PREFIX = cf_object_ 1775MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
1701 1776
1702INCLUDE: $PERL genacc object ../include/object.h | 1777INCLUDE: $PERL $srcdir/genacc object ../include/object.h |
1703 1778
1704int invoke (object *op, int event, ...) 1779int invoke (object *op, int event, ...)
1705 CODE: 1780 CODE:
1706 if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT"); 1781 if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");
1707 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); 1782 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1709 RETVAL = op->invoke ((event_type)event, ARG_AV (av), DT_END); 1784 RETVAL = op->invoke ((event_type)event, ARG_AV (av), DT_END);
1710 OUTPUT: RETVAL 1785 OUTPUT: RETVAL
1711 1786
1712SV *registry (object *op) 1787SV *registry (object *op)
1713 1788
1714void mortals () 1789int objects_size ()
1715 PPCODE: 1790 CODE:
1716 EXTEND (SP, object::mortals.size ());
1717 for (AUTODECL (i, object::mortals.begin ()); i != object::mortals.end (); ++i)
1718 PUSHs (to_sv (*i));
1719
1720object *first ()
1721 CODE:
1722 RETVAL = object::first; 1791 RETVAL = objects.size ();
1792 OUTPUT: RETVAL
1793
1794object *objects (U32 index)
1795 CODE:
1796 RETVAL = index < objects.size () ? objects [index] : 0;
1797 OUTPUT: RETVAL
1798
1799int actives_size ()
1800 CODE:
1801 RETVAL = actives.size ();
1802 OUTPUT: RETVAL
1803
1804object *actives (U32 index)
1805 CODE:
1806 RETVAL = index < actives.size () ? actives [index] : 0;
1723 OUTPUT: RETVAL 1807 OUTPUT: RETVAL
1724 1808
1725# missing properties 1809# missing properties
1726 1810
1727object *head (object *op) 1811object *head (object *op)
1728 PROTOTYPE: $ 1812 PROTOTYPE: $
1729 CODE: 1813 CODE:
1730 RETVAL = op->head ? op->head : op; 1814 RETVAL = op->head_ ();
1731 OUTPUT: RETVAL 1815 OUTPUT: RETVAL
1732 1816
1733int is_head (object *op) 1817int is_head (object *op)
1734 PROTOTYPE: $ 1818 PROTOTYPE: $
1735 CODE: 1819 CODE:
1736 RETVAL = !op->head; 1820 RETVAL = op->head_ () == op;
1737 OUTPUT: RETVAL 1821 OUTPUT: RETVAL
1738 1822
1739void 1823void
1740inv (object *obj) 1824inv (object *obj)
1741 PROTOTYPE: $ 1825 PROTOTYPE: $
1749void 1833void
1750set_animation (object *op, int idx) 1834set_animation (object *op, int idx)
1751 CODE: 1835 CODE:
1752 SET_ANIMATION (op, idx); 1836 SET_ANIMATION (op, idx);
1753 1837
1838int
1839num_animations (object *op)
1840 CODE:
1841 RETVAL = NUM_ANIMATIONS (op);
1842 OUTPUT: RETVAL
1843
1754object *find_best_object_match (object *op, const char *match) 1844object *find_best_object_match (object *op, const char *match)
1755 1845
1756object *find_marked_object (object *op) 1846object *find_marked_object (object *op)
1757 1847
1758int need_identify (object *obj); 1848int need_identify (object *obj);
1759 1849
1760int apply_shop_mat (object *shop_mat, object *op); 1850int apply_shop_mat (object *shop_mat, object *op);
1851
1852int move_player (object *op, int dir)
1853 CODE:
1854 RETVAL = move_player (op, dir);
1855 OUTPUT:
1856 RETVAL
1761 1857
1762int move (object *op, int dir, object *originator = op) 1858int move (object *op, int dir, object *originator = op)
1763 CODE: 1859 CODE:
1764 RETVAL = move_ob (op, dir, originator); 1860 RETVAL = move_ob (op, dir, originator);
1765 OUTPUT: 1861 OUTPUT:
1770 manual_apply (applied, applier, flags); 1866 manual_apply (applied, applier, flags);
1771 1867
1772void apply_below (object *op) 1868void apply_below (object *op)
1773 CODE: 1869 CODE:
1774 player_apply_below (op); 1870 player_apply_below (op);
1871
1872int cast_heal (object *op, object *caster, object *spell, int dir = 0)
1775 1873
1776object *cf_object_present_archname_inside (object *op, char *whatstr) 1874object *cf_object_present_archname_inside (object *op, char *whatstr)
1777 1875
1778int cf_object_transfer (object *op, int x, int y, int r = 0, object_ornull *orig = 0) 1876int cf_object_transfer (object *op, int x, int y, int r = 0, object_ornull *orig = 0)
1779 1877
1832 1930
1833void drop (object *who, object *op) 1931void drop (object *who, object *op)
1834 1932
1835void pick_up (object *who, object *op) 1933void pick_up (object *who, object *op)
1836 1934
1837object *cf_object_insert_object (object *op, object *container)
1838
1839object *cf_object_insert_in_ob (object *ob, object *where)
1840
1841int cf_object_teleport (object *op, maptile *map, int x, int y) 1935int cf_object_teleport (object *op, maptile *map, int x, int y)
1842 1936
1843void update_object (object *op, int action) 1937void update_object (object *op, int action)
1844 1938
1845object *cf_create_object_by_name (const char *name) 1939object *cf_create_object_by_name (const char *name)
1964void esrv_update_item (object *op, int what, object *item) 2058void esrv_update_item (object *op, int what, object *item)
1965 C_ARGS: what, op, item 2059 C_ARGS: what, op, item
1966 2060
1967void clear_los (object *op) 2061void clear_los (object *op)
1968 2062
1969int command_teleport (object *op, char *params)
1970
1971int command_summon (object *op, char *params) 2063int command_summon (object *op, char *params)
1972 2064
1973int command_arrest (object *op, char *params) 2065int command_arrest (object *op, char *params)
1974 2066
1975int command_kick (object *op, char *params)
1976
1977int command_banish (object *op, char *params) 2067int command_banish (object *op, char *params)
1978 2068
1979 2069
1980MODULE = cf PACKAGE = cf::player PREFIX = cf_player_ 2070MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
1981 2071
1982INCLUDE: $PERL genacc player ../include/player.h | 2072INCLUDE: $PERL $srcdir/genacc player ../include/player.h |
1983 2073
1984int invoke (player *pl, int event, ...) 2074int invoke (player *pl, int event, ...)
1985 CODE: 2075 CODE:
1986 if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER"); 2076 if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");
1987 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); 2077 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
2000 pl->orig_stats = pl->ob->stats; 2090 pl->orig_stats = pl->ob->stats;
2001 2091
2002void cf_player_move (player *pl, int dir) 2092void cf_player_move (player *pl, int dir)
2003 2093
2004void play_sound_player_only (player *pl, int soundnum, int x = 0, int y = 0); 2094void play_sound_player_only (player *pl, int soundnum, int x = 0, int y = 0);
2005
2006player *first ()
2007 CODE:
2008 RETVAL = first_player;
2009 OUTPUT: RETVAL
2010 2095
2011bool 2096bool
2012cell_visible (player *pl, int dx, int dy) 2097cell_visible (player *pl, int dx, int dy)
2013 CODE: 2098 CODE:
2014 RETVAL = FABS (dx) <= pl->ns->mapx / 2 && FABS (dy) <= pl->ns->mapy / 2 2099 RETVAL = FABS (dx) <= pl->ns->mapx / 2 && FABS (dy) <= pl->ns->mapy / 2
2067 RETVAL = map->invoke ((event_type)event, ARG_AV (av), DT_END); 2152 RETVAL = map->invoke ((event_type)event, ARG_AV (av), DT_END);
2068 OUTPUT: RETVAL 2153 OUTPUT: RETVAL
2069 2154
2070SV *registry (maptile *map) 2155SV *registry (maptile *map)
2071 2156
2072INCLUDE: $PERL genacc maptile ../include/map.h | 2157INCLUDE: $PERL $srcdir/genacc maptile ../include/map.h |
2073 2158
2074void 2159void
2075maptile::instantiate () 2160maptile::instantiate ()
2076 2161
2077maptile *new () 2162maptile *new ()
2092 for_all_players (pl) 2177 for_all_players (pl)
2093 if (pl->ob && pl->ob->map == THIS) 2178 if (pl->ob && pl->ob->map == THIS)
2094 PUSHs (sv_2mortal (to_sv (pl->ob))); 2179 PUSHs (sv_2mortal (to_sv (pl->ob)));
2095 } 2180 }
2096 2181
2182void
2183maptile::add_underlay (SV *data, int offset, int stride, SV *palette)
2184 CODE:
2185{
2186 if (!SvROK (palette) || SvTYPE (SvRV (palette)) != SVt_PVAV)
2187 croak ("maptile::add_underlay: palette must be arrayref");
2188
2189 palette = SvRV (palette);
2190
2191 STRLEN idxlen;
2192 const uint8_t *idx = (const uint8_t *)SvPVbyte (data, idxlen);
2193
2194 for (int x = 0; x < THIS->width; ++x)
2195 for (int y = 0; y < THIS->height; ++y)
2196 {
2197 for (object *op = THIS->at (x, y).bot; op; op = op->above)
2198 if (op->flag [FLAG_IS_FLOOR])
2199 goto skip_space;
2200
2201 {
2202 int offs = offset + y * stride + x;
2203 if (IN_RANGE_EXC (offs, 0, idxlen))
2204 {
2205 if (SV **elem = av_fetch ((AV *)palette, idx [offs], 0))
2206 {
2207 object *ob = get_archetype (SvPVutf8_nolen (*elem));
2208 ob->flag [FLAG_NO_MAP_SAVE] = true;
2209 THIS->insert (ob, x, y, 0, INS_ABOVE_FLOOR_ONLY);
2210 }
2211 }
2212 }
2213
2214 skip_space: ;
2215 }
2216}
2217
2218void
2219maptile::set_regiondata (SV *data, int offset, int stride, SV *palette)
2220 CODE:
2221{
2222 if (!SvROK (palette) || SvTYPE (SvRV (palette)) != SVt_PVAV)
2223 croak ("maptile::set_regiondata: palette must be arrayref");
2224
2225 palette = SvRV (palette);
2226
2227 STRLEN idxlen;
2228 const uint8_t *idx = (const uint8_t *)SvPVbyte (data, idxlen);
2229
2230 region **regionmap = (region **)malloc (
2231 (av_len ((AV *)palette) + 1) * sizeof (region *));
2232 uint8_t *regions = salloc<uint8_t> (THIS->size ());
2233
2234 for (int i = av_len ((AV *)palette) + 1; i--; )
2235 regionmap [i] = region::find (
2236 SvPVutf8_nolen (*av_fetch ((AV *)palette, i, 1)));
2237
2238 for (int y = 0; y < THIS->height; ++y)
2239 memcpy (regions + y * THIS->width, idx + offset + y * stride, THIS->width);
2240
2241 sfree (THIS->regions, THIS->size ());
2242 free (THIS->regionmap);
2243
2244 THIS->regions = regions;
2245 THIS->regionmap = regionmap;
2246}
2247
2097void play_sound_map (maptile *map, int x, int y, int sound_num) 2248void play_sound_map (maptile *map, int x, int y, int sound_num)
2098 2249
2099int out_of_map (maptile *map, int x, int y) 2250int out_of_map (maptile *map, int x, int y)
2100 2251
2101void 2252void
2117 2268
2118object* cf_map_present_arch_by_name (maptile *map, const char* str, int nx, int ny) 2269object* cf_map_present_arch_by_name (maptile *map, const char* str, int nx, int ny)
2119 C_ARGS: str, map, nx, ny 2270 C_ARGS: str, map, nx, ny
2120 2271
2121void 2272void
2122cf_map_normalise (maptile *map, int x, int y) 2273get_map_flags (maptile *map, int x, int y)
2123 PPCODE: 2274 PPCODE:
2124{ 2275{
2125 maptile *nmap = 0; 2276 maptile *nmap = 0;
2126 I16 nx = 0, ny = 0; 2277 I16 nx = 0, ny = 0;
2127 int flags = get_map_flags (map, &nmap, x, y, &nx, &ny); 2278 int flags = get_map_flags (map, &nmap, x, y, &nx, &ny);
2182 2333
2183void fix_walls (maptile *map, int x, int y) 2334void fix_walls (maptile *map, int x, int y)
2184 2335
2185void fix_walls_around (maptile *map, int x, int y) 2336void fix_walls_around (maptile *map, int x, int y)
2186 2337
2187const char *
2188region_name (maptile *m)
2189 CODE:
2190 RETVAL = get_name_of_region_for_map (m);
2191 OUTPUT: RETVAL
2192
2193# worst xs function of my life 2338# worst xs function of my life
2194maptile * 2339bool
2195_create_random_map (\ 2340_create_random_map (\
2196 char *path,\ 2341 maptile *self,\
2197 char *wallstyle,\ 2342 char *wallstyle,\
2198 char *wall_name,\ 2343 char *wall_name,\
2199 char *floorstyle,\ 2344 char *floorstyle,\
2200 char *monsterstyle,\ 2345 char *monsterstyle,\
2201 char *treasurestyle,\ 2346 char *treasurestyle,\
2205 char *origin_map,\ 2350 char *origin_map,\
2206 char *final_map,\ 2351 char *final_map,\
2207 char *exitstyle,\ 2352 char *exitstyle,\
2208 char *this_map,\ 2353 char *this_map,\
2209 char *exit_on_final_map,\ 2354 char *exit_on_final_map,\
2210 int Xsize,\ 2355 int xsize,\
2211 int Ysize,\ 2356 int ysize,\
2212 int expand2x,\ 2357 int expand2x,\
2213 int layoutoptions1,\ 2358 int layoutoptions1,\
2214 int layoutoptions2,\ 2359 int layoutoptions2,\
2215 int layoutoptions3,\ 2360 int layoutoptions3,\
2216 int symmetry,\ 2361 int symmetry,\
2221 int dungeon_depth,\ 2366 int dungeon_depth,\
2222 int decoroptions,\ 2367 int decoroptions,\
2223 int orientation,\ 2368 int orientation,\
2224 int origin_y,\ 2369 int origin_y,\
2225 int origin_x,\ 2370 int origin_x,\
2226 int random_seed,\ 2371 U32 random_seed,\
2227 val64 total_map_hp,\ 2372 val64 total_map_hp,\
2228 int map_layout_style,\ 2373 int map_layout_style,\
2229 int treasureoptions,\ 2374 int treasureoptions,\
2230 int symmetry_used,\ 2375 int symmetry_used,\
2231 region *region\ 2376 region *region,\
2377 char *custom\
2232) 2378)
2233 CODE: 2379 CODE:
2234{ 2380{
2235 random_map_params rmp; 2381 random_map_params rmp;
2236 2382
2246 assign (rmp.exit_on_final_map, exit_on_final_map); 2392 assign (rmp.exit_on_final_map, exit_on_final_map);
2247 2393
2248 rmp.origin_map = origin_map; 2394 rmp.origin_map = origin_map;
2249 rmp.final_map = final_map; 2395 rmp.final_map = final_map;
2250 rmp.this_map = this_map; 2396 rmp.this_map = this_map;
2251 rmp.Xsize = Xsize; 2397 rmp.xsize = xsize;
2252 rmp.Ysize = Ysize; 2398 rmp.ysize = ysize;
2253 rmp.expand2x = expand2x; 2399 rmp.expand2x = expand2x;
2254 rmp.layoutoptions1 = layoutoptions1; 2400 rmp.layoutoptions1 = layoutoptions1;
2255 rmp.layoutoptions2 = layoutoptions2; 2401 rmp.layoutoptions2 = layoutoptions2;
2256 rmp.layoutoptions3 = layoutoptions3; 2402 rmp.layoutoptions3 = layoutoptions3;
2257 rmp.symmetry = symmetry; 2403 rmp.symmetry = symmetry;
2268 rmp.total_map_hp = total_map_hp; 2414 rmp.total_map_hp = total_map_hp;
2269 rmp.map_layout_style = map_layout_style; 2415 rmp.map_layout_style = map_layout_style;
2270 rmp.treasureoptions = treasureoptions; 2416 rmp.treasureoptions = treasureoptions;
2271 rmp.symmetry_used = symmetry_used; 2417 rmp.symmetry_used = symmetry_used;
2272 rmp.region = region; 2418 rmp.region = region;
2419 rmp.custom = custom;
2273 2420
2274 RETVAL = generate_random_map (path, &rmp); 2421 RETVAL = self->generate_random_map (&rmp);
2275} 2422}
2276 OUTPUT: 2423 OUTPUT:
2277 RETVAL 2424 RETVAL
2278 2425
2279MODULE = cf PACKAGE = cf::arch 2426MODULE = cf PACKAGE = cf::arch
2288 PROTOTYPE: 2435 PROTOTYPE:
2289 CODE: 2436 CODE:
2290 RETVAL = first_archetype; 2437 RETVAL = first_archetype;
2291 OUTPUT: RETVAL 2438 OUTPUT: RETVAL
2292 2439
2293INCLUDE: $PERL genacc archetype ../include/object.h | 2440INCLUDE: $PERL $srcdir/genacc archetype ../include/object.h |
2294 2441
2295MODULE = cf PACKAGE = cf::party 2442MODULE = cf PACKAGE = cf::party
2296 2443
2297partylist *first () 2444partylist *first ()
2298 PROTOTYPE: 2445 PROTOTYPE:
2299 CODE: 2446 CODE:
2300 RETVAL = get_firstparty (); 2447 RETVAL = get_firstparty ();
2301 OUTPUT: RETVAL 2448 OUTPUT: RETVAL
2302 2449
2303INCLUDE: $PERL genacc partylist ../include/player.h | 2450INCLUDE: $PERL $srcdir/genacc partylist ../include/player.h |
2304 2451
2305MODULE = cf PACKAGE = cf::region 2452MODULE = cf PACKAGE = cf::region
2306 2453
2307region *first () 2454void
2308 PROTOTYPE: 2455list ()
2309 CODE: 2456 PPCODE:
2310 RETVAL = first_region; 2457 for_all_regions (rgn)
2311 OUTPUT: RETVAL 2458 XPUSHs (sv_2mortal (to_sv (rgn)));
2312 2459
2313region *find (char *name) 2460region *find (char *name)
2314 PROTOTYPE: $ 2461 PROTOTYPE: $
2315 CODE: 2462 CODE:
2316 RETVAL = get_region_by_name (name); 2463 RETVAL = region::find (name);
2317 OUTPUT: RETVAL 2464 OUTPUT: RETVAL
2318 2465
2466region *find_fuzzy (char *name)
2467 PROTOTYPE: $
2468 CODE:
2469 RETVAL = region::find_fuzzy (name);
2470 OUTPUT: RETVAL
2471
2319INCLUDE: $PERL genacc region ../include/map.h | 2472INCLUDE: $PERL $srcdir/genacc region ../include/map.h |
2320 2473
2321MODULE = cf PACKAGE = cf::living 2474MODULE = cf PACKAGE = cf::living
2322 2475
2323INCLUDE: $PERL genacc living ../include/living.h | 2476INCLUDE: $PERL $srcdir/genacc living ../include/living.h |
2324 2477
2325MODULE = cf PACKAGE = cf::settings 2478MODULE = cf PACKAGE = cf::settings
2326 2479
2327INCLUDE: $PERL genacc Settings ../include/global.h | 2480INCLUDE: $PERL $srcdir/genacc Settings ../include/global.h |
2328 2481
2329MODULE = cf PACKAGE = cf::client 2482MODULE = cf PACKAGE = cf::client
2330 2483
2331INCLUDE: $PERL genacc client ../include/client.h | 2484INCLUDE: $PERL $srcdir/genacc client ../include/client.h |
2332 2485
2333int invoke (client *ns, int event, ...) 2486int invoke (client *ns, int event, ...)
2334 CODE: 2487 CODE:
2335 if (KLASS_OF (event) != KLASS_CLIENT) croak ("event class must be CLIENT"); 2488 if (KLASS_OF (event) != KLASS_CLIENT) croak ("event class must be CLIENT");
2336 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); 2489 AV *av = (AV *)sv_2mortal ((SV *)newAV ());

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines