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.22 by root, Mon Aug 28 16:13:00 2006 UTC vs.
Revision 1.33 by elmex, Thu Aug 31 01:03:36 2006 UTC

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 28
35#ifndef __CEXTRACT__ 29#ifndef __CEXTRACT__
36#include <plugin.h> 30#include <plugin.h>
48#include <sproto.h> 42#include <sproto.h>
49 43
50#include "cfperl.h" 44#include "cfperl.h"
51#include "shstr.h" 45#include "shstr.h"
52 46
47#include <EXTERN.h>
48#include <perl.h>
49#include <XSUB.h>
50
53#include "perlxsi.c" 51#include "perlxsi.c"
54 52
55extern sint64 *levels; // the experience table 53extern sint64 *levels; // the experience table
56 54
57typedef object object_ornull; 55typedef object object_ornull;
61#define newSVval64 newSVnv 59#define newSVval64 newSVnv
62#define SvVAL64 SvNV 60#define SvVAL64 SvNV
63 61
64static f_plug_api gethook = cfapi_get_hooks; 62static f_plug_api gethook = cfapi_get_hooks;
65static f_plug_api object_set_property = cfapi_object_set_property; 63static f_plug_api object_set_property = cfapi_object_set_property;
66static f_plug_api map_get_map = cfapi_map_get_map;
67static f_plug_api object_insert = cfapi_object_insert; 64static f_plug_api object_insert = cfapi_object_insert;
65
66static bool perl_booted;
68 67
69/* this is a stupid way to do things, and awkward to use for plug-in authors */ 68/* this is a stupid way to do things, and awkward to use for plug-in authors */
70typedef struct 69typedef struct
71{ 70{
72 object* who; 71 object* who;
117 return &PL_sv_undef; 116 return &PL_sv_undef;
118 117
119 if (!obj->self) 118 if (!obj->self)
120 obj->self = newSVptr (obj, klass); 119 obj->self = newSVptr (obj, klass);
121 120
122 return newSVsv (static_cast<SV *>(obj->self)); 121 return newSVsv (obj->self);
123} 122}
124 123
125static void 124static void
126SVptr_cache_set (void *ptr, SV *sv) 125SVptr_cache_set (void *ptr, SV *sv)
127{ 126{
316void attachable_base::clear () 315void attachable_base::clear ()
317{ 316{
318 if (self) 317 if (self)
319 { 318 {
320 if (cb) 319 if (cb)
321 if (SvROK (*av_fetch ((AV *)cb, EVENT_OBJECT_DESTROY, 1))) 320 if (SvROK (*av_fetch (cb, EVENT_OBJECT_DESTROY, 1)))
322 INVOKE_OBJECT (DESTROY, static_cast<object *>(this)); 321 INVOKE_OBJECT (DESTROY, static_cast<object *>(this));
323 else if (SvROK (*av_fetch ((AV *)cb, EVENT_MAP_DESTROY, 1))) 322 else if (SvROK (*av_fetch (cb, EVENT_MAP_DESTROY, 1)))
324 INVOKE_MAP (DESTROY, static_cast<mapstruct *>(this)); 323 INVOKE_MAP (DESTROY, static_cast<mapstruct *>(this));
325 324
326 // disconnect Perl from C, to avoid crashes 325 // disconnect Perl from C, to avoid crashes
327 sv_unmagic (SvRV ((SV *)self), PERL_MAGIC_ext); 326 sv_unmagic (SvRV ((SV *)self), PERL_MAGIC_ext);
328 327
360 SvREFCNT_dec ((SV *)self); 359 SvREFCNT_dec ((SV *)self);
361 self = 0; 360 self = 0;
362 } 361 }
363} 362}
364 363
365void 364void attachable_base::instantiate (data_type type, void *obj)
366object::instantiate_ ()
367{ 365{
368 dSP; 366 dSP;
369 ENTER; 367 ENTER;
370 SAVETMPS; 368 SAVETMPS;
371 PUSHMARK (SP); 369 PUSHMARK (SP);
372 EXTEND (SP, 2); 370 EXTEND (SP, 2);
373 PUSHs (sv_2mortal (newSVdt (DT_OBJECT, static_cast<object *>(this)))); 371 PUSHs (sv_2mortal (newSVdt (type, obj)));
374 PUSHs (sv_2mortal (newSVpv (attach, 0))); 372 PUSHs (sv_2mortal (newSVpv (attach, 0)));
373
374 free_string (attach);
375 attach = 0;
376
375 PUTBACK; 377 PUTBACK;
376 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL); 378 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL);
377 FREETMPS; 379 FREETMPS;
378 LEAVE; 380 LEAVE;
379 381
380 INVOKE_OBJECT (INSTANTIATE, this); 382 switch (type)
383 {
384 case DT_OBJECT: INVOKE_OBJECT (INSTANTIATE, obj); break;
385 case DT_MAP: INVOKE_MAP (INSTANTIATE, obj); break;
386 }
381} 387}
382 388
383///////////////////////////////////////////////////////////////////////////// 389/////////////////////////////////////////////////////////////////////////////
384 390
385void reattach (data_type type, void *obj) 391void reattach (data_type type, void *obj)
418 this->filename = (SV *)newSVpv (filename, 0); 424 this->filename = (SV *)newSVpv (filename, 0);
419 425
420 char filename2 [4096]; 426 char filename2 [4096];
421 snprintf (filename2, 4096, "%s~", filename); 427 snprintf (filename2, 4096, "%s~", filename);
422 428
429 av = newAV ();
430
431 // TODO: fast dynbuf implementation... yeah, we need obstacks
432 text = newSV (10 * 1024 * 1024); // only temporarily used, so be generous
433}
434
435object_freezer::~object_freezer ()
436{
437 dSP;
438 ENTER;
439 SAVETMPS;
440 PUSHMARK (SP);
441 XPUSHs (sv_2mortal ((SV *)filename));
442 XPUSHs (sv_2mortal (newRV_noinc (text)));
443 XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
444 PUTBACK;
445 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL);
446 FREETMPS;
447 LEAVE;
448}
449
450void object_freezer::put (attachable_base *ext)
451{
452 ext->optimise ();
453
454 if (ext->self)
455 {
456 int idx = AvFILLp ((AV *)av) + 1;
457 av_store (av, idx, SvREFCNT_inc (ext->self));
458
459 sv_catpvf (text, "oid %d\n", idx);
460 }
461}
462
463int fprintf (object_freezer &freezer, const char *format, ...)
464{
465 va_list ap;
466
467 va_start (ap, format);
468 sv_vcatpvfn (freezer.text, format, strlen (format), &ap, 0, 0, 0);
469 va_end (ap);
470}
471
472int fputs (const char *s, object_freezer &freezer)
473{
474 sv_catpvn (freezer.text, s, strlen (s));
475}
476
477object_thawer::object_thawer (const char *filename)
478{
479 av = 0;
480 fp = 0;
481
482 if (!filename)
483 return;
484
423 fp = fopen (filename2, "w"); 485 fp = fopen (filename, "r");
424
425 if (!fp) 486 if (!fp)
426 LOG (llevError, "cannot open file '%s' for writing: %s\n", filename2, strerror (errno));
427
428 av = (AV *)newAV ();
429}
430
431object_freezer::~object_freezer ()
432{
433 if (fp)
434 { 487 {
435 fclose (fp); 488 LOG (llevError, "object_thawer: unable to open '%s': %s.\n", filename, strerror (errno));
489 return;
490 }
436 491
492 if (perl_booted)
493 {
437 dSP; 494 dSP;
438 ENTER; 495 ENTER;
439 SAVETMPS; 496 SAVETMPS;
440 PUSHMARK (SP); 497 PUSHMARK (SP);
441 XPUSHs (sv_2mortal ((SV *)filename)); 498 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
442 XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
443 PUTBACK; 499 PUTBACK;
444 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL); 500
501 if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL))
502 {
503 SPAGAIN;
504 SV *sv = POPs;
505 if (SvROK (sv))
506 av = (AV *)SvREFCNT_inc (SvRV (sv));
507 }
508
445 FREETMPS; 509 FREETMPS;
446 LEAVE; 510 LEAVE;
447 } 511 }
448 else
449 SvREFCNT_dec ((SV *)filename);
450}
451
452void object_freezer::put (attachable_base *ext)
453{
454 ext->optimise ();
455
456 if (ext->self)
457 {
458 int idx = AvFILLp ((AV *)av) + 1;
459 av_store ((AV *)av, idx, SvREFCNT_inc ((SV *)ext->self));
460 fprintf (fp, "oid %d\n", idx);
461 }
462}
463
464object_thawer::object_thawer (FILE *fp, const char *filename)
465{
466 this->fp = fp;
467 av = 0;
468
469 if (!filename)
470 return;
471
472 dSP;
473 ENTER;
474 SAVETMPS;
475 PUSHMARK (SP);
476 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
477 PUTBACK;
478
479 if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL))
480 {
481 SPAGAIN;
482 SV *sv = POPs;
483 if (SvROK (sv))
484 av = SvREFCNT_inc (SvRV (sv));
485 }
486
487 FREETMPS;
488 LEAVE;
489} 512}
490 513
491void object_thawer::get (data_type type, void *obj, attachable_base *ext, int oid) 514void object_thawer::get (data_type type, void *obj, attachable_base *ext, int oid)
492{ 515{
493 if (!av || oid < 0) // this is actually an error of sorts 516 if (!av || oid < 0) // this is actually an error of sorts
503 printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid); 526 printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid);
504 return; 527 return;
505 } 528 }
506 529
507 ext->self = *svp; *svp = &PL_sv_undef; 530 ext->self = *svp; *svp = &PL_sv_undef;
508 sv_magic (SvRV ((SV *)ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0); 531 sv_magic (SvRV (ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0);
509 532
510 reattach (type, obj); 533 reattach (type, obj);
511} 534}
512 535
513object_thawer::~object_thawer () 536object_thawer::~object_thawer ()
514{ 537{
538 if (fp) fclose (fp);
515 if (av) SvREFCNT_dec ((AV *)av); 539 if (av) SvREFCNT_dec ((AV *)av);
516} 540}
517 541
518///////////////////////////////////////////////////////////////////////////// 542/////////////////////////////////////////////////////////////////////////////
519 543
619} 643}
620 644
621void 645void
622cfperl_init () 646cfperl_init ()
623{ 647{
648 PERL_SYS_INIT3 (&settings.argc, &settings.argv, 0);
649 perl = perl_alloc ();
650 perl_construct (perl);
651
652 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
653
624 char *argv[] = { 654 char *argv[] = {
625 "", 655 "",
626 "-e" 656 "-e"
627 "BEGIN {"
628 " cf->bootstrap;" 657 "cf->bootstrap;"
629 " unshift @INC, cf::datadir ();" 658 "unshift @INC, cf::datadir ();"
630 "}"
631 ""
632 "use cf;"
633 }; 659 };
634
635 perl = perl_alloc ();
636 perl_construct (perl);
637
638 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
639 660
640 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl)) 661 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl))
641 { 662 {
642 printf ("unable to initialize perl-interpreter, aborting.\n"); 663 printf ("unable to initialize perl-interpreter, aborting.\n");
643
644 exit (EXIT_FAILURE); 664 exit (EXIT_FAILURE);
645 //perl_destruct (perl);
646 //perl_free (perl);
647 //perl = 0;
648 //return;
649 } 665 }
650 666
651 obj_cache = newHV (); 667 obj_cache = newHV ();
668}
669
670void cfperl_boot ()
671{
672 perl_booted = true;
673
674 eval_pv ("require cf", 1);
652} 675}
653 676
654void cfperl_main () 677void cfperl_main ()
655{ 678{
656 dSP; 679 dSP;
728 dt = (data_type) va_arg (ap, int); 751 dt = (data_type) va_arg (ap, int);
729 assert (("first argument must be of type object", dt == DT_OBJECT)); 752 assert (("first argument must be of type object", dt == DT_OBJECT));
730 op = va_arg (ap, object *); 753 op = va_arg (ap, object *);
731 754
732 if (op->cb) 755 if (op->cb)
733 gather_callbacks (callbacks, (AV *)op->cb, event); 756 gather_callbacks (callbacks, op->cb, event);
734 757
735 if (op->type) 758 if (op->type)
736 { 759 {
737 if (op->subtype && op->type + op->subtype * NUM_SUBTYPES <= AvFILLp (cb_type)) 760 if (op->subtype && op->type + op->subtype * NUM_SUBTYPES <= AvFILLp (cb_type))
738 { 761 {
759 dt = (data_type) va_arg (ap, int); 782 dt = (data_type) va_arg (ap, int);
760 assert (("first argument must be of type player", dt == DT_PLAYER)); 783 assert (("first argument must be of type player", dt == DT_PLAYER));
761 pl = va_arg (ap, player *); 784 pl = va_arg (ap, player *);
762 785
763 if (pl->cb) 786 if (pl->cb)
764 gather_callbacks (callbacks, (AV *)pl->cb, event); 787 gather_callbacks (callbacks, pl->cb, event);
765 788
766 gather_callbacks (callbacks, cb_player, event); 789 gather_callbacks (callbacks, cb_player, event);
767 break; 790 break;
768 791
769 case KLASS_MAP: 792 case KLASS_MAP:
770 dt = (data_type) va_arg (ap, int); 793 dt = (data_type) va_arg (ap, int);
771 assert (("first argument must be of type object", dt == DT_MAP)); 794 assert (("first argument must be of type object", dt == DT_MAP));
772 map = va_arg (ap, mapstruct *); 795 map = va_arg (ap, mapstruct *);
773 796
774 if (map->cb) 797 if (map->cb)
775 gather_callbacks (callbacks, (AV *)map->cb, event); 798 gather_callbacks (callbacks, map->cb, event);
776 799
777 gather_callbacks (callbacks, cb_map, event); 800 gather_callbacks (callbacks, cb_map, event);
778 break; 801 break;
779 802
780 default: 803 default:
1400 prop (CFAPI_INT, MAP_PROP_WINDDIR) 1423 prop (CFAPI_INT, MAP_PROP_WINDDIR)
1401 prop (CFAPI_INT, MAP_PROP_SKY) 1424 prop (CFAPI_INT, MAP_PROP_SKY)
1402 prop (CFAPI_INT, MAP_PROP_WPARTX) 1425 prop (CFAPI_INT, MAP_PROP_WPARTX)
1403 prop (CFAPI_INT, MAP_PROP_WPARTY) 1426 prop (CFAPI_INT, MAP_PROP_WPARTY)
1404 prop (CFAPI_STRING, MAP_PROP_MESSAGE) 1427 prop (CFAPI_STRING, MAP_PROP_MESSAGE)
1405 prop (CFAPI_PMAP, MAP_PROP_NEXT)
1406 prop (CFAPI_PREGION, MAP_PROP_REGION) 1428 prop (CFAPI_PREGION, MAP_PROP_REGION)
1407 prop (CFAPI_POBJECT, OBJECT_PROP_OB_ABOVE)
1408 prop (CFAPI_POBJECT, OBJECT_PROP_OB_BELOW)
1409 prop (CFAPI_POBJECT, OBJECT_PROP_NEXT_ACTIVE_OB) 1429 prop (CFAPI_POBJECT, OBJECT_PROP_NEXT_ACTIVE_OB)
1410 prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB) 1430 prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB)
1411 prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY) 1431 prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY)
1412 prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT) 1432 prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT)
1413 prop (CFAPI_POBJECT, OBJECT_PROP_HEAD)
1414 prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER) 1433 prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER)
1415 prop (CFAPI_PMAP, OBJECT_PROP_MAP) 1434 prop (CFAPI_PMAP, OBJECT_PROP_MAP)
1416 prop (CFAPI_INT, OBJECT_PROP_COUNT) 1435 prop (CFAPI_INT, OBJECT_PROP_COUNT)
1417 prop (CFAPI_INT, OBJECT_PROP_REFCOUNT) 1436 prop (CFAPI_INT, OBJECT_PROP_REFCOUNT)
1418 prop (CFAPI_STRING, OBJECT_PROP_NAME) 1437 prop (CFAPI_STRING, OBJECT_PROP_NAME)
1598const char *cost_string_from_value(uint64 cost, int approx = 0) 1617const char *cost_string_from_value(uint64 cost, int approx = 0)
1599 1618
1600int invoke (int event, ...) 1619int invoke (int event, ...)
1601 CODE: 1620 CODE:
1602 if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL"); 1621 if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL");
1603 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 1; i < items; i++) av_push (av, ST (i)); 1622 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1623 for (int i = 1; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1604 RETVAL = INVOKE_((event_type)event, ARG_AV (av)); 1624 RETVAL = INVOKE_((event_type)event, ARG_AV (av));
1605 OUTPUT: RETVAL 1625 OUTPUT: RETVAL
1606 1626
1607int 1627int
1608exp_to_level (val64 exp) 1628exp_to_level (val64 exp)
1641 RETVAL = newSVpv (resist_plus[atnr], 0); 1661 RETVAL = newSVpv (resist_plus[atnr], 0);
1642 else 1662 else
1643 XSRETURN_UNDEF; 1663 XSRETURN_UNDEF;
1644 OUTPUT: RETVAL 1664 OUTPUT: RETVAL
1645 1665
1666int
1667_valid (SV *obj)
1668 CODE:
1669 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
1670 OUTPUT:
1671 RETVAL
1672
1646MODULE = cf PACKAGE = cf::object PREFIX = cf_object_ 1673MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
1647 1674
1648int invoke (object *op, int event, ...) 1675int invoke (object *op, int event, ...)
1649 CODE: 1676 CODE:
1650 if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT"); 1677 if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");
1651 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i)); 1678 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1679 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1652 RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av)); 1680 RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av));
1653 OUTPUT: RETVAL 1681 OUTPUT: RETVAL
1654 1682
1655SV *registry (object *op) 1683SV *registry (object *op)
1656 CODE: 1684 CODE:
1657 RETVAL = registry_of (op); 1685 RETVAL = registry_of (op);
1658 OUTPUT: 1686 OUTPUT:
1687 RETVAL
1688
1689object *head (object *op)
1690 PROTOTYPE: $
1691 ALIAS:
1692 more = 1
1693 above = 2
1694 below = 3
1695 CODE:
1696 switch (ix)
1697 {
1698 case 0: RETVAL = op->head ? op->head : op; break; // DOH!
1699 case 1: RETVAL = op->more; break;
1700 case 2: RETVAL = op->above; break;
1701 case 3: RETVAL = op->below; break;
1702 }
1703 OUTPUT:
1659 RETVAL 1704 RETVAL
1660 1705
1661SV * 1706SV *
1662get_property (object *obj, int type, int idx) 1707get_property (object *obj, int type, int idx)
1663 CODE: 1708 CODE:
1743 1788
1744int need_identify (const object *obj); 1789int need_identify (const object *obj);
1745 1790
1746int apply_shop_mat (object *shop_mat, object *op); 1791int apply_shop_mat (object *shop_mat, object *op);
1747 1792
1748void cf_object_move (object *op, int dir, object *originator = op) 1793int move (object *op, int dir, object *originator = op)
1794 CODE:
1795 RETVAL = move_ob (op, dir, originator);
1796 OUTPUT:
1797 RETVAL
1749 1798
1750void cf_object_apply (object *op, object *author, int flags = 0) 1799void cf_object_apply (object *op, object *author, int flags = 0)
1751 1800
1752void cf_object_apply_below (object *op) 1801void cf_object_apply_below (object *op)
1753 1802
1794int cf_object_out_of_map (object *op, int x, int y) 1843int cf_object_out_of_map (object *op, int x, int y)
1795 1844
1796void cf_object_drop (object *op, object *author) 1845void cf_object_drop (object *op, object *author)
1797 1846
1798void cf_object_take (object *op, object *author) 1847void cf_object_take (object *op, object *author)
1799
1800void cf_object_say (object *op, char *msg)
1801
1802void cf_object_speak (object *op, char *msg)
1803 1848
1804object *cf_object_insert_object (object *op, object *container) 1849object *cf_object_insert_object (object *op, object *container)
1805 1850
1806const char *cf_object_get_msg (object *ob) 1851const char *cf_object_get_msg (object *ob)
1807 ALIAS: msg = 0 1852 ALIAS: msg = 0
1946MODULE = cf PACKAGE = cf::player PREFIX = cf_player_ 1991MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
1947 1992
1948int invoke (player *pl, int event, ...) 1993int invoke (player *pl, int event, ...)
1949 CODE: 1994 CODE:
1950 if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER"); 1995 if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");
1951 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i)); 1996 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1997 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1952 RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av)); 1998 RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av));
1953 OUTPUT: RETVAL 1999 OUTPUT: RETVAL
1954 2000
1955SV *registry (player *pl) 2001SV *registry (player *pl)
1956 CODE: 2002 CODE:
2083 OUTPUT: RETVAL 2129 OUTPUT: RETVAL
2084 2130
2085 2131
2086MODULE = cf PACKAGE = cf::map PREFIX = cf_map_ 2132MODULE = cf PACKAGE = cf::map PREFIX = cf_map_
2087 2133
2134mapstruct *first ()
2135 PROTOTYPE:
2136 CODE:
2137 RETVAL = first_map;
2138 OUTPUT: RETVAL
2139
2140mapstruct *next (mapstruct *map)
2141 PROTOTYPE:
2142 CODE:
2143 RETVAL = map->next;
2144 OUTPUT: RETVAL
2145
2088int invoke (mapstruct *map, int event, ...) 2146int invoke (mapstruct *map, int event, ...)
2089 CODE: 2147 CODE:
2090 if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP"); 2148 if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP");
2091 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i)); 2149 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
2150 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
2092 RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av)); 2151 RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av));
2093 OUTPUT: 2152 OUTPUT: RETVAL
2094 RETVAL
2095 2153
2096SV *registry (mapstruct *map) 2154SV *registry (mapstruct *map)
2097 CODE: 2155 CODE:
2098 RETVAL = registry_of (map); 2156 RETVAL = registry_of (map);
2099 OUTPUT: 2157 OUTPUT:
2119 2177
2120mapstruct *new (int width, int height) 2178mapstruct *new (int width, int height)
2121 PROTOTYPE: 2179 PROTOTYPE:
2122 CODE: 2180 CODE:
2123{ 2181{
2124 int unused_type; 2182 RETVAL = get_empty_map (width, height);
2125 RETVAL = (mapstruct*) map_get_map (&unused_type, 0, width, height);
2126} 2183}
2127 OUTPUT: 2184 OUTPUT:
2128 RETVAL 2185 RETVAL
2129 2186
2130void delete_map (mapstruct *map) 2187void delete_map (mapstruct *map)
2145 XSRETURN_UNDEF; 2202 XSRETURN_UNDEF;
2146 RETVAL = map->tile_path [dir]; 2203 RETVAL = map->tile_path [dir];
2147 OUTPUT: 2204 OUTPUT:
2148 RETVAL 2205 RETVAL
2149 2206
2150mapstruct *cf_map_get_map (char *name) 2207mapstruct *ready_map_name (char *name, int flags = 0)
2151 PROTOTYPE: $ 2208 PROTOTYPE: $;$
2152 ALIAS: map = 0 2209 ALIAS:
2210 find = 0
2211 get_map = 1
2153 2212
2154mapstruct *has_been_loaded (char *name) 2213mapstruct *has_been_loaded (char *name)
2155 PROTOTYPE: $ 2214 PROTOTYPE: $
2156
2157mapstruct *cf_map_get_first ()
2158 PROTOTYPE:
2159 ALIAS: first = 0
2160 2215
2161# whoever "designed" the plug-in api should have wasted 2216# whoever "designed" the plug-in api should have wasted
2162# his/her time with staying away from the project - would have 2217# his/her time with staying away from the project - would have
2163# saved others a lot of time, without doubt. 2218# saved others a lot of time, without doubt.
2164void set_path (mapstruct *where, char *path) 2219void set_path (mapstruct *where, char *path)
2178 RETVAL 2233 RETVAL
2179 2234
2180void set_unique (mapstruct *map, bool unique) 2235void set_unique (mapstruct *map, bool unique)
2181 CODE: 2236 CODE:
2182 map->unique = unique; 2237 map->unique = unique;
2238
2239void
2240trigger (mapstruct *map, long connection, bool state = true)
2241 CODE:
2242 activate_connection (map, connection, state);
2243
2244void
2245get_connection (mapstruct *map, long connection)
2246 PPCODE:
2247 oblinkpt *obp = get_connection_links (map, connection);
2248 if (obp)
2249 for (objectlink *ol = obp->link; ol; ol = ol->next)
2250 XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, ol->ob)));
2183 2251
2184object *cf_map_insert_object_there (mapstruct *where, object *op, object *originator, int flags) 2252object *cf_map_insert_object_there (mapstruct *where, object *op, object *originator, int flags)
2185 2253
2186object *cf_map_insert_object (mapstruct *where, object* op, int x, int y) 2254object *cf_map_insert_object (mapstruct *where, object* op, int x, int y)
2187 2255
2248 case 6: RETVAL = newSVuv ( GET_MAP_MOVE_ON (obj, x, y)); break; 2316 case 6: RETVAL = newSVuv ( GET_MAP_MOVE_ON (obj, x, y)); break;
2249 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; 2317 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;
2250 } 2318 }
2251 OUTPUT: 2319 OUTPUT:
2252 RETVAL 2320 RETVAL
2253
2254# "deserialise" perl map data into the map # TODO# compatibility cruft, remove
2255void
2256_set_obs (mapstruct *map, SV *sv)
2257 CODE:
2258{
2259 object *o;
2260 AV *av;
2261 int x, y;
2262 AV *obs = (AV *)SvRV (sv);
2263
2264 for (y = 0; y < MAP_HEIGHT (map); y++)
2265 for (x = 0; x < MAP_WIDTH (map); x++)
2266 {
2267 sv = *av_fetch (obs, x + y * MAP_HEIGHT (map), 1);
2268
2269 if (!SvROK (sv))
2270 continue;
2271
2272 av = (AV *)SvRV (sv);
2273
2274 for (o = GET_MAP_OB (map, x, y); o; o = o->above)
2275 {
2276 sv = av_shift (av);
2277
2278 if (SvROK (sv))
2279 {
2280 sv_magic ((SV *)SvRV (sv), 0, PERL_MAGIC_ext, (char *)o, 0);
2281 SVptr_cache_set (o, sv);
2282 }
2283 }
2284 }
2285}
2286 2321
2287 2322
2288MODULE = cf PACKAGE = cf::arch 2323MODULE = cf PACKAGE = cf::arch
2289 2324
2290archetype *first() 2325archetype *first()

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines