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.11 by root, Sat Aug 26 08:44:06 2006 UTC vs.
Revision 1.18 by root, Mon Aug 28 07:07:42 2006 UTC

… …
28#include <XSUB.h> 28#include <XSUB.h>
29 29
30#undef save_long // clashes with libproto.h 30#undef save_long // clashes with libproto.h
31 31
32#define PLUGIN_NAME "perl" 32#define PLUGIN_NAME "perl"
33#define PLUGIN_VERSION "cfperl 0.3" 33#define PLUGIN_VERSION "cfperl 0.5"
34 34
35#ifndef __CEXTRACT__ 35#ifndef __CEXTRACT__
36#include <plugin.h> 36#include <plugin.h>
37#endif 37#endif
38 38
… …
46#include <sounds.h> 46#include <sounds.h>
47#include <cstdarg> 47#include <cstdarg>
48#include <sproto.h> 48#include <sproto.h>
49 49
50#include "cfperl.h" 50#include "cfperl.h"
51#include "shstr.h"
51 52
52#include "perlxsi.c" 53#include "perlxsi.c"
53
54static void *globalEventListener (int *type, ...);
55 54
56extern sint64 *levels; // the experience table 55extern sint64 *levels; // the experience table
57 56
58typedef object object_ornull; 57typedef object object_ornull;
59typedef mapstruct mapstruct_ornull; 58typedef mapstruct mapstruct_ornull;
… …
61typedef double val64; 60typedef double val64;
62#define newSVval64 newSVnv 61#define newSVval64 newSVnv
63#define SvVAL64 SvNV 62#define SvVAL64 SvNV
64 63
65static f_plug_api gethook; 64static f_plug_api gethook;
66static f_plug_api registerGlobalEvent;
67static f_plug_api unregisterGlobalEvent;
68static f_plug_api systemDirectory; 65static f_plug_api systemDirectory;
69static f_plug_api object_set_property; 66static f_plug_api object_set_property;
70static f_plug_api map_get_map; 67static f_plug_api map_get_map;
71static f_plug_api object_insert; 68static f_plug_api object_insert;
72 69
… …
100#define PUSH_IV PUSHs (sv_2mortal (newSViv (va_arg (args, int)))) 97#define PUSH_IV PUSHs (sv_2mortal (newSViv (va_arg (args, int))))
101 98
102////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 99//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
103 100
104static SV * 101static SV *
105newSVptr (void *ptr, const char *klass) 102newSVptr (void *ptr, const char *klass, HV *hv = newHV ())
106{ 103{
107 SV *sv; 104 SV *sv;
108 105
109 if (!ptr) 106 if (!ptr)
110 return &PL_sv_undef; 107 return &PL_sv_undef;
111 108
112 sv = (SV *)newHV ();
113 sv_magic (sv, 0, PERL_MAGIC_ext, (char *)ptr, 0); 109 sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0);
114 return sv_bless (newRV_noinc (sv), gv_stashpv (klass, 1)); 110 return sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
115} 111}
116 112
117template<class extendable> 113template<class attachable>
118SV * 114SV *
119newSVextendable (extendable *obj, const char *klass) 115newSVattachable (attachable *obj, const char *klass)
120{ 116{
121 if (!obj) 117 if (!obj)
122 return &PL_sv_undef; 118 return &PL_sv_undef;
123 119
124 if (!obj->self) 120 if (!obj->self)
… …
201{ 197{
202 SV *sv; 198 SV *sv;
203 199
204 switch (type) 200 switch (type)
205 { 201 {
206 // first three exist only for cfapi-compatibility
207 case DT_INT_PTR:
208 sv = newSViv (*va_arg (ap, int *));
209 break;
210
211 case DT_INT64_PTR:
212 sv = newSVval64 ((val64)*va_arg (ap, sint64 *));
213 break;
214
215 case DT_DOUBLE_PTR:
216 sv = newSVnv (*va_arg (ap, double *));
217 break;
218
219 case DT_INT: 202 case DT_INT:
220 sv = newSViv (va_arg (ap, int)); 203 sv = newSViv (va_arg (ap, int));
221 break; 204 break;
222 205
223 case DT_INT64: 206 case DT_INT64:
… …
244 break; 227 break;
245 228
246 case DT_OBJECT: 229 case DT_OBJECT:
247 { 230 {
248 object *obj = va_arg (ap, object *); 231 object *obj = va_arg (ap, object *);
249 sv = newSVextendable (obj, obj->type == PLAYER ? "cf::object::player::wrap" : "cf::object::wrap"); 232 sv = newSVattachable (obj, obj && obj->type == PLAYER ? "cf::object::player::wrap" : "cf::object::wrap");
250 } 233 }
251 break; 234 break;
252 235
253 case DT_MAP: 236 case DT_MAP:
254 // va_arg (object *) when void * is passed is an XSI extension 237 // va_arg (object *) when void * is passed is an XSI extension
255 sv = newSVextendable (va_arg (ap, mapstruct *), "cf::map::wrap"); 238 sv = newSVattachable (va_arg (ap, mapstruct *), "cf::map::wrap");
256 break; 239 break;
257 240
258 case DT_PLAYER: 241 case DT_PLAYER:
259 sv = newSVextendable (va_arg (ap, player *), "cf::player::wrap"); 242 sv = newSVattachable (va_arg (ap, player *), "cf::player::wrap");
260 break; 243 break;
261 244
262 case DT_ARCH: 245 case DT_ARCH:
263 sv = newSVptr (va_arg (ap, archetype *), "cf::arch::wrap"); 246 sv = newSVptr (va_arg (ap, archetype *), "cf::arch::wrap");
264 break; 247 break;
… …
298 va_list ap; 281 va_list ap;
299 va_start (ap, type); 282 va_start (ap, type);
300 283
301 switch (type) 284 switch (type)
302 { 285 {
303 case CFAPI_INT: sv = newSVdt_va (ap, DT_INT_PTR ); break; 286 case CFAPI_INT: sv = newSViv (*va_arg (ap, int * )); break;
304 case CFAPI_LONG: sv = newSVdt_va (ap, DT_INT64_PTR ); break; 287 case CFAPI_LONG: sv = newSVval64 (*va_arg (ap, sint64 *)); break;
305 case CFAPI_DOUBLE: sv = newSVdt_va (ap, DT_DOUBLE_PTR); break; 288 case CFAPI_DOUBLE: sv = newSVnv (*va_arg (ap, double *)); break;
306 case CFAPI_STRING: sv = newSVdt_va (ap, DT_STRING); break; 289 case CFAPI_STRING: sv = newSVdt_va (ap, DT_STRING); break;
307 case CFAPI_POBJECT: sv = newSVdt_va (ap, DT_OBJECT); break; 290 case CFAPI_POBJECT: sv = newSVdt_va (ap, DT_OBJECT); break;
308 case CFAPI_PMAP: sv = newSVdt_va (ap, DT_MAP ); break; 291 case CFAPI_PMAP: sv = newSVdt_va (ap, DT_MAP ); break;
309 case CFAPI_PPLAYER: sv = newSVdt_va (ap, DT_PLAYER); break; 292 case CFAPI_PPLAYER: sv = newSVdt_va (ap, DT_PLAYER); break;
310 case CFAPI_PARCH: sv = newSVdt_va (ap, DT_ARCH ); break; 293 case CFAPI_PARCH: sv = newSVdt_va (ap, DT_ARCH ); break;
… …
320 return sv; 303 return sv;
321} 304}
322 305
323////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 306//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
324 307
308SV *
309registry_of (attachable_base *ext)
310{
311 if (!ext->cb)
312 ext->cb = newAV ();
313
314 return newRV_inc ((SV *)ext->cb);
315}
316
325void extendable_base::clear () 317void attachable_base::clear ()
326{ 318{
327 //if (self) fprintf (stderr, "free_ob_self %p\n", this);//D 319 //if (self) fprintf (stderr, "free_ob_self %p %s (%p,%p)\n", this, ((object *)this)->name, self, cb);//D
320
328 if (self) SvREFCNT_dec (self), self = 0; 321 if (self) SvREFCNT_dec (self);
329 if (cb) SvREFCNT_dec (cb), cb = 0; 322 if (cb) SvREFCNT_dec (cb);
330}
331 323
324 if (attach) free_string (attach);
325
326 self = 0;
327 cb = 0;
328 attach = 0;
329}
330
332void extendable_base::optimise () 331void attachable_base::optimise ()
333{ 332{
334 // optional, and not used yet anyways 333 if (!self)
335// // empty and unreferenced? nuke it 334 return;
336// if (SvREFCNT (sv) == 1 && SvREFCNT (SvRV (sv)) == 1 && !HvFILL ((HV *)(SvRV (sv))))
337// {
338// hv_delete (obj_cache, HeKEY (he), HeKLEN (he), G_DISCARD);
339// todo++;
340// }
341 335
342} 336 HV *hv = (HV *)SvRV ((SV *)self);
343 337
344void extendable_base::reattach (data_type type, void *self) 338 if (SvREFCNT ((SV *)self) == 1
339 && SvREFCNT ((SV *)hv) == 1
340 && !HvKEYS (hv))
341 {
342 SvREFCNT_dec ((SV *)self);
343 self = 0;
344 }
345}
346
347void
348object::instantiate_ ()
345{ 349{
346 dSP; 350 dSP;
347
348 ENTER; 351 ENTER;
349 SAVETMPS; 352 SAVETMPS;
350 PUSHMARK (SP); 353 PUSHMARK (SP);
351 EXTEND (SP, 1); 354 EXTEND (SP, 2);
355 PUSHs (sv_2mortal (newSVdt (DT_OBJECT, static_cast<object *>(this))));
356 PUSHs (sv_2mortal (newSVpv (attach, 0)));
357 PUTBACK;
358 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL);
359 FREETMPS;
360 LEAVE;
361
362 INVOKE_OBJECT (INSTANTIATE, this);
363}
364
365/////////////////////////////////////////////////////////////////////////////
366
367void reattach (data_type type, void *obj)
368{
369 dSP;
370 ENTER;
371 SAVETMPS;
372 PUSHMARK (SP);
352 PUSHs (sv_2mortal (newSVdt (type, self))); 373 XPUSHs (sv_2mortal (newSVdt (type, obj)));
353 PUTBACK; 374 PUTBACK;
354 call_pv ("cf::reattach", G_DISCARD | G_VOID | G_EVAL); 375 call_pv ("cf::reattach", G_DISCARD | G_VOID | G_EVAL);
355 FREETMPS; 376 FREETMPS;
356 LEAVE; 377 LEAVE;
357}
358 378
359void extendable_base::instantiate (data_type type, void *self) 379 switch (type)
380 {
381 case DT_OBJECT: INVOKE_OBJECT (REATTACH, obj); break;
382 case DT_PLAYER: INVOKE_PLAYER (REATTACH, obj); break;
383 case DT_MAP: INVOKE_MAP (REATTACH, obj); break;
384 }
385}
386
387template<class subclass>
388void reattach (attachable<subclass> *obj)
389{
390 obj->optimise ();
391
392 if (obj->self)
393 reattach (subclass::get_dt (), (subclass *)obj);
394}
395
396object_freezer::object_freezer (const char *filename)
397: filename (filename)
398{
399 av = (AV *)newAV ();
400}
401
402object_freezer::~object_freezer ()
360{ 403{
361 dSP; 404 dSP;
362
363 ENTER; 405 ENTER;
364 SAVETMPS; 406 SAVETMPS;
365 PUSHMARK (SP); 407 PUSHMARK (SP);
366 EXTEND (SP, 1);
367 PUSHs (sv_2mortal (newSVdt (type, self))); 408 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
409 XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
368 PUTBACK; 410 PUTBACK;
369 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL); 411 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL);
370 FREETMPS; 412 FREETMPS;
371 LEAVE; 413 LEAVE;
372} 414}
373 415
374void extendable_base::clone (data_type type, void *self, void *dest) 416void object_freezer::put (FILE *fp, attachable_base *ext)
375{ 417{
418 ext->optimise ();
419
420 if (ext->self)
421 {
422 int idx = AvFILLp ((AV *)av) + 1;
423 av_store ((AV *)av, idx, SvREFCNT_inc ((SV *)ext->self));
424 fprintf (fp, "oid %d\n", idx);
425 }
426}
427
428object_thawer::object_thawer (const char *filename)
429{
430 av = 0;
431
432 if (!filename)
433 return;
434
376 dSP; 435 dSP;
377
378 ENTER; 436 ENTER;
379 SAVETMPS; 437 SAVETMPS;
380 PUSHMARK (SP); 438 PUSHMARK (SP);
381 EXTEND (SP, 1);
382 PUSHs (sv_2mortal (newSVdt (type, self))); 439 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
383 PUSHs (sv_2mortal (newSVdt (type, dest)));
384 PUTBACK; 440 PUTBACK;
385 call_pv ("cf::clone", G_DISCARD | G_VOID | G_EVAL); 441
442 if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL))
443 {
444 SPAGAIN;
445 SV *sv = POPs;
446 if (SvROK (sv))
447 av = SvREFCNT_inc (SvRV (sv));
448 }
449
386 FREETMPS; 450 FREETMPS;
387 LEAVE; 451 LEAVE;
388} 452}
389 453
454void object_thawer::get (data_type type, void *obj, attachable_base *ext, int oid)
455{
456 if (!av || oid < 0) // this is actually an error of sorts
457 return;
458
459 // we have to "re-instantiate"/reattach to an object, so nuke ext->attach
460 ext->clear ();
461
462 SV **svp = av_fetch ((AV *)av, oid, 0);
463
464 if (!svp || !SvROK (*svp))
465 {
466 printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid);
467 return;
468 }
469
470 ext->self = *svp; *svp = &PL_sv_undef;
471 sv_magic (SvRV ((SV *)ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0);
472
473 reattach (type, obj);
474}
475
476object_thawer::~object_thawer ()
477{
478 if (av)
479 SvREFCNT_dec ((SV *)av);
480}
481
390///////////////////////////////////////////////////////////////////////////// 482/////////////////////////////////////////////////////////////////////////////
391 483
392extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) 484extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
393{ 485{
394 gethook = gethooksptr; 486 gethook = gethooksptr;
395 printf (PLUGIN_VERSION " init\n");
396 487
397 return 0; 488 return 0;
398} 489}
399 490
400static CommArray_s rtn_cmd; 491static CommArray_s rtn_cmd;
… …
481extern "C" int cfperl_postInitPlugin () 572extern "C" int cfperl_postInitPlugin ()
482{ 573{
483 int hooktype = 1; 574 int hooktype = 1;
484 int rtype = 0; 575 int rtype = 0;
485 576
486 printf (PLUGIN_VERSION " post init\n");
487
488 registerGlobalEvent = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_register_global_event");
489 unregisterGlobalEvent = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_unregister_global_event");
490 systemDirectory = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_directory"); 577 systemDirectory = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_directory");
491 object_set_property = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_set_property"); 578 object_set_property = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_set_property");
492 map_get_map = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_map_get_map"); 579 map_get_map = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_map_get_map");
493 object_insert = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_insert"); 580 object_insert = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_insert");
494 581
495 cf_init_plugin (gethook); 582 cf_init_plugin (gethook);
496 583
497 /* Pick the global events you want to monitor from this plugin */
498 registerGlobalEvent (NULL, EVENT_SHOUT, PLUGIN_NAME, globalEventListener);
499 registerGlobalEvent (NULL, EVENT_TELL, PLUGIN_NAME, globalEventListener);
500 registerGlobalEvent (NULL, EVENT_MUZZLE, PLUGIN_NAME, globalEventListener);
501 registerGlobalEvent (NULL, EVENT_KICK, PLUGIN_NAME, globalEventListener);
502
503 return 0; 584 return 0;
504}
505
506static void *
507globalEventListener (int *type, ...)
508{
509 va_list args;
510 static int rv;
511 int event_code;
512
513 if (!perl)
514 return NULL;
515
516 va_start (args, type);
517 event_code = va_arg (args, int);
518
519 dSP;
520
521 ENTER;
522 SAVETMPS;
523
524 PUSHMARK (SP);
525
526 EXTEND (SP, 10);
527 PUSHs (sv_2mortal (newSViv (event_code)));
528
529 switch (event_code)
530 {
531 case EVENT_CRASH:
532 break;
533
534 case EVENT_SHOUT:
535 case EVENT_MUZZLE:
536 case EVENT_KICK:
537 PUSH_OB;
538 PUSH_PV;
539 break;
540
541 case EVENT_TELL:
542 break;
543 }
544
545 va_end (args);
546
547 PUTBACK;
548 int count = call_pv ("cf::inject_global_event", G_SCALAR | G_EVAL);
549 SPAGAIN;
550
551 if (SvTRUE (ERRSV))
552 LOG (llevError, "global event '%d' callback evaluation error: %s", event_code, SvPV_nolen (ERRSV));
553
554 rv = count > 0 ? POPi : 0;
555
556 PUTBACK;
557 FREETMPS;
558 LEAVE;
559
560 return &rv;
561}
562
563extern "C" void *cfperl_eventListener (int *type, ...)
564{
565 static int rv;
566 va_list args;
567 int event_code;
568 object *who, *activator, *third, *event;
569 char *message, *extension, *options;
570
571 if (!perl)
572 return NULL;
573
574 va_start (args, type);
575 who = va_arg (args, object *);
576 event_code = va_arg (args, int);
577 activator = va_arg (args, object *);
578 third = va_arg (args, object *);
579 message = va_arg (args, char *);
580 va_arg (args, int); // fix yourself
581 extension = va_arg (args, char *);
582 options = va_arg (args, char *);
583 event = va_arg (args, object *);
584 va_end (args);
585
586 {
587 dSP;
588
589 ENTER;
590 SAVETMPS;
591
592 PUSHMARK (SP);
593 EXTEND (SP, 10);
594
595 PUSHcfapi (STRING, extension);
596 PUSHs (sv_2mortal (newSViv (event_code)));
597
598 PUSHcfapi (POBJECT, event);
599 PUSHcfapi (POBJECT, who);
600
601 switch (event_code)
602 {
603 case EVENT_STOP: // $ob (e.g. arrow)
604 case EVENT_TIME: // $ob
605 case EVENT_TIMER: // $ob
606 break;
607
608 case EVENT_APPLY: // $ob, $who
609 case EVENT_DROP: // $ob, $who
610 case EVENT_CLOSE: // $ob, $who
611 case EVENT_MOVE: // $ob, $enemy
612 case EVENT_THROW: // $ob, $thrower
613 PUSHcfapi (POBJECT, activator);
614 break;
615
616 case EVENT_DROP_ON: // $ob, $who, $what
617 case EVENT_ATTACK: // $ob, $who, $victim (?? please god enlighten me)
618 PUSHcfapi (POBJECT, activator);
619 PUSHcfapi (POBJECT, third);
620 break;
621
622 case EVENT_TRIGGER: // $ob, $originator, [$victim], [$msg]
623 PUSHcfapi (POBJECT, activator);
624 PUSHcfapi (POBJECT, third);
625 PUSHcfapi (POBJECT, message);
626 break;
627
628 case EVENT_SAY: // $ob, $who, $msg
629 PUSHcfapi (POBJECT, activator);
630 PUSHcfapi (STRING, message);
631 break;
632
633 default:
634 LOG (llevError, "perl plugin called for unsupported event type %d", event_code);
635 break;
636 }
637
638 PUTBACK;
639 int count = call_pv ("cf::inject_event", G_SCALAR | G_EVAL);
640 SPAGAIN;
641
642 if (SvTRUE (ERRSV))
643 LOG (llevError, "event '%d' callback evaluation error: %s", event_code, SvPV_nolen (ERRSV));
644
645 rv = count > 0 ? POPi : 0;
646
647 PUTBACK;
648 FREETMPS;
649 LEAVE;
650 }
651
652 return &rv;
653} 585}
654 586
655extern "C" int cfperl_closePlugin () 587extern "C" int cfperl_closePlugin ()
656{ 588{
657 return 0; 589 return 0;
… …
702static event_klass klass_of[NUM_EVENT_TYPES] = { 634static event_klass klass_of[NUM_EVENT_TYPES] = {
703# define def(type,name) KLASS_ ## type, 635# define def(type,name) KLASS_ ## type,
704# include "eventinc.h" 636# include "eventinc.h"
705# undef def 637# undef def
706}; 638};
639
640#define KLASS_OF(event) (((unsigned int)event) < NUM_EVENT_TYPES ? klass_of [event] : KLASS_NONE)
707 641
708static void 642static void
709gather_callbacks (AV *&callbacks, AV *registry, event_type event) 643gather_callbacks (AV *&callbacks, AV *registry, event_type event)
710{ 644{
711 // event must be in array 645 // event must be in array
… …
754 // 2a. per-type callback 688 // 2a. per-type callback
755 // 4. global callbacks 689 // 4. global callbacks
756 690
757 gather_callbacks (callbacks, cb_global, event); 691 gather_callbacks (callbacks, cb_global, event);
758 692
759 switch (klass_of [event]) 693 switch (KLASS_OF (event))
760 { 694 {
761 case KLASS_GLOBAL: 695 case KLASS_GLOBAL:
762 break; 696 break;
763 697
764 case KLASS_OBJECT: 698 case KLASS_OBJECT:
765 dt = (data_type) va_arg (ap, int); 699 dt = (data_type) va_arg (ap, int);
766 assert (("first argument must be of type object", dt == DT_OBJECT)); 700 assert (("first argument must be of type object", dt == DT_OBJECT));
767
768 op = va_arg (ap, object *); 701 op = va_arg (ap, object *);
769 702
703 if (op->cb)
704 gather_callbacks (callbacks, (AV *)op->cb, event);
705
706 if (op->type)
707 {
708 if (op->subtype && op->type + op->subtype * NUM_SUBTYPES <= AvFILLp (cb_type))
709 {
710 SV *registry = AvARRAY (cb_type)[op->type + op->subtype * NUM_SUBTYPES];
711
712 if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
713 gather_callbacks (callbacks, (AV *)SvRV (registry), event);
714 }
715
716 if (op->type <= AvFILLp (cb_type))
717 {
718 SV *registry = AvARRAY (cb_type)[op->type];
719
720 if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
721 gather_callbacks (callbacks, (AV *)SvRV (registry), event);
722 }
723 }
724
770 gather_callbacks (callbacks, cb_object, event); 725 gather_callbacks (callbacks, cb_object, event);
771 //TODO: per-object
772
773 if (op->type > 0 && op->type <= AvFILLp (cb_type))
774 {
775 SV *registry = AvARRAY (cb_type)[op->type];
776
777 if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
778 gather_callbacks (callbacks, (AV *)SvRV (registry), event);
779 }
780 726
781 break; 727 break;
782 728
783 case KLASS_PLAYER: 729 case KLASS_PLAYER:
784 dt = (data_type) va_arg (ap, int); 730 dt = (data_type) va_arg (ap, int);
785 assert (("first argument must be of type player", dt == DT_PLAYER)); 731 assert (("first argument must be of type player", dt == DT_PLAYER));
786
787 pl = va_arg (ap, player *); 732 pl = va_arg (ap, player *);
733
734 if (pl->cb)
735 gather_callbacks (callbacks, (AV *)pl->cb, event);
736
788 gather_callbacks (callbacks, cb_player, event); 737 gather_callbacks (callbacks, cb_player, event);
789 break; 738 break;
790 739
791 case KLASS_MAP: 740 case KLASS_MAP:
792 dt = (data_type) va_arg (ap, int); 741 dt = (data_type) va_arg (ap, int);
793 assert (("first argument must be of type object", dt == DT_MAP)); 742 assert (("first argument must be of type object", dt == DT_MAP));
794
795 map = va_arg (ap, mapstruct *); 743 map = va_arg (ap, mapstruct *);
744
745 if (map->cb)
746 gather_callbacks (callbacks, (AV *)map->cb, event);
747
796 gather_callbacks (callbacks, cb_map, event); 748 gather_callbacks (callbacks, cb_map, event);
797 break; 749 break;
798 750
799 default: 751 default:
800 assert (("unsupported event klass in cfperl_invoke", 0)); 752 assert (("unsupported event klass in cfperl_invoke", 0));
… …
812 EXTEND (SP, 3); 764 EXTEND (SP, 3);
813 765
814 PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays 766 PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays
815 PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks))); 767 PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks)));
816 768
817 switch (klass_of [event]) 769 switch (KLASS_OF (event))
818 { 770 {
819 case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break; 771 case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break;
820 case KLASS_PLAYER: PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl))); break; 772 case KLASS_PLAYER: PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl))); break;
821 case KLASS_MAP: PUSHs (sv_2mortal (newSVdt (DT_MAP, map))); break; 773 case KLASS_MAP: PUSHs (sv_2mortal (newSVdt (DT_MAP, map))); break;
822 } 774 }
… …
826 dt = (data_type) va_arg (ap, int); 778 dt = (data_type) va_arg (ap, int);
827 779
828 if (dt == DT_END) 780 if (dt == DT_END)
829 break; 781 break;
830 782
783 if (dt == DT_AV)
784 {
785 AV *av = va_arg (ap, AV *);
786
787 for (int i = 0; i <= av_len (av); ++i)
788 XPUSHs (*av_fetch (av, i, 1));
789 }
790 else
831 XPUSHs (sv_2mortal (newSVdt_va (ap, dt))); 791 XPUSHs (sv_2mortal (newSVdt_va (ap, dt)));
832 } 792 }
833 793
834 va_end (ap); 794 va_end (ap);
835 795
836 PUTBACK; 796 PUTBACK;
837 int count = call_pv ("cf::invoke", G_SCALAR | G_EVAL); 797 int count = call_pv ("cf::do_invoke", G_SCALAR | G_EVAL);
838 SPAGAIN; 798 SPAGAIN;
839 799
840 count = count > 0 ? POPi : 0; 800 count = count > 0 ? POPi : 0;
841 801
842 FREETMPS; 802 FREETMPS;
843 LEAVE; 803 LEAVE;
844 804
845 return count; 805 return count;
806}
807
808SV *
809cfperl_result (int idx)
810{
811 AV *av = get_av ("cfperl::invoke_results", 0);
812 if (!av)
813 return &PL_sv_undef;
814
815 SV **sv = av_fetch (av, idx, 0);
816 if (!sv)
817 return &PL_sv_undef;
818
819 return *sv;
820}
821
822int
823cfperl_result_INT (int idx)
824{
825 return SvIV (cfperl_result (idx));
846} 826}
847 827
848MODULE = cf PACKAGE = cf PREFIX = cf_ 828MODULE = cf PACKAGE = cf PREFIX = cf_
849 829
850BOOT: 830BOOT:
… …
984 const_iv (BUILDER) 964 const_iv (BUILDER)
985 const_iv (MATERIAL) 965 const_iv (MATERIAL)
986 const_iv (ITEM_TRANSFORMER) 966 const_iv (ITEM_TRANSFORMER)
987 const_iv (QUEST) 967 const_iv (QUEST)
988 968
969 const_iv (NUM_SUBTYPES)
970
989 const_iv (ST_BD_BUILD) 971 const_iv (ST_BD_BUILD)
990 const_iv (ST_BD_REMOVE) 972 const_iv (ST_BD_REMOVE)
991 973
992 const_iv (ST_MAT_FLOOR) 974 const_iv (ST_MAT_FLOOR)
993 const_iv (ST_MAT_WALL) 975 const_iv (ST_MAT_WALL)
… …
1341 for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ-- > const_iv; ) 1323 for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ-- > const_iv; )
1342 newCONSTSUB (stash, (char *)civ->name, newSViv (civ->iv)); 1324 newCONSTSUB (stash, (char *)civ->name, newSViv (civ->iv));
1343 1325
1344 static const struct { 1326 static const struct {
1345 const char *name; 1327 const char *name;
1328 int skip;
1346 IV klass; 1329 IV klass;
1347 IV iv; 1330 IV iv;
1348 } *eiv, event_iv[] = { 1331 } *eiv, event_iv[] = {
1349# define def(klass,name) { # name, (IV)KLASS_ ## klass, (IV)EV_ ## klass ## _ ## name }, 1332# define def(klass,name) { "EVENT_" # klass "_" # name, sizeof ("EVENT_" # klass), (IV)KLASS_ ## klass, (IV)EVENT_ ## klass ## _ ## name },
1350# include "eventinc.h" 1333# include "eventinc.h"
1351# undef def 1334# undef def
1352 }; 1335 };
1353 1336
1354 AV *av = get_av ("cf::EVENT", 1); 1337 AV *av = get_av ("cf::EVENT", 1);
1355 1338
1356 for (eiv = event_iv + sizeof (event_iv) / sizeof (event_iv [0]); eiv-- > event_iv; ) 1339 for (eiv = event_iv + sizeof (event_iv) / sizeof (event_iv [0]); eiv-- > event_iv; )
1357 { 1340 {
1358 AV *event = newAV (); 1341 AV *event = newAV ();
1359 av_push (event, newSVpv ((char *)eiv->name, 0)); 1342 av_push (event, newSVpv ((char *)eiv->name + eiv->skip, 0));
1360 av_push (event, newSViv (eiv->klass)); 1343 av_push (event, newSViv (eiv->klass));
1361 av_store (av, eiv->iv, newRV_noinc ((SV *)event)); 1344 av_store (av, eiv->iv, newRV_noinc ((SV *)event));
1345 newCONSTSUB (stash, (char *)eiv->name, newSViv (eiv->iv));
1362 } 1346 }
1363
1364 static const struct {
1365 const char *name;
1366 IV iv;
1367 } *event, event_list[] = {
1368# define const_event(name) { # name, (IV)EVENT_ ## name },
1369 const_event (NONE)
1370 const_event (APPLY)
1371 const_event (ATTACK)
1372 const_event (DROP)
1373 const_event (DROP_ON)
1374 const_event (PICKUP)
1375 const_event (SAY)
1376 const_event (STOP)
1377 const_event (TIME)
1378 const_event (THROW)
1379 const_event (TRIGGER)
1380 const_event (CLOSE)
1381 const_event (TIMER)
1382 const_event (MOVE)
1383
1384 const_event (SHOUT)
1385 const_event (TELL)
1386 const_event (MUZZLE)
1387 const_event (KICK)
1388 };
1389
1390 av = get_av ("cf::PLUGIN_EVENT", 1);
1391
1392 for (event = event_list + sizeof (event_list) / sizeof (event_list [0]); event-- > event_list; )
1393 av_store (av, event->iv, newSVpv ((char *)event->name, 0));
1394 1347
1395 static const struct { 1348 static const struct {
1396 int dtype; 1349 int dtype;
1397 const char *name; 1350 const char *name;
1398 IV idx; 1351 IV idx;
… …
1526 { 1479 {
1527 hv_store (prop_type, cprop->name, strlen (cprop->name), newSViv (cprop->dtype), 0); 1480 hv_store (prop_type, cprop->name, strlen (cprop->name), newSViv (cprop->dtype), 0);
1528 hv_store (prop_idx, cprop->name, strlen (cprop->name), newSViv (cprop->idx ), 0); 1481 hv_store (prop_idx, cprop->name, strlen (cprop->name), newSViv (cprop->idx ), 0);
1529 } 1482 }
1530 1483
1531 cb_global = get_av ("cf::CB_GLOBAL", 1);
1532 cb_object = get_av ("cf::CB_OBJECT", 1);
1533 cb_player = get_av ("cf::CB_PLAYER", 1);
1534 cb_type = get_av ("cf::CB_TYPE" , 1);
1535 cb_map = get_av ("cf::CB_MAP" , 1);
1536
1537 //I_EVENT_API (PACKAGE); 1484 //I_EVENT_API (PACKAGE);
1485}
1486
1487void _reload_1 ()
1488 CODE:
1489 cb_global = get_av ("cf::CB_GLOBAL", 1);
1490 cb_object = get_av ("cf::CB_OBJECT", 1);
1491 cb_player = get_av ("cf::CB_PLAYER", 1);
1492 cb_type = get_av ("cf::CB_TYPE" , 1);
1493 cb_map = get_av ("cf::CB_MAP" , 1);
1494
1495void _reload_2 ()
1496 CODE:
1497{
1498 // reattach to all attachable objects in the game.
1499 for (player *pl = first_player; pl; pl = pl->next)
1500 reattach (pl);
1501
1502 for (mapstruct *map = first_map; map; map = map->next)
1503 reattach (map);
1504
1505 for (object *op = objects; op; op = op->next)
1506 reattach (op);
1538} 1507}
1539 1508
1540NV floor (NV x) 1509NV floor (NV x)
1541 1510
1542NV ceil (NV x) 1511NV ceil (NV x)
… …
1588 1557
1589int random_roll(int min, int max, object *op, int goodbad); 1558int random_roll(int min, int max, object *op, int goodbad);
1590 1559
1591const char *cost_string_from_value(uint64 cost, int approx = 0) 1560const char *cost_string_from_value(uint64 cost, int approx = 0)
1592 1561
1562int invoke (int event, ...)
1563 CODE:
1564 if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL");
1565 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 1; i < items; i++) av_push (av, ST (i));
1566 RETVAL = INVOKE_((event_type)event, ARG_AV (av));
1567 OUTPUT: RETVAL
1568
1593int 1569int
1594exp_to_level (val64 exp) 1570exp_to_level (val64 exp)
1595 CODE: 1571 CODE:
1596{ 1572{
1597 int i = 0; 1573 int i = 0;
… …
1628 else 1604 else
1629 XSRETURN_UNDEF; 1605 XSRETURN_UNDEF;
1630 OUTPUT: RETVAL 1606 OUTPUT: RETVAL
1631 1607
1632MODULE = cf PACKAGE = cf::object PREFIX = cf_object_ 1608MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
1609
1610int invoke (object *op, int event, ...)
1611 CODE:
1612 if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");
1613 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i));
1614 RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av));
1615 OUTPUT: RETVAL
1616
1617SV *registry (object *op)
1618 CODE:
1619 RETVAL = registry_of (op);
1620 OUTPUT:
1621 RETVAL
1633 1622
1634SV * 1623SV *
1635get_property (object *obj, int type, int idx) 1624get_property (object *obj, int type, int idx)
1636 CODE: 1625 CODE:
1637 RETVAL = newSVcfapi (type, cf_object_get_property (obj, idx)); 1626 RETVAL = newSVcfapi (type, cf_object_get_property (obj, idx));
… …
1914 1903
1915void cf_player_set_party (object *op, partylist *party) 1904void cf_player_set_party (object *op, partylist *party)
1916 1905
1917void kill_player (object *op) 1906void kill_player (object *op)
1918 1907
1919MODULE = cf PACKAGE = cf::object::map PREFIX = cf_
1920
1921MODULE = cf PACKAGE = cf::player PREFIX = cf_player_ 1908MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
1909
1910int invoke (player *pl, int event, ...)
1911 CODE:
1912 if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");
1913 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i));
1914 RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av));
1915 OUTPUT: RETVAL
1916
1917SV *registry (player *pl)
1918 CODE:
1919 RETVAL = registry_of (pl);
1920 OUTPUT:
1921 RETVAL
1922 1922
1923player *cf_player_find (char *name) 1923player *cf_player_find (char *name)
1924 PROTOTYPE: $ 1924 PROTOTYPE: $
1925 1925
1926void cf_player_move (player *pl, int dir) 1926void cf_player_move (player *pl, int dir)
… …
2044 RETVAL = &pl->last_stats; 2044 RETVAL = &pl->last_stats;
2045 OUTPUT: RETVAL 2045 OUTPUT: RETVAL
2046 2046
2047 2047
2048MODULE = cf PACKAGE = cf::map PREFIX = cf_map_ 2048MODULE = cf PACKAGE = cf::map PREFIX = cf_map_
2049
2050int invoke (mapstruct *map, int event, ...)
2051 CODE:
2052 if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP");
2053 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); for (int i = 2; i < items; i++) av_push (av, ST (i));
2054 RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av));
2055 OUTPUT:
2056 RETVAL
2057
2058SV *registry (mapstruct *map)
2059 CODE:
2060 RETVAL = registry_of (map);
2061 OUTPUT:
2062 RETVAL
2049 2063
2050SV * 2064SV *
2051get_property (mapstruct *obj, int type, int idx) 2065get_property (mapstruct *obj, int type, int idx)
2052 CODE: 2066 CODE:
2053 RETVAL = newSVcfapi (type, cf_map_get_property (obj, idx)); 2067 RETVAL = newSVcfapi (type, cf_map_get_property (obj, idx));
… …
2197 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; 2211 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;
2198 } 2212 }
2199 OUTPUT: 2213 OUTPUT:
2200 RETVAL 2214 RETVAL
2201 2215
2202# "serialise" map perl data into a ref 2216# "deserialise" perl map data into the map # TODO# compatibility cruft, remove
2203void
2204_get_obs (mapstruct *map)
2205 PPCODE:
2206{
2207 object *o;
2208 int x, y;
2209 AV *obs = newAV ();
2210 int nonnull = 0;
2211
2212 for (y = 0; y < MAP_HEIGHT (map); y++)
2213 for (x = 0; x < MAP_WIDTH (map); x++)
2214 {
2215 AV *av = newAV ();
2216
2217 for (o = GET_MAP_OB (map, x, y); o; o = o->above)
2218 {
2219 SV *sv = SVptr_cache_get (o);
2220
2221 if (sv && HvFILL (SvRV (sv)))
2222 {
2223 nonnull = 1;
2224 sv = newSVsv (sv);
2225 }
2226 else
2227 sv = &PL_sv_undef;
2228
2229 av_push (av, sv);
2230 }
2231
2232 av_store (obs, x + y * MAP_HEIGHT (map), newRV_noinc ((SV *)av));
2233 }
2234
2235 if (nonnull)
2236 XPUSHs (sv_2mortal (newRV_noinc ((SV *)obs)));
2237 else
2238 SvREFCNT_dec (obs);
2239}
2240
2241# "deserialise" perl map data into the map
2242void 2217void
2243_set_obs (mapstruct *map, SV *sv) 2218_set_obs (mapstruct *map, SV *sv)
2244 CODE: 2219 CODE:
2245{ 2220{
2246 object *o; 2221 object *o;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines