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.19 by root, Mon Aug 28 07:54:11 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{
313 return newRV_inc ((SV *)ext->cb); 312 return newRV_inc ((SV *)ext->cb);
314} 313}
315 314
316void attachable_base::clear () 315void attachable_base::clear ()
317{ 316{
318 //if (self) fprintf (stderr, "free_ob_self %p %s (%p,%p)\n", this, ((object *)this)->name, self, cb);//D 317 if (self)
318 {
319 if (cb)
320 if (SvROK (*av_fetch (cb, EVENT_OBJECT_DESTROY, 1)))
321 INVOKE_OBJECT (DESTROY, static_cast<object *>(this));
322 else if (SvROK (*av_fetch (cb, EVENT_MAP_DESTROY, 1)))
323 INVOKE_MAP (DESTROY, static_cast<mapstruct *>(this));
319 324
325 // disconnect Perl from C, to avoid crashes
326 sv_unmagic (SvRV ((SV *)self), PERL_MAGIC_ext);
327
328 // clear the perl hash, might or might not be a good idea
329 hv_clear ((HV *)SvRV ((SV *)self));
330
320 if (self) SvREFCNT_dec (self); 331 SvREFCNT_dec (self);
332 self = 0;
333 }
334
335 if (cb)
336 {
321 if (cb) SvREFCNT_dec (cb); 337 SvREFCNT_dec (cb);
338 cb = 0;
339 }
322 340
341 if (attach)
342 {
323 if (attach) free_string (attach); 343 free_string (attach);
324
325 self = 0;
326 cb = 0;
327 attach = 0; 344 attach = 0;
345 }
328} 346}
329 347
330void attachable_base::optimise () 348void attachable_base::optimise ()
331{ 349{
332 if (!self) 350 if (!self)
341 SvREFCNT_dec ((SV *)self); 359 SvREFCNT_dec ((SV *)self);
342 self = 0; 360 self = 0;
343 } 361 }
344} 362}
345 363
346void 364void attachable_base::instantiate (data_type type, void *obj)
347object::instantiate_ ()
348{ 365{
349 dSP; 366 dSP;
350 ENTER; 367 ENTER;
351 SAVETMPS; 368 SAVETMPS;
352 PUSHMARK (SP); 369 PUSHMARK (SP);
353 EXTEND (SP, 2); 370 EXTEND (SP, 2);
354 PUSHs (sv_2mortal (newSVdt (DT_OBJECT, static_cast<object *>(this)))); 371 PUSHs (sv_2mortal (newSVdt (type, obj)));
355 PUSHs (sv_2mortal (newSVpv (attach, 0))); 372 PUSHs (sv_2mortal (newSVpv (attach, 0)));
373
374 free_string (attach);
375 attach = 0;
376
356 PUTBACK; 377 PUTBACK;
357 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL); 378 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL);
358 FREETMPS; 379 FREETMPS;
359 LEAVE; 380 LEAVE;
360 381
361 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 }
362} 387}
363 388
364///////////////////////////////////////////////////////////////////////////// 389/////////////////////////////////////////////////////////////////////////////
365 390
366void reattach (data_type type, void *obj) 391void reattach (data_type type, void *obj)
367{ 392{
393 //TODO only do this when the object has _attachment's
394
368 dSP; 395 dSP;
369 ENTER; 396 ENTER;
370 SAVETMPS; 397 SAVETMPS;
371 PUSHMARK (SP); 398 PUSHMARK (SP);
372 XPUSHs (sv_2mortal (newSVdt (type, obj))); 399 XPUSHs (sv_2mortal (newSVdt (type, obj)));
391 if (obj->self) 418 if (obj->self)
392 reattach (subclass::get_dt (), (subclass *)obj); 419 reattach (subclass::get_dt (), (subclass *)obj);
393} 420}
394 421
395object_freezer::object_freezer (const char *filename) 422object_freezer::object_freezer (const char *filename)
396: filename (filename)
397{ 423{
424 this->filename = (SV *)newSVpv (filename, 0);
425
426 char filename2 [4096];
427 snprintf (filename2, 4096, "%s~", filename);
428
398 av = (AV *)newAV (); 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
399} 433}
400 434
401object_freezer::~object_freezer () 435object_freezer::~object_freezer ()
402{ 436{
403 dSP; 437 dSP;
404 ENTER; 438 ENTER;
405 SAVETMPS; 439 SAVETMPS;
406 PUSHMARK (SP); 440 PUSHMARK (SP);
407 XPUSHs (sv_2mortal (newSVpv (filename, 0))); 441 XPUSHs (sv_2mortal ((SV *)filename));
442 XPUSHs (sv_2mortal (newRV_noinc (text)));
408 XPUSHs (sv_2mortal (newRV_noinc ((SV *)av))); 443 XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
409 PUTBACK; 444 PUTBACK;
410 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL); 445 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL);
411 FREETMPS; 446 FREETMPS;
412 LEAVE; 447 LEAVE;
413} 448}
414 449
415void object_freezer::put (FILE *fp, attachable_base *ext) 450void object_freezer::put (attachable_base *ext)
416{ 451{
417 ext->optimise (); 452 ext->optimise ();
418 453
419 if (ext->self) 454 if (ext->self)
420 { 455 {
421 int idx = AvFILLp ((AV *)av) + 1; 456 int idx = AvFILLp ((AV *)av) + 1;
422 av_store ((AV *)av, idx, SvREFCNT_inc ((SV *)ext->self)); 457 av_store (av, idx, SvREFCNT_inc (ext->self));
423 fprintf (fp, "oid %d\n", idx); 458
459 sv_catpvf (text, "oid %d\n", idx);
424 } 460 }
425} 461}
426 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
427object_thawer::object_thawer (const char *filename) 477object_thawer::object_thawer (const char *filename)
428{ 478{
429 av = 0; 479 av = 0;
480 fp = 0;
430 481
431 if (!filename) 482 if (!filename)
432 return; 483 return;
433 484
434 dSP; 485 fp = fopen (filename, "r");
435 ENTER; 486 if (!fp)
436 SAVETMPS;
437 PUSHMARK (SP);
438 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
439 PUTBACK;
440
441 if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL))
442 { 487 {
443 SPAGAIN; 488 LOG (llevError, "object_thawer: unable to open '%s': %s.\n", filename, strerror (errno));
444 SV *sv = POPs; 489 return;
445 if (SvROK (sv))
446 av = SvREFCNT_inc (SvRV (sv));
447 } 490 }
448 491
492 if (perl_booted)
493 {
494 dSP;
495 ENTER;
496 SAVETMPS;
497 PUSHMARK (SP);
498 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
499 PUTBACK;
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
449 FREETMPS; 509 FREETMPS;
450 LEAVE; 510 LEAVE;
511 }
451} 512}
452 513
453void 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)
454{ 515{
455 if (!av || oid < 0) // this is actually an error of sorts 516 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); 526 printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid);
466 return; 527 return;
467 } 528 }
468 529
469 ext->self = *svp; *svp = &PL_sv_undef; 530 ext->self = *svp; *svp = &PL_sv_undef;
470 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);
471 532
472 reattach (type, obj); 533 reattach (type, obj);
473} 534}
474 535
475object_thawer::~object_thawer () 536object_thawer::~object_thawer ()
476{ 537{
477 if (av) 538 if (fp) fclose (fp);
478 SvREFCNT_dec ((SV *)av); 539 if (av) SvREFCNT_dec ((AV *)av);
479} 540}
480 541
481///////////////////////////////////////////////////////////////////////////// 542/////////////////////////////////////////////////////////////////////////////
482 543
483extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) 544extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
582} 643}
583 644
584void 645void
585cfperl_init () 646cfperl_init ()
586{ 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
587 char *argv[] = { 654 char *argv[] = {
588 "", 655 "",
589 "-e" 656 "-e"
590 "BEGIN {"
591 " cf->bootstrap;" 657 "cf->bootstrap;"
592 " unshift @INC, cf::datadir ();" 658 "unshift @INC, cf::datadir ();"
593 "}"
594 ""
595 "use cf;"
596 }; 659 };
597
598 perl = perl_alloc ();
599 perl_construct (perl);
600
601 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
602 660
603 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))
604 { 662 {
605 printf ("unable to initialize perl-interpreter, aborting.\n"); 663 printf ("unable to initialize perl-interpreter, aborting.\n");
606
607 exit (EXIT_FAILURE); 664 exit (EXIT_FAILURE);
608 //perl_destruct (perl);
609 //perl_free (perl);
610 //perl = 0;
611 //return;
612 } 665 }
613 666
614 obj_cache = newHV (); 667 obj_cache = newHV ();
668}
669
670void cfperl_boot ()
671{
672 perl_booted = true;
673
674 eval_pv ("require cf", 1);
615} 675}
616 676
617void cfperl_main () 677void cfperl_main ()
618{ 678{
619 dSP; 679 dSP;
691 dt = (data_type) va_arg (ap, int); 751 dt = (data_type) va_arg (ap, int);
692 assert (("first argument must be of type object", dt == DT_OBJECT)); 752 assert (("first argument must be of type object", dt == DT_OBJECT));
693 op = va_arg (ap, object *); 753 op = va_arg (ap, object *);
694 754
695 if (op->cb) 755 if (op->cb)
696 gather_callbacks (callbacks, (AV *)op->cb, event); 756 gather_callbacks (callbacks, op->cb, event);
697 757
698 if (op->type) 758 if (op->type)
699 { 759 {
700 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))
701 { 761 {
722 dt = (data_type) va_arg (ap, int); 782 dt = (data_type) va_arg (ap, int);
723 assert (("first argument must be of type player", dt == DT_PLAYER)); 783 assert (("first argument must be of type player", dt == DT_PLAYER));
724 pl = va_arg (ap, player *); 784 pl = va_arg (ap, player *);
725 785
726 if (pl->cb) 786 if (pl->cb)
727 gather_callbacks (callbacks, (AV *)pl->cb, event); 787 gather_callbacks (callbacks, pl->cb, event);
728 788
729 gather_callbacks (callbacks, cb_player, event); 789 gather_callbacks (callbacks, cb_player, event);
730 break; 790 break;
731 791
732 case KLASS_MAP: 792 case KLASS_MAP:
733 dt = (data_type) va_arg (ap, int); 793 dt = (data_type) va_arg (ap, int);
734 assert (("first argument must be of type object", dt == DT_MAP)); 794 assert (("first argument must be of type object", dt == DT_MAP));
735 map = va_arg (ap, mapstruct *); 795 map = va_arg (ap, mapstruct *);
736 796
737 if (map->cb) 797 if (map->cb)
738 gather_callbacks (callbacks, (AV *)map->cb, event); 798 gather_callbacks (callbacks, map->cb, event);
739 799
740 gather_callbacks (callbacks, cb_map, event); 800 gather_callbacks (callbacks, cb_map, event);
741 break; 801 break;
742 802
743 default: 803 default:
1363 prop (CFAPI_INT, MAP_PROP_WINDDIR) 1423 prop (CFAPI_INT, MAP_PROP_WINDDIR)
1364 prop (CFAPI_INT, MAP_PROP_SKY) 1424 prop (CFAPI_INT, MAP_PROP_SKY)
1365 prop (CFAPI_INT, MAP_PROP_WPARTX) 1425 prop (CFAPI_INT, MAP_PROP_WPARTX)
1366 prop (CFAPI_INT, MAP_PROP_WPARTY) 1426 prop (CFAPI_INT, MAP_PROP_WPARTY)
1367 prop (CFAPI_STRING, MAP_PROP_MESSAGE) 1427 prop (CFAPI_STRING, MAP_PROP_MESSAGE)
1368 prop (CFAPI_PMAP, MAP_PROP_NEXT)
1369 prop (CFAPI_PREGION, MAP_PROP_REGION) 1428 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) 1429 prop (CFAPI_POBJECT, OBJECT_PROP_NEXT_ACTIVE_OB)
1373 prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB) 1430 prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB)
1374 prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY) 1431 prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY)
1375 prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT) 1432 prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT)
1376 prop (CFAPI_POBJECT, OBJECT_PROP_HEAD)
1377 prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER) 1433 prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER)
1378 prop (CFAPI_PMAP, OBJECT_PROP_MAP) 1434 prop (CFAPI_PMAP, OBJECT_PROP_MAP)
1379 prop (CFAPI_INT, OBJECT_PROP_COUNT) 1435 prop (CFAPI_INT, OBJECT_PROP_COUNT)
1380 prop (CFAPI_INT, OBJECT_PROP_REFCOUNT) 1436 prop (CFAPI_INT, OBJECT_PROP_REFCOUNT)
1381 prop (CFAPI_STRING, OBJECT_PROP_NAME) 1437 prop (CFAPI_STRING, OBJECT_PROP_NAME)
1561const char *cost_string_from_value(uint64 cost, int approx = 0) 1617const char *cost_string_from_value(uint64 cost, int approx = 0)
1562 1618
1563int invoke (int event, ...) 1619int invoke (int event, ...)
1564 CODE: 1620 CODE:
1565 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");
1566 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)));
1567 RETVAL = INVOKE_((event_type)event, ARG_AV (av)); 1624 RETVAL = INVOKE_((event_type)event, ARG_AV (av));
1568 OUTPUT: RETVAL 1625 OUTPUT: RETVAL
1569 1626
1570int 1627int
1571exp_to_level (val64 exp) 1628exp_to_level (val64 exp)
1604 RETVAL = newSVpv (resist_plus[atnr], 0); 1661 RETVAL = newSVpv (resist_plus[atnr], 0);
1605 else 1662 else
1606 XSRETURN_UNDEF; 1663 XSRETURN_UNDEF;
1607 OUTPUT: RETVAL 1664 OUTPUT: RETVAL
1608 1665
1666int
1667_valid (SV *obj)
1668 CODE:
1669 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
1670 OUTPUT:
1671 RETVAL
1672
1609MODULE = cf PACKAGE = cf::object PREFIX = cf_object_ 1673MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
1610 1674
1611int invoke (object *op, int event, ...) 1675int invoke (object *op, int event, ...)
1612 CODE: 1676 CODE:
1613 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");
1614 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)));
1615 RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av)); 1680 RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av));
1616 OUTPUT: RETVAL 1681 OUTPUT: RETVAL
1617 1682
1618SV *registry (object *op) 1683SV *registry (object *op)
1619 CODE: 1684 CODE:
1620 RETVAL = registry_of (op); 1685 RETVAL = registry_of (op);
1621 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:
1622 RETVAL 1704 RETVAL
1623 1705
1624SV * 1706SV *
1625get_property (object *obj, int type, int idx) 1707get_property (object *obj, int type, int idx)
1626 CODE: 1708 CODE:
1706 1788
1707int need_identify (const object *obj); 1789int need_identify (const object *obj);
1708 1790
1709int apply_shop_mat (object *shop_mat, object *op); 1791int apply_shop_mat (object *shop_mat, object *op);
1710 1792
1711void 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
1712 1798
1713void cf_object_apply (object *op, object *author, int flags = 0) 1799void cf_object_apply (object *op, object *author, int flags = 0)
1714 1800
1715void cf_object_apply_below (object *op) 1801void cf_object_apply_below (object *op)
1716 1802
1757int cf_object_out_of_map (object *op, int x, int y) 1843int cf_object_out_of_map (object *op, int x, int y)
1758 1844
1759void cf_object_drop (object *op, object *author) 1845void cf_object_drop (object *op, object *author)
1760 1846
1761void cf_object_take (object *op, object *author) 1847void cf_object_take (object *op, object *author)
1762
1763void cf_object_say (object *op, char *msg)
1764
1765void cf_object_speak (object *op, char *msg)
1766 1848
1767object *cf_object_insert_object (object *op, object *container) 1849object *cf_object_insert_object (object *op, object *container)
1768 1850
1769const char *cf_object_get_msg (object *ob) 1851const char *cf_object_get_msg (object *ob)
1770 ALIAS: msg = 0 1852 ALIAS: msg = 0
1909MODULE = cf PACKAGE = cf::player PREFIX = cf_player_ 1991MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
1910 1992
1911int invoke (player *pl, int event, ...) 1993int invoke (player *pl, int event, ...)
1912 CODE: 1994 CODE:
1913 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");
1914 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)));
1915 RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av)); 1998 RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av));
1916 OUTPUT: RETVAL 1999 OUTPUT: RETVAL
1917 2000
1918SV *registry (player *pl) 2001SV *registry (player *pl)
1919 CODE: 2002 CODE:
2046 OUTPUT: RETVAL 2129 OUTPUT: RETVAL
2047 2130
2048 2131
2049MODULE = cf PACKAGE = cf::map PREFIX = cf_map_ 2132MODULE = cf PACKAGE = cf::map PREFIX = cf_map_
2050 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
2051int invoke (mapstruct *map, int event, ...) 2146int invoke (mapstruct *map, int event, ...)
2052 CODE: 2147 CODE:
2053 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");
2054 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)));
2055 RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av)); 2151 RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av));
2056 OUTPUT: 2152 OUTPUT: RETVAL
2057 RETVAL
2058 2153
2059SV *registry (mapstruct *map) 2154SV *registry (mapstruct *map)
2060 CODE: 2155 CODE:
2061 RETVAL = registry_of (map); 2156 RETVAL = registry_of (map);
2062 OUTPUT: 2157 OUTPUT:
2082 2177
2083mapstruct *new (int width, int height) 2178mapstruct *new (int width, int height)
2084 PROTOTYPE: 2179 PROTOTYPE:
2085 CODE: 2180 CODE:
2086{ 2181{
2087 int unused_type; 2182 RETVAL = get_empty_map (width, height);
2088 RETVAL = (mapstruct*) map_get_map (&unused_type, 0, width, height);
2089} 2183}
2090 OUTPUT: 2184 OUTPUT:
2091 RETVAL 2185 RETVAL
2092 2186
2093void delete_map (mapstruct *map) 2187void delete_map (mapstruct *map)
2108 XSRETURN_UNDEF; 2202 XSRETURN_UNDEF;
2109 RETVAL = map->tile_path [dir]; 2203 RETVAL = map->tile_path [dir];
2110 OUTPUT: 2204 OUTPUT:
2111 RETVAL 2205 RETVAL
2112 2206
2113mapstruct *cf_map_get_map (char *name) 2207mapstruct *ready_map_name (char *name, int flags = 0)
2114 PROTOTYPE: $ 2208 PROTOTYPE: $;$
2115 ALIAS: map = 0 2209 ALIAS:
2210 find = 0
2211 get_map = 1
2116 2212
2117mapstruct *has_been_loaded (char *name) 2213mapstruct *has_been_loaded (char *name)
2118 PROTOTYPE: $ 2214 PROTOTYPE: $
2119
2120mapstruct *cf_map_get_first ()
2121 PROTOTYPE:
2122 ALIAS: first = 0
2123 2215
2124# whoever "designed" the plug-in api should have wasted 2216# whoever "designed" the plug-in api should have wasted
2125# his/her time with staying away from the project - would have 2217# his/her time with staying away from the project - would have
2126# saved others a lot of time, without doubt. 2218# saved others a lot of time, without doubt.
2127void set_path (mapstruct *where, char *path) 2219void set_path (mapstruct *where, char *path)
2141 RETVAL 2233 RETVAL
2142 2234
2143void set_unique (mapstruct *map, bool unique) 2235void set_unique (mapstruct *map, bool unique)
2144 CODE: 2236 CODE:
2145 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)));
2146 2251
2147object *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)
2148 2253
2149object *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)
2150 2255
2211 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;
2212 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;
2213 } 2318 }
2214 OUTPUT: 2319 OUTPUT:
2215 RETVAL 2320 RETVAL
2216
2217# "deserialise" perl map data into the map # TODO# compatibility cruft, remove
2218void
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 2321
2250 2322
2251MODULE = cf PACKAGE = cf::arch 2323MODULE = cf PACKAGE = cf::arch
2252 2324
2253archetype *first() 2325archetype *first()

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines