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.16 by root, Sun Aug 27 15:24:22 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;
59 57
60typedef double val64; 58typedef double val64;
61#define newSVval64 newSVnv 59#define newSVval64 newSVnv
62#define SvVAL64 SvNV 60#define SvVAL64 SvNV
63 61
64static f_plug_api gethook; 62static f_plug_api gethook = cfapi_get_hooks;
65static f_plug_api systemDirectory; 63static f_plug_api object_set_property = cfapi_object_set_property;
66static f_plug_api object_set_property; 64static f_plug_api object_insert = cfapi_object_insert;
67static f_plug_api map_get_map; 65
68static f_plug_api object_insert; 66static bool perl_booted;
69 67
70/* 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 */
71typedef struct 69typedef struct
72{ 70{
73 object* who; 71 object* who;
108 106
109 sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0); 107 sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0);
110 return sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 108 return sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
111} 109}
112 110
113template<class extendable> 111template<class attachable>
114SV * 112SV *
115newSVextendable (extendable *obj, const char *klass) 113newSVattachable (attachable *obj, const char *klass)
116{ 114{
117 if (!obj) 115 if (!obj)
118 return &PL_sv_undef; 116 return &PL_sv_undef;
119 117
120 if (!obj->self) 118 if (!obj->self)
121 obj->self = newSVptr (obj, klass); 119 obj->self = newSVptr (obj, klass);
122 120
123 return newSVsv (static_cast<SV *>(obj->self)); 121 return newSVsv (obj->self);
124} 122}
125 123
126static void 124static void
127SVptr_cache_set (void *ptr, SV *sv) 125SVptr_cache_set (void *ptr, SV *sv)
128{ 126{
227 break; 225 break;
228 226
229 case DT_OBJECT: 227 case DT_OBJECT:
230 { 228 {
231 object *obj = va_arg (ap, object *); 229 object *obj = va_arg (ap, object *);
232 sv = newSVextendable (obj, obj && obj->type == PLAYER ? "cf::object::player::wrap" : "cf::object::wrap"); 230 sv = newSVattachable (obj, obj && obj->type == PLAYER ? "cf::object::player::wrap" : "cf::object::wrap");
233 } 231 }
234 break; 232 break;
235 233
236 case DT_MAP: 234 case DT_MAP:
237 // va_arg (object *) when void * is passed is an XSI extension 235 // va_arg (object *) when void * is passed is an XSI extension
238 sv = newSVextendable (va_arg (ap, mapstruct *), "cf::map::wrap"); 236 sv = newSVattachable (va_arg (ap, mapstruct *), "cf::map::wrap");
239 break; 237 break;
240 238
241 case DT_PLAYER: 239 case DT_PLAYER:
242 sv = newSVextendable (va_arg (ap, player *), "cf::player::wrap"); 240 sv = newSVattachable (va_arg (ap, player *), "cf::player::wrap");
243 break; 241 break;
244 242
245 case DT_ARCH: 243 case DT_ARCH:
246 sv = newSVptr (va_arg (ap, archetype *), "cf::arch::wrap"); 244 sv = newSVptr (va_arg (ap, archetype *), "cf::arch::wrap");
247 break; 245 break;
304} 302}
305 303
306////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 304//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
307 305
308SV * 306SV *
309registry_of (extendable_base *ext) 307registry_of (attachable_base *ext)
310{ 308{
311 if (!ext->cb) 309 if (!ext->cb)
312 ext->cb = newAV (); 310 ext->cb = newAV ();
313 311
314 return newRV_inc ((SV *)ext->cb); 312 return newRV_inc ((SV *)ext->cb);
315} 313}
316 314
317void extendable_base::clear () 315void attachable_base::clear ()
318{ 316{
319 //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));
320 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
321 if (self) SvREFCNT_dec (self); 331 SvREFCNT_dec (self);
332 self = 0;
333 }
334
335 if (cb)
336 {
322 if (cb) SvREFCNT_dec (cb); 337 SvREFCNT_dec (cb);
338 cb = 0;
339 }
323 340
341 if (attach)
342 {
324 if (attach) free_string (attach); 343 free_string (attach);
325
326 self = 0;
327 cb = 0;
328 attach = 0; 344 attach = 0;
345 }
329} 346}
330 347
331void extendable_base::optimise () 348void attachable_base::optimise ()
332{ 349{
333 if (!self) 350 if (!self)
334 return; 351 return;
335 352
336 HV *hv = (HV *)SvRV ((SV *)self); 353 HV *hv = (HV *)SvRV ((SV *)self);
342 SvREFCNT_dec ((SV *)self); 359 SvREFCNT_dec ((SV *)self);
343 self = 0; 360 self = 0;
344 } 361 }
345} 362}
346 363
347void 364void attachable_base::instantiate (data_type type, void *obj)
348object::instantiate_ ()
349{ 365{
350 dSP; 366 dSP;
351 ENTER; 367 ENTER;
352 SAVETMPS; 368 SAVETMPS;
353 PUSHMARK (SP); 369 PUSHMARK (SP);
354 EXTEND (SP, 2); 370 EXTEND (SP, 2);
355 PUSHs (sv_2mortal (newSVdt (DT_OBJECT, static_cast<object *>(this)))); 371 PUSHs (sv_2mortal (newSVdt (type, obj)));
356 PUSHs (sv_2mortal (newSVpv (attach, 0))); 372 PUSHs (sv_2mortal (newSVpv (attach, 0)));
373
374 free_string (attach);
375 attach = 0;
376
357 PUTBACK; 377 PUTBACK;
358 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL); 378 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL);
359 FREETMPS; 379 FREETMPS;
360 LEAVE; 380 LEAVE;
361 381
362 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 }
363} 387}
364 388
365///////////////////////////////////////////////////////////////////////////// 389/////////////////////////////////////////////////////////////////////////////
366 390
367object_freezer::object_freezer (const char *filename)
368: filename (filename)
369{
370 av = (AV *)newAV ();
371 idx = 0;
372 av_extend ((AV *)av, 1024);
373}
374
375object_freezer::~object_freezer ()
376{
377 dSP;
378 ENTER;
379 SAVETMPS;
380 PUSHMARK (SP);
381 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
382 XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
383 PUTBACK;
384 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL);
385 FREETMPS;
386 LEAVE;
387}
388
389void object_freezer::put (extendable_base *ext)
390{
391 ext->optimise ();
392
393 if (ext->self)
394 av_store ((AV *)av, idx, SvREFCNT_inc ((SV *)ext->self));
395
396 ++idx;
397}
398
399object_thawer::object_thawer (const char *filename)
400{
401 av = 0;
402 idx = 0;
403
404 if (!filename)
405 return;
406
407 dSP;
408 ENTER;
409 SAVETMPS;
410 PUSHMARK (SP);
411 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
412 PUTBACK;
413
414 if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL))
415 {
416 SPAGAIN;
417 SV *sv = POPs;
418 if (SvROK (sv))
419 av = SvREFCNT_inc (SvRV (sv));
420 }
421
422 FREETMPS;
423 LEAVE;
424}
425
426void reattach (data_type type, void *obj) 391void reattach (data_type type, void *obj)
427{ 392{
393 //TODO only do this when the object has _attachment's
394
428 dSP; 395 dSP;
429 ENTER; 396 ENTER;
430 SAVETMPS; 397 SAVETMPS;
431 PUSHMARK (SP); 398 PUSHMARK (SP);
432 XPUSHs (sv_2mortal (newSVdt (type, obj))); 399 XPUSHs (sv_2mortal (newSVdt (type, obj)));
442 case DT_MAP: INVOKE_MAP (REATTACH, obj); break; 409 case DT_MAP: INVOKE_MAP (REATTACH, obj); break;
443 } 410 }
444} 411}
445 412
446template<class subclass> 413template<class subclass>
447void reattach (extendable<subclass> *obj) 414void reattach (attachable<subclass> *obj)
448{ 415{
449 obj->optimise (); 416 obj->optimise ();
450 417
451 if (obj->self) 418 if (obj->self)
452 reattach (subclass::get_dt (), (subclass *)obj); 419 reattach (subclass::get_dt (), (subclass *)obj);
453} 420}
454 421
422object_freezer::object_freezer (const char *filename)
423{
424 this->filename = (SV *)newSVpv (filename, 0);
425
426 char filename2 [4096];
427 snprintf (filename2, 4096, "%s~", filename);
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
485 fp = fopen (filename, "r");
486 if (!fp)
487 {
488 LOG (llevError, "object_thawer: unable to open '%s': %s.\n", filename, strerror (errno));
489 return;
490 }
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
509 FREETMPS;
510 LEAVE;
511 }
512}
513
455void object_thawer::get (data_type type, void *obj, extendable_base *ext) 514void object_thawer::get (data_type type, void *obj, attachable_base *ext, int oid)
456{ 515{
457 if (!av) 516 if (!av || oid < 0) // this is actually an error of sorts
458 return; 517 return;
459 518
460 // we have to "re-instantiate"/reattach to an object, so nuke ext->attach 519 // we have to "re-instantiate"/reattach to an object, so nuke ext->attach
461 ext->clear (); 520 ext->clear ();
462 521
463 SV **svp = av_fetch ((AV *)av, idx, 0); 522 SV **svp = av_fetch ((AV *)av, oid, 0);
464 523
465 ++idx;
466
467 if (!svp)
468 return;
469
470 if (SvROK (*svp)) 524 if (!svp || !SvROK (*svp))
471 { 525 {
472 ext->self = SvREFCNT_inc (*svp); 526 printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid);
473 sv_magic (SvRV ((SV *)ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0); 527 return;
474
475 reattach (type, obj);
476 } 528 }
529
530 ext->self = *svp; *svp = &PL_sv_undef;
531 sv_magic (SvRV (ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0);
532
533 reattach (type, obj);
477} 534}
478 535
479object_thawer::~object_thawer () 536object_thawer::~object_thawer ()
480{ 537{
481 if (av) 538 if (fp) fclose (fp);
482 SvREFCNT_dec ((SV *)av); 539 if (av) SvREFCNT_dec ((AV *)av);
483} 540}
484 541
485///////////////////////////////////////////////////////////////////////////// 542/////////////////////////////////////////////////////////////////////////////
486 543
487extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) 544extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
488{ 545{
489 gethook = gethooksptr;
490 printf (PLUGIN_VERSION " init\n");
491
492 return 0; 546 return 0;
493} 547}
494 548
495static CommArray_s rtn_cmd; 549static CommArray_s rtn_cmd;
496 550
576extern "C" int cfperl_postInitPlugin () 630extern "C" int cfperl_postInitPlugin ()
577{ 631{
578 int hooktype = 1; 632 int hooktype = 1;
579 int rtype = 0; 633 int rtype = 0;
580 634
581 printf (PLUGIN_VERSION " post init\n");
582
583 systemDirectory = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_directory");
584 object_set_property = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_set_property");
585 map_get_map = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_map_get_map");
586 object_insert = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_insert");
587
588 cf_init_plugin (gethook); 635 cf_init_plugin (gethook);
589 636
590 return 0; 637 return 0;
591} 638}
592 639
596} 643}
597 644
598void 645void
599cfperl_init () 646cfperl_init ()
600{ 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
601 char *argv[] = { 654 char *argv[] = {
602 "", 655 "",
603 "-e" 656 "-e"
604 "BEGIN {"
605 " cf->bootstrap;" 657 "cf->bootstrap;"
606 " unshift @INC, cf::datadir ();" 658 "unshift @INC, cf::datadir ();"
607 "}"
608 ""
609 "use cf;"
610 }; 659 };
611
612 perl = perl_alloc ();
613 perl_construct (perl);
614
615 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
616 660
617 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))
618 { 662 {
619 printf ("unable to initialize perl-interpreter, aborting.\n"); 663 printf ("unable to initialize perl-interpreter, aborting.\n");
620
621 exit (EXIT_FAILURE); 664 exit (EXIT_FAILURE);
622 //perl_destruct (perl);
623 //perl_free (perl);
624 //perl = 0;
625 //return;
626 } 665 }
627 666
628 obj_cache = newHV (); 667 obj_cache = newHV ();
668}
669
670void cfperl_boot ()
671{
672 perl_booted = true;
673
674 eval_pv ("require cf", 1);
629} 675}
630 676
631void cfperl_main () 677void cfperl_main ()
632{ 678{
633 dSP; 679 dSP;
640static event_klass klass_of[NUM_EVENT_TYPES] = { 686static event_klass klass_of[NUM_EVENT_TYPES] = {
641# define def(type,name) KLASS_ ## type, 687# define def(type,name) KLASS_ ## type,
642# include "eventinc.h" 688# include "eventinc.h"
643# undef def 689# undef def
644}; 690};
691
692#define KLASS_OF(event) (((unsigned int)event) < NUM_EVENT_TYPES ? klass_of [event] : KLASS_NONE)
645 693
646static void 694static void
647gather_callbacks (AV *&callbacks, AV *registry, event_type event) 695gather_callbacks (AV *&callbacks, AV *registry, event_type event)
648{ 696{
649 // event must be in array 697 // event must be in array
692 // 2a. per-type callback 740 // 2a. per-type callback
693 // 4. global callbacks 741 // 4. global callbacks
694 742
695 gather_callbacks (callbacks, cb_global, event); 743 gather_callbacks (callbacks, cb_global, event);
696 744
697 switch (klass_of [event]) 745 switch (KLASS_OF (event))
698 { 746 {
699 case KLASS_GLOBAL: 747 case KLASS_GLOBAL:
700 break; 748 break;
701 749
702 case KLASS_OBJECT: 750 case KLASS_OBJECT:
703 dt = (data_type) va_arg (ap, int); 751 dt = (data_type) va_arg (ap, int);
704 assert (("first argument must be of type object", dt == DT_OBJECT)); 752 assert (("first argument must be of type object", dt == DT_OBJECT));
705 op = va_arg (ap, object *); 753 op = va_arg (ap, object *);
706 754
707 if (op->cb) 755 if (op->cb)
708 gather_callbacks (callbacks, (AV *)op->cb, event); 756 gather_callbacks (callbacks, op->cb, event);
709 757
710 if (op->type) 758 if (op->type)
711 { 759 {
712 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))
713 { 761 {
734 dt = (data_type) va_arg (ap, int); 782 dt = (data_type) va_arg (ap, int);
735 assert (("first argument must be of type player", dt == DT_PLAYER)); 783 assert (("first argument must be of type player", dt == DT_PLAYER));
736 pl = va_arg (ap, player *); 784 pl = va_arg (ap, player *);
737 785
738 if (pl->cb) 786 if (pl->cb)
739 gather_callbacks (callbacks, (AV *)pl->cb, event); 787 gather_callbacks (callbacks, pl->cb, event);
740 788
741 gather_callbacks (callbacks, cb_player, event); 789 gather_callbacks (callbacks, cb_player, event);
742 break; 790 break;
743 791
744 case KLASS_MAP: 792 case KLASS_MAP:
745 dt = (data_type) va_arg (ap, int); 793 dt = (data_type) va_arg (ap, int);
746 assert (("first argument must be of type object", dt == DT_MAP)); 794 assert (("first argument must be of type object", dt == DT_MAP));
747 map = va_arg (ap, mapstruct *); 795 map = va_arg (ap, mapstruct *);
748 796
749 if (map->cb) 797 if (map->cb)
750 gather_callbacks (callbacks, (AV *)map->cb, event); 798 gather_callbacks (callbacks, map->cb, event);
751 799
752 gather_callbacks (callbacks, cb_map, event); 800 gather_callbacks (callbacks, cb_map, event);
753 break; 801 break;
754 802
755 default: 803 default:
768 EXTEND (SP, 3); 816 EXTEND (SP, 3);
769 817
770 PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays 818 PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays
771 PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks))); 819 PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks)));
772 820
773 switch (klass_of [event]) 821 switch (KLASS_OF (event))
774 { 822 {
775 case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break; 823 case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break;
776 case KLASS_PLAYER: PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl))); break; 824 case KLASS_PLAYER: PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl))); break;
777 case KLASS_MAP: PUSHs (sv_2mortal (newSVdt (DT_MAP, map))); break; 825 case KLASS_MAP: PUSHs (sv_2mortal (newSVdt (DT_MAP, map))); break;
778 } 826 }
1375 prop (CFAPI_INT, MAP_PROP_WINDDIR) 1423 prop (CFAPI_INT, MAP_PROP_WINDDIR)
1376 prop (CFAPI_INT, MAP_PROP_SKY) 1424 prop (CFAPI_INT, MAP_PROP_SKY)
1377 prop (CFAPI_INT, MAP_PROP_WPARTX) 1425 prop (CFAPI_INT, MAP_PROP_WPARTX)
1378 prop (CFAPI_INT, MAP_PROP_WPARTY) 1426 prop (CFAPI_INT, MAP_PROP_WPARTY)
1379 prop (CFAPI_STRING, MAP_PROP_MESSAGE) 1427 prop (CFAPI_STRING, MAP_PROP_MESSAGE)
1380 prop (CFAPI_PMAP, MAP_PROP_NEXT)
1381 prop (CFAPI_PREGION, MAP_PROP_REGION) 1428 prop (CFAPI_PREGION, MAP_PROP_REGION)
1382 prop (CFAPI_POBJECT, OBJECT_PROP_OB_ABOVE)
1383 prop (CFAPI_POBJECT, OBJECT_PROP_OB_BELOW)
1384 prop (CFAPI_POBJECT, OBJECT_PROP_NEXT_ACTIVE_OB) 1429 prop (CFAPI_POBJECT, OBJECT_PROP_NEXT_ACTIVE_OB)
1385 prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB) 1430 prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB)
1386 prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY) 1431 prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY)
1387 prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT) 1432 prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT)
1388 prop (CFAPI_POBJECT, OBJECT_PROP_HEAD)
1389 prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER) 1433 prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER)
1390 prop (CFAPI_PMAP, OBJECT_PROP_MAP) 1434 prop (CFAPI_PMAP, OBJECT_PROP_MAP)
1391 prop (CFAPI_INT, OBJECT_PROP_COUNT) 1435 prop (CFAPI_INT, OBJECT_PROP_COUNT)
1392 prop (CFAPI_INT, OBJECT_PROP_REFCOUNT) 1436 prop (CFAPI_INT, OBJECT_PROP_REFCOUNT)
1393 prop (CFAPI_STRING, OBJECT_PROP_NAME) 1437 prop (CFAPI_STRING, OBJECT_PROP_NAME)
1525 PROTOTYPE: $$ 1569 PROTOTYPE: $$
1526 1570
1527char *path_combine_and_normalize (char *base, char *path) 1571char *path_combine_and_normalize (char *base, char *path)
1528 PROTOTYPE: $$ 1572 PROTOTYPE: $$
1529 1573
1530char * 1574const char *
1531cf_get_maps_directory (char *path) 1575get_maps_directory (char *path)
1532 PROTOTYPE: $ 1576 PROTOTYPE: $
1533 ALIAS: maps_directory = 0 1577 ALIAS: maps_directory = 0
1578 CODE:
1579 RETVAL = create_pathname (path);
1580 OUTPUT: RETVAL
1534 1581
1535void 1582void
1536sub_generation_inc () 1583sub_generation_inc ()
1537 CODE: 1584 CODE:
1538 PL_sub_generation++; 1585 PL_sub_generation++;
1547 confdir = 3 1594 confdir = 3
1548 localdir = 4 1595 localdir = 4
1549 playerdir = 5 1596 playerdir = 5
1550 datadir = 6 1597 datadir = 6
1551 CODE: 1598 CODE:
1552{ 1599 switch (ix)
1553 int unused_type; 1600 {
1554 RETVAL = (char *)systemDirectory (&unused_type, ix); 1601 case 0: RETVAL = settings.mapdir ; break;
1555} 1602 case 1: RETVAL = settings.uniquedir; break;
1603 case 2: RETVAL = settings.tmpdir ; break;
1604 case 3: RETVAL = settings.confdir ; break;
1605 case 4: RETVAL = settings.localdir ; break;
1606 case 5: RETVAL = settings.playerdir; break;
1607 case 6: RETVAL = settings.datadir ; break;
1608 }
1556 OUTPUT: RETVAL 1609 OUTPUT: RETVAL
1557 1610
1558int 1611int
1559cf_find_animation (char *text) 1612cf_find_animation (char *text)
1560 PROTOTYPE: $ 1613 PROTOTYPE: $
1561 1614
1562int random_roll(int min, int max, object *op, int goodbad); 1615int random_roll(int min, int max, object *op, int goodbad);
1563 1616
1564const char *cost_string_from_value(uint64 cost, int approx = 0) 1617const char *cost_string_from_value(uint64 cost, int approx = 0)
1565 1618
1566int invoke (int event, SV *arg1, ...) 1619int invoke (int event, ...)
1567 CODE: 1620 CODE:
1568{ 1621 if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL");
1569 // parse first arg and call invoke_object etc as seen fit 1622 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1570 //TODO 1623 for (int i = 1; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1571 //cfperl_invoke (event, 1624 RETVAL = INVOKE_((event_type)event, ARG_AV (av));
1572} 1625 OUTPUT: RETVAL
1573 1626
1574int 1627int
1575exp_to_level (val64 exp) 1628exp_to_level (val64 exp)
1576 CODE: 1629 CODE:
1577{ 1630{
1608 RETVAL = newSVpv (resist_plus[atnr], 0); 1661 RETVAL = newSVpv (resist_plus[atnr], 0);
1609 else 1662 else
1610 XSRETURN_UNDEF; 1663 XSRETURN_UNDEF;
1611 OUTPUT: RETVAL 1664 OUTPUT: RETVAL
1612 1665
1666int
1667_valid (SV *obj)
1668 CODE:
1669 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
1670 OUTPUT:
1671 RETVAL
1672
1613MODULE = cf PACKAGE = cf::object PREFIX = cf_object_ 1673MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
1674
1675int invoke (object *op, int event, ...)
1676 CODE:
1677 if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");
1678 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1679 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1680 RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av));
1681 OUTPUT: RETVAL
1682
1683SV *registry (object *op)
1684 CODE:
1685 RETVAL = registry_of (op);
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:
1704 RETVAL
1614 1705
1615SV * 1706SV *
1616get_property (object *obj, int type, int idx) 1707get_property (object *obj, int type, int idx)
1617 CODE: 1708 CODE:
1618 RETVAL = newSVcfapi (type, cf_object_get_property (obj, idx)); 1709 RETVAL = newSVcfapi (type, cf_object_get_property (obj, idx));
1697 1788
1698int need_identify (const object *obj); 1789int need_identify (const object *obj);
1699 1790
1700int apply_shop_mat (object *shop_mat, object *op); 1791int apply_shop_mat (object *shop_mat, object *op);
1701 1792
1702void 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
1703 1798
1704void cf_object_apply (object *op, object *author, int flags = 0) 1799void cf_object_apply (object *op, object *author, int flags = 0)
1705 1800
1706void cf_object_apply_below (object *op) 1801void cf_object_apply_below (object *op)
1707 1802
1748int cf_object_out_of_map (object *op, int x, int y) 1843int cf_object_out_of_map (object *op, int x, int y)
1749 1844
1750void cf_object_drop (object *op, object *author) 1845void cf_object_drop (object *op, object *author)
1751 1846
1752void cf_object_take (object *op, object *author) 1847void cf_object_take (object *op, object *author)
1753
1754void cf_object_say (object *op, char *msg)
1755
1756void cf_object_speak (object *op, char *msg)
1757 1848
1758object *cf_object_insert_object (object *op, object *container) 1849object *cf_object_insert_object (object *op, object *container)
1759 1850
1760const char *cf_object_get_msg (object *ob) 1851const char *cf_object_get_msg (object *ob)
1761 ALIAS: msg = 0 1852 ALIAS: msg = 0
1815 CODE: 1906 CODE:
1816{ 1907{
1817 int unused_type; 1908 int unused_type;
1818 RETVAL = (object *)object_insert (&unused_type, ob, 0, where, orig, flag, x, y); 1909 RETVAL = (object *)object_insert (&unused_type, ob, 0, where, orig, flag, x, y);
1819} 1910}
1820
1821SV *registry (object *op)
1822 CODE:
1823 RETVAL = registry_of (op);
1824 OUTPUT:
1825 RETVAL
1826 1911
1827# syntatic sugar for easier use in event callbacks. 1912# syntatic sugar for easier use in event callbacks.
1828const char *options (object *op) 1913const char *options (object *op)
1829 CODE: 1914 CODE:
1830 RETVAL = op->name; 1915 RETVAL = op->name;
1903 1988
1904void kill_player (object *op) 1989void kill_player (object *op)
1905 1990
1906MODULE = cf PACKAGE = cf::player PREFIX = cf_player_ 1991MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
1907 1992
1993int invoke (player *pl, int event, ...)
1994 CODE:
1995 if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");
1996 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1997 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1998 RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av));
1999 OUTPUT: RETVAL
2000
1908SV *registry (player *pl) 2001SV *registry (player *pl)
1909 CODE: 2002 CODE:
1910 RETVAL = registry_of (pl); 2003 RETVAL = registry_of (pl);
1911 OUTPUT: 2004 OUTPUT:
1912 RETVAL 2005 RETVAL
2036 OUTPUT: RETVAL 2129 OUTPUT: RETVAL
2037 2130
2038 2131
2039MODULE = cf PACKAGE = cf::map PREFIX = cf_map_ 2132MODULE = cf PACKAGE = cf::map PREFIX = cf_map_
2040 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
2146int invoke (mapstruct *map, int event, ...)
2147 CODE:
2148 if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP");
2149 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
2150 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
2151 RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av));
2152 OUTPUT: RETVAL
2153
2041SV *registry (mapstruct *map) 2154SV *registry (mapstruct *map)
2042 CODE: 2155 CODE:
2043 RETVAL = registry_of (map); 2156 RETVAL = registry_of (map);
2044 OUTPUT: 2157 OUTPUT:
2045 RETVAL 2158 RETVAL
2064 2177
2065mapstruct *new (int width, int height) 2178mapstruct *new (int width, int height)
2066 PROTOTYPE: 2179 PROTOTYPE:
2067 CODE: 2180 CODE:
2068{ 2181{
2069 int unused_type; 2182 RETVAL = get_empty_map (width, height);
2070 RETVAL = (mapstruct*) map_get_map (&unused_type, 0, width, height);
2071} 2183}
2072 OUTPUT: 2184 OUTPUT:
2073 RETVAL 2185 RETVAL
2074 2186
2075void delete_map (mapstruct *map) 2187void delete_map (mapstruct *map)
2090 XSRETURN_UNDEF; 2202 XSRETURN_UNDEF;
2091 RETVAL = map->tile_path [dir]; 2203 RETVAL = map->tile_path [dir];
2092 OUTPUT: 2204 OUTPUT:
2093 RETVAL 2205 RETVAL
2094 2206
2095mapstruct *cf_map_get_map (char *name) 2207mapstruct *ready_map_name (char *name, int flags = 0)
2096 PROTOTYPE: $ 2208 PROTOTYPE: $;$
2097 ALIAS: map = 0 2209 ALIAS:
2210 find = 0
2211 get_map = 1
2098 2212
2099mapstruct *has_been_loaded (char *name) 2213mapstruct *has_been_loaded (char *name)
2100 PROTOTYPE: $ 2214 PROTOTYPE: $
2101
2102mapstruct *cf_map_get_first ()
2103 PROTOTYPE:
2104 ALIAS: first = 0
2105 2215
2106# whoever "designed" the plug-in api should have wasted 2216# whoever "designed" the plug-in api should have wasted
2107# his/her time with staying away from the project - would have 2217# his/her time with staying away from the project - would have
2108# saved others a lot of time, without doubt. 2218# saved others a lot of time, without doubt.
2109void set_path (mapstruct *where, char *path) 2219void set_path (mapstruct *where, char *path)
2124 2234
2125void set_unique (mapstruct *map, bool unique) 2235void set_unique (mapstruct *map, bool unique)
2126 CODE: 2236 CODE:
2127 map->unique = unique; 2237 map->unique = unique;
2128 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)));
2251
2129object *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)
2130 2253
2131object *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)
2132 2255
2133object* cf_map_present_arch_by_name (mapstruct *map, const char* str, int nx, int ny) 2256object* cf_map_present_arch_by_name (mapstruct *map, const char* str, int nx, int ny)
2137cf_map_normalise (mapstruct *map, int x, int y) 2260cf_map_normalise (mapstruct *map, int x, int y)
2138 PPCODE: 2261 PPCODE:
2139{ 2262{
2140 mapstruct *nmap = 0; 2263 mapstruct *nmap = 0;
2141 I16 nx = 0, ny = 0; 2264 I16 nx = 0, ny = 0;
2142 int flags = cf_map_get_flags (map, &nmap, x, y, &nx, &ny); 2265 int flags = get_map_flags (map, &nmap, x, y, &nx, &ny);
2143 2266
2144 EXTEND (SP, 4); 2267 EXTEND (SP, 4);
2145 PUSHs (sv_2mortal (newSViv (flags))); 2268 PUSHs (sv_2mortal (newSViv (flags)));
2146 2269
2147 if (GIMME_V == G_ARRAY) 2270 if (GIMME_V == G_ARRAY)
2159{ 2282{
2160 object *o; 2283 object *o;
2161 mapstruct *nmap = 0; 2284 mapstruct *nmap = 0;
2162 I16 nx, ny; 2285 I16 nx, ny;
2163 2286
2164 cf_map_get_flags (map, &nmap, x, y, &nx, &ny); 2287 get_map_flags (map, &nmap, x, y, &nx, &ny);
2165 2288
2166 if (nmap) 2289 if (nmap)
2167 for (o = GET_MAP_OB (nmap, nx, ny); o; o = o->above) 2290 for (o = GET_MAP_OB (nmap, nx, ny); o; o = o->above)
2168 XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, o))); 2291 XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, o)));
2169} 2292}
2194 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;
2195 } 2318 }
2196 OUTPUT: 2319 OUTPUT:
2197 RETVAL 2320 RETVAL
2198 2321
2199# "deserialise" perl map data into the map # TODO# compatibility cruft, remove
2200void
2201_set_obs (mapstruct *map, SV *sv)
2202 CODE:
2203{
2204 object *o;
2205 AV *av;
2206 int x, y;
2207 AV *obs = (AV *)SvRV (sv);
2208 2322
2209 for (y = 0; y < MAP_HEIGHT (map); y++) 2323MODULE = cf PACKAGE = cf::arch
2210 for (x = 0; x < MAP_WIDTH (map); x++)
2211 {
2212 sv = *av_fetch (obs, x + y * MAP_HEIGHT (map), 1);
2213 2324
2214 if (!SvROK (sv)) 2325archetype *first()
2215 continue;
2216
2217 av = (AV *)SvRV (sv);
2218
2219 for (o = GET_MAP_OB (map, x, y); o; o = o->above)
2220 {
2221 sv = av_shift (av);
2222
2223 if (SvROK (sv))
2224 {
2225 sv_magic ((SV *)SvRV (sv), 0, PERL_MAGIC_ext, (char *)o, 0);
2226 SVptr_cache_set (o, sv);
2227 }
2228 }
2229 }
2230}
2231
2232
2233MODULE = cf PACKAGE = cf::arch PREFIX = cf_archetype_
2234
2235archetype *cf_archetype_get_first()
2236 PROTOTYPE: 2326 PROTOTYPE:
2237 ALIAS: first = 0 2327 CODE:
2328 RETVAL = first_archetype;
2329 OUTPUT: RETVAL
2238 2330
2239archetype *cf_archetype_get_next (archetype *arch) 2331archetype *next (archetype *arch)
2240 ALIAS: next = 0 2332 CODE:
2333 RETVAL = arch->next;
2334 OUTPUT: RETVAL
2241 2335
2242archetype *cf_archetype_get_head (archetype *arch) 2336archetype *head (archetype *arch)
2243 ALIAS: head = 0 2337 CODE:
2338 RETVAL = arch->head;
2339 OUTPUT: RETVAL
2244 2340
2245archetype *cf_archetype_get_more (archetype *arch) 2341archetype *more (archetype *arch)
2246 ALIAS: more = 0 2342 CODE:
2343 RETVAL = arch->more;
2344 OUTPUT: RETVAL
2247 2345
2248const char *cf_archetype_get_name (archetype *arch) 2346const char *name (archetype *arch)
2249 ALIAS: name = 0 2347 CODE:
2348 RETVAL = arch->name;
2349 OUTPUT: RETVAL
2250 2350
2251object *cf_archetype_get_clone (archetype *arch) 2351object *clone (archetype *arch)
2252 ALIAS: clone = 0 2352 CODE:
2353 RETVAL = &arch->clone;
2354 OUTPUT: RETVAL
2253 2355
2254MODULE = cf PACKAGE = cf::party PREFIX = cf_party_ 2356MODULE = cf PACKAGE = cf::party
2255 2357
2256partylist *cf_party_get_first () 2358partylist *first ()
2257 PROTOTYPE: 2359 PROTOTYPE:
2258 ALIAS: first = 0 2360 CODE:
2361 RETVAL = get_firstparty ();
2362 OUTPUT: RETVAL
2259 2363
2260partylist *cf_party_get_next (partylist *party) 2364partylist *next (partylist *party)
2261 ALIAS: next = 0 2365 CODE:
2366 RETVAL = party->next;
2367 OUTPUT: RETVAL
2262 2368
2263const char *cf_party_get_name (partylist *party) 2369const char *name (partylist *party)
2370 CODE:
2371 RETVAL = party->partyname;
2372 OUTPUT: RETVAL
2264 2373
2265const char *cf_party_get_password (partylist *party) 2374const char *password (partylist *party)
2266 ALIAS: password = 0 2375 CODE:
2376 RETVAL = party->passwd;
2377 OUTPUT: RETVAL
2267 2378
2268player *cf_party_get_first_player (partylist *party) 2379MODULE = cf PACKAGE = cf::region
2269 ALIAS: first_player = 0
2270 2380
2271player *cf_party_get_next_player (partylist *party, player *op) 2381region *first ()
2272 ALIAS: next_player = 0
2273
2274
2275MODULE = cf PACKAGE = cf::region PREFIX = cf_region_
2276
2277region *cf_region_get_first ()
2278 PROTOTYPE: 2382 PROTOTYPE:
2279 ALIAS: first = 0 2383 CODE:
2384 RETVAL = first_region;
2385 OUTPUT: RETVAL
2280 2386
2387region *next (region *reg)
2388 CODE:
2389 RETVAL = reg->next;
2390 OUTPUT: RETVAL
2391
2392const char *name (region *reg)
2393 CODE:
2394 RETVAL = reg->name;
2395 OUTPUT: RETVAL
2396
2397region *parent (region *reg)
2398 CODE:
2399 RETVAL = reg->parent;
2400 OUTPUT: RETVAL
2401
2281const char *cf_region_get_name (region *reg) 2402const char *longname (region *reg)
2282 ALIAS: name = 0 2403 CODE:
2404 RETVAL = reg->longname;
2405 OUTPUT: RETVAL
2283 2406
2284region *cf_region_get_next (region *reg) 2407const char *msg (region *reg)
2285 ALIAS: next = 0 2408 CODE:
2409 RETVAL = reg->msg;
2410 OUTPUT: RETVAL
2286 2411
2287region *cf_region_get_parent (region *reg) 2412MODULE = cf PACKAGE = cf::living
2288 ALIAS: parent = 0
2289
2290const char *cf_region_get_longname (region *reg)
2291 ALIAS: longname = 0
2292
2293const char *cf_region_get_message (region *reg)
2294 ALIAS: message = 0
2295
2296
2297MODULE = cf PACKAGE = cf::living PREFIX = cf_living_
2298 2413
2299val64 2414val64
2300exp (living *liv, val64 new_val = 0) 2415exp (living *liv, val64 new_val = 0)
2301 PROTOTYPE: $;$ 2416 PROTOTYPE: $;$
2302 ALIAS: 2417 ALIAS:

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines