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.14 by root, Sun Aug 27 13:02:04 2006 UTC vs.
Revision 1.36 by elmex, Thu Aug 31 10:15:14 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)
366: filename (filename)
367{
368 av = (AV *)newAV ();
369 idx = 0;
370 av_extend ((AV *)av, 1024);
371}
372
373object_freezer::~object_freezer ()
374{
375 dSP;
376 ENTER;
377 SAVETMPS;
378 PUSHMARK (SP);
379 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
380 XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
381 PUTBACK;
382 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL);
383 FREETMPS;
384 LEAVE;
385}
386
387void object_freezer::put (extendable_base *ext)
388{
389 ext->optimise ();
390
391 if (ext->self)
392 av_store ((AV *)av, idx, SvREFCNT_inc ((SV *)ext->self));
393
394 ++idx;
395}
396
397object_thawer::object_thawer (const char *filename)
398{
399 av = 0;
400 idx = 0;
401
402 if (!filename)
403 return;
404
405 dSP;
406 ENTER;
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 {
414 SPAGAIN;
415 SV *sv = POPs;
416 if (SvROK (sv))
417 av = SvREFCNT_inc (SvRV (sv));
418 }
419
420 FREETMPS;
421 LEAVE;
422}
423
424void reattach (data_type type, void *obj) 381void reattach (data_type type, void *obj)
425{ 382{
383 //TODO only do this when the object has _attachment's
384
426 dSP; 385 dSP;
427 ENTER; 386 ENTER;
428 SAVETMPS; 387 SAVETMPS;
429 PUSHMARK (SP); 388 PUSHMARK (SP);
430 XPUSHs (sv_2mortal (newSVdt (type, obj))); 389 XPUSHs (sv_2mortal (newSVdt (type, obj)));
440 case DT_MAP: INVOKE_MAP (REATTACH, obj); break; 399 case DT_MAP: INVOKE_MAP (REATTACH, obj); break;
441 } 400 }
442} 401}
443 402
444template<class subclass> 403template<class subclass>
445void reattach (extendable<subclass> *obj) 404void reattach (attachable<subclass> *obj)
446{ 405{
406 obj->optimise ();
407
447 if (obj->self) 408 if (obj->self)
448 reattach (subclass::get_dt (), (subclass *)obj); 409 reattach ((data_type) cftype<subclass>::dt, (subclass *)obj);
449} 410}
450 411
412#include "kw_hash.h"
413
414object_freezer::object_freezer ()
415{
416 av = newAV ();
417 // TODO: fast dynbuf implementation... yeah, we need obstacks
418 text = newSV (10 * 1024 * 1024); // only temporarily used, so be generous
419}
420
421object_freezer::~object_freezer ()
422{
423 SvREFCNT_dec (text);
424 SvREFCNT_dec (av);
425}
426
427void object_freezer::put (attachable_base *ext)
428{
429 ext->optimise ();
430
431 if (ext->self)
432 {
433 int idx = AvFILLp ((AV *)av) + 1;
434 av_store (av, idx, SvREFCNT_inc (ext->self));
435
436 sv_catpvf (text, "oid %d\n", idx);
437 }
438}
439
440void object_freezer::put (keyword k)
441{
442 sv_catpv (text, keyword_str [k]);
443}
444
445void object_freezer::put (const char *v)
446{
447 sv_catpv (text, v);
448}
449
450void object_freezer::put (int v)
451{
452 sv_catpvf (text, "%d\n", v);
453}
454
455bool object_freezer::save (const char *filename)
456{
457 dSP;
458 ENTER;
459 SAVETMPS;
460 PUSHMARK (SP);
461 EXTEND (SP, 3);
462 PUSHs (sv_2mortal (newSVpv (filename, 0)));
463 PUSHs (sv_2mortal (newRV_inc (text)));
464 PUSHs (sv_2mortal (newRV_inc ((SV *)av)));
465 PUTBACK;
466 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL);
467 FREETMPS;
468 LEAVE;
469}
470
471int fprintf (object_freezer &freezer, const char *format, ...)
472{
473 va_list ap;
474
475 va_start (ap, format);
476 sv_vcatpvfn (freezer.text, format, strlen (format), &ap, 0, 0, 0);
477 va_end (ap);
478}
479
480int fputs (const char *s, object_freezer &freezer)
481{
482 sv_catpvn (freezer.text, s, strlen (s));
483}
484
485object_thawer::object_thawer (const char *filename)
486{
487 av = 0;
488 fp = 0;
489
490 if (!filename)
491 return;
492
493 fp = fopen (filename, "r");
494 if (!fp)
495 {
496 LOG (llevError, "object_thawer: unable to open '%s': %s.\n", filename, strerror (errno));
497 return;
498 }
499
500 if (perl_booted)
501 {
502 dSP;
503 ENTER;
504 SAVETMPS;
505 PUSHMARK (SP);
506 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
507 PUTBACK;
508
509 if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL))
510 {
511 SPAGAIN;
512 SV *sv = POPs;
513 if (SvROK (sv))
514 av = (AV *)SvREFCNT_inc (SvRV (sv));
515 }
516
517 FREETMPS;
518 LEAVE;
519 }
520}
521
451void object_thawer::get (data_type type, void *obj, extendable_base *ext) 522void object_thawer::get (data_type type, void *obj, attachable_base *ext, int oid)
452{ 523{
453 if (!av) 524 if (!av || oid < 0) // this is actually an error of sorts
454 return; 525 return;
455 526
456 // we have to "re-instantiate"/reattach to an object, so nuke ext->attach 527 // we have to "re-instantiate"/reattach to an object, so nuke ext->attach
457 ext->clear (); 528 ext->clear ();
458 529
459 SV **svp = av_fetch ((AV *)av, idx, 0); 530 SV **svp = av_fetch ((AV *)av, oid, 0);
460 531
461 ++idx;
462
463 if (!svp)
464 return;
465
466 if (SvROK (*svp)) 532 if (!svp || !SvROK (*svp))
467 { 533 {
468 ext->self = SvREFCNT_inc (*svp); 534 printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid);
469 sv_magic (SvRV ((SV *)ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0); 535 return;
470
471 reattach (type, obj);
472 } 536 }
537
538 ext->self = *svp; *svp = &PL_sv_undef;
539 sv_magic (SvRV (ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0);
540
541 reattach (type, obj);
473} 542}
474 543
475object_thawer::~object_thawer () 544object_thawer::~object_thawer ()
476{ 545{
477 if (av) 546 if (fp) fclose (fp);
478 SvREFCNT_dec ((SV *)av); 547 if (av) SvREFCNT_dec ((AV *)av);
479} 548}
480 549
550token object_thawer::get_token ()
551{
552#if 0
553 for (;;)
554 {
555 if (!fgets (line, sizeof (line), fp))
556 return token (KW_eof);
557
558 unsigned char *p = (unsigned char *)line;
559
560 while (*p > ' ')
561 p++;
562
563 int len = p - (unsigned char *)line;
564
565 while ((*p - 1) < ' ')
566 p++;
567
568 if (*p)
569 {
570 char *v = p;
571
572 while (*p && *p != '\n')
573 p++;
574
575 *p = 0;
576
577 return token (k, v);
578 }
579 else
580 return token (k);
581 }
582#endif
583}
584
481///////////////////////////////////////////////////////////////////////////// 585/////////////////////////////////////////////////////////////////////////////
482 586
483extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) 587extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
484{ 588{
485 gethook = gethooksptr;
486 printf (PLUGIN_VERSION " init\n");
487
488 return 0; 589 return 0;
489} 590}
490 591
491static CommArray_s rtn_cmd; 592static CommArray_s rtn_cmd;
492 593
572extern "C" int cfperl_postInitPlugin () 673extern "C" int cfperl_postInitPlugin ()
573{ 674{
574 int hooktype = 1; 675 int hooktype = 1;
575 int rtype = 0; 676 int rtype = 0;
576 677
577 printf (PLUGIN_VERSION " post init\n");
578
579 systemDirectory = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_directory");
580 object_set_property = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_set_property");
581 map_get_map = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_map_get_map");
582 object_insert = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_insert");
583
584 cf_init_plugin (gethook); 678 cf_init_plugin (gethook);
585 679
586 return 0; 680 return 0;
587} 681}
588 682
592} 686}
593 687
594void 688void
595cfperl_init () 689cfperl_init ()
596{ 690{
691 PERL_SYS_INIT3 (&settings.argc, &settings.argv, 0);
692 perl = perl_alloc ();
693 perl_construct (perl);
694
695 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
696
597 char *argv[] = { 697 char *argv[] = {
598 "", 698 "",
599 "-e" 699 "-e"
600 "BEGIN {"
601 " cf->bootstrap;" 700 "cf->bootstrap;"
602 " unshift @INC, cf::datadir ();" 701 "unshift @INC, cf::datadir ();"
603 "}"
604 ""
605 "use cf;"
606 }; 702 };
607
608 perl = perl_alloc ();
609 perl_construct (perl);
610
611 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
612 703
613 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl)) 704 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl))
614 { 705 {
615 printf ("unable to initialize perl-interpreter, aborting.\n"); 706 printf ("unable to initialize perl-interpreter, aborting.\n");
616
617 exit (EXIT_FAILURE); 707 exit (EXIT_FAILURE);
618 //perl_destruct (perl);
619 //perl_free (perl);
620 //perl = 0;
621 //return;
622 } 708 }
623 709
624 obj_cache = newHV (); 710 obj_cache = newHV ();
711}
712
713void cfperl_boot ()
714{
715 perl_booted = true;
716
717 eval_pv ("require cf", 1);
625} 718}
626 719
627void cfperl_main () 720void cfperl_main ()
628{ 721{
629 dSP; 722 dSP;
636static event_klass klass_of[NUM_EVENT_TYPES] = { 729static event_klass klass_of[NUM_EVENT_TYPES] = {
637# define def(type,name) KLASS_ ## type, 730# define def(type,name) KLASS_ ## type,
638# include "eventinc.h" 731# include "eventinc.h"
639# undef def 732# undef def
640}; 733};
734
735#define KLASS_OF(event) (((unsigned int)event) < NUM_EVENT_TYPES ? klass_of [event] : KLASS_NONE)
641 736
642static void 737static void
643gather_callbacks (AV *&callbacks, AV *registry, event_type event) 738gather_callbacks (AV *&callbacks, AV *registry, event_type event)
644{ 739{
645 // event must be in array 740 // event must be in array
688 // 2a. per-type callback 783 // 2a. per-type callback
689 // 4. global callbacks 784 // 4. global callbacks
690 785
691 gather_callbacks (callbacks, cb_global, event); 786 gather_callbacks (callbacks, cb_global, event);
692 787
693 switch (klass_of [event]) 788 switch (KLASS_OF (event))
694 { 789 {
695 case KLASS_GLOBAL: 790 case KLASS_GLOBAL:
696 break; 791 break;
697 792
698 case KLASS_OBJECT: 793 case KLASS_OBJECT:
699 dt = (data_type) va_arg (ap, int); 794 dt = (data_type) va_arg (ap, int);
700 assert (("first argument must be of type object", dt == DT_OBJECT)); 795 assert (("first argument must be of type object", dt == DT_OBJECT));
701 op = va_arg (ap, object *); 796 op = va_arg (ap, object *);
702 797
703 if (op->cb) 798 if (op->cb)
704 gather_callbacks (callbacks, (AV *)op->cb, event); 799 gather_callbacks (callbacks, op->cb, event);
705 800
706 if (op->type) 801 if (op->type)
707 { 802 {
708 if (op->subtype && op->type + op->subtype * NUM_SUBTYPES <= AvFILLp (cb_type)) 803 if (op->subtype && op->type + op->subtype * NUM_SUBTYPES <= AvFILLp (cb_type))
709 { 804 {
730 dt = (data_type) va_arg (ap, int); 825 dt = (data_type) va_arg (ap, int);
731 assert (("first argument must be of type player", dt == DT_PLAYER)); 826 assert (("first argument must be of type player", dt == DT_PLAYER));
732 pl = va_arg (ap, player *); 827 pl = va_arg (ap, player *);
733 828
734 if (pl->cb) 829 if (pl->cb)
735 gather_callbacks (callbacks, (AV *)pl->cb, event); 830 gather_callbacks (callbacks, pl->cb, event);
736 831
737 gather_callbacks (callbacks, cb_player, event); 832 gather_callbacks (callbacks, cb_player, event);
738 break; 833 break;
739 834
740 case KLASS_MAP: 835 case KLASS_MAP:
741 dt = (data_type) va_arg (ap, int); 836 dt = (data_type) va_arg (ap, int);
742 assert (("first argument must be of type object", dt == DT_MAP)); 837 assert (("first argument must be of type object", dt == DT_MAP));
743 map = va_arg (ap, mapstruct *); 838 map = va_arg (ap, mapstruct *);
744 839
745 if (map->cb) 840 if (map->cb)
746 gather_callbacks (callbacks, (AV *)map->cb, event); 841 gather_callbacks (callbacks, map->cb, event);
747 842
748 gather_callbacks (callbacks, cb_map, event); 843 gather_callbacks (callbacks, cb_map, event);
749 break; 844 break;
750 845
751 default: 846 default:
764 EXTEND (SP, 3); 859 EXTEND (SP, 3);
765 860
766 PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays 861 PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays
767 PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks))); 862 PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks)));
768 863
769 switch (klass_of [event]) 864 switch (KLASS_OF (event))
770 { 865 {
771 case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break; 866 case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break;
772 case KLASS_PLAYER: PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl))); break; 867 case KLASS_PLAYER: PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl))); break;
773 case KLASS_MAP: PUSHs (sv_2mortal (newSVdt (DT_MAP, map))); break; 868 case KLASS_MAP: PUSHs (sv_2mortal (newSVdt (DT_MAP, map))); break;
774 } 869 }
1371 prop (CFAPI_INT, MAP_PROP_WINDDIR) 1466 prop (CFAPI_INT, MAP_PROP_WINDDIR)
1372 prop (CFAPI_INT, MAP_PROP_SKY) 1467 prop (CFAPI_INT, MAP_PROP_SKY)
1373 prop (CFAPI_INT, MAP_PROP_WPARTX) 1468 prop (CFAPI_INT, MAP_PROP_WPARTX)
1374 prop (CFAPI_INT, MAP_PROP_WPARTY) 1469 prop (CFAPI_INT, MAP_PROP_WPARTY)
1375 prop (CFAPI_STRING, MAP_PROP_MESSAGE) 1470 prop (CFAPI_STRING, MAP_PROP_MESSAGE)
1376 prop (CFAPI_PMAP, MAP_PROP_NEXT)
1377 prop (CFAPI_PREGION, MAP_PROP_REGION) 1471 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) 1472 prop (CFAPI_POBJECT, OBJECT_PROP_NEXT_ACTIVE_OB)
1381 prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB) 1473 prop (CFAPI_POBJECT, OBJECT_PROP_PREV_ACTIVE_OB)
1382 prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY) 1474 prop (CFAPI_POBJECT, OBJECT_PROP_INVENTORY)
1383 prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT) 1475 prop (CFAPI_POBJECT, OBJECT_PROP_ENVIRONMENT)
1384 prop (CFAPI_POBJECT, OBJECT_PROP_HEAD)
1385 prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER) 1476 prop (CFAPI_POBJECT, OBJECT_PROP_CONTAINER)
1386 prop (CFAPI_PMAP, OBJECT_PROP_MAP) 1477 prop (CFAPI_PMAP, OBJECT_PROP_MAP)
1387 prop (CFAPI_INT, OBJECT_PROP_COUNT) 1478 prop (CFAPI_INT, OBJECT_PROP_COUNT)
1388 prop (CFAPI_INT, OBJECT_PROP_REFCOUNT) 1479 prop (CFAPI_INT, OBJECT_PROP_REFCOUNT)
1389 prop (CFAPI_STRING, OBJECT_PROP_NAME) 1480 prop (CFAPI_STRING, OBJECT_PROP_NAME)
1521 PROTOTYPE: $$ 1612 PROTOTYPE: $$
1522 1613
1523char *path_combine_and_normalize (char *base, char *path) 1614char *path_combine_and_normalize (char *base, char *path)
1524 PROTOTYPE: $$ 1615 PROTOTYPE: $$
1525 1616
1526char * 1617const char *
1527cf_get_maps_directory (char *path) 1618get_maps_directory (char *path)
1528 PROTOTYPE: $ 1619 PROTOTYPE: $
1529 ALIAS: maps_directory = 0 1620 ALIAS: maps_directory = 0
1621 CODE:
1622 RETVAL = create_pathname (path);
1623 OUTPUT: RETVAL
1530 1624
1531void 1625void
1532sub_generation_inc () 1626sub_generation_inc ()
1533 CODE: 1627 CODE:
1534 PL_sub_generation++; 1628 PL_sub_generation++;
1543 confdir = 3 1637 confdir = 3
1544 localdir = 4 1638 localdir = 4
1545 playerdir = 5 1639 playerdir = 5
1546 datadir = 6 1640 datadir = 6
1547 CODE: 1641 CODE:
1548{ 1642 switch (ix)
1549 int unused_type; 1643 {
1550 RETVAL = (char *)systemDirectory (&unused_type, ix); 1644 case 0: RETVAL = settings.mapdir ; break;
1551} 1645 case 1: RETVAL = settings.uniquedir; break;
1646 case 2: RETVAL = settings.tmpdir ; break;
1647 case 3: RETVAL = settings.confdir ; break;
1648 case 4: RETVAL = settings.localdir ; break;
1649 case 5: RETVAL = settings.playerdir; break;
1650 case 6: RETVAL = settings.datadir ; break;
1651 }
1552 OUTPUT: RETVAL 1652 OUTPUT: RETVAL
1553 1653
1554int 1654int
1555cf_find_animation (char *text) 1655cf_find_animation (char *text)
1556 PROTOTYPE: $ 1656 PROTOTYPE: $
1557 1657
1558int random_roll(int min, int max, object *op, int goodbad); 1658int random_roll(int min, int max, object *op, int goodbad);
1559 1659
1560const char *cost_string_from_value(uint64 cost, int approx = 0) 1660const char *cost_string_from_value(uint64 cost, int approx = 0)
1561 1661
1562int invoke (int event, SV *arg1, ...) 1662int invoke (int event, ...)
1563 CODE: 1663 CODE:
1564{ 1664 if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL");
1565 // parse first arg and call invoke_object etc as seen fit 1665 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1566 //TODO 1666 for (int i = 1; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1567 //cfperl_invoke (event, 1667 RETVAL = INVOKE_((event_type)event, ARG_AV (av));
1568} 1668 OUTPUT: RETVAL
1569 1669
1570int 1670int
1571exp_to_level (val64 exp) 1671exp_to_level (val64 exp)
1572 CODE: 1672 CODE:
1573{ 1673{
1604 RETVAL = newSVpv (resist_plus[atnr], 0); 1704 RETVAL = newSVpv (resist_plus[atnr], 0);
1605 else 1705 else
1606 XSRETURN_UNDEF; 1706 XSRETURN_UNDEF;
1607 OUTPUT: RETVAL 1707 OUTPUT: RETVAL
1608 1708
1709int
1710_valid (SV *obj)
1711 CODE:
1712 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
1713 OUTPUT:
1714 RETVAL
1715
1609MODULE = cf PACKAGE = cf::object PREFIX = cf_object_ 1716MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
1717
1718int invoke (object *op, int event, ...)
1719 CODE:
1720 if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");
1721 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1722 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1723 RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av));
1724 OUTPUT: RETVAL
1725
1726SV *registry (object *op)
1727 CODE:
1728 RETVAL = registry_of (op);
1729 OUTPUT:
1730 RETVAL
1731
1732object *head (object *op)
1733 PROTOTYPE: $
1734 ALIAS:
1735 more = 1
1736 above = 2
1737 below = 3
1738 CODE:
1739 switch (ix)
1740 {
1741 case 0: RETVAL = op->head ? op->head : op; break; // DOH!
1742 case 1: RETVAL = op->more; break;
1743 case 2: RETVAL = op->above; break;
1744 case 3: RETVAL = op->below; break;
1745 }
1746 OUTPUT:
1747 RETVAL
1610 1748
1611SV * 1749SV *
1612get_property (object *obj, int type, int idx) 1750get_property (object *obj, int type, int idx)
1613 CODE: 1751 CODE:
1614 RETVAL = newSVcfapi (type, cf_object_get_property (obj, idx)); 1752 RETVAL = newSVcfapi (type, cf_object_get_property (obj, idx));
1693 1831
1694int need_identify (const object *obj); 1832int need_identify (const object *obj);
1695 1833
1696int apply_shop_mat (object *shop_mat, object *op); 1834int apply_shop_mat (object *shop_mat, object *op);
1697 1835
1698void cf_object_move (object *op, int dir, object *originator = op) 1836int move (object *op, int dir, object *originator = op)
1837 CODE:
1838 RETVAL = move_ob (op, dir, originator);
1839 OUTPUT:
1840 RETVAL
1699 1841
1700void cf_object_apply (object *op, object *author, int flags = 0) 1842void cf_object_apply (object *op, object *author, int flags = 0)
1701 1843
1702void cf_object_apply_below (object *op) 1844void cf_object_apply_below (object *op)
1703 1845
1744int cf_object_out_of_map (object *op, int x, int y) 1886int cf_object_out_of_map (object *op, int x, int y)
1745 1887
1746void cf_object_drop (object *op, object *author) 1888void cf_object_drop (object *op, object *author)
1747 1889
1748void cf_object_take (object *op, object *author) 1890void cf_object_take (object *op, object *author)
1749
1750void cf_object_say (object *op, char *msg)
1751
1752void cf_object_speak (object *op, char *msg)
1753 1891
1754object *cf_object_insert_object (object *op, object *container) 1892object *cf_object_insert_object (object *op, object *container)
1755 1893
1756const char *cf_object_get_msg (object *ob) 1894const char *cf_object_get_msg (object *ob)
1757 ALIAS: msg = 0 1895 ALIAS: msg = 0
1811 CODE: 1949 CODE:
1812{ 1950{
1813 int unused_type; 1951 int unused_type;
1814 RETVAL = (object *)object_insert (&unused_type, ob, 0, where, orig, flag, x, y); 1952 RETVAL = (object *)object_insert (&unused_type, ob, 0, where, orig, flag, x, y);
1815} 1953}
1816
1817SV *registry (object *op)
1818 CODE:
1819 RETVAL = registry_of (op);
1820 OUTPUT:
1821 RETVAL
1822 1954
1823# syntatic sugar for easier use in event callbacks. 1955# syntatic sugar for easier use in event callbacks.
1824const char *options (object *op) 1956const char *options (object *op)
1825 CODE: 1957 CODE:
1826 RETVAL = op->name; 1958 RETVAL = op->name;
1899 2031
1900void kill_player (object *op) 2032void kill_player (object *op)
1901 2033
1902MODULE = cf PACKAGE = cf::player PREFIX = cf_player_ 2034MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
1903 2035
2036int invoke (player *pl, int event, ...)
2037 CODE:
2038 if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");
2039 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
2040 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
2041 RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av));
2042 OUTPUT: RETVAL
2043
1904SV *registry (player *pl) 2044SV *registry (player *pl)
1905 CODE: 2045 CODE:
1906 RETVAL = registry_of (pl); 2046 RETVAL = registry_of (pl);
1907 OUTPUT: 2047 OUTPUT:
1908 RETVAL 2048 RETVAL
2032 OUTPUT: RETVAL 2172 OUTPUT: RETVAL
2033 2173
2034 2174
2035MODULE = cf PACKAGE = cf::map PREFIX = cf_map_ 2175MODULE = cf PACKAGE = cf::map PREFIX = cf_map_
2036 2176
2177mapstruct *first ()
2178 PROTOTYPE:
2179 CODE:
2180 RETVAL = first_map;
2181 OUTPUT: RETVAL
2182
2183mapstruct *next (mapstruct *map)
2184 PROTOTYPE:
2185 CODE:
2186 RETVAL = map->next;
2187 OUTPUT: RETVAL
2188
2189int invoke (mapstruct *map, int event, ...)
2190 CODE:
2191 if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP");
2192 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
2193 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
2194 RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av));
2195 OUTPUT: RETVAL
2196
2037SV *registry (mapstruct *map) 2197SV *registry (mapstruct *map)
2038 CODE: 2198 CODE:
2039 RETVAL = registry_of (map); 2199 RETVAL = registry_of (map);
2040 OUTPUT: 2200 OUTPUT:
2041 RETVAL 2201 RETVAL
2060 2220
2061mapstruct *new (int width, int height) 2221mapstruct *new (int width, int height)
2062 PROTOTYPE: 2222 PROTOTYPE:
2063 CODE: 2223 CODE:
2064{ 2224{
2065 int unused_type; 2225 RETVAL = get_empty_map (width, height);
2066 RETVAL = (mapstruct*) map_get_map (&unused_type, 0, width, height);
2067} 2226}
2068 OUTPUT: 2227 OUTPUT:
2069 RETVAL 2228 RETVAL
2070 2229
2071void delete_map (mapstruct *map) 2230void delete_map (mapstruct *map)
2086 XSRETURN_UNDEF; 2245 XSRETURN_UNDEF;
2087 RETVAL = map->tile_path [dir]; 2246 RETVAL = map->tile_path [dir];
2088 OUTPUT: 2247 OUTPUT:
2089 RETVAL 2248 RETVAL
2090 2249
2091mapstruct *cf_map_get_map (char *name) 2250mapstruct *ready_map_name (char *name, int flags = 0)
2092 PROTOTYPE: $ 2251 PROTOTYPE: $;$
2093 ALIAS: map = 0 2252 ALIAS:
2253 find = 0
2254 get_map = 1
2094 2255
2095mapstruct *has_been_loaded (char *name) 2256mapstruct *has_been_loaded (char *name)
2096 PROTOTYPE: $ 2257 PROTOTYPE: $
2097
2098mapstruct *cf_map_get_first ()
2099 PROTOTYPE:
2100 ALIAS: first = 0
2101 2258
2102# whoever "designed" the plug-in api should have wasted 2259# whoever "designed" the plug-in api should have wasted
2103# his/her time with staying away from the project - would have 2260# his/her time with staying away from the project - would have
2104# saved others a lot of time, without doubt. 2261# saved others a lot of time, without doubt.
2105void set_path (mapstruct *where, char *path) 2262void set_path (mapstruct *where, char *path)
2120 2277
2121void set_unique (mapstruct *map, bool unique) 2278void set_unique (mapstruct *map, bool unique)
2122 CODE: 2279 CODE:
2123 map->unique = unique; 2280 map->unique = unique;
2124 2281
2282void
2283trigger (mapstruct *map, long connection, bool state = true)
2284 CODE:
2285 activate_connection (map, connection, state);
2286
2287void
2288get_connection (mapstruct *map, long connection)
2289 PPCODE:
2290 oblinkpt *obp = get_connection_links (map, connection);
2291 if (obp)
2292 for (objectlink *ol = obp->link; ol; ol = ol->next)
2293 XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, ol->ob)));
2294
2125object *cf_map_insert_object_there (mapstruct *where, object *op, object *originator, int flags) 2295object *cf_map_insert_object_there (mapstruct *where, object *op, object *originator, int flags)
2126 2296
2127object *cf_map_insert_object (mapstruct *where, object* op, int x, int y) 2297object *cf_map_insert_object (mapstruct *where, object* op, int x, int y)
2128 2298
2129object* cf_map_present_arch_by_name (mapstruct *map, const char* str, int nx, int ny) 2299object* cf_map_present_arch_by_name (mapstruct *map, const char* str, int nx, int ny)
2133cf_map_normalise (mapstruct *map, int x, int y) 2303cf_map_normalise (mapstruct *map, int x, int y)
2134 PPCODE: 2304 PPCODE:
2135{ 2305{
2136 mapstruct *nmap = 0; 2306 mapstruct *nmap = 0;
2137 I16 nx = 0, ny = 0; 2307 I16 nx = 0, ny = 0;
2138 int flags = cf_map_get_flags (map, &nmap, x, y, &nx, &ny); 2308 int flags = get_map_flags (map, &nmap, x, y, &nx, &ny);
2139 2309
2140 EXTEND (SP, 4); 2310 EXTEND (SP, 4);
2141 PUSHs (sv_2mortal (newSViv (flags))); 2311 PUSHs (sv_2mortal (newSViv (flags)));
2142 2312
2143 if (GIMME_V == G_ARRAY) 2313 if (GIMME_V == G_ARRAY)
2155{ 2325{
2156 object *o; 2326 object *o;
2157 mapstruct *nmap = 0; 2327 mapstruct *nmap = 0;
2158 I16 nx, ny; 2328 I16 nx, ny;
2159 2329
2160 cf_map_get_flags (map, &nmap, x, y, &nx, &ny); 2330 get_map_flags (map, &nmap, x, y, &nx, &ny);
2161 2331
2162 if (nmap) 2332 if (nmap)
2163 for (o = GET_MAP_OB (nmap, nx, ny); o; o = o->above) 2333 for (o = GET_MAP_OB (nmap, nx, ny); o; o = o->above)
2164 XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, o))); 2334 XPUSHs (sv_2mortal (newSVcfapi (CFAPI_POBJECT, o)));
2165} 2335}
2190 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; 2360 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;
2191 } 2361 }
2192 OUTPUT: 2362 OUTPUT:
2193 RETVAL 2363 RETVAL
2194 2364
2195# "deserialise" perl map data into the map # TODO# compatibility cruft, remove
2196void
2197_set_obs (mapstruct *map, SV *sv)
2198 CODE:
2199{
2200 object *o;
2201 AV *av;
2202 int x, y;
2203 AV *obs = (AV *)SvRV (sv);
2204 2365
2205 for (y = 0; y < MAP_HEIGHT (map); y++) 2366MODULE = cf PACKAGE = cf::arch
2206 for (x = 0; x < MAP_WIDTH (map); x++)
2207 {
2208 sv = *av_fetch (obs, x + y * MAP_HEIGHT (map), 1);
2209 2367
2210 if (!SvROK (sv)) 2368archetype *find (const char *name)
2211 continue; 2369 CODE:
2370 RETVAL = find_archetype (name);
2371 OUTPUT:
2372 RETVAL
2212 2373
2213 av = (AV *)SvRV (sv); 2374archetype *first()
2214
2215 for (o = GET_MAP_OB (map, x, y); o; o = o->above)
2216 {
2217 sv = av_shift (av);
2218
2219 if (SvROK (sv))
2220 {
2221 sv_magic ((SV *)SvRV (sv), 0, PERL_MAGIC_ext, (char *)o, 0);
2222 SVptr_cache_set (o, sv);
2223 }
2224 }
2225 }
2226}
2227
2228
2229MODULE = cf PACKAGE = cf::arch PREFIX = cf_archetype_
2230
2231archetype *cf_archetype_get_first()
2232 PROTOTYPE: 2375 PROTOTYPE:
2233 ALIAS: first = 0 2376 CODE:
2377 RETVAL = first_archetype;
2378 OUTPUT: RETVAL
2234 2379
2235archetype *cf_archetype_get_next (archetype *arch) 2380archetype *next (archetype *arch)
2236 ALIAS: next = 0 2381 CODE:
2382 RETVAL = arch->next;
2383 OUTPUT: RETVAL
2237 2384
2238archetype *cf_archetype_get_head (archetype *arch) 2385archetype *head (archetype *arch)
2239 ALIAS: head = 0 2386 CODE:
2387 RETVAL = arch->head;
2388 OUTPUT: RETVAL
2240 2389
2241archetype *cf_archetype_get_more (archetype *arch) 2390archetype *more (archetype *arch)
2242 ALIAS: more = 0 2391 CODE:
2392 RETVAL = arch->more;
2393 OUTPUT: RETVAL
2243 2394
2244const char *cf_archetype_get_name (archetype *arch) 2395const char *name (archetype *arch)
2245 ALIAS: name = 0 2396 CODE:
2397 RETVAL = arch->name;
2398 OUTPUT: RETVAL
2246 2399
2247object *cf_archetype_get_clone (archetype *arch) 2400object *clone (archetype *arch)
2248 ALIAS: clone = 0 2401 CODE:
2402 RETVAL = &arch->clone;
2403 OUTPUT: RETVAL
2249 2404
2250MODULE = cf PACKAGE = cf::party PREFIX = cf_party_ 2405MODULE = cf PACKAGE = cf::party
2251 2406
2252partylist *cf_party_get_first () 2407partylist *first ()
2253 PROTOTYPE: 2408 PROTOTYPE:
2254 ALIAS: first = 0 2409 CODE:
2410 RETVAL = get_firstparty ();
2411 OUTPUT: RETVAL
2255 2412
2256partylist *cf_party_get_next (partylist *party) 2413partylist *next (partylist *party)
2257 ALIAS: next = 0 2414 CODE:
2415 RETVAL = party->next;
2416 OUTPUT: RETVAL
2258 2417
2259const char *cf_party_get_name (partylist *party) 2418const char *name (partylist *party)
2419 CODE:
2420 RETVAL = party->partyname;
2421 OUTPUT: RETVAL
2260 2422
2261const char *cf_party_get_password (partylist *party) 2423const char *password (partylist *party)
2262 ALIAS: password = 0 2424 CODE:
2425 RETVAL = party->passwd;
2426 OUTPUT: RETVAL
2263 2427
2264player *cf_party_get_first_player (partylist *party) 2428MODULE = cf PACKAGE = cf::region
2265 ALIAS: first_player = 0
2266 2429
2267player *cf_party_get_next_player (partylist *party, player *op) 2430region *first ()
2268 ALIAS: next_player = 0
2269
2270
2271MODULE = cf PACKAGE = cf::region PREFIX = cf_region_
2272
2273region *cf_region_get_first ()
2274 PROTOTYPE: 2431 PROTOTYPE:
2275 ALIAS: first = 0 2432 CODE:
2433 RETVAL = first_region;
2434 OUTPUT: RETVAL
2276 2435
2436region *next (region *reg)
2437 CODE:
2438 RETVAL = reg->next;
2439 OUTPUT: RETVAL
2440
2441const char *name (region *reg)
2442 CODE:
2443 RETVAL = reg->name;
2444 OUTPUT: RETVAL
2445
2446region *parent (region *reg)
2447 CODE:
2448 RETVAL = reg->parent;
2449 OUTPUT: RETVAL
2450
2277const char *cf_region_get_name (region *reg) 2451const char *longname (region *reg)
2278 ALIAS: name = 0 2452 CODE:
2453 RETVAL = reg->longname;
2454 OUTPUT: RETVAL
2279 2455
2280region *cf_region_get_next (region *reg) 2456const char *msg (region *reg)
2281 ALIAS: next = 0 2457 CODE:
2458 RETVAL = reg->msg;
2459 OUTPUT: RETVAL
2282 2460
2283region *cf_region_get_parent (region *reg) 2461MODULE = cf PACKAGE = cf::living
2284 ALIAS: parent = 0
2285
2286const char *cf_region_get_longname (region *reg)
2287 ALIAS: longname = 0
2288
2289const char *cf_region_get_message (region *reg)
2290 ALIAS: message = 0
2291
2292
2293MODULE = cf PACKAGE = cf::living PREFIX = cf_living_
2294 2462
2295val64 2463val64
2296exp (living *liv, val64 new_val = 0) 2464exp (living *liv, val64 new_val = 0)
2297 PROTOTYPE: $;$ 2465 PROTOTYPE: $;$
2298 ALIAS: 2466 ALIAS:

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines