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.13 by root, Sun Aug 27 16:15:13 2006 UTC vs.
Revision 1.39 by elmex, Fri Sep 1 17:16:47 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;
108 96
109 sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0); 97 sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0);
110 return sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 98 return sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
111} 99}
112 100
113template<class extendable> 101template<class attachable>
114SV * 102SV *
115newSVextendable (extendable *obj, const char *klass) 103newSVattachable (attachable *obj, const char *klass)
116{ 104{
117 if (!obj) 105 if (!obj)
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{
227 break; 215 break;
228 216
229 case DT_OBJECT: 217 case DT_OBJECT:
230 { 218 {
231 object *obj = va_arg (ap, object *); 219 object *obj = va_arg (ap, object *);
232 sv = newSVextendable (obj, obj && obj->type == PLAYER ? "cf::object::player::wrap" : "cf::object::wrap"); 220 sv = newSVattachable (obj, obj && obj->type == PLAYER ? "cf::object::player::wrap" : "cf::object::wrap");
233 } 221 }
234 break; 222 break;
235 223
236 case DT_MAP: 224 case DT_MAP:
237 // va_arg (object *) when void * is passed is an XSI extension 225 // va_arg (object *) when void * is passed is an XSI extension
238 sv = newSVextendable (va_arg (ap, mapstruct *), "cf::map::wrap"); 226 sv = newSVattachable (va_arg (ap, mapstruct *), "cf::map::wrap");
239 break; 227 break;
240 228
241 case DT_PLAYER: 229 case DT_PLAYER:
242 sv = newSVextendable (va_arg (ap, player *), "cf::player::wrap"); 230 sv = newSVattachable (va_arg (ap, player *), "cf::player::wrap");
243 break; 231 break;
244 232
245 case DT_ARCH: 233 case DT_ARCH:
246 sv = newSVptr (va_arg (ap, archetype *), "cf::arch::wrap"); 234 sv = newSVptr (va_arg (ap, archetype *), "cf::arch::wrap");
247 break; 235 break;
304} 292}
305 293
306////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 294//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
307 295
308SV * 296SV *
309registry_of (extendable_base *ext) 297registry_of (attachable_base *ext)
310{ 298{
311 if (!ext->cb) 299 if (!ext->cb)
312 ext->cb = newAV (); 300 ext->cb = newAV ();
313 301
314 return newRV_inc ((SV *)ext->cb); 302 return newRV_inc ((SV *)ext->cb);
315} 303}
316 304
317void extendable_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 extendable_base::optimise () 338void attachable_base::optimise ()
332{ 339{
333 if (!self) 340 if (!self)
334 return; 341 return;
335 342
336 HV *hv = (HV *)SvRV ((SV *)self); 343 HV *hv = (HV *)SvRV ((SV *)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;
371
372 switch (type)
373 {
374 case DT_OBJECT: INVOKE_OBJECT (INSTANTIATE, obj); break;
375 case DT_MAP: INVOKE_MAP (INSTANTIATE, obj); break;
376 }
361} 377}
362 378
363///////////////////////////////////////////////////////////////////////////// 379/////////////////////////////////////////////////////////////////////////////
364 380
365object_freezer::object_freezer (const char *filename) 381void reattach (data_type type, void *obj)
366: filename (filename)
367{ 382{
368 av = (AV *)newAV (); 383 //TODO only do this when the object has _attachment's
369 idx = 0;
370 av_extend ((AV *)av, 1024);
371}
372 384
373object_freezer::~object_freezer ()
374{
375 dSP; 385 dSP;
376 ENTER; 386 ENTER;
377 SAVETMPS; 387 SAVETMPS;
378 PUSHMARK (SP); 388 PUSHMARK (SP);
389 XPUSHs (sv_2mortal (newSVdt (type, obj)));
390 PUTBACK;
391 call_pv ("cf::reattach", G_DISCARD | G_VOID | G_EVAL);
392 FREETMPS;
393 LEAVE;
394
395 switch (type)
396 {
397 case DT_OBJECT: INVOKE_OBJECT (REATTACH, obj); break;
398 case DT_PLAYER: INVOKE_PLAYER (REATTACH, obj); break;
399 case DT_MAP: INVOKE_MAP (REATTACH, obj); break;
400 }
401}
402
403template<class subclass>
404void reattach (attachable<subclass> *obj)
405{
406 obj->optimise ();
407
408 if (obj->self)
409 reattach ((data_type) cftype<subclass>::dt, (subclass *)obj);
410}
411
412#include "kw_hash.h"
413
414object_freezer::object_freezer ()
415: dynbuf (128 * 1024, 64 * 1024)
416{
417 av = newAV ();
418}
419
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
440bool object_freezer::save (const char *filename)
441{
442 dSP;
443 ENTER;
444 SAVETMPS;
445 PUSHMARK (SP);
446 EXTEND (SP, 3);
379 XPUSHs (sv_2mortal (newSVpv (filename, 0))); 447 PUSHs (sv_2mortal (newSVpv (filename, 0)));
448 PUSHs (sv_2mortal (newRV_noinc (newSVpvn ((char *)linearise (), size ()))));
380 XPUSHs (sv_2mortal (newRV_noinc ((SV *)av))); 449 PUSHs (sv_2mortal (newRV_inc ((SV *)av)));
381 PUTBACK; 450 PUTBACK;
382 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL); 451 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL);
383 FREETMPS; 452 FREETMPS;
384 LEAVE; 453 LEAVE;
385} 454}
386 455
387void object_freezer::put (extendable_base *ext) 456int fprintf (object_freezer &freezer, const char *format, ...)
388{ 457{
389 ext->optimise (); 458 va_list ap;
390 459
391 if (ext->self) 460 va_start (ap, format);
392 av_store ((AV *)av, idx, SvREFCNT_inc ((SV *)ext->self));
393 461
394 ++idx; 462 int len = vsnprintf ((char *)freezer.force (1024), 1024, format, ap);
463
464 if (len >= 0)
465 freezer.alloc (len);
466
467 va_end (ap);
468}
469
470int fputs (const char *s, object_freezer &freezer)
471{
472 freezer.add (s);
395} 473}
396 474
397object_thawer::object_thawer (const char *filename) 475object_thawer::object_thawer (const char *filename)
398{ 476{
399 av = 0; 477 av = 0;
400 idx = 0; 478 fp = 0;
401 479
402 if (!filename) 480 if (!filename)
403 return; 481 return;
404 482
405 dSP; 483 fp = fopen (filename, "r");
406 ENTER; 484 if (!fp)
407 SAVETMPS;
408 PUSHMARK (SP);
409 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
410 PUTBACK;
411
412 if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL))
413 { 485 {
414 SPAGAIN; 486 LOG (llevError, "object_thawer: unable to open '%s': %s.\n", filename, strerror (errno));
415 SV *sv = POPs; 487 return;
416 if (SvROK (sv))
417 av = SvREFCNT_inc (SvRV (sv));
418 } 488 }
419 489
420 FREETMPS; 490 if (perl_booted)
421 LEAVE;
422}
423
424void object_thawer::get (data_type type, void *obj, extendable_base *ext)
425{
426 if (!av)
427 return;
428
429 // we have to "re-instantiate"/reattach to an object, so nuke ext->attach
430 ext->clear ();
431
432 SV **svp = av_fetch ((AV *)av, idx, 0);
433
434 ++idx;
435
436 if (!svp)
437 return;
438
439 if (SvROK (*svp))
440 { 491 {
441 ext->self = SvREFCNT_inc (*svp);
442 sv_magic (SvRV ((SV *)ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0);
443
444 dSP; 492 dSP;
445 ENTER; 493 ENTER;
446 SAVETMPS; 494 SAVETMPS;
447 PUSHMARK (SP); 495 PUSHMARK (SP);
448 EXTEND (SP, 1);
449 PUSHs (sv_2mortal (newSVdt (type, obj))); 496 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
450 PUTBACK; 497 PUTBACK;
451 call_pv ("cf::reattach", G_DISCARD | G_VOID | G_EVAL); 498
499 if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL))
500 {
501 SPAGAIN;
502 SV *sv = POPs;
503 if (SvROK (sv))
504 av = (AV *)SvREFCNT_inc (SvRV (sv));
505 }
506
452 FREETMPS; 507 FREETMPS;
453 LEAVE; 508 LEAVE;
454
455 if (ext->cb && type == DT_OBJECT)
456 INVOKE_OBJECT (REATTACH, (object *)obj);
457 } 509 }
458} 510}
459 511
512void object_thawer::get (data_type type, void *obj, attachable_base *ext, int oid)
513{
514 if (!av || oid < 0) // this is actually an error of sorts
515 return;
516
517 // we have to "re-instantiate"/reattach to an object, so nuke ext->attach
518 ext->clear ();
519
520 SV **svp = av_fetch ((AV *)av, oid, 0);
521
522 if (!svp || !SvROK (*svp))
523 {
524 printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid);
525 return;
526 }
527
528 ext->self = *svp; *svp = &PL_sv_undef;
529 sv_magic (SvRV (ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0);
530
531 reattach (type, obj);
532}
533
460object_thawer::~object_thawer () 534object_thawer::~object_thawer ()
461{ 535{
462 if (av) 536 if (fp) fclose (fp);
463 SvREFCNT_dec ((SV *)av); 537 if (av) SvREFCNT_dec ((AV *)av);
464} 538}
465 539
540token object_thawer::get_token ()
541{
542#if 0
543 for (;;)
544 {
545 if (!fgets (line, sizeof (line), fp))
546 return token (KW_eof);
547
548 unsigned char *p = (unsigned char *)line;
549
550 while (*p > ' ')
551 p++;
552
553 int len = p - (unsigned char *)line;
554
555 while ((*p - 1) < ' ')
556 p++;
557
558 if (*p)
559 {
560 char *v = p;
561
562 while (*p && *p != '\n')
563 p++;
564
565 *p = 0;
566
567 return token (k, v);
568 }
569 else
570 return token (k);
571 }
572#endif
573}
574
466///////////////////////////////////////////////////////////////////////////// 575/////////////////////////////////////////////////////////////////////////////
467 576
468extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) 577extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
469{ 578{
470 gethook = gethooksptr;
471 printf (PLUGIN_VERSION " init\n");
472
473 return 0; 579 return 0;
474} 580}
475 581
476static CommArray_s rtn_cmd; 582static CommArray_s rtn_cmd;
477 583
557extern "C" int cfperl_postInitPlugin () 663extern "C" int cfperl_postInitPlugin ()
558{ 664{
559 int hooktype = 1; 665 int hooktype = 1;
560 int rtype = 0; 666 int rtype = 0;
561 667
562 printf (PLUGIN_VERSION " post init\n");
563
564 systemDirectory = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_directory");
565 object_set_property = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_set_property");
566 map_get_map = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_map_get_map");
567 object_insert = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_insert");
568
569 cf_init_plugin (gethook); 668 cf_init_plugin (gethook);
570 669
571 return 0; 670 return 0;
572} 671}
573 672
577} 676}
578 677
579void 678void
580cfperl_init () 679cfperl_init ()
581{ 680{
681 PERL_SYS_INIT3 (&settings.argc, &settings.argv, 0);
682 perl = perl_alloc ();
683 perl_construct (perl);
684
685 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
686
582 char *argv[] = { 687 char *argv[] = {
583 "", 688 "",
584 "-e" 689 "-e"
585 "BEGIN {"
586 " cf->bootstrap;" 690 "cf->bootstrap;"
587 " unshift @INC, cf::datadir ();" 691 "unshift @INC, cf::datadir ();"
588 "}"
589 ""
590 "use cf;"
591 }; 692 };
592
593 perl = perl_alloc ();
594 perl_construct (perl);
595
596 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
597 693
598 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl)) 694 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl))
599 { 695 {
600 printf ("unable to initialize perl-interpreter, aborting.\n"); 696 printf ("unable to initialize perl-interpreter, aborting.\n");
601
602 exit (EXIT_FAILURE); 697 exit (EXIT_FAILURE);
603 //perl_destruct (perl);
604 //perl_free (perl);
605 //perl = 0;
606 //return;
607 } 698 }
608 699
609 obj_cache = newHV (); 700 obj_cache = newHV ();
701}
702
703void cfperl_boot ()
704{
705 perl_booted = true;
706
707 eval_pv ("require cf", 1);
610} 708}
611 709
612void cfperl_main () 710void cfperl_main ()
613{ 711{
614 dSP; 712 dSP;
621static event_klass klass_of[NUM_EVENT_TYPES] = { 719static event_klass klass_of[NUM_EVENT_TYPES] = {
622# define def(type,name) KLASS_ ## type, 720# define def(type,name) KLASS_ ## type,
623# include "eventinc.h" 721# include "eventinc.h"
624# undef def 722# undef def
625}; 723};
724
725#define KLASS_OF(event) (((unsigned int)event) < NUM_EVENT_TYPES ? klass_of [event] : KLASS_NONE)
626 726
627static void 727static void
628gather_callbacks (AV *&callbacks, AV *registry, event_type event) 728gather_callbacks (AV *&callbacks, AV *registry, event_type event)
629{ 729{
630 // event must be in array 730 // event must be in array
673 // 2a. per-type callback 773 // 2a. per-type callback
674 // 4. global callbacks 774 // 4. global callbacks
675 775
676 gather_callbacks (callbacks, cb_global, event); 776 gather_callbacks (callbacks, cb_global, event);
677 777
678 switch (klass_of [event]) 778 switch (KLASS_OF (event))
679 { 779 {
680 case KLASS_GLOBAL: 780 case KLASS_GLOBAL:
681 break; 781 break;
682 782
683 case KLASS_OBJECT: 783 case KLASS_OBJECT:
684 dt = (data_type) va_arg (ap, int); 784 dt = (data_type) va_arg (ap, int);
685 assert (("first argument must be of type object", dt == DT_OBJECT)); 785 assert (("first argument must be of type object", dt == DT_OBJECT));
686 op = va_arg (ap, object *); 786 op = va_arg (ap, object *);
687 787
688 if (op->cb) 788 if (op->cb)
689 gather_callbacks (callbacks, (AV *)op->cb, event); 789 gather_callbacks (callbacks, op->cb, event);
790
791 if (op->type)
792 {
793 if (op->subtype && op->type + op->subtype * NUM_SUBTYPES <= AvFILLp (cb_type))
794 {
795 SV *registry = AvARRAY (cb_type)[op->type + op->subtype * NUM_SUBTYPES];
796
797 if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
798 gather_callbacks (callbacks, (AV *)SvRV (registry), event);
799 }
800
801 if (op->type <= AvFILLp (cb_type))
802 {
803 SV *registry = AvARRAY (cb_type)[op->type];
804
805 if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
806 gather_callbacks (callbacks, (AV *)SvRV (registry), event);
807 }
808 }
690 809
691 gather_callbacks (callbacks, cb_object, event); 810 gather_callbacks (callbacks, cb_object, event);
692
693 if (op->type > 0 && op->type <= AvFILLp (cb_type))
694 {
695 SV *registry = AvARRAY (cb_type)[op->type];
696
697 if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
698 gather_callbacks (callbacks, (AV *)SvRV (registry), event);
699 }
700 811
701 break; 812 break;
702 813
703 case KLASS_PLAYER: 814 case KLASS_PLAYER:
704 dt = (data_type) va_arg (ap, int); 815 dt = (data_type) va_arg (ap, int);
705 assert (("first argument must be of type player", dt == DT_PLAYER)); 816 assert (("first argument must be of type player", dt == DT_PLAYER));
706 pl = va_arg (ap, player *); 817 pl = va_arg (ap, player *);
707 818
708 if (pl->cb) 819 if (pl->cb)
709 gather_callbacks (callbacks, (AV *)pl->cb, event); 820 gather_callbacks (callbacks, pl->cb, event);
710 821
711 gather_callbacks (callbacks, cb_player, event); 822 gather_callbacks (callbacks, cb_player, event);
712 break; 823 break;
713 824
714 case KLASS_MAP: 825 case KLASS_MAP:
715 dt = (data_type) va_arg (ap, int); 826 dt = (data_type) va_arg (ap, int);
716 assert (("first argument must be of type object", dt == DT_MAP)); 827 assert (("first argument must be of type object", dt == DT_MAP));
717 map = va_arg (ap, mapstruct *); 828 map = va_arg (ap, mapstruct *);
718 829
719 if (map->cb) 830 if (map->cb)
720 gather_callbacks (callbacks, (AV *)map->cb, event); 831 gather_callbacks (callbacks, map->cb, event);
721 832
722 gather_callbacks (callbacks, cb_map, event); 833 gather_callbacks (callbacks, cb_map, event);
723 break; 834 break;
724 835
725 default: 836 default:
738 EXTEND (SP, 3); 849 EXTEND (SP, 3);
739 850
740 PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays 851 PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays
741 PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks))); 852 PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks)));
742 853
743 switch (klass_of [event]) 854 switch (KLASS_OF (event))
744 { 855 {
745 case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break; 856 case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break;
746 case KLASS_PLAYER: PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl))); break; 857 case KLASS_PLAYER: PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl))); break;
747 case KLASS_MAP: PUSHs (sv_2mortal (newSVdt (DT_MAP, map))); break; 858 case KLASS_MAP: PUSHs (sv_2mortal (newSVdt (DT_MAP, map))); break;
748 } 859 }
938 const_iv (BUILDER) 1049 const_iv (BUILDER)
939 const_iv (MATERIAL) 1050 const_iv (MATERIAL)
940 const_iv (ITEM_TRANSFORMER) 1051 const_iv (ITEM_TRANSFORMER)
941 const_iv (QUEST) 1052 const_iv (QUEST)
942 1053
1054 const_iv (NUM_SUBTYPES)
1055
943 const_iv (ST_BD_BUILD) 1056 const_iv (ST_BD_BUILD)
944 const_iv (ST_BD_REMOVE) 1057 const_iv (ST_BD_REMOVE)
945 1058
946 const_iv (ST_MAT_FLOOR) 1059 const_iv (ST_MAT_FLOOR)
947 const_iv (ST_MAT_WALL) 1060 const_iv (ST_MAT_WALL)
1175 1288
1176 const_iv (SK_EXP_ADD_SKILL) 1289 const_iv (SK_EXP_ADD_SKILL)
1177 const_iv (SK_EXP_TOTAL) 1290 const_iv (SK_EXP_TOTAL)
1178 const_iv (SK_EXP_NONE) 1291 const_iv (SK_EXP_NONE)
1179 const_iv (SK_SUBTRACT_SKILL_EXP) 1292 const_iv (SK_SUBTRACT_SKILL_EXP)
1293 const_iv (SK_EXP_SKILL_ONLY)
1180 1294
1181 const_iv (SK_LOCKPICKING) 1295 const_iv (SK_LOCKPICKING)
1182 const_iv (SK_HIDING) 1296 const_iv (SK_HIDING)
1183 const_iv (SK_SMITHERY) 1297 const_iv (SK_SMITHERY)
1184 const_iv (SK_BOWYER) 1298 const_iv (SK_BOWYER)
1288 1402
1289 const_iv (KLASS_GLOBAL) 1403 const_iv (KLASS_GLOBAL)
1290 const_iv (KLASS_OBJECT) 1404 const_iv (KLASS_OBJECT)
1291 const_iv (KLASS_PLAYER) 1405 const_iv (KLASS_PLAYER)
1292 const_iv (KLASS_MAP) 1406 const_iv (KLASS_MAP)
1293
1294 const_iv (EVENT_OBJECT_INSTANTIATE)
1295 }; 1407 };
1296 1408
1297 for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ-- > const_iv; ) 1409 for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ-- > const_iv; )
1298 newCONSTSUB (stash, (char *)civ->name, newSViv (civ->iv)); 1410 newCONSTSUB (stash, (char *)civ->name, newSViv (civ->iv));
1299 1411
1300 static const struct { 1412 static const struct {
1301 const char *name; 1413 const char *name;
1414 int skip;
1302 IV klass; 1415 IV klass;
1303 IV iv; 1416 IV iv;
1304 } *eiv, event_iv[] = { 1417 } *eiv, event_iv[] = {
1305# define def(klass,name) { # name, (IV)KLASS_ ## klass, (IV)EVENT_ ## klass ## _ ## name }, 1418# define def(klass,name) { "EVENT_" # klass "_" # name, sizeof ("EVENT_" # klass), (IV)KLASS_ ## klass, (IV)EVENT_ ## klass ## _ ## name },
1306# include "eventinc.h" 1419# include "eventinc.h"
1307# undef def 1420# undef def
1308 }; 1421 };
1309 1422
1310 AV *av = get_av ("cf::EVENT", 1); 1423 AV *av = get_av ("cf::EVENT", 1);
1311 1424
1312 for (eiv = event_iv + sizeof (event_iv) / sizeof (event_iv [0]); eiv-- > event_iv; ) 1425 for (eiv = event_iv + sizeof (event_iv) / sizeof (event_iv [0]); eiv-- > event_iv; )
1313 { 1426 {
1314 AV *event = newAV (); 1427 AV *event = newAV ();
1315 av_push (event, newSVpv ((char *)eiv->name, 0)); 1428 av_push (event, newSVpv ((char *)eiv->name + eiv->skip, 0));
1316 av_push (event, newSViv (eiv->klass)); 1429 av_push (event, newSViv (eiv->klass));
1317 av_store (av, eiv->iv, newRV_noinc ((SV *)event)); 1430 av_store (av, eiv->iv, newRV_noinc ((SV *)event));
1431 newCONSTSUB (stash, (char *)eiv->name, newSViv (eiv->iv));
1318 } 1432 }
1319 1433
1320 static const struct { 1434 static const struct {
1321 int dtype; 1435 int dtype;
1322 const char *name; 1436 const char *name;
1343 prop (CFAPI_INT, MAP_PROP_WINDDIR) 1457 prop (CFAPI_INT, MAP_PROP_WINDDIR)
1344 prop (CFAPI_INT, MAP_PROP_SKY) 1458 prop (CFAPI_INT, MAP_PROP_SKY)
1345 prop (CFAPI_INT, MAP_PROP_WPARTX) 1459 prop (CFAPI_INT, MAP_PROP_WPARTX)
1346 prop (CFAPI_INT, MAP_PROP_WPARTY) 1460 prop (CFAPI_INT, MAP_PROP_WPARTY)
1347 prop (CFAPI_STRING, MAP_PROP_MESSAGE) 1461 prop (CFAPI_STRING, MAP_PROP_MESSAGE)
1348 prop (CFAPI_PMAP, MAP_PROP_NEXT)
1349 prop (CFAPI_PREGION, MAP_PROP_REGION) 1462 prop (CFAPI_PREGION, MAP_PROP_REGION)
1350 prop (CFAPI_POBJECT, OBJECT_PROP_OB_ABOVE)
1351 prop (CFAPI_POBJECT, OBJECT_PROP_OB_BELOW)
1352 prop (CFAPI_POBJECT, OBJECT_PROP_NEXT_ACTIVE_OB) 1463 prop (CFAPI_POBJECT, OBJECT_PROP_NEXT_ACTIVE_OB)
1353 prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB) 1464 prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB)
1354 prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY) 1465 prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY)
1355 prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT) 1466 prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT)
1356 prop (CFAPI_POBJECT, OBJECT_PROP_HEAD)
1357 prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER) 1467 prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER)
1358 prop (CFAPI_PMAP, OBJECT_PROP_MAP) 1468 prop (CFAPI_PMAP, OBJECT_PROP_MAP)
1359 prop (CFAPI_INT, OBJECT_PROP_COUNT) 1469 prop (CFAPI_INT, OBJECT_PROP_COUNT)
1360 prop (CFAPI_INT, OBJECT_PROP_REFCOUNT) 1470 prop (CFAPI_INT, OBJECT_PROP_REFCOUNT)
1361 prop (CFAPI_STRING, OBJECT_PROP_NAME) 1471 prop (CFAPI_STRING, OBJECT_PROP_NAME)
1451 { 1561 {
1452 hv_store (prop_type, cprop->name, strlen (cprop->name), newSViv (cprop->dtype), 0); 1562 hv_store (prop_type, cprop->name, strlen (cprop->name), newSViv (cprop->dtype), 0);
1453 hv_store (prop_idx, cprop->name, strlen (cprop->name), newSViv (cprop->idx ), 0); 1563 hv_store (prop_idx, cprop->name, strlen (cprop->name), newSViv (cprop->idx ), 0);
1454 } 1564 }
1455 1565
1456 cb_global = get_av ("cf::CB_GLOBAL", 1);
1457 cb_object = get_av ("cf::CB_OBJECT", 1);
1458 cb_player = get_av ("cf::CB_PLAYER", 1);
1459 cb_type = get_av ("cf::CB_TYPE" , 1);
1460 cb_map = get_av ("cf::CB_MAP" , 1);
1461
1462 //I_EVENT_API (PACKAGE); 1566 //I_EVENT_API (PACKAGE);
1567}
1568
1569void _reload_1 ()
1570 CODE:
1571 cb_global = get_av ("cf::CB_GLOBAL", 1);
1572 cb_object = get_av ("cf::CB_OBJECT", 1);
1573 cb_player = get_av ("cf::CB_PLAYER", 1);
1574 cb_type = get_av ("cf::CB_TYPE" , 1);
1575 cb_map = get_av ("cf::CB_MAP" , 1);
1576
1577void _reload_2 ()
1578 CODE:
1579{
1580 // reattach to all attachable objects in the game.
1581 for (player *pl = first_player; pl; pl = pl->next)
1582 reattach (pl);
1583
1584 for (mapstruct *map = first_map; map; map = map->next)
1585 reattach (map);
1586
1587 for (object *op = objects; op; op = op->next)
1588 reattach (op);
1463} 1589}
1464 1590
1465NV floor (NV x) 1591NV floor (NV x)
1466 1592
1467NV ceil (NV x) 1593NV ceil (NV x)
1477 PROTOTYPE: $$ 1603 PROTOTYPE: $$
1478 1604
1479char *path_combine_and_normalize (char *base, char *path) 1605char *path_combine_and_normalize (char *base, char *path)
1480 PROTOTYPE: $$ 1606 PROTOTYPE: $$
1481 1607
1482char * 1608const char *
1483cf_get_maps_directory (char *path) 1609get_maps_directory (char *path)
1484 PROTOTYPE: $ 1610 PROTOTYPE: $
1485 ALIAS: maps_directory = 0 1611 ALIAS: maps_directory = 0
1612 CODE:
1613 RETVAL = create_pathname (path);
1614 OUTPUT: RETVAL
1486 1615
1487void 1616void
1488sub_generation_inc () 1617sub_generation_inc ()
1489 CODE: 1618 CODE:
1490 PL_sub_generation++; 1619 PL_sub_generation++;
1499 confdir = 3 1628 confdir = 3
1500 localdir = 4 1629 localdir = 4
1501 playerdir = 5 1630 playerdir = 5
1502 datadir = 6 1631 datadir = 6
1503 CODE: 1632 CODE:
1504{ 1633 switch (ix)
1505 int unused_type; 1634 {
1506 RETVAL = (char *)systemDirectory (&unused_type, ix); 1635 case 0: RETVAL = settings.mapdir ; break;
1507} 1636 case 1: RETVAL = settings.uniquedir; break;
1637 case 2: RETVAL = settings.tmpdir ; break;
1638 case 3: RETVAL = settings.confdir ; break;
1639 case 4: RETVAL = settings.localdir ; break;
1640 case 5: RETVAL = settings.playerdir; break;
1641 case 6: RETVAL = settings.datadir ; break;
1642 }
1508 OUTPUT: RETVAL 1643 OUTPUT: RETVAL
1509 1644
1510int 1645int
1511cf_find_animation (char *text) 1646cf_find_animation (char *text)
1512 PROTOTYPE: $ 1647 PROTOTYPE: $
1513 1648
1514int random_roll(int min, int max, object *op, int goodbad); 1649int random_roll(int min, int max, object *op, int goodbad);
1515 1650
1516const char *cost_string_from_value(uint64 cost, int approx = 0) 1651const char *cost_string_from_value(uint64 cost, int approx = 0)
1517 1652
1518int invoke (int event, SV *arg1, ...) 1653int invoke (int event, ...)
1519 CODE: 1654 CODE:
1520{ 1655 if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL");
1521 // parse first arg and call invoke_object etc as seen fit 1656 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1522 //TODO 1657 for (int i = 1; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1523 //cfperl_invoke (event, 1658 RETVAL = INVOKE_((event_type)event, ARG_AV (av));
1524} 1659 OUTPUT: RETVAL
1525 1660
1526int 1661int
1527exp_to_level (val64 exp) 1662exp_to_level (val64 exp)
1528 CODE: 1663 CODE:
1529{ 1664{
1560 RETVAL = newSVpv (resist_plus[atnr], 0); 1695 RETVAL = newSVpv (resist_plus[atnr], 0);
1561 else 1696 else
1562 XSRETURN_UNDEF; 1697 XSRETURN_UNDEF;
1563 OUTPUT: RETVAL 1698 OUTPUT: RETVAL
1564 1699
1700int
1701_valid (SV *obj)
1702 CODE:
1703 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
1704 OUTPUT:
1705 RETVAL
1706
1565MODULE = cf PACKAGE = cf::object PREFIX = cf_object_ 1707MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
1708
1709int invoke (object *op, int event, ...)
1710 CODE:
1711 if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");
1712 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1713 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1714 RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av));
1715 OUTPUT: RETVAL
1716
1717SV *registry (object *op)
1718 CODE:
1719 RETVAL = registry_of (op);
1720 OUTPUT:
1721 RETVAL
1722
1723object *head (object *op)
1724 PROTOTYPE: $
1725 ALIAS:
1726 more = 1
1727 above = 2
1728 below = 3
1729 CODE:
1730 switch (ix)
1731 {
1732 case 0: RETVAL = op->head ? op->head : op; break; // DOH!
1733 case 1: RETVAL = op->more; break;
1734 case 2: RETVAL = op->above; break;
1735 case 3: RETVAL = op->below; break;
1736 }
1737 OUTPUT:
1738 RETVAL
1566 1739
1567SV * 1740SV *
1568get_property (object *obj, int type, int idx) 1741get_property (object *obj, int type, int idx)
1569 CODE: 1742 CODE:
1570 RETVAL = newSVcfapi (type, cf_object_get_property (obj, idx)); 1743 RETVAL = newSVcfapi (type, cf_object_get_property (obj, idx));
1649 1822
1650int need_identify (const object *obj); 1823int need_identify (const object *obj);
1651 1824
1652int apply_shop_mat (object *shop_mat, object *op); 1825int apply_shop_mat (object *shop_mat, object *op);
1653 1826
1654void cf_object_move (object *op, int dir, object *originator = op) 1827int move (object *op, int dir, object *originator = op)
1828 CODE:
1829 RETVAL = move_ob (op, dir, originator);
1830 OUTPUT:
1831 RETVAL
1655 1832
1656void cf_object_apply (object *op, object *author, int flags = 0) 1833void cf_object_apply (object *op, object *author, int flags = 0)
1657 1834
1658void cf_object_apply_below (object *op) 1835void cf_object_apply_below (object *op)
1659 1836
1700int cf_object_out_of_map (object *op, int x, int y) 1877int cf_object_out_of_map (object *op, int x, int y)
1701 1878
1702void cf_object_drop (object *op, object *author) 1879void cf_object_drop (object *op, object *author)
1703 1880
1704void cf_object_take (object *op, object *author) 1881void cf_object_take (object *op, object *author)
1705
1706void cf_object_say (object *op, char *msg)
1707
1708void cf_object_speak (object *op, char *msg)
1709 1882
1710object *cf_object_insert_object (object *op, object *container) 1883object *cf_object_insert_object (object *op, object *container)
1711 1884
1712const char *cf_object_get_msg (object *ob) 1885const char *cf_object_get_msg (object *ob)
1713 ALIAS: msg = 0 1886 ALIAS: msg = 0
1767 CODE: 1940 CODE:
1768{ 1941{
1769 int unused_type; 1942 int unused_type;
1770 RETVAL = (object *)object_insert (&unused_type, ob, 0, where, orig, flag, x, y); 1943 RETVAL = (object *)object_insert (&unused_type, ob, 0, where, orig, flag, x, y);
1771} 1944}
1772
1773SV *registry (object *op)
1774 CODE:
1775 RETVAL = registry_of (op);
1776 OUTPUT:
1777 RETVAL
1778 1945
1779# syntatic sugar for easier use in event callbacks. 1946# syntatic sugar for easier use in event callbacks.
1780const char *options (object *op) 1947const char *options (object *op)
1781 CODE: 1948 CODE:
1782 RETVAL = op->name; 1949 RETVAL = op->name;
1855 2022
1856void kill_player (object *op) 2023void kill_player (object *op)
1857 2024
1858MODULE = cf PACKAGE = cf::player PREFIX = cf_player_ 2025MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
1859 2026
2027int invoke (player *pl, int event, ...)
2028 CODE:
2029 if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");
2030 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
2031 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
2032 RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av));
2033 OUTPUT: RETVAL
2034
1860SV *registry (player *pl) 2035SV *registry (player *pl)
1861 CODE: 2036 CODE:
1862 RETVAL = registry_of (pl); 2037 RETVAL = registry_of (pl);
1863 OUTPUT: 2038 OUTPUT:
1864 RETVAL 2039 RETVAL
1988 OUTPUT: RETVAL 2163 OUTPUT: RETVAL
1989 2164
1990 2165
1991MODULE = cf PACKAGE = cf::map PREFIX = cf_map_ 2166MODULE = cf PACKAGE = cf::map PREFIX = cf_map_
1992 2167
2168mapstruct *first ()
2169 PROTOTYPE:
2170 CODE:
2171 RETVAL = first_map;
2172 OUTPUT: RETVAL
2173
2174mapstruct *next (mapstruct *map)
2175 PROTOTYPE:
2176 CODE:
2177 RETVAL = map->next;
2178 OUTPUT: RETVAL
2179
2180int invoke (mapstruct *map, int event, ...)
2181 CODE:
2182 if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP");
2183 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
2184 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
2185 RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av));
2186 OUTPUT: RETVAL
2187
1993SV *registry (mapstruct *map) 2188SV *registry (mapstruct *map)
1994 CODE: 2189 CODE:
1995 RETVAL = registry_of (map); 2190 RETVAL = registry_of (map);
1996 OUTPUT: 2191 OUTPUT:
1997 RETVAL 2192 RETVAL
2016 2211
2017mapstruct *new (int width, int height) 2212mapstruct *new (int width, int height)
2018 PROTOTYPE: 2213 PROTOTYPE:
2019 CODE: 2214 CODE:
2020{ 2215{
2021 int unused_type; 2216 RETVAL = get_empty_map (width, height);
2022 RETVAL = (mapstruct*) map_get_map (&unused_type, 0, width, height);
2023} 2217}
2024 OUTPUT: 2218 OUTPUT:
2025 RETVAL 2219 RETVAL
2026 2220
2027void delete_map (mapstruct *map) 2221void delete_map (mapstruct *map)
2042 XSRETURN_UNDEF; 2236 XSRETURN_UNDEF;
2043 RETVAL = map->tile_path [dir]; 2237 RETVAL = map->tile_path [dir];
2044 OUTPUT: 2238 OUTPUT:
2045 RETVAL 2239 RETVAL
2046 2240
2047mapstruct *cf_map_get_map (char *name) 2241mapstruct *ready_map_name (char *name, int flags = 0)
2048 PROTOTYPE: $ 2242 PROTOTYPE: $;$
2049 ALIAS: map = 0 2243 ALIAS:
2244 find = 0
2245 get_map = 1
2050 2246
2051mapstruct *has_been_loaded (char *name) 2247mapstruct *has_been_loaded (char *name)
2052 PROTOTYPE: $ 2248 PROTOTYPE: $
2053
2054mapstruct *cf_map_get_first ()
2055 PROTOTYPE:
2056 ALIAS: first = 0
2057 2249
2058# whoever "designed" the plug-in api should have wasted 2250# whoever "designed" the plug-in api should have wasted
2059# his/her time with staying away from the project - would have 2251# his/her time with staying away from the project - would have
2060# saved others a lot of time, without doubt. 2252# saved others a lot of time, without doubt.
2061void set_path (mapstruct *where, char *path) 2253void set_path (mapstruct *where, char *path)
2076 2268
2077void set_unique (mapstruct *map, bool unique) 2269void set_unique (mapstruct *map, bool unique)
2078 CODE: 2270 CODE:
2079 map->unique = unique; 2271 map->unique = unique;
2080 2272
2273void
2274trigger (mapstruct *map, long connection, bool state = true)
2275 CODE:
2276 activate_connection (map, connection, state);
2277
2278void
2279get_connection (mapstruct *map, long connection)
2280 PPCODE:
2281 oblinkpt *obp = get_connection_links (map, connection);
2282 if (obp)
2283 for (objectlink *ol = obp->link; ol; ol = ol->next)
2284 XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, ol->ob)));
2285
2081object *cf_map_insert_object_there (mapstruct *where, object *op, object *originator, int flags) 2286object *cf_map_insert_object_there (mapstruct *where, object *op, object *originator, int flags)
2082 2287
2083object *cf_map_insert_object (mapstruct *where, object* op, int x, int y) 2288object *cf_map_insert_object (mapstruct *where, object* op, int x, int y)
2084 2289
2085object* cf_map_present_arch_by_name (mapstruct *map, const char* str, int nx, int ny) 2290object* cf_map_present_arch_by_name (mapstruct *map, const char* str, int nx, int ny)
2089cf_map_normalise (mapstruct *map, int x, int y) 2294cf_map_normalise (mapstruct *map, int x, int y)
2090 PPCODE: 2295 PPCODE:
2091{ 2296{
2092 mapstruct *nmap = 0; 2297 mapstruct *nmap = 0;
2093 I16 nx = 0, ny = 0; 2298 I16 nx = 0, ny = 0;
2094 int flags = cf_map_get_flags (map, &nmap, x, y, &nx, &ny); 2299 int flags = get_map_flags (map, &nmap, x, y, &nx, &ny);
2095 2300
2096 EXTEND (SP, 4); 2301 EXTEND (SP, 4);
2097 PUSHs (sv_2mortal (newSViv (flags))); 2302 PUSHs (sv_2mortal (newSViv (flags)));
2098 2303
2099 if (GIMME_V == G_ARRAY) 2304 if (GIMME_V == G_ARRAY)
2111{ 2316{
2112 object *o; 2317 object *o;
2113 mapstruct *nmap = 0; 2318 mapstruct *nmap = 0;
2114 I16 nx, ny; 2319 I16 nx, ny;
2115 2320
2116 cf_map_get_flags (map, &nmap, x, y, &nx, &ny); 2321 get_map_flags (map, &nmap, x, y, &nx, &ny);
2117 2322
2118 if (nmap) 2323 if (nmap)
2119 for (o = GET_MAP_OB (nmap, nx, ny); o; o = o->above) 2324 for (o = GET_MAP_OB (nmap, nx, ny); o; o = o->above)
2120 XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, o))); 2325 XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, o)));
2121} 2326}
2146 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; 2351 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;
2147 } 2352 }
2148 OUTPUT: 2353 OUTPUT:
2149 RETVAL 2354 RETVAL
2150 2355
2151# "deserialise" perl map data into the map # TODO# compatibility cruft, remove
2152void
2153_set_obs (mapstruct *map, SV *sv)
2154 CODE:
2155{
2156 object *o;
2157 AV *av;
2158 int x, y;
2159 AV *obs = (AV *)SvRV (sv);
2160 2356
2161 for (y = 0; y < MAP_HEIGHT (map); y++) 2357MODULE = cf PACKAGE = cf::arch
2162 for (x = 0; x < MAP_WIDTH (map); x++)
2163 {
2164 sv = *av_fetch (obs, x + y * MAP_HEIGHT (map), 1);
2165 2358
2166 if (!SvROK (sv)) 2359archetype *find (const char *name)
2167 continue; 2360 CODE:
2361 RETVAL = find_archetype (name);
2362 OUTPUT:
2363 RETVAL
2168 2364
2169 av = (AV *)SvRV (sv); 2365archetype *first()
2170
2171 for (o = GET_MAP_OB (map, x, y); o; o = o->above)
2172 {
2173 sv = av_shift (av);
2174
2175 if (SvROK (sv))
2176 {
2177 sv_magic ((SV *)SvRV (sv), 0, PERL_MAGIC_ext, (char *)o, 0);
2178 SVptr_cache_set (o, sv);
2179 }
2180 }
2181 }
2182}
2183
2184
2185MODULE = cf PACKAGE = cf::arch PREFIX = cf_archetype_
2186
2187archetype *cf_archetype_get_first()
2188 PROTOTYPE: 2366 PROTOTYPE:
2189 ALIAS: first = 0 2367 CODE:
2368 RETVAL = first_archetype;
2369 OUTPUT: RETVAL
2190 2370
2191archetype *cf_archetype_get_next (archetype *arch) 2371archetype *next (archetype *arch)
2192 ALIAS: next = 0 2372 CODE:
2373 RETVAL = arch->next;
2374 OUTPUT: RETVAL
2193 2375
2194archetype *cf_archetype_get_head (archetype *arch) 2376archetype *head (archetype *arch)
2195 ALIAS: head = 0 2377 CODE:
2378 RETVAL = arch->head;
2379 OUTPUT: RETVAL
2196 2380
2197archetype *cf_archetype_get_more (archetype *arch) 2381archetype *more (archetype *arch)
2198 ALIAS: more = 0 2382 CODE:
2383 RETVAL = arch->more;
2384 OUTPUT: RETVAL
2199 2385
2200const char *cf_archetype_get_name (archetype *arch) 2386const char *name (archetype *arch)
2201 ALIAS: name = 0 2387 CODE:
2388 RETVAL = arch->name;
2389 OUTPUT: RETVAL
2202 2390
2203object *cf_archetype_get_clone (archetype *arch) 2391object *clone (archetype *arch)
2204 ALIAS: clone = 0 2392 CODE:
2393 RETVAL = &arch->clone;
2394 OUTPUT: RETVAL
2205 2395
2206MODULE = cf PACKAGE = cf::party PREFIX = cf_party_ 2396MODULE = cf PACKAGE = cf::party
2207 2397
2208partylist *cf_party_get_first () 2398partylist *first ()
2209 PROTOTYPE: 2399 PROTOTYPE:
2210 ALIAS: first = 0 2400 CODE:
2401 RETVAL = get_firstparty ();
2402 OUTPUT: RETVAL
2211 2403
2212partylist *cf_party_get_next (partylist *party) 2404partylist *next (partylist *party)
2213 ALIAS: next = 0 2405 CODE:
2406 RETVAL = party->next;
2407 OUTPUT: RETVAL
2214 2408
2215const char *cf_party_get_name (partylist *party) 2409const char *name (partylist *party)
2410 CODE:
2411 RETVAL = party->partyname;
2412 OUTPUT: RETVAL
2216 2413
2217const char *cf_party_get_password (partylist *party) 2414const char *password (partylist *party)
2218 ALIAS: password = 0 2415 CODE:
2416 RETVAL = party->passwd;
2417 OUTPUT: RETVAL
2219 2418
2220player *cf_party_get_first_player (partylist *party) 2419MODULE = cf PACKAGE = cf::region
2221 ALIAS: first_player = 0
2222 2420
2223player *cf_party_get_next_player (partylist *party, player *op) 2421region *first ()
2224 ALIAS: next_player = 0
2225
2226
2227MODULE = cf PACKAGE = cf::region PREFIX = cf_region_
2228
2229region *cf_region_get_first ()
2230 PROTOTYPE: 2422 PROTOTYPE:
2231 ALIAS: first = 0 2423 CODE:
2424 RETVAL = first_region;
2425 OUTPUT: RETVAL
2232 2426
2427region *next (region *reg)
2428 CODE:
2429 RETVAL = reg->next;
2430 OUTPUT: RETVAL
2431
2432const char *name (region *reg)
2433 CODE:
2434 RETVAL = reg->name;
2435 OUTPUT: RETVAL
2436
2437region *parent (region *reg)
2438 CODE:
2439 RETVAL = reg->parent;
2440 OUTPUT: RETVAL
2441
2233const char *cf_region_get_name (region *reg) 2442const char *longname (region *reg)
2234 ALIAS: name = 0 2443 CODE:
2444 RETVAL = reg->longname;
2445 OUTPUT: RETVAL
2235 2446
2236region *cf_region_get_next (region *reg) 2447const char *msg (region *reg)
2237 ALIAS: next = 0 2448 CODE:
2449 RETVAL = reg->msg;
2450 OUTPUT: RETVAL
2238 2451
2239region *cf_region_get_parent (region *reg) 2452MODULE = cf PACKAGE = cf::living
2240 ALIAS: parent = 0
2241
2242const char *cf_region_get_longname (region *reg)
2243 ALIAS: longname = 0
2244
2245const char *cf_region_get_message (region *reg)
2246 ALIAS: message = 0
2247
2248
2249MODULE = cf PACKAGE = cf::living PREFIX = cf_living_
2250 2453
2251val64 2454val64
2252exp (living *liv, val64 new_val = 0) 2455exp (living *liv, val64 new_val = 0)
2253 PROTOTYPE: $;$ 2456 PROTOTYPE: $;$
2254 ALIAS: 2457 ALIAS:

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines