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.160 by elmex, Wed Jan 31 14:11:02 2007 UTC vs.
Revision 1.168 by root, Thu Feb 15 03:19:02 2007 UTC

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
126 sv_unmagic ((SV *)self, PERL_MAGIC_ext); 127 sv_unmagic ((SV *)self, PERL_MAGIC_ext);
127 SvREFCNT_dec (self); 128 SvREFCNT_dec (self);
128 129
129 // self *must* be null now because thats sv_unmagic's job. 130 // self *must* be null now because thats sv_unmagic's job.
130 assert (!this->self); 131 assert (!this->self);
132 flags |= 0x80; // severed //D
131 } 133 }
132} 134}
133 135
134void 136void
135attachable::optimise () 137attachable::optimise ()
136{ 138{
137 if (self 139 if (self
138 && SvREFCNT (self) == 1 140 && SvREFCNT (self) == 1
139 && !HvTOTALKEYS (self)) 141 && !HvTOTALKEYS (self))
142 flags |= 0x40,//D
140 sever_self (); 143 sever_self ();
141} 144}
142 145
143// check wether the object really is dead 146// check wether the object really is dead
144void 147void
162 } 165 }
163 166
164 if (self) 167 if (self)
165 sever_self (); 168 sever_self ();
166 169
170 flags |= 0x20; //D
167 mortals.push_back (this); 171 mortals.push_back (this);
168} 172}
169 173
170void 174void
171attachable::destroy () 175attachable::destroy ()
266 270
267 if (!obj->self) 271 if (!obj->self)
268 { 272 {
269 obj->self = newHV (); 273 obj->self = newHV ();
270 sv_magicext ((SV *)obj->self, 0, PERL_MAGIC_ext, &attachable::vtbl, (char *)obj, 0); 274 sv_magicext ((SV *)obj->self, 0, PERL_MAGIC_ext, &attachable::vtbl, (char *)obj, 0);
275 obj->flags |= (obj->flags & 0xc0) << 8;
276 obj->flags &= ~0xc0;//D
277 obj->flags |= 0x10;//D
271 278
272 // now bless the object _once_ 279 // now bless the object _once_
273 return sv_bless (newRV_inc ((SV *)obj->self), stash); 280 return sv_bless (newRV_inc ((SV *)obj->self), stash);
274 } 281 }
275 else 282 else
604 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl)) 611 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl))
605 { 612 {
606 printf ("unable to initialize perl-interpreter, aborting.\n"); 613 printf ("unable to initialize perl-interpreter, aborting.\n");
607 exit (EXIT_FAILURE); 614 exit (EXIT_FAILURE);
608 } 615 }
616
617 {
618 dSP;
619
620 PUSHMARK (SP);
621 PUTBACK;
622 call_pv ("cf::init", G_DISCARD | G_VOID);
623 }
609} 624}
610 625
611void cfperl_main () 626void cfperl_main ()
612{ 627{
613 dSP; 628 dSP;
831void 846void
832cfperl_emergency_save () 847cfperl_emergency_save ()
833{ 848{
834 CALL_BEGIN (0); 849 CALL_BEGIN (0);
835 CALL_CALL ("cf::emergency_save", G_VOID); 850 CALL_CALL ("cf::emergency_save", G_VOID);
851 CALL_END;
852}
853
854void
855cfperl_cleanup (int make_core)
856{
857 CALL_BEGIN (1);
858 CALL_ARG (make_core);
859 CALL_CALL ("cf::post_cleanup", G_VOID);
836 CALL_END; 860 CALL_END;
837} 861}
838 862
839maptile * 863maptile *
840maptile::find_sync (const char *path, maptile *origin) 864maptile::find_sync (const char *path, maptile *origin)
1711 RETVAL = newSVpv (resist_plus[atnr], 0); 1735 RETVAL = newSVpv (resist_plus[atnr], 0);
1712 else 1736 else
1713 XSRETURN_UNDEF; 1737 XSRETURN_UNDEF;
1714 OUTPUT: RETVAL 1738 OUTPUT: RETVAL
1715 1739
1740bool
1741load_regions (const char *filename)
1742 CODE:
1743 RETVAL = loader_region ().load (filename);
1744 OUTPUT: RETVAL
1745
1716MODULE = cf PACKAGE = cf::attachable 1746MODULE = cf PACKAGE = cf::attachable
1717 1747
1718int 1748int
1719valid (SV *obj) 1749valid (SV *obj)
1720 CODE: 1750 CODE:
1721 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext); 1751 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
1722 OUTPUT: 1752 OUTPUT:
1723 RETVAL 1753 RETVAL
1754
1755void
1756debug_trace (attachable *obj, bool on = true)
1757 CODE:
1758 obj->flags &= ~attachable::F_DEBUG_TRACE;
1759 if (on)
1760 obj->flags |= attachable::F_DEBUG_TRACE;
1724 1761
1725int mortals_size () 1762int mortals_size ()
1726 CODE: 1763 CODE:
1727 RETVAL = attachable::mortals.size (); 1764 RETVAL = attachable::mortals.size ();
1728 OUTPUT: RETVAL 1765 OUTPUT: RETVAL
1832 manual_apply (applied, applier, flags); 1869 manual_apply (applied, applier, flags);
1833 1870
1834void apply_below (object *op) 1871void apply_below (object *op)
1835 CODE: 1872 CODE:
1836 player_apply_below (op); 1873 player_apply_below (op);
1874
1875int cast_heal (object *op, object *caster, object *spell, int dir = 0)
1837 1876
1838object *cf_object_present_archname_inside (object *op, char *whatstr) 1877object *cf_object_present_archname_inside (object *op, char *whatstr)
1839 1878
1840int cf_object_transfer (object *op, int x, int y, int r = 0, object_ornull *orig = 0) 1879int cf_object_transfer (object *op, int x, int y, int r = 0, object_ornull *orig = 0)
1841 1880
2056 pl->orig_stats = pl->ob->stats; 2095 pl->orig_stats = pl->ob->stats;
2057 2096
2058void cf_player_move (player *pl, int dir) 2097void cf_player_move (player *pl, int dir)
2059 2098
2060void play_sound_player_only (player *pl, int soundnum, int x = 0, int y = 0); 2099void play_sound_player_only (player *pl, int soundnum, int x = 0, int y = 0);
2061
2062player *first ()
2063 CODE:
2064 RETVAL = first_player;
2065 OUTPUT: RETVAL
2066 2100
2067bool 2101bool
2068cell_visible (player *pl, int dx, int dy) 2102cell_visible (player *pl, int dx, int dy)
2069 CODE: 2103 CODE:
2070 RETVAL = FABS (dx) <= pl->ns->mapx / 2 && FABS (dy) <= pl->ns->mapy / 2 2104 RETVAL = FABS (dx) <= pl->ns->mapx / 2 && FABS (dy) <= pl->ns->mapy / 2
2149 if (pl->ob && pl->ob->map == THIS) 2183 if (pl->ob && pl->ob->map == THIS)
2150 PUSHs (sv_2mortal (to_sv (pl->ob))); 2184 PUSHs (sv_2mortal (to_sv (pl->ob)));
2151 } 2185 }
2152 2186
2153void 2187void
2154maptile::set_regiondata (SV *data, SV *plt) 2188maptile::add_underlay (SV *data, int offset, int stride, SV *palette)
2155 CODE: 2189 CODE:
2156{ 2190{
2157 if (!SvROK (plt) || SvTYPE (SvRV (plt)) != SVt_PVAV) 2191 if (!SvROK (palette) || SvTYPE (SvRV (palette)) != SVt_PVAV)
2192 croak ("maptile::add_underlay: palette must be arrayref");
2193
2194 palette = SvRV (palette);
2195
2196 STRLEN idxlen;
2197 const uint8_t *idx = (const uint8_t *)SvPVbyte (data, idxlen);
2198
2199 for (int x = 0; x < THIS->width; ++x)
2200 for (int y = 0; y < THIS->height; ++y)
2201 {
2202 for (object *op = THIS->at (x, y).bot; op; op = op->above)
2203 if (op->flag [FLAG_IS_FLOOR])
2204 goto skip_space;
2205
2206 {
2207 int offs = offset + y * stride + x;
2208 if (IN_RANGE_EXC (offs, 0, idxlen))
2209 {
2210 if (SV **elem = av_fetch ((AV *)palette, idx [offs], 0))
2211 {
2212 object *ob = get_archetype (SvPVutf8_nolen (*elem));
2213 ob->flag [FLAG_NO_MAP_SAVE] = true;
2214 THIS->insert (ob, x, y, 0, INS_ABOVE_FLOOR_ONLY);
2215 }
2216 }
2217 }
2218
2219 skip_space: ;
2220 }
2221}
2222
2223void
2224maptile::set_regiondata (SV *data, int offset, int stride, SV *palette)
2225 CODE:
2226{
2227 if (!SvROK (palette) || SvTYPE (SvRV (palette)) != SVt_PVAV)
2158 croak ("maptile::set_regiondata needs arrayref as plt arg"); 2228 croak ("maptile::set_regiondata: palette must be arrayref");
2159 2229
2160 AV *av = (AV *)SvRV (plt); 2230 palette = SvRV (palette);
2161 2231
2162 region **regionmap = (region **)malloc ((av_len (av) + 1) * sizeof (region *)); 2232 STRLEN idxlen;
2233 const uint8_t *idx = (const uint8_t *)SvPVbyte (data, idxlen);
2163 2234
2235 region **regionmap = (region **)malloc (
2236 (av_len ((AV *)palette) + 1) * sizeof (region *));
2237 uint8_t *regions = salloc<uint8_t> (THIS->size ());
2238
2164 for (int i = av_len (av) + 1; i--; ) 2239 for (int i = av_len ((AV *)palette) + 1; i--; )
2165 regionmap [i] = region::find (SvPVutf8_nolen (*av_fetch (av, i, 1))); 2240 regionmap [i] = region::find (
2241 SvPVutf8_nolen (*av_fetch ((AV *)palette, i, 1)));
2166 2242
2167 THIS->regions = salloc<uint8_t> (THIS->size (), (uint8_t *)SvPVbyte_nolen (data)); 2243 for (int y = 0; y < THIS->height; ++y)
2244 memcpy (regions + y * THIS->width, idx + offset + y * stride, THIS->width);
2245
2246 sfree (THIS->regions, THIS->size ());
2247 free (THIS->regionmap);
2248
2249 THIS->regions = regions;
2168 THIS->regionmap = regionmap; 2250 THIS->regionmap = regionmap;
2169} 2251}
2170 2252
2171void play_sound_map (maptile *map, int x, int y, int sound_num) 2253void play_sound_map (maptile *map, int x, int y, int sound_num)
2172 2254
2372 2454
2373INCLUDE: $PERL genacc partylist ../include/player.h | 2455INCLUDE: $PERL genacc partylist ../include/player.h |
2374 2456
2375MODULE = cf PACKAGE = cf::region 2457MODULE = cf PACKAGE = cf::region
2376 2458
2377region *first () 2459void
2378 PROTOTYPE: 2460list ()
2379 CODE: 2461 PPCODE:
2380 RETVAL = first_region; 2462 for_all_regions (rgn)
2381 OUTPUT: RETVAL 2463 XPUSHs (sv_2mortal (to_sv (rgn)));
2382 2464
2383region *find (char *name) 2465region *find (char *name)
2384 PROTOTYPE: $ 2466 PROTOTYPE: $
2385 CODE: 2467 CODE:
2386 RETVAL = region::find (name); 2468 RETVAL = region::find (name);
2387 OUTPUT: RETVAL 2469 OUTPUT: RETVAL
2388 2470
2471region *find_fuzzy (char *name)
2472 PROTOTYPE: $
2473 CODE:
2474 RETVAL = region::find_fuzzy (name);
2475 OUTPUT: RETVAL
2476
2389INCLUDE: $PERL genacc region ../include/map.h | 2477INCLUDE: $PERL genacc region ../include/map.h |
2390 2478
2391MODULE = cf PACKAGE = cf::living 2479MODULE = cf PACKAGE = cf::living
2392 2480
2393INCLUDE: $PERL genacc living ../include/living.h | 2481INCLUDE: $PERL genacc living ../include/living.h |

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines