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.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{
107 flags |=0x3300;//D
106 assert (!self); 108 assert (!self);
107 assert (!cb); 109 assert (!cb);
108} 110}
109 111
110int 112int
… …
126 sv_unmagic ((SV *)self, PERL_MAGIC_ext); 128 sv_unmagic ((SV *)self, PERL_MAGIC_ext);
127 SvREFCNT_dec (self); 129 SvREFCNT_dec (self);
128 130
129 // self *must* be null now because thats sv_unmagic's job. 131 // self *must* be null now because thats sv_unmagic's job.
130 assert (!this->self); 132 assert (!this->self);
133 flags |= 0x80; // severed //D
131 } 134 }
132} 135}
133 136
134void 137void
135attachable::optimise () 138attachable::optimise ()
136{ 139{
137 if (self 140 if (self
138 && SvREFCNT (self) == 1 141 && SvREFCNT (self) == 1
139 && !HvTOTALKEYS (self)) 142 && !HvTOTALKEYS (self))
143 flags |= 0x40,//D
140 sever_self (); 144 sever_self ();
141} 145}
142 146
143// check wether the object really is dead 147// check wether the object really is dead
144void 148void
… …
162 } 166 }
163 167
164 if (self) 168 if (self)
165 sever_self (); 169 sever_self ();
166 170
171 flags |= 0x20; //D
167 mortals.push_back (this); 172 mortals.push_back (this);
168} 173}
169 174
170void 175void
171attachable::destroy () 176attachable::destroy ()
… …
266 271
267 if (!obj->self) 272 if (!obj->self)
268 { 273 {
269 obj->self = newHV (); 274 obj->self = newHV ();
270 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);
276 obj->flags |= (obj->flags & 0xc0) << 8;
277 obj->flags &= ~0xc0;//D
278 obj->flags |= 0x10;//D
271 279
272 // now bless the object _once_ 280 // now bless the object _once_
273 return sv_bless (newRV_inc ((SV *)obj->self), stash); 281 return sv_bless (newRV_inc ((SV *)obj->self), stash);
274 } 282 }
275 else 283 else
… …
604 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))
605 { 613 {
606 printf ("unable to initialize perl-interpreter, aborting.\n"); 614 printf ("unable to initialize perl-interpreter, aborting.\n");
607 exit (EXIT_FAILURE); 615 exit (EXIT_FAILURE);
608 } 616 }
617
618 {
619 dSP;
620
621 PUSHMARK (SP);
622 PUTBACK;
623 call_pv ("cf::init", G_DISCARD | G_VOID);
624 }
609} 625}
610 626
611void cfperl_main () 627void cfperl_main ()
612{ 628{
613 dSP; 629 dSP;
… …
831void 847void
832cfperl_emergency_save () 848cfperl_emergency_save ()
833{ 849{
834 CALL_BEGIN (0); 850 CALL_BEGIN (0);
835 CALL_CALL ("cf::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);
836 CALL_END; 861 CALL_END;
837} 862}
838 863
839maptile * 864maptile *
840maptile::find_sync (const char *path, maptile *origin) 865maptile::find_sync (const char *path, maptile *origin)
… …
1561{ 1586{
1562 // reattach to all attachable objects in the game. 1587 // reattach to all attachable objects in the game.
1563 for_all_clients (ns) 1588 for_all_clients (ns)
1564 ns->reattach (); 1589 ns->reattach ();
1565 1590
1566 for_all_players (pl)
1567 pl->reattach ();
1568
1569 //TODO
1570 //for (map_container::iterator i = maps.begin (); i != maps.end (); ++i)
1571 // i->second->reattach ();
1572
1573 for_all_objects (op) 1591 for_all_objects (op)
1574 op->reattach (); 1592 op->reattach ();
1575} 1593}
1576 1594
1577NV floor (NV x) 1595NV floor (NV x)
… …
1711 RETVAL = newSVpv (resist_plus[atnr], 0); 1729 RETVAL = newSVpv (resist_plus[atnr], 0);
1712 else 1730 else
1713 XSRETURN_UNDEF; 1731 XSRETURN_UNDEF;
1714 OUTPUT: RETVAL 1732 OUTPUT: RETVAL
1715 1733
1734bool
1735load_resource_file (const char *filename)
1736
1716MODULE = cf PACKAGE = cf::attachable 1737MODULE = cf PACKAGE = cf::attachable
1717 1738
1718int 1739int
1719valid (SV *obj) 1740valid (SV *obj)
1720 CODE: 1741 CODE:
1721 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext); 1742 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
1722 OUTPUT: 1743 OUTPUT:
1723 RETVAL 1744 RETVAL
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;
1724 1752
1725int mortals_size () 1753int mortals_size ()
1726 CODE: 1754 CODE:
1727 RETVAL = attachable::mortals.size (); 1755 RETVAL = attachable::mortals.size ();
1728 OUTPUT: RETVAL 1756 OUTPUT: RETVAL
… …
1730#object *mortals (U32 index) 1758#object *mortals (U32 index)
1731# CODE: 1759# CODE:
1732# RETVAL = index < attachable::mortals.size () ? attachable::mortals [index] : 0; 1760# RETVAL = index < attachable::mortals.size () ? attachable::mortals [index] : 0;
1733# OUTPUT: RETVAL 1761# OUTPUT: RETVAL
1734 1762
1735INCLUDE: $PERL genacc attachable ../include/cfperl.h | 1763INCLUDE: $PERL $srcdir/genacc attachable ../include/cfperl.h |
1736 1764
1737MODULE = cf PACKAGE = cf::global 1765MODULE = cf PACKAGE = cf::global
1738 1766
1739int invoke (SV *klass, int event, ...) 1767int invoke (SV *klass, int event, ...)
1740 CODE: 1768 CODE:
… …
1744 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);
1745 OUTPUT: RETVAL 1773 OUTPUT: RETVAL
1746 1774
1747MODULE = cf PACKAGE = cf::object PREFIX = cf_object_ 1775MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
1748 1776
1749INCLUDE: $PERL genacc object ../include/object.h | 1777INCLUDE: $PERL $srcdir/genacc object ../include/object.h |
1750 1778
1751int invoke (object *op, int event, ...) 1779int invoke (object *op, int event, ...)
1752 CODE: 1780 CODE:
1753 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");
1754 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); 1782 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
… …
1819 1847
1820int need_identify (object *obj); 1848int need_identify (object *obj);
1821 1849
1822int apply_shop_mat (object *shop_mat, object *op); 1850int apply_shop_mat (object *shop_mat, object *op);
1823 1851
1852int move_player (object *op, int dir)
1853 CODE:
1854 RETVAL = move_player (op, dir);
1855 OUTPUT:
1856 RETVAL
1857
1824int move (object *op, int dir, object *originator = op) 1858int move (object *op, int dir, object *originator = op)
1825 CODE: 1859 CODE:
1826 RETVAL = move_ob (op, dir, originator); 1860 RETVAL = move_ob (op, dir, originator);
1827 OUTPUT: 1861 OUTPUT:
1828 RETVAL 1862 RETVAL
… …
1832 manual_apply (applied, applier, flags); 1866 manual_apply (applied, applier, flags);
1833 1867
1834void apply_below (object *op) 1868void apply_below (object *op)
1835 CODE: 1869 CODE:
1836 player_apply_below (op); 1870 player_apply_below (op);
1871
1872int cast_heal (object *op, object *caster, object *spell, int dir = 0)
1837 1873
1838object *cf_object_present_archname_inside (object *op, char *whatstr) 1874object *cf_object_present_archname_inside (object *op, char *whatstr)
1839 1875
1840int 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)
1841 1877
… …
2026 2062
2027int command_summon (object *op, char *params) 2063int command_summon (object *op, char *params)
2028 2064
2029int command_arrest (object *op, char *params) 2065int command_arrest (object *op, char *params)
2030 2066
2031int command_kick (object *op, char *params)
2032
2033int command_banish (object *op, char *params) 2067int command_banish (object *op, char *params)
2034 2068
2035 2069
2036MODULE = cf PACKAGE = cf::player PREFIX = cf_player_ 2070MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
2037 2071
2038INCLUDE: $PERL genacc player ../include/player.h | 2072INCLUDE: $PERL $srcdir/genacc player ../include/player.h |
2039 2073
2040int invoke (player *pl, int event, ...) 2074int invoke (player *pl, int event, ...)
2041 CODE: 2075 CODE:
2042 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");
2043 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); 2077 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
… …
2056 pl->orig_stats = pl->ob->stats; 2090 pl->orig_stats = pl->ob->stats;
2057 2091
2058void cf_player_move (player *pl, int dir) 2092void cf_player_move (player *pl, int dir)
2059 2093
2060void 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);
2061
2062player *first ()
2063 CODE:
2064 RETVAL = first_player;
2065 OUTPUT: RETVAL
2066 2095
2067bool 2096bool
2068cell_visible (player *pl, int dx, int dy) 2097cell_visible (player *pl, int dx, int dy)
2069 CODE: 2098 CODE:
2070 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
… …
2123 RETVAL = map->invoke ((event_type)event, ARG_AV (av), DT_END); 2152 RETVAL = map->invoke ((event_type)event, ARG_AV (av), DT_END);
2124 OUTPUT: RETVAL 2153 OUTPUT: RETVAL
2125 2154
2126SV *registry (maptile *map) 2155SV *registry (maptile *map)
2127 2156
2128INCLUDE: $PERL genacc maptile ../include/map.h | 2157INCLUDE: $PERL $srcdir/genacc maptile ../include/map.h |
2129 2158
2130void 2159void
2131maptile::instantiate () 2160maptile::instantiate ()
2132 2161
2133maptile *new () 2162maptile *new ()
… …
2149 if (pl->ob && pl->ob->map == THIS) 2178 if (pl->ob && pl->ob->map == THIS)
2150 PUSHs (sv_2mortal (to_sv (pl->ob))); 2179 PUSHs (sv_2mortal (to_sv (pl->ob)));
2151 } 2180 }
2152 2181
2153void 2182void
2154maptile::set_regiondata (SV *data, SV *plt) 2183maptile::add_underlay (SV *data, int offset, int stride, SV *palette)
2155 CODE: 2184 CODE:
2156{ 2185{
2157 if (!SvROK (plt) || SvTYPE (SvRV (plt)) != SVt_PVAV) 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)
2158 croak ("maptile::set_regiondata needs arrayref as plt arg"); 2223 croak ("maptile::set_regiondata: palette must be arrayref");
2159 2224
2160 AV *av = (AV *)SvRV (plt); 2225 palette = SvRV (palette);
2161 2226
2162 region **regionmap = (region **)malloc ((av_len (av) + 1) * sizeof (region *)); 2227 STRLEN idxlen;
2228 const uint8_t *idx = (const uint8_t *)SvPVbyte (data, idxlen);
2163 2229
2230 region **regionmap = (region **)malloc (
2231 (av_len ((AV *)palette) + 1) * sizeof (region *));
2232 uint8_t *regions = salloc<uint8_t> (THIS->size ());
2233
2164 for (int i = av_len (av) + 1; i--; ) 2234 for (int i = av_len ((AV *)palette) + 1; i--; )
2165 regionmap [i] = region::find (SvPVutf8_nolen (*av_fetch (av, i, 1))); 2235 regionmap [i] = region::find (
2236 SvPVutf8_nolen (*av_fetch ((AV *)palette, i, 1)));
2166 2237
2167 THIS->regions = salloc<uint8_t> (THIS->size (), (uint8_t *)SvPVbyte_nolen (data)); 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;
2168 THIS->regionmap = regionmap; 2245 THIS->regionmap = regionmap;
2169} 2246}
2170 2247
2171void 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)
2172 2249
… …
2358 PROTOTYPE: 2435 PROTOTYPE:
2359 CODE: 2436 CODE:
2360 RETVAL = first_archetype; 2437 RETVAL = first_archetype;
2361 OUTPUT: RETVAL 2438 OUTPUT: RETVAL
2362 2439
2363INCLUDE: $PERL genacc archetype ../include/object.h | 2440INCLUDE: $PERL $srcdir/genacc archetype ../include/object.h |
2364 2441
2365MODULE = cf PACKAGE = cf::party 2442MODULE = cf PACKAGE = cf::party
2366 2443
2367partylist *first () 2444partylist *first ()
2368 PROTOTYPE: 2445 PROTOTYPE:
2369 CODE: 2446 CODE:
2370 RETVAL = get_firstparty (); 2447 RETVAL = get_firstparty ();
2371 OUTPUT: RETVAL 2448 OUTPUT: RETVAL
2372 2449
2373INCLUDE: $PERL genacc partylist ../include/player.h | 2450INCLUDE: $PERL $srcdir/genacc partylist ../include/player.h |
2374 2451
2375MODULE = cf PACKAGE = cf::region 2452MODULE = cf PACKAGE = cf::region
2376 2453
2377region *first () 2454void
2378 PROTOTYPE: 2455list ()
2379 CODE: 2456 PPCODE:
2380 RETVAL = first_region; 2457 for_all_regions (rgn)
2381 OUTPUT: RETVAL 2458 XPUSHs (sv_2mortal (to_sv (rgn)));
2382 2459
2383region *find (char *name) 2460region *find (char *name)
2384 PROTOTYPE: $ 2461 PROTOTYPE: $
2385 CODE: 2462 CODE:
2386 RETVAL = region::find (name); 2463 RETVAL = region::find (name);
2387 OUTPUT: RETVAL 2464 OUTPUT: RETVAL
2388 2465
2466region *find_fuzzy (char *name)
2467 PROTOTYPE: $
2468 CODE:
2469 RETVAL = region::find_fuzzy (name);
2470 OUTPUT: RETVAL
2471
2389INCLUDE: $PERL genacc region ../include/map.h | 2472INCLUDE: $PERL $srcdir/genacc region ../include/map.h |
2390 2473
2391MODULE = cf PACKAGE = cf::living 2474MODULE = cf PACKAGE = cf::living
2392 2475
2393INCLUDE: $PERL genacc living ../include/living.h | 2476INCLUDE: $PERL $srcdir/genacc living ../include/living.h |
2394 2477
2395MODULE = cf PACKAGE = cf::settings 2478MODULE = cf PACKAGE = cf::settings
2396 2479
2397INCLUDE: $PERL genacc Settings ../include/global.h | 2480INCLUDE: $PERL $srcdir/genacc Settings ../include/global.h |
2398 2481
2399MODULE = cf PACKAGE = cf::client 2482MODULE = cf PACKAGE = cf::client
2400 2483
2401INCLUDE: $PERL genacc client ../include/client.h | 2484INCLUDE: $PERL $srcdir/genacc client ../include/client.h |
2402 2485
2403int invoke (client *ns, int event, ...) 2486int invoke (client *ns, int event, ...)
2404 CODE: 2487 CODE:
2405 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");
2406 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