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.18 by root, Mon Aug 28 07:07:42 2006 UTC vs.
Revision 1.37 by root, Thu Aug 31 17:54:15 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
35#ifndef __CEXTRACT__
36#include <plugin.h>
37#endif
38
39#undef MODULEAPI
40#ifdef WIN32
41#else
42#define MODULEAPI
43#endif
44 28
45#include <plugin_common.h> 29#include <plugin_common.h>
46#include <sounds.h> 30#include <sounds.h>
47#include <cstdarg> 31#include <cstdarg>
48#include <sproto.h> 32#include <sproto.h>
49 33
50#include "cfperl.h" 34#include "cfperl.h"
51#include "shstr.h" 35#include "shstr.h"
52 36
37#include <EXTERN.h>
38#include <perl.h>
39#include <XSUB.h>
40
53#include "perlxsi.c" 41#include "perlxsi.c"
54 42
55extern sint64 *levels; // the experience table 43extern sint64 *levels; // the experience table
56 44
57typedef object object_ornull; 45typedef object object_ornull;
59 47
60typedef double val64; 48typedef double val64;
61#define newSVval64 newSVnv 49#define newSVval64 newSVnv
62#define SvVAL64 SvNV 50#define SvVAL64 SvNV
63 51
64static f_plug_api gethook; 52static f_plug_api gethook = cfapi_get_hooks;
65static f_plug_api systemDirectory; 53static f_plug_api object_set_property = cfapi_object_set_property;
66static f_plug_api object_set_property; 54static f_plug_api object_insert = cfapi_object_insert;
67static f_plug_api map_get_map; 55
68static f_plug_api object_insert; 56static bool perl_booted;
69 57
70/* this is a stupid way to do things, and awkward to use for plug-in authors */ 58/* this is a stupid way to do things, and awkward to use for plug-in authors */
71typedef struct 59typedef struct
72{ 60{
73 object* who; 61 object* who;
118 return &PL_sv_undef; 106 return &PL_sv_undef;
119 107
120 if (!obj->self) 108 if (!obj->self)
121 obj->self = newSVptr (obj, klass); 109 obj->self = newSVptr (obj, klass);
122 110
123 return newSVsv (static_cast<SV *>(obj->self)); 111 return newSVsv (obj->self);
124} 112}
125 113
126static void 114static void
127SVptr_cache_set (void *ptr, SV *sv) 115SVptr_cache_set (void *ptr, SV *sv)
128{ 116{
314 return newRV_inc ((SV *)ext->cb); 302 return newRV_inc ((SV *)ext->cb);
315} 303}
316 304
317void attachable_base::clear () 305void attachable_base::clear ()
318{ 306{
319 //if (self) fprintf (stderr, "free_ob_self %p %s (%p,%p)\n", this, ((object *)this)->name, self, cb);//D 307 if (self)
308 {
309 if (cb)
310 if (SvROK (*av_fetch (cb, EVENT_OBJECT_DESTROY, 1)))
311 INVOKE_OBJECT (DESTROY, static_cast<object *>(this));
312 else if (SvROK (*av_fetch (cb, EVENT_MAP_DESTROY, 1)))
313 INVOKE_MAP (DESTROY, static_cast<mapstruct *>(this));
320 314
315 // disconnect Perl from C, to avoid crashes
316 sv_unmagic (SvRV ((SV *)self), PERL_MAGIC_ext);
317
318 // clear the perl hash, might or might not be a good idea
319 hv_clear ((HV *)SvRV ((SV *)self));
320
321 if (self) SvREFCNT_dec (self); 321 SvREFCNT_dec (self);
322 self = 0;
323 }
324
325 if (cb)
326 {
322 if (cb) SvREFCNT_dec (cb); 327 SvREFCNT_dec (cb);
328 cb = 0;
329 }
323 330
331 if (attach)
332 {
324 if (attach) free_string (attach); 333 free_string (attach);
325
326 self = 0;
327 cb = 0;
328 attach = 0; 334 attach = 0;
335 }
329} 336}
330 337
331void attachable_base::optimise () 338void attachable_base::optimise ()
332{ 339{
333 if (!self) 340 if (!self)
342 SvREFCNT_dec ((SV *)self); 349 SvREFCNT_dec ((SV *)self);
343 self = 0; 350 self = 0;
344 } 351 }
345} 352}
346 353
347void 354void attachable_base::instantiate (data_type type, void *obj)
348object::instantiate_ ()
349{ 355{
350 dSP; 356 dSP;
351 ENTER; 357 ENTER;
352 SAVETMPS; 358 SAVETMPS;
353 PUSHMARK (SP); 359 PUSHMARK (SP);
354 EXTEND (SP, 2); 360 EXTEND (SP, 2);
355 PUSHs (sv_2mortal (newSVdt (DT_OBJECT, static_cast<object *>(this)))); 361 PUSHs (sv_2mortal (newSVdt (type, obj)));
356 PUSHs (sv_2mortal (newSVpv (attach, 0))); 362 PUSHs (sv_2mortal (newSVpv (attach, 0)));
363
364 free_string (attach);
365 attach = 0;
366
357 PUTBACK; 367 PUTBACK;
358 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL); 368 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL);
359 FREETMPS; 369 FREETMPS;
360 LEAVE; 370 LEAVE;
361 371
362 INVOKE_OBJECT (INSTANTIATE, this); 372 switch (type)
373 {
374 case DT_OBJECT: INVOKE_OBJECT (INSTANTIATE, obj); break;
375 case DT_MAP: INVOKE_MAP (INSTANTIATE, obj); break;
376 }
363} 377}
364 378
365///////////////////////////////////////////////////////////////////////////// 379/////////////////////////////////////////////////////////////////////////////
366 380
367void reattach (data_type type, void *obj) 381void reattach (data_type type, void *obj)
368{ 382{
383 //TODO only do this when the object has _attachment's
384
369 dSP; 385 dSP;
370 ENTER; 386 ENTER;
371 SAVETMPS; 387 SAVETMPS;
372 PUSHMARK (SP); 388 PUSHMARK (SP);
373 XPUSHs (sv_2mortal (newSVdt (type, obj))); 389 XPUSHs (sv_2mortal (newSVdt (type, obj)));
388void reattach (attachable<subclass> *obj) 404void reattach (attachable<subclass> *obj)
389{ 405{
390 obj->optimise (); 406 obj->optimise ();
391 407
392 if (obj->self) 408 if (obj->self)
393 reattach (subclass::get_dt (), (subclass *)obj); 409 reattach ((data_type) cftype<subclass>::dt, (subclass *)obj);
394} 410}
395 411
412#include "kw_hash.h"
413
396object_freezer::object_freezer (const char *filename) 414object_freezer::object_freezer ()
397: filename (filename) 415: dynbuf (128 * 1024, 64 * 1024)
398{ 416{
399 av = (AV *)newAV (); 417 av = newAV ();
400} 418}
401 419
402object_freezer::~object_freezer () 420object_freezer::~object_freezer ()
421{
422 SvREFCNT_dec (av);
423}
424
425void object_freezer::put (attachable_base *ext)
426{
427 ext->optimise ();
428
429 if (ext->self)
430 {
431 int idx = AvFILLp ((AV *)av) + 1;
432 av_store (av, idx, SvREFCNT_inc (ext->self));
433
434 add ((void *)"oid ", 4);
435 add ((sint32)idx);
436 add ('\n');
437 }
438}
439
440void object_freezer::put (const char *k, const char *v)
441{
442 add (k);
443
444 //if (v)
445 add (' '); //TODO//cf compatibility always add space
446 if (v)
447 add (v);
448
449 add ('\n');
450}
451
452void object_freezer::put (const char *k, int v)
453{
454 add (k);
455 add (' ');
456 add (sint32 (v));
457 add ('\n');
458}
459
460void object_freezer::put (keyword k, const char *v)
461{
462 int klen = keyword_len [k];
463 int vlen = v ? strlen (v) : 0;
464
465 char *p = (char *)alloc (klen + 1 + vlen + 1);
466
467 memcpy (p, keyword_str [k], klen); p += klen;
468 *p++ = ' '; //TODO//cf compatibility always add space
469 memcpy (p, v, vlen); p += vlen;
470 *p = '\n';
471}
472
473void object_freezer::put (keyword k, double v)
474{
475 char buf [128];
476
477 snprintf (buf, 128, "%.7g", v);
478
479 put (k, (const char *)buf);
480}
481
482void object_freezer::put_(keyword k, sint64 v)
483{
484 add (keyword_str [k], keyword_len [k]);
485 add (' ');
486 add (v);
487 add ('\n');
488}
489
490void object_freezer::put_(keyword k, sint32 v)
491{
492 add (keyword_str [k], keyword_len [k]);
493 add (' ');
494 add (v);
495 add ('\n');
496}
497
498void object_freezer::put (keyword kbeg, keyword kend, const char *v)
499{
500 add (keyword_str [kbeg], keyword_len [kbeg]); add ('\n');
501
502 if (v)
503 {
504 add (v);
505 add ('\n');
506 }
507
508 add (keyword_str [kend], keyword_len [kend]); add ('\n');
509}
510
511bool object_freezer::save (const char *filename)
403{ 512{
404 dSP; 513 dSP;
405 ENTER; 514 ENTER;
406 SAVETMPS; 515 SAVETMPS;
407 PUSHMARK (SP); 516 PUSHMARK (SP);
517 EXTEND (SP, 3);
408 XPUSHs (sv_2mortal (newSVpv (filename, 0))); 518 PUSHs (sv_2mortal (newSVpv (filename, 0)));
519 PUSHs (sv_2mortal (newRV_noinc (newSVpvn ((char *)linearise (), size ()))));
409 XPUSHs (sv_2mortal (newRV_noinc ((SV *)av))); 520 PUSHs (sv_2mortal (newRV_inc ((SV *)av)));
410 PUTBACK; 521 PUTBACK;
411 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL); 522 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL);
412 FREETMPS; 523 FREETMPS;
413 LEAVE; 524 LEAVE;
414} 525}
415 526
416void object_freezer::put (FILE *fp, attachable_base *ext) 527int fprintf (object_freezer &freezer, const char *format, ...)
417{ 528{
418 ext->optimise (); 529 va_list ap;
419 530
420 if (ext->self) 531 va_start (ap, format);
421 { 532
422 int idx = AvFILLp ((AV *)av) + 1; 533 int len = vsnprintf ((char *)freezer.force (1024), 1024, format, ap);
423 av_store ((AV *)av, idx, SvREFCNT_inc ((SV *)ext->self)); 534
424 fprintf (fp, "oid %d\n", idx); 535 if (len >= 0)
425 } 536 freezer.alloc (len);
537
538 va_end (ap);
539}
540
541int fputs (const char *s, object_freezer &freezer)
542{
543 freezer.add (s);
426} 544}
427 545
428object_thawer::object_thawer (const char *filename) 546object_thawer::object_thawer (const char *filename)
429{ 547{
430 av = 0; 548 av = 0;
549 fp = 0;
431 550
432 if (!filename) 551 if (!filename)
433 return; 552 return;
434 553
435 dSP; 554 fp = fopen (filename, "r");
436 ENTER; 555 if (!fp)
437 SAVETMPS;
438 PUSHMARK (SP);
439 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
440 PUTBACK;
441
442 if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL))
443 { 556 {
444 SPAGAIN; 557 LOG (llevError, "object_thawer: unable to open '%s': %s.\n", filename, strerror (errno));
445 SV *sv = POPs; 558 return;
446 if (SvROK (sv))
447 av = SvREFCNT_inc (SvRV (sv));
448 } 559 }
449 560
561 if (perl_booted)
562 {
563 dSP;
564 ENTER;
565 SAVETMPS;
566 PUSHMARK (SP);
567 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
568 PUTBACK;
569
570 if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL))
571 {
572 SPAGAIN;
573 SV *sv = POPs;
574 if (SvROK (sv))
575 av = (AV *)SvREFCNT_inc (SvRV (sv));
576 }
577
450 FREETMPS; 578 FREETMPS;
451 LEAVE; 579 LEAVE;
580 }
452} 581}
453 582
454void object_thawer::get (data_type type, void *obj, attachable_base *ext, int oid) 583void object_thawer::get (data_type type, void *obj, attachable_base *ext, int oid)
455{ 584{
456 if (!av || oid < 0) // this is actually an error of sorts 585 if (!av || oid < 0) // this is actually an error of sorts
466 printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid); 595 printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid);
467 return; 596 return;
468 } 597 }
469 598
470 ext->self = *svp; *svp = &PL_sv_undef; 599 ext->self = *svp; *svp = &PL_sv_undef;
471 sv_magic (SvRV ((SV *)ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0); 600 sv_magic (SvRV (ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0);
472 601
473 reattach (type, obj); 602 reattach (type, obj);
474} 603}
475 604
476object_thawer::~object_thawer () 605object_thawer::~object_thawer ()
477{ 606{
478 if (av) 607 if (fp) fclose (fp);
479 SvREFCNT_dec ((SV *)av); 608 if (av) SvREFCNT_dec ((AV *)av);
480} 609}
481 610
611token object_thawer::get_token ()
612{
613#if 0
614 for (;;)
615 {
616 if (!fgets (line, sizeof (line), fp))
617 return token (KW_eof);
618
619 unsigned char *p = (unsigned char *)line;
620
621 while (*p > ' ')
622 p++;
623
624 int len = p - (unsigned char *)line;
625
626 while ((*p - 1) < ' ')
627 p++;
628
629 if (*p)
630 {
631 char *v = p;
632
633 while (*p && *p != '\n')
634 p++;
635
636 *p = 0;
637
638 return token (k, v);
639 }
640 else
641 return token (k);
642 }
643#endif
644}
645
482///////////////////////////////////////////////////////////////////////////// 646/////////////////////////////////////////////////////////////////////////////
483 647
484extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) 648extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
485{ 649{
486 gethook = gethooksptr;
487
488 return 0; 650 return 0;
489} 651}
490 652
491static CommArray_s rtn_cmd; 653static CommArray_s rtn_cmd;
492 654
572extern "C" int cfperl_postInitPlugin () 734extern "C" int cfperl_postInitPlugin ()
573{ 735{
574 int hooktype = 1; 736 int hooktype = 1;
575 int rtype = 0; 737 int rtype = 0;
576 738
577 systemDirectory = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_directory");
578 object_set_property = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_set_property");
579 map_get_map = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_map_get_map");
580 object_insert = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_insert");
581
582 cf_init_plugin (gethook); 739 cf_init_plugin (gethook);
583 740
584 return 0; 741 return 0;
585} 742}
586 743
590} 747}
591 748
592void 749void
593cfperl_init () 750cfperl_init ()
594{ 751{
752 PERL_SYS_INIT3 (&settings.argc, &settings.argv, 0);
753 perl = perl_alloc ();
754 perl_construct (perl);
755
756 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
757
595 char *argv[] = { 758 char *argv[] = {
596 "", 759 "",
597 "-e" 760 "-e"
598 "BEGIN {"
599 " cf->bootstrap;" 761 "cf->bootstrap;"
600 " unshift @INC, cf::datadir ();" 762 "unshift @INC, cf::datadir ();"
601 "}"
602 ""
603 "use cf;"
604 }; 763 };
605
606 perl = perl_alloc ();
607 perl_construct (perl);
608
609 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
610 764
611 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl)) 765 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl))
612 { 766 {
613 printf ("unable to initialize perl-interpreter, aborting.\n"); 767 printf ("unable to initialize perl-interpreter, aborting.\n");
614
615 exit (EXIT_FAILURE); 768 exit (EXIT_FAILURE);
616 //perl_destruct (perl);
617 //perl_free (perl);
618 //perl = 0;
619 //return;
620 } 769 }
621 770
622 obj_cache = newHV (); 771 obj_cache = newHV ();
772}
773
774void cfperl_boot ()
775{
776 perl_booted = true;
777
778 eval_pv ("require cf", 1);
623} 779}
624 780
625void cfperl_main () 781void cfperl_main ()
626{ 782{
627 dSP; 783 dSP;
699 dt = (data_type) va_arg (ap, int); 855 dt = (data_type) va_arg (ap, int);
700 assert (("first argument must be of type object", dt == DT_OBJECT)); 856 assert (("first argument must be of type object", dt == DT_OBJECT));
701 op = va_arg (ap, object *); 857 op = va_arg (ap, object *);
702 858
703 if (op->cb) 859 if (op->cb)
704 gather_callbacks (callbacks, (AV *)op->cb, event); 860 gather_callbacks (callbacks, op->cb, event);
705 861
706 if (op->type) 862 if (op->type)
707 { 863 {
708 if (op->subtype && op->type + op->subtype * NUM_SUBTYPES <= AvFILLp (cb_type)) 864 if (op->subtype && op->type + op->subtype * NUM_SUBTYPES <= AvFILLp (cb_type))
709 { 865 {
730 dt = (data_type) va_arg (ap, int); 886 dt = (data_type) va_arg (ap, int);
731 assert (("first argument must be of type player", dt == DT_PLAYER)); 887 assert (("first argument must be of type player", dt == DT_PLAYER));
732 pl = va_arg (ap, player *); 888 pl = va_arg (ap, player *);
733 889
734 if (pl->cb) 890 if (pl->cb)
735 gather_callbacks (callbacks, (AV *)pl->cb, event); 891 gather_callbacks (callbacks, pl->cb, event);
736 892
737 gather_callbacks (callbacks, cb_player, event); 893 gather_callbacks (callbacks, cb_player, event);
738 break; 894 break;
739 895
740 case KLASS_MAP: 896 case KLASS_MAP:
741 dt = (data_type) va_arg (ap, int); 897 dt = (data_type) va_arg (ap, int);
742 assert (("first argument must be of type object", dt == DT_MAP)); 898 assert (("first argument must be of type object", dt == DT_MAP));
743 map = va_arg (ap, mapstruct *); 899 map = va_arg (ap, mapstruct *);
744 900
745 if (map->cb) 901 if (map->cb)
746 gather_callbacks (callbacks, (AV *)map->cb, event); 902 gather_callbacks (callbacks, map->cb, event);
747 903
748 gather_callbacks (callbacks, cb_map, event); 904 gather_callbacks (callbacks, cb_map, event);
749 break; 905 break;
750 906
751 default: 907 default:
1371 prop (CFAPI_INT, MAP_PROP_WINDDIR) 1527 prop (CFAPI_INT, MAP_PROP_WINDDIR)
1372 prop (CFAPI_INT, MAP_PROP_SKY) 1528 prop (CFAPI_INT, MAP_PROP_SKY)
1373 prop (CFAPI_INT, MAP_PROP_WPARTX) 1529 prop (CFAPI_INT, MAP_PROP_WPARTX)
1374 prop (CFAPI_INT, MAP_PROP_WPARTY) 1530 prop (CFAPI_INT, MAP_PROP_WPARTY)
1375 prop (CFAPI_STRING, MAP_PROP_MESSAGE) 1531 prop (CFAPI_STRING, MAP_PROP_MESSAGE)
1376 prop (CFAPI_PMAP, MAP_PROP_NEXT)
1377 prop (CFAPI_PREGION, MAP_PROP_REGION) 1532 prop (CFAPI_PREGION, MAP_PROP_REGION)
1378 prop (CFAPI_POBJECT, OBJECT_PROP_OB_ABOVE)
1379 prop (CFAPI_POBJECT, OBJECT_PROP_OB_BELOW)
1380 prop (CFAPI_POBJECT, OBJECT_PROP_NEXT_ACTIVE_OB) 1533 prop (CFAPI_POBJECT, OBJECT_PROP_NEXT_ACTIVE_OB)
1381 prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB) 1534 prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB)
1382 prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY) 1535 prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY)
1383 prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT) 1536 prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT)
1384 prop (CFAPI_POBJECT, OBJECT_PROP_HEAD)
1385 prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER) 1537 prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER)
1386 prop (CFAPI_PMAP, OBJECT_PROP_MAP) 1538 prop (CFAPI_PMAP, OBJECT_PROP_MAP)
1387 prop (CFAPI_INT, OBJECT_PROP_COUNT) 1539 prop (CFAPI_INT, OBJECT_PROP_COUNT)
1388 prop (CFAPI_INT, OBJECT_PROP_REFCOUNT) 1540 prop (CFAPI_INT, OBJECT_PROP_REFCOUNT)
1389 prop (CFAPI_STRING, OBJECT_PROP_NAME) 1541 prop (CFAPI_STRING, OBJECT_PROP_NAME)
1521 PROTOTYPE: $$ 1673 PROTOTYPE: $$
1522 1674
1523char *path_combine_and_normalize (char *base, char *path) 1675char *path_combine_and_normalize (char *base, char *path)
1524 PROTOTYPE: $$ 1676 PROTOTYPE: $$
1525 1677
1526char * 1678const char *
1527cf_get_maps_directory (char *path) 1679get_maps_directory (char *path)
1528 PROTOTYPE: $ 1680 PROTOTYPE: $
1529 ALIAS: maps_directory = 0 1681 ALIAS: maps_directory = 0
1682 CODE:
1683 RETVAL = create_pathname (path);
1684 OUTPUT: RETVAL
1530 1685
1531void 1686void
1532sub_generation_inc () 1687sub_generation_inc ()
1533 CODE: 1688 CODE:
1534 PL_sub_generation++; 1689 PL_sub_generation++;
1543 confdir = 3 1698 confdir = 3
1544 localdir = 4 1699 localdir = 4
1545 playerdir = 5 1700 playerdir = 5
1546 datadir = 6 1701 datadir = 6
1547 CODE: 1702 CODE:
1548{ 1703 switch (ix)
1549 int unused_type; 1704 {
1550 RETVAL = (char *)systemDirectory (&unused_type, ix); 1705 case 0: RETVAL = settings.mapdir ; break;
1551} 1706 case 1: RETVAL = settings.uniquedir; break;
1707 case 2: RETVAL = settings.tmpdir ; break;
1708 case 3: RETVAL = settings.confdir ; break;
1709 case 4: RETVAL = settings.localdir ; break;
1710 case 5: RETVAL = settings.playerdir; break;
1711 case 6: RETVAL = settings.datadir ; break;
1712 }
1552 OUTPUT: RETVAL 1713 OUTPUT: RETVAL
1553 1714
1554int 1715int
1555cf_find_animation (char *text) 1716cf_find_animation (char *text)
1556 PROTOTYPE: $ 1717 PROTOTYPE: $
1560const char *cost_string_from_value(uint64 cost, int approx = 0) 1721const char *cost_string_from_value(uint64 cost, int approx = 0)
1561 1722
1562int invoke (int event, ...) 1723int invoke (int event, ...)
1563 CODE: 1724 CODE:
1564 if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL"); 1725 if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL");
1565 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 1; i < items; i++) av_push (av, ST (i)); 1726 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1727 for (int i = 1; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1566 RETVAL = INVOKE_((event_type)event, ARG_AV (av)); 1728 RETVAL = INVOKE_((event_type)event, ARG_AV (av));
1567 OUTPUT: RETVAL 1729 OUTPUT: RETVAL
1568 1730
1569int 1731int
1570exp_to_level (val64 exp) 1732exp_to_level (val64 exp)
1603 RETVAL = newSVpv (resist_plus[atnr], 0); 1765 RETVAL = newSVpv (resist_plus[atnr], 0);
1604 else 1766 else
1605 XSRETURN_UNDEF; 1767 XSRETURN_UNDEF;
1606 OUTPUT: RETVAL 1768 OUTPUT: RETVAL
1607 1769
1770int
1771_valid (SV *obj)
1772 CODE:
1773 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
1774 OUTPUT:
1775 RETVAL
1776
1608MODULE = cf PACKAGE = cf::object PREFIX = cf_object_ 1777MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
1609 1778
1610int invoke (object *op, int event, ...) 1779int invoke (object *op, int event, ...)
1611 CODE: 1780 CODE:
1612 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");
1613 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i)); 1782 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1783 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1614 RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av)); 1784 RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av));
1615 OUTPUT: RETVAL 1785 OUTPUT: RETVAL
1616 1786
1617SV *registry (object *op) 1787SV *registry (object *op)
1618 CODE: 1788 CODE:
1619 RETVAL = registry_of (op); 1789 RETVAL = registry_of (op);
1620 OUTPUT: 1790 OUTPUT:
1791 RETVAL
1792
1793object *head (object *op)
1794 PROTOTYPE: $
1795 ALIAS:
1796 more = 1
1797 above = 2
1798 below = 3
1799 CODE:
1800 switch (ix)
1801 {
1802 case 0: RETVAL = op->head ? op->head : op; break; // DOH!
1803 case 1: RETVAL = op->more; break;
1804 case 2: RETVAL = op->above; break;
1805 case 3: RETVAL = op->below; break;
1806 }
1807 OUTPUT:
1621 RETVAL 1808 RETVAL
1622 1809
1623SV * 1810SV *
1624get_property (object *obj, int type, int idx) 1811get_property (object *obj, int type, int idx)
1625 CODE: 1812 CODE:
1705 1892
1706int need_identify (const object *obj); 1893int need_identify (const object *obj);
1707 1894
1708int apply_shop_mat (object *shop_mat, object *op); 1895int apply_shop_mat (object *shop_mat, object *op);
1709 1896
1710void cf_object_move (object *op, int dir, object *originator = op) 1897int move (object *op, int dir, object *originator = op)
1898 CODE:
1899 RETVAL = move_ob (op, dir, originator);
1900 OUTPUT:
1901 RETVAL
1711 1902
1712void cf_object_apply (object *op, object *author, int flags = 0) 1903void cf_object_apply (object *op, object *author, int flags = 0)
1713 1904
1714void cf_object_apply_below (object *op) 1905void cf_object_apply_below (object *op)
1715 1906
1756int cf_object_out_of_map (object *op, int x, int y) 1947int cf_object_out_of_map (object *op, int x, int y)
1757 1948
1758void cf_object_drop (object *op, object *author) 1949void cf_object_drop (object *op, object *author)
1759 1950
1760void cf_object_take (object *op, object *author) 1951void cf_object_take (object *op, object *author)
1761
1762void cf_object_say (object *op, char *msg)
1763
1764void cf_object_speak (object *op, char *msg)
1765 1952
1766object *cf_object_insert_object (object *op, object *container) 1953object *cf_object_insert_object (object *op, object *container)
1767 1954
1768const char *cf_object_get_msg (object *ob) 1955const char *cf_object_get_msg (object *ob)
1769 ALIAS: msg = 0 1956 ALIAS: msg = 0
1908MODULE = cf PACKAGE = cf::player PREFIX = cf_player_ 2095MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
1909 2096
1910int invoke (player *pl, int event, ...) 2097int invoke (player *pl, int event, ...)
1911 CODE: 2098 CODE:
1912 if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER"); 2099 if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");
1913 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i)); 2100 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
2101 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1914 RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av)); 2102 RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av));
1915 OUTPUT: RETVAL 2103 OUTPUT: RETVAL
1916 2104
1917SV *registry (player *pl) 2105SV *registry (player *pl)
1918 CODE: 2106 CODE:
2045 OUTPUT: RETVAL 2233 OUTPUT: RETVAL
2046 2234
2047 2235
2048MODULE = cf PACKAGE = cf::map PREFIX = cf_map_ 2236MODULE = cf PACKAGE = cf::map PREFIX = cf_map_
2049 2237
2238mapstruct *first ()
2239 PROTOTYPE:
2240 CODE:
2241 RETVAL = first_map;
2242 OUTPUT: RETVAL
2243
2244mapstruct *next (mapstruct *map)
2245 PROTOTYPE:
2246 CODE:
2247 RETVAL = map->next;
2248 OUTPUT: RETVAL
2249
2050int invoke (mapstruct *map, int event, ...) 2250int invoke (mapstruct *map, int event, ...)
2051 CODE: 2251 CODE:
2052 if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP"); 2252 if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP");
2053 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i)); 2253 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
2254 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
2054 RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av)); 2255 RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av));
2055 OUTPUT: 2256 OUTPUT: RETVAL
2056 RETVAL
2057 2257
2058SV *registry (mapstruct *map) 2258SV *registry (mapstruct *map)
2059 CODE: 2259 CODE:
2060 RETVAL = registry_of (map); 2260 RETVAL = registry_of (map);
2061 OUTPUT: 2261 OUTPUT:
2081 2281
2082mapstruct *new (int width, int height) 2282mapstruct *new (int width, int height)
2083 PROTOTYPE: 2283 PROTOTYPE:
2084 CODE: 2284 CODE:
2085{ 2285{
2086 int unused_type; 2286 RETVAL = get_empty_map (width, height);
2087 RETVAL = (mapstruct*) map_get_map (&unused_type, 0, width, height);
2088} 2287}
2089 OUTPUT: 2288 OUTPUT:
2090 RETVAL 2289 RETVAL
2091 2290
2092void delete_map (mapstruct *map) 2291void delete_map (mapstruct *map)
2107 XSRETURN_UNDEF; 2306 XSRETURN_UNDEF;
2108 RETVAL = map->tile_path [dir]; 2307 RETVAL = map->tile_path [dir];
2109 OUTPUT: 2308 OUTPUT:
2110 RETVAL 2309 RETVAL
2111 2310
2112mapstruct *cf_map_get_map (char *name) 2311mapstruct *ready_map_name (char *name, int flags = 0)
2113 PROTOTYPE: $ 2312 PROTOTYPE: $;$
2114 ALIAS: map = 0 2313 ALIAS:
2314 find = 0
2315 get_map = 1
2115 2316
2116mapstruct *has_been_loaded (char *name) 2317mapstruct *has_been_loaded (char *name)
2117 PROTOTYPE: $ 2318 PROTOTYPE: $
2118
2119mapstruct *cf_map_get_first ()
2120 PROTOTYPE:
2121 ALIAS: first = 0
2122 2319
2123# whoever "designed" the plug-in api should have wasted 2320# whoever "designed" the plug-in api should have wasted
2124# his/her time with staying away from the project - would have 2321# his/her time with staying away from the project - would have
2125# saved others a lot of time, without doubt. 2322# saved others a lot of time, without doubt.
2126void set_path (mapstruct *where, char *path) 2323void set_path (mapstruct *where, char *path)
2141 2338
2142void set_unique (mapstruct *map, bool unique) 2339void set_unique (mapstruct *map, bool unique)
2143 CODE: 2340 CODE:
2144 map->unique = unique; 2341 map->unique = unique;
2145 2342
2343void
2344trigger (mapstruct *map, long connection, bool state = true)
2345 CODE:
2346 activate_connection (map, connection, state);
2347
2348void
2349get_connection (mapstruct *map, long connection)
2350 PPCODE:
2351 oblinkpt *obp = get_connection_links (map, connection);
2352 if (obp)
2353 for (objectlink *ol = obp->link; ol; ol = ol->next)
2354 XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, ol->ob)));
2355
2146object *cf_map_insert_object_there (mapstruct *where, object *op, object *originator, int flags) 2356object *cf_map_insert_object_there (mapstruct *where, object *op, object *originator, int flags)
2147 2357
2148object *cf_map_insert_object (mapstruct *where, object* op, int x, int y) 2358object *cf_map_insert_object (mapstruct *where, object* op, int x, int y)
2149 2359
2150object* cf_map_present_arch_by_name (mapstruct *map, const char* str, int nx, int ny) 2360object* cf_map_present_arch_by_name (mapstruct *map, const char* str, int nx, int ny)
2154cf_map_normalise (mapstruct *map, int x, int y) 2364cf_map_normalise (mapstruct *map, int x, int y)
2155 PPCODE: 2365 PPCODE:
2156{ 2366{
2157 mapstruct *nmap = 0; 2367 mapstruct *nmap = 0;
2158 I16 nx = 0, ny = 0; 2368 I16 nx = 0, ny = 0;
2159 int flags = cf_map_get_flags (map, &nmap, x, y, &nx, &ny); 2369 int flags = get_map_flags (map, &nmap, x, y, &nx, &ny);
2160 2370
2161 EXTEND (SP, 4); 2371 EXTEND (SP, 4);
2162 PUSHs (sv_2mortal (newSViv (flags))); 2372 PUSHs (sv_2mortal (newSViv (flags)));
2163 2373
2164 if (GIMME_V == G_ARRAY) 2374 if (GIMME_V == G_ARRAY)
2176{ 2386{
2177 object *o; 2387 object *o;
2178 mapstruct *nmap = 0; 2388 mapstruct *nmap = 0;
2179 I16 nx, ny; 2389 I16 nx, ny;
2180 2390
2181 cf_map_get_flags (map, &nmap, x, y, &nx, &ny); 2391 get_map_flags (map, &nmap, x, y, &nx, &ny);
2182 2392
2183 if (nmap) 2393 if (nmap)
2184 for (o = GET_MAP_OB (nmap, nx, ny); o; o = o->above) 2394 for (o = GET_MAP_OB (nmap, nx, ny); o; o = o->above)
2185 XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, o))); 2395 XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, o)));
2186} 2396}
2211 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; 2421 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;
2212 } 2422 }
2213 OUTPUT: 2423 OUTPUT:
2214 RETVAL 2424 RETVAL
2215 2425
2216# "deserialise" perl map data into the map # TODO# compatibility cruft, remove
2217void
2218_set_obs (mapstruct *map, SV *sv)
2219 CODE:
2220{
2221 object *o;
2222 AV *av;
2223 int x, y;
2224 AV *obs = (AV *)SvRV (sv);
2225 2426
2226 for (y = 0; y < MAP_HEIGHT (map); y++) 2427MODULE = cf PACKAGE = cf::arch
2227 for (x = 0; x < MAP_WIDTH (map); x++)
2228 {
2229 sv = *av_fetch (obs, x + y * MAP_HEIGHT (map), 1);
2230 2428
2231 if (!SvROK (sv)) 2429archetype *find (const char *name)
2232 continue; 2430 CODE:
2431 RETVAL = find_archetype (name);
2432 OUTPUT:
2433 RETVAL
2233 2434
2234 av = (AV *)SvRV (sv); 2435archetype *first()
2235
2236 for (o = GET_MAP_OB (map, x, y); o; o = o->above)
2237 {
2238 sv = av_shift (av);
2239
2240 if (SvROK (sv))
2241 {
2242 sv_magic ((SV *)SvRV (sv), 0, PERL_MAGIC_ext, (char *)o, 0);
2243 SVptr_cache_set (o, sv);
2244 }
2245 }
2246 }
2247}
2248
2249
2250MODULE = cf PACKAGE = cf::arch PREFIX = cf_archetype_
2251
2252archetype *cf_archetype_get_first()
2253 PROTOTYPE: 2436 PROTOTYPE:
2254 ALIAS: first = 0 2437 CODE:
2438 RETVAL = first_archetype;
2439 OUTPUT: RETVAL
2255 2440
2256archetype *cf_archetype_get_next (archetype *arch) 2441archetype *next (archetype *arch)
2257 ALIAS: next = 0 2442 CODE:
2443 RETVAL = arch->next;
2444 OUTPUT: RETVAL
2258 2445
2259archetype *cf_archetype_get_head (archetype *arch) 2446archetype *head (archetype *arch)
2260 ALIAS: head = 0 2447 CODE:
2448 RETVAL = arch->head;
2449 OUTPUT: RETVAL
2261 2450
2262archetype *cf_archetype_get_more (archetype *arch) 2451archetype *more (archetype *arch)
2263 ALIAS: more = 0 2452 CODE:
2453 RETVAL = arch->more;
2454 OUTPUT: RETVAL
2264 2455
2265const char *cf_archetype_get_name (archetype *arch) 2456const char *name (archetype *arch)
2266 ALIAS: name = 0 2457 CODE:
2458 RETVAL = arch->name;
2459 OUTPUT: RETVAL
2267 2460
2268object *cf_archetype_get_clone (archetype *arch) 2461object *clone (archetype *arch)
2269 ALIAS: clone = 0 2462 CODE:
2463 RETVAL = &arch->clone;
2464 OUTPUT: RETVAL
2270 2465
2271MODULE = cf PACKAGE = cf::party PREFIX = cf_party_ 2466MODULE = cf PACKAGE = cf::party
2272 2467
2273partylist *cf_party_get_first () 2468partylist *first ()
2274 PROTOTYPE: 2469 PROTOTYPE:
2275 ALIAS: first = 0 2470 CODE:
2471 RETVAL = get_firstparty ();
2472 OUTPUT: RETVAL
2276 2473
2277partylist *cf_party_get_next (partylist *party) 2474partylist *next (partylist *party)
2278 ALIAS: next = 0 2475 CODE:
2476 RETVAL = party->next;
2477 OUTPUT: RETVAL
2279 2478
2280const char *cf_party_get_name (partylist *party) 2479const char *name (partylist *party)
2480 CODE:
2481 RETVAL = party->partyname;
2482 OUTPUT: RETVAL
2281 2483
2282const char *cf_party_get_password (partylist *party) 2484const char *password (partylist *party)
2283 ALIAS: password = 0 2485 CODE:
2486 RETVAL = party->passwd;
2487 OUTPUT: RETVAL
2284 2488
2285player *cf_party_get_first_player (partylist *party) 2489MODULE = cf PACKAGE = cf::region
2286 ALIAS: first_player = 0
2287 2490
2288player *cf_party_get_next_player (partylist *party, player *op) 2491region *first ()
2289 ALIAS: next_player = 0
2290
2291
2292MODULE = cf PACKAGE = cf::region PREFIX = cf_region_
2293
2294region *cf_region_get_first ()
2295 PROTOTYPE: 2492 PROTOTYPE:
2296 ALIAS: first = 0 2493 CODE:
2494 RETVAL = first_region;
2495 OUTPUT: RETVAL
2297 2496
2497region *next (region *reg)
2498 CODE:
2499 RETVAL = reg->next;
2500 OUTPUT: RETVAL
2501
2502const char *name (region *reg)
2503 CODE:
2504 RETVAL = reg->name;
2505 OUTPUT: RETVAL
2506
2507region *parent (region *reg)
2508 CODE:
2509 RETVAL = reg->parent;
2510 OUTPUT: RETVAL
2511
2298const char *cf_region_get_name (region *reg) 2512const char *longname (region *reg)
2299 ALIAS: name = 0 2513 CODE:
2514 RETVAL = reg->longname;
2515 OUTPUT: RETVAL
2300 2516
2301region *cf_region_get_next (region *reg) 2517const char *msg (region *reg)
2302 ALIAS: next = 0 2518 CODE:
2519 RETVAL = reg->msg;
2520 OUTPUT: RETVAL
2303 2521
2304region *cf_region_get_parent (region *reg) 2522MODULE = cf PACKAGE = cf::living
2305 ALIAS: parent = 0
2306
2307const char *cf_region_get_longname (region *reg)
2308 ALIAS: longname = 0
2309
2310const char *cf_region_get_message (region *reg)
2311 ALIAS: message = 0
2312
2313
2314MODULE = cf PACKAGE = cf::living PREFIX = cf_living_
2315 2523
2316val64 2524val64
2317exp (living *liv, val64 new_val = 0) 2525exp (living *liv, val64 new_val = 0)
2318 PROTOTYPE: $;$ 2526 PROTOTYPE: $;$
2319 ALIAS: 2527 ALIAS:

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines