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.6 by root, Thu Aug 24 17:29:30 2006 UTC vs.
Revision 1.14 by root, Sun Aug 27 13:02:04 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
… …
87} CFPContext; 84} CFPContext;
88 85
89static HV *obj_cache; 86static HV *obj_cache;
90static PerlInterpreter *perl; 87static PerlInterpreter *perl;
91 88
89static AV *cb_global, *cb_object, *cb_player, *cb_type, *cb_map;
90
92#define PUSHcfapi(type,value) PUSHs (sv_2mortal (newSVcfapi (CFAPI_ ## type, (value)))) 91#define PUSHcfapi(type,value) PUSHs (sv_2mortal (newSVcfapi (CFAPI_ ## type, (value))))
93#define PUSHcfapi_va(type,ctype) PUSHcfapi (type, va_arg (args, ctype)) 92#define PUSHcfapi_va(type,ctype) PUSHcfapi (type, va_arg (args, ctype))
94#define PUSH_OB PUSHcfapi_va(POBJECT, object *) 93#define PUSH_OB PUSHcfapi_va(POBJECT, object *)
95#define PUSH_PL PUSHcfapi_va(PPLAYER, player *) 94#define PUSH_PL PUSHcfapi_va(PPLAYER, player *)
96#define PUSH_MAP PUSHcfapi_va(PMAP, mapstruct *) 95#define PUSH_MAP PUSHcfapi_va(PMAP, mapstruct *)
97#define PUSH_PV PUSHcfapi_va(STRING, const char *) 96#define PUSH_PV PUSHcfapi_va(STRING, const char *)
98#define PUSH_IV PUSHs (sv_2mortal (newSViv (va_arg (args, int)))) 97#define PUSH_IV PUSHs (sv_2mortal (newSViv (va_arg (args, int))))
99 98
100////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 99//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
101 100
102// garbage collect some perl objects, if possible
103// all objects no longer referenced and empty are
104// eligible for destruction.
105static void
106clean_obj_cache ()
107{
108 static int count;
109
110 if (++count & 7)
111 return;
112
113 int todo = 1000;
114 do
115 {
116 I32 klen;
117 char *key;
118 HE *he = hv_iternext (obj_cache);
119
120 if (he)
121 {
122 SV *sv = hv_iterval (obj_cache, he);
123
124 // empty and unreferenced? nuke it
125 if (SvREFCNT (sv) == 1 && SvREFCNT (SvRV (sv)) == 1 && !HvFILL ((HV *)(SvRV (sv))))
126 {
127 hv_delete (obj_cache, HeKEY (he), HeKLEN (he), G_DISCARD);
128 todo++;
129 }
130 }
131 else
132 break;
133 }
134 while (--todo);
135}
136
137static SV * 101static SV *
138newSVptr (void *ptr, const char *klass) 102newSVptr (void *ptr, const char *klass, HV *hv = newHV ())
139{ 103{
140 SV *sv; 104 SV *sv;
141 105
142 if (!ptr) 106 if (!ptr)
143 return &PL_sv_undef; 107 return &PL_sv_undef;
144 108
145 sv = newSV (0);
146 sv_magic (sv, 0, PERL_MAGIC_ext, (char *)ptr, 0); 109 sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0);
147 return sv_bless (newRV_noinc (sv), gv_stashpv (klass, 1)); 110 return sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
111}
112
113template<class extendable>
114SV *
115newSVextendable (extendable *obj, const char *klass)
116{
117 if (!obj)
118 return &PL_sv_undef;
119
120 if (!obj->self)
121 obj->self = newSVptr (obj, klass);
122
123 return newSVsv (static_cast<SV *>(obj->self));
148} 124}
149 125
150static void 126static void
151SVptr_cache_set (void *ptr, SV *sv) 127SVptr_cache_set (void *ptr, SV *sv)
152{ 128{
… …
222 SV *sv; 198 SV *sv;
223 199
224 switch (type) 200 switch (type)
225 { 201 {
226 case DT_INT: 202 case DT_INT:
227 sv = newSViv (*va_arg (ap, int *)); 203 sv = newSViv (va_arg (ap, int));
228 break; 204 break;
229 205
230 case DT_LONG: 206 case DT_INT64:
231 sv = newSVval64 ((val64)*va_arg (ap, sint64 *)); 207 sv = newSVval64 ((val64)va_arg (ap, sint64));
232 break; 208 break;
233 209
234 case DT_DOUBLE: 210 case DT_DOUBLE:
235 sv = newSVnv (*va_arg (ap, double *)); 211 sv = newSVnv (va_arg (ap, double));
236 break; 212 break;
237 213
238 case DT_STRING: 214 case DT_STRING:
239 { 215 {
240 char *str = va_arg (ap, char *); 216 char *str = (char *)va_arg (ap, const char *);
241 sv = str ? newSVpv (str, 0) : &PL_sv_undef; 217 sv = str ? newSVpv (str, 0) : &PL_sv_undef;
242 } 218 }
243 break; 219 break;
244 220
245 case DT_DATA: 221 case DT_DATA:
246 { 222 {
247 char *str = (char *)va_arg (ap, void *); 223 char *str = (char *)va_arg (ap, const void *);
248 int len = va_arg (ap, int); 224 int len = va_arg (ap, int);
249 sv = str ? newSVpv (str, len) : &PL_sv_undef; 225 sv = str ? newSVpv (str, len) : &PL_sv_undef;
250 } 226 }
251 break; 227 break;
252 228
253 case DT_OBJECT: 229 case DT_OBJECT:
254 { 230 {
255 object *obj = va_arg (ap, object *); 231 object *obj = va_arg (ap, object *);
256 232 sv = newSVextendable (obj, obj && obj->type == PLAYER ? "cf::object::player::wrap" : "cf::object::wrap");
257 if (!obj)
258 sv = &PL_sv_undef;
259 else
260 switch (obj->type)
261 {
262 case MAP:
263 sv = newSVptr_cached (obj, "cf::object::map::wrap");
264 break;
265
266 case PLAYER:
267 sv = newSVptr_cached (obj, "cf::object::player::wrap");
268 break;
269
270 default:
271 sv = newSVptr_cached (obj, "cf::object::wrap");
272 break;
273 }
274 } 233 }
275 break; 234 break;
276 235
277 case DT_MAP: 236 case DT_MAP:
237 // va_arg (object *) when void * is passed is an XSI extension
278 sv = newSVptr (va_arg (ap, mapstruct *), "cf::map::wrap"); 238 sv = newSVextendable (va_arg (ap, mapstruct *), "cf::map::wrap");
279 break; 239 break;
280 240
281 case DT_PLAYER: 241 case DT_PLAYER:
282 sv = newSVptr (va_arg (ap, player *), "cf::player::wrap"); 242 sv = newSVextendable (va_arg (ap, player *), "cf::player::wrap");
283 break; 243 break;
284 244
285 case DT_ARCH: 245 case DT_ARCH:
286 sv = newSVptr (va_arg (ap, archetype *), "cf::arch::wrap"); 246 sv = newSVptr (va_arg (ap, archetype *), "cf::arch::wrap");
287 break; 247 break;
… …
321 va_list ap; 281 va_list ap;
322 va_start (ap, type); 282 va_start (ap, type);
323 283
324 switch (type) 284 switch (type)
325 { 285 {
326 case CFAPI_INT: sv = newSVdt_va (ap, DT_INT ); break; 286 case CFAPI_INT: sv = newSViv (*va_arg (ap, int * )); break;
327 case CFAPI_LONG: sv = newSVdt_va (ap, DT_LONG ); break; 287 case CFAPI_LONG: sv = newSVval64 (*va_arg (ap, sint64 *)); break;
328 case CFAPI_DOUBLE: sv = newSVdt_va (ap, DT_DOUBLE); break; 288 case CFAPI_DOUBLE: sv = newSVnv (*va_arg (ap, double *)); break;
329 case CFAPI_STRING: sv = newSVdt_va (ap, DT_STRING); break; 289 case CFAPI_STRING: sv = newSVdt_va (ap, DT_STRING); break;
330 case CFAPI_POBJECT: sv = newSVdt_va (ap, DT_OBJECT); break; 290 case CFAPI_POBJECT: sv = newSVdt_va (ap, DT_OBJECT); break;
331 case CFAPI_PMAP: sv = newSVdt_va (ap, DT_MAP ); break; 291 case CFAPI_PMAP: sv = newSVdt_va (ap, DT_MAP ); break;
332 case CFAPI_PPLAYER: sv = newSVdt_va (ap, DT_PLAYER); break; 292 case CFAPI_PPLAYER: sv = newSVdt_va (ap, DT_PLAYER); break;
333 case CFAPI_PARCH: sv = newSVdt_va (ap, DT_ARCH ); break; 293 case CFAPI_PARCH: sv = newSVdt_va (ap, DT_ARCH ); break;
… …
339 } 299 }
340 300
341 va_end (ap); 301 va_end (ap);
342 302
343 return sv; 303 return sv;
304}
305
306//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
307
308SV *
309registry_of (extendable_base *ext)
310{
311 if (!ext->cb)
312 ext->cb = newAV ();
313
314 return newRV_inc ((SV *)ext->cb);
315}
316
317void extendable_base::clear ()
318{
319 //if (self) fprintf (stderr, "free_ob_self %p %s (%p,%p)\n", this, ((object *)this)->name, self, cb);//D
320
321 if (self) SvREFCNT_dec (self);
322 if (cb) SvREFCNT_dec (cb);
323
324 if (attach) free_string (attach);
325
326 self = 0;
327 cb = 0;
328 attach = 0;
329}
330
331void extendable_base::optimise ()
332{
333 if (!self)
334 return;
335
336 HV *hv = (HV *)SvRV ((SV *)self);
337
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_ ()
349{
350 dSP;
351 ENTER;
352 SAVETMPS;
353 PUSHMARK (SP);
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
363/////////////////////////////////////////////////////////////////////////////
364
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)
425{
426 dSP;
427 ENTER;
428 SAVETMPS;
429 PUSHMARK (SP);
430 XPUSHs (sv_2mortal (newSVdt (type, obj)));
431 PUTBACK;
432 call_pv ("cf::reattach", G_DISCARD | G_VOID | G_EVAL);
433 FREETMPS;
434 LEAVE;
435
436 switch (type)
437 {
438 case DT_OBJECT: INVOKE_OBJECT (REATTACH, obj); break;
439 case DT_PLAYER: INVOKE_PLAYER (REATTACH, obj); break;
440 case DT_MAP: INVOKE_MAP (REATTACH, obj); break;
441 }
442}
443
444template<class subclass>
445void reattach (extendable<subclass> *obj)
446{
447 if (obj->self)
448 reattach (subclass::get_dt (), (subclass *)obj);
449}
450
451void object_thawer::get (data_type type, void *obj, extendable_base *ext)
452{
453 if (!av)
454 return;
455
456 // we have to "re-instantiate"/reattach to an object, so nuke ext->attach
457 ext->clear ();
458
459 SV **svp = av_fetch ((AV *)av, idx, 0);
460
461 ++idx;
462
463 if (!svp)
464 return;
465
466 if (SvROK (*svp))
467 {
468 ext->self = SvREFCNT_inc (*svp);
469 sv_magic (SvRV ((SV *)ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0);
470
471 reattach (type, obj);
472 }
473}
474
475object_thawer::~object_thawer ()
476{
477 if (av)
478 SvREFCNT_dec ((SV *)av);
344} 479}
345 480
346///////////////////////////////////////////////////////////////////////////// 481/////////////////////////////////////////////////////////////////////////////
347 482
348extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) 483extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
… …
439 int hooktype = 1; 574 int hooktype = 1;
440 int rtype = 0; 575 int rtype = 0;
441 576
442 printf (PLUGIN_VERSION " post init\n"); 577 printf (PLUGIN_VERSION " post init\n");
443 578
444 registerGlobalEvent = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_register_global_event");
445 unregisterGlobalEvent = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_unregister_global_event");
446 systemDirectory = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_directory"); 579 systemDirectory = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_system_directory");
447 object_set_property = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_set_property"); 580 object_set_property = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_set_property");
448 map_get_map = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_map_get_map"); 581 map_get_map = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_map_get_map");
449 object_insert = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_insert"); 582 object_insert = (void* (*)(int*, ...)) gethook (&rtype, hooktype, "cfapi_object_insert");
450 583
451 cf_init_plugin (gethook); 584 cf_init_plugin (gethook);
452 585
453 /* Pick the global events you want to monitor from this plugin */ 586 return 0;
454 registerGlobalEvent (NULL, EVENT_BORN, PLUGIN_NAME, globalEventListener); 587}
455 registerGlobalEvent (NULL, EVENT_CLOCK, PLUGIN_NAME, globalEventListener);
456 //registerGlobalEvent (NULL, EVENT_CRASH, PLUGIN_NAME, globalEventListener);
457 registerGlobalEvent (NULL, EVENT_FIND_UNARMED_SKILL, PLUGIN_NAME, globalEventListener);
458 registerGlobalEvent (NULL, EVENT_PLAYER_USE_SKILL, PLUGIN_NAME, globalEventListener);
459 registerGlobalEvent (NULL, EVENT_CAST_SPELL, PLUGIN_NAME, globalEventListener);
460 registerGlobalEvent (NULL, EVENT_MONSTER_USE_SKILL, PLUGIN_NAME, globalEventListener);
461 registerGlobalEvent (NULL, EVENT_PLAYER_DEATH, PLUGIN_NAME, globalEventListener);
462 registerGlobalEvent (NULL, EVENT_GKILL, PLUGIN_NAME, globalEventListener);
463 registerGlobalEvent (NULL, EVENT_LOGIN, PLUGIN_NAME, globalEventListener);
464 registerGlobalEvent (NULL, EVENT_LOGOUT, PLUGIN_NAME, globalEventListener);
465 registerGlobalEvent (NULL, EVENT_MAPENTER, PLUGIN_NAME, globalEventListener);
466 registerGlobalEvent (NULL, EVENT_MAPLEAVE, PLUGIN_NAME, globalEventListener);
467 registerGlobalEvent (NULL, EVENT_MAPRESET, PLUGIN_NAME, globalEventListener);
468 registerGlobalEvent (NULL, EVENT_MAPLOAD, PLUGIN_NAME, globalEventListener);
469 registerGlobalEvent (NULL, EVENT_MAPOUT, PLUGIN_NAME, globalEventListener);
470 registerGlobalEvent (NULL, EVENT_MAPIN, PLUGIN_NAME, globalEventListener);
471 registerGlobalEvent (NULL, EVENT_MAPCLEAN, PLUGIN_NAME, globalEventListener);
472 registerGlobalEvent (NULL, EVENT_REMOVE, PLUGIN_NAME, globalEventListener);
473 registerGlobalEvent (NULL, EVENT_SHOUT, PLUGIN_NAME, globalEventListener);
474 registerGlobalEvent (NULL, EVENT_TELL, PLUGIN_NAME, globalEventListener);
475 registerGlobalEvent (NULL, EVENT_MUZZLE, PLUGIN_NAME, globalEventListener);
476 registerGlobalEvent (NULL, EVENT_KICK, PLUGIN_NAME, globalEventListener);
477 registerGlobalEvent (NULL, EVENT_FREE_OB, PLUGIN_NAME, globalEventListener);
478 registerGlobalEvent (NULL, EVENT_PLAYER_LOAD, PLUGIN_NAME, globalEventListener);
479 registerGlobalEvent (NULL, EVENT_PLAYER_SAVE, PLUGIN_NAME, globalEventListener);
480 registerGlobalEvent (NULL, EVENT_EXTCMD, PLUGIN_NAME, globalEventListener);
481 588
589extern "C" int cfperl_closePlugin ()
590{
591 return 0;
592}
593
594void
595cfperl_init ()
596{
482 char *argv[] = { 597 char *argv[] = {
483 "", 598 "",
484 "-e" 599 "-e"
485 "BEGIN {" 600 "BEGIN {"
486 " cf->bootstrap;" 601 " cf->bootstrap;"
… …
501 616
502 exit (EXIT_FAILURE); 617 exit (EXIT_FAILURE);
503 //perl_destruct (perl); 618 //perl_destruct (perl);
504 //perl_free (perl); 619 //perl_free (perl);
505 //perl = 0; 620 //perl = 0;
621 //return;
506 } 622 }
507 else 623
508 {
509 obj_cache = newHV (); 624 obj_cache = newHV ();
510 }
511
512 return 0;
513}
514
515static void *
516globalEventListener (int *type, ...)
517{
518 va_list args;
519 static int rv;
520 int event_code;
521
522 if (!perl)
523 return NULL;
524
525 va_start (args, type);
526 event_code = va_arg (args, int);
527
528 if (event_code == EVENT_FREE_OB)
529 {
530 player *pl;
531 object *op;
532 SV *sv;
533
534 op = va_arg (args, object *);
535 sv = hv_delete (obj_cache, (char *)&op, sizeof (void *), 0);
536
537 if (sv)
538 clearSVptr (sv);
539
540 rv = 0;
541 }
542 else if (event_code == EVENT_CLOCK)
543 {
544 clean_obj_cache ();
545 }
546 else
547 {
548 dSP;
549
550 ENTER;
551 SAVETMPS;
552
553 PUSHMARK (SP);
554
555 EXTEND (SP, 10);
556 PUSHs (sv_2mortal (newSViv (event_code)));
557
558 switch (event_code)
559 {
560 case EVENT_CRASH:
561 break;
562
563 case EVENT_PLAYER_LOAD:
564 case EVENT_PLAYER_SAVE:
565 PUSH_OB;
566 PUSH_PV;
567 break;
568
569 case EVENT_MAPLOAD:
570 case EVENT_MAPOUT:
571 case EVENT_MAPIN:
572 case EVENT_MAPCLEAN:
573 case EVENT_MAPRESET:
574 PUSH_MAP;
575 break;
576
577 case EVENT_MAPENTER:
578 case EVENT_MAPLEAVE:
579 case EVENT_BORN:
580 case EVENT_REMOVE:
581 case EVENT_PLAYER_DEATH:
582 PUSH_OB;
583 break;
584
585 case EVENT_GKILL:
586 PUSH_OB;
587 PUSH_OB;
588 break;
589
590 case EVENT_LOGIN:
591 case EVENT_LOGOUT:
592 PUSH_PL;
593 PUSH_PV;
594 break;
595
596 case EVENT_SHOUT:
597 case EVENT_MUZZLE:
598 case EVENT_KICK:
599 PUSH_OB;
600 PUSH_PV;
601 break;
602
603 case EVENT_FIND_UNARMED_SKILL:
604 PUSH_OB;
605 break;
606
607 case EVENT_PLAYER_USE_SKILL:
608 case EVENT_MONSTER_USE_SKILL:
609 case EVENT_CAST_SPELL:
610 PUSH_OB;
611 PUSH_OB;
612 PUSH_OB;
613 PUSH_IV;
614 PUSH_PV;
615 break;
616
617 case EVENT_EXTCMD:
618 PUSH_PL;
619 {
620 char *buf = va_arg (args, char *);
621 int len = va_arg (args, int);
622 PUSHs (sv_2mortal (newSVpvn (buf, len)));
623 }
624 break;
625
626 case EVENT_TELL:
627 break;
628 }
629
630 va_end (args);
631
632 PUTBACK;
633 int count = call_pv ("cf::inject_global_event", G_SCALAR | G_EVAL);
634 SPAGAIN;
635
636 if (SvTRUE (ERRSV))
637 LOG (llevError, "global event '%d' callback evaluation error: %s", event_code, SvPV_nolen (ERRSV));
638
639 rv = count > 0 ? POPi : 0;
640
641 PUTBACK;
642 FREETMPS;
643 LEAVE;
644 }
645
646 return &rv;
647}
648
649extern "C" void *cfperl_eventListener (int *type, ...)
650{
651 static int rv;
652 va_list args;
653 int event_code;
654 object *who, *activator, *third, *event;
655 char *message, *extension, *options;
656
657 if (!perl)
658 return NULL;
659
660 va_start (args, type);
661 who = va_arg (args, object *);
662 event_code = va_arg (args, int);
663 activator = va_arg (args, object *);
664 third = va_arg (args, object *);
665 message = va_arg (args, char *);
666 va_arg (args, int); // fix yourself
667 extension = va_arg (args, char *);
668 options = va_arg (args, char *);
669 event = va_arg (args, object *);
670 va_end (args);
671
672 {
673 dSP;
674
675 ENTER;
676 SAVETMPS;
677
678 PUSHMARK (SP);
679 EXTEND (SP, 10);
680
681 PUSHcfapi (STRING, extension);
682 PUSHs (sv_2mortal (newSViv (event_code)));
683
684 PUSHcfapi (POBJECT, event);
685 PUSHcfapi (POBJECT, who);
686
687 switch (event_code)
688 {
689 case EVENT_STOP: // $ob (e.g. arrow)
690 case EVENT_TIME: // $ob
691 case EVENT_TIMER: // $ob
692 break;
693
694 case EVENT_APPLY: // $ob, $who
695 case EVENT_DROP: // $ob, $who
696 case EVENT_CLOSE: // $ob, $who
697 case EVENT_DEATH: // $ob[, $killer]
698 case EVENT_MOVE: // $ob, $enemy
699 case EVENT_THROW: // $ob, $thrower
700 PUSHcfapi (POBJECT, activator);
701 break;
702
703 case EVENT_DROP_ON: // $ob, $who, $what
704 case EVENT_ATTACK: // $ob, $who, $victim (?? please god enlighten me)
705 PUSHcfapi (POBJECT, activator);
706 PUSHcfapi (POBJECT, third);
707 break;
708
709 case EVENT_TRIGGER: // $ob, $originator, [$victim], [$msg]
710 PUSHcfapi (POBJECT, activator);
711 PUSHcfapi (POBJECT, third);
712 PUSHcfapi (POBJECT, message);
713 break;
714
715 case EVENT_SAY: // $ob, $who, $msg
716 PUSHcfapi (POBJECT, activator);
717 PUSHcfapi (STRING, message);
718 break;
719
720 default:
721 LOG (llevError, "perl plugin called for unsupported event type %d", event_code);
722 break;
723 }
724
725 PUTBACK;
726 int count = call_pv ("cf::inject_event", G_SCALAR | G_EVAL);
727 SPAGAIN;
728
729 if (SvTRUE (ERRSV))
730 LOG (llevError, "event '%d' callback evaluation error: %s", event_code, SvPV_nolen (ERRSV));
731
732 rv = count > 0 ? POPi : 0;
733
734 PUTBACK;
735 FREETMPS;
736 LEAVE;
737 }
738
739 return &rv;
740}
741
742extern "C" int cfperl_closePlugin ()
743{
744 return 0;
745} 625}
746 626
747void cfperl_main () 627void cfperl_main ()
748{ 628{
749 dSP; 629 dSP;
750 630
751 PUSHMARK (SP); 631 PUSHMARK (SP);
752 PUTBACK; 632 PUTBACK;
753 call_pv ("cf::run", G_DISCARD | G_VOID); 633 call_pv ("cf::main", G_DISCARD | G_VOID);
754} 634}
755 635
756int cfperl_invoke (const char *klass, event_type event, ...) 636static event_klass klass_of[NUM_EVENT_TYPES] = {
637# define def(type,name) KLASS_ ## type,
638# include "eventinc.h"
639# undef def
640};
641
642static void
643gather_callbacks (AV *&callbacks, AV *registry, event_type event)
757{ 644{
645 // event must be in array
646 if (event >= 0 && event <= AvFILLp (registry))
647 {
648 SV *cbs_ = AvARRAY (registry)[event];
649
650 // element must be list of callback entries
651 if (cbs_ && SvROK (cbs_) && SvTYPE (SvRV (cbs_)) == SVt_PVAV)
652 {
653 AV *cbs = (AV *)SvRV (cbs_);
654
655 // no callback entries, no callbacks to call
656 if (AvFILLp (cbs) >= 0)
657 {
658 if (!callbacks)
659 {
660 callbacks = newAV ();
661 av_extend (callbacks, 16);
662 }
663
664 // never use SvREFCNT_inc to copy values, but its ok here :)
665 for (int i = 0; i <= AvFILLp (cbs); ++i)
666 av_push (callbacks, SvREFCNT_inc (AvARRAY (cbs)[i]));
667 }
668 }
669 }
670}
671
672bool cfperl_invoke (event_type event, ...)
673{
674 data_type dt;
675 va_list ap;
676
677 va_start (ap, event);
678
679 AV *callbacks = 0;
680
681 object *op;
682 player *pl;
683 mapstruct *map;
684
685 // callback call ordering is:
686 // 1. per-object callback (NYI)
687 // 2. per-class object
688 // 2a. per-type callback
689 // 4. global callbacks
690
691 gather_callbacks (callbacks, cb_global, event);
692
693 switch (klass_of [event])
694 {
695 case KLASS_GLOBAL:
696 break;
697
698 case KLASS_OBJECT:
699 dt = (data_type) va_arg (ap, int);
700 assert (("first argument must be of type object", dt == DT_OBJECT));
701 op = va_arg (ap, object *);
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
725 gather_callbacks (callbacks, cb_object, event);
726
727 break;
728
729 case KLASS_PLAYER:
730 dt = (data_type) va_arg (ap, int);
731 assert (("first argument must be of type player", dt == DT_PLAYER));
732 pl = va_arg (ap, player *);
733
734 if (pl->cb)
735 gather_callbacks (callbacks, (AV *)pl->cb, event);
736
737 gather_callbacks (callbacks, cb_player, event);
738 break;
739
740 case KLASS_MAP:
741 dt = (data_type) va_arg (ap, int);
742 assert (("first argument must be of type object", dt == DT_MAP));
743 map = va_arg (ap, mapstruct *);
744
745 if (map->cb)
746 gather_callbacks (callbacks, (AV *)map->cb, event);
747
748 gather_callbacks (callbacks, cb_map, event);
749 break;
750
751 default:
752 assert (("unsupported event klass in cfperl_invoke", 0));
753 }
754
755 // short-circuit processing if no callbacks found/defined
756 if (!callbacks)
757 return 0;
758
758 dSP; 759 dSP;
759 va_list ap;
760
761 ENTER; 760 ENTER;
762 SAVETMPS; 761 SAVETMPS;
763 762
764 va_start (ap, event);
765 PUSHMARK (SP); 763 PUSHMARK (SP);
766 EXTEND (SP, 2); 764 EXTEND (SP, 3);
767 PUSHs (sv_2mortal (newSViv (event))); 765
766 PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays
767 PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks)));
768
769 switch (klass_of [event])
770 {
771 case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break;
772 case KLASS_PLAYER: PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl))); break;
773 case KLASS_MAP: PUSHs (sv_2mortal (newSVdt (DT_MAP, map))); break;
774 }
768 775
769 for (;;) 776 for (;;)
770 { 777 {
771 data_type dt = (data_type) va_arg (ap, int); 778 dt = (data_type) va_arg (ap, int);
772 779
773 if (dt == DT_END) 780 if (dt == DT_END)
774 break; 781 break;
775 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
776 PUSHs (sv_2mortal (newSVdt_va (ap, dt))); 791 XPUSHs (sv_2mortal (newSVdt_va (ap, dt)));
777 } 792 }
778 793
779 va_end (ap); 794 va_end (ap);
780 795
781 PUTBACK; 796 PUTBACK;
782 int count = call_pv (klass, G_SCALAR | G_EVAL); 797 int count = call_pv ("cf::do_invoke", G_SCALAR | G_EVAL);
783 SPAGAIN; 798 SPAGAIN;
784 799
785 count = count > 0 ? POPi : 0; 800 count = count > 0 ? POPi : 0;
786 801
787 FREETMPS; 802 FREETMPS;
788 LEAVE; 803 LEAVE;
789 804
790 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));
791} 826}
792 827
793MODULE = cf PACKAGE = cf PREFIX = cf_ 828MODULE = cf PACKAGE = cf PREFIX = cf_
794 829
795BOOT: 830BOOT:
… …
929 const_iv (BUILDER) 964 const_iv (BUILDER)
930 const_iv (MATERIAL) 965 const_iv (MATERIAL)
931 const_iv (ITEM_TRANSFORMER) 966 const_iv (ITEM_TRANSFORMER)
932 const_iv (QUEST) 967 const_iv (QUEST)
933 968
969 const_iv (NUM_SUBTYPES)
970
934 const_iv (ST_BD_BUILD) 971 const_iv (ST_BD_BUILD)
935 const_iv (ST_BD_REMOVE) 972 const_iv (ST_BD_REMOVE)
936 973
937 const_iv (ST_MAT_FLOOR) 974 const_iv (ST_MAT_FLOOR)
938 const_iv (ST_MAT_WALL) 975 const_iv (ST_MAT_WALL)
… …
1274 1311
1275 const_iv (MAP_IN_MEMORY) 1312 const_iv (MAP_IN_MEMORY)
1276 const_iv (MAP_SWAPPED) 1313 const_iv (MAP_SWAPPED)
1277 const_iv (MAP_LOADING) 1314 const_iv (MAP_LOADING)
1278 const_iv (MAP_SAVING) 1315 const_iv (MAP_SAVING)
1316
1317 const_iv (KLASS_GLOBAL)
1318 const_iv (KLASS_OBJECT)
1319 const_iv (KLASS_PLAYER)
1320 const_iv (KLASS_MAP)
1279 }; 1321 };
1280 1322
1281 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; )
1282 newCONSTSUB (stash, (char *)civ->name, newSViv (civ->iv)); 1324 newCONSTSUB (stash, (char *)civ->name, newSViv (civ->iv));
1283 1325
1284 static const struct { 1326 static const struct {
1285 const char *name; 1327 const char *name;
1328 int skip;
1329 IV klass;
1286 IV iv; 1330 IV iv;
1287 } *eiv, event_iv[] = { 1331 } *eiv, event_iv[] = {
1288# define def(name) { # name, (IV)EV_ ## name }, 1332# define def(klass,name) { "EVENT_" # klass "_" # name, sizeof ("EVENT_" # klass), (IV)KLASS_ ## klass, (IV)EVENT_ ## klass ## _ ## name },
1289# include "eventinc.h" 1333# include "eventinc.h"
1290# undef def 1334# undef def
1291 }; 1335 };
1292 1336
1293 AV *av = get_av ("cf::EVENT", 1); 1337 AV *av = get_av ("cf::EVENT", 1);
1294 1338
1295 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; )
1296 av_store (av, eiv->iv, newSVpv ((char *)eiv->name, 0)); 1340 {
1297 1341 AV *event = newAV ();
1298 static const struct { 1342 av_push (event, newSVpv ((char *)eiv->name + eiv->skip, 0));
1299 const char *name; 1343 av_push (event, newSViv (eiv->klass));
1300 IV iv; 1344 av_store (av, eiv->iv, newRV_noinc ((SV *)event));
1301 } *event, event_list[] = { 1345 newCONSTSUB (stash, (char *)eiv->name, newSViv (eiv->iv));
1302# define const_event(name) { # name, (IV)EVENT_ ## name }, 1346 }
1303 const_event (NONE)
1304 const_event (APPLY)
1305 const_event (ATTACK)
1306 const_event (DEATH)
1307 const_event (DROP)
1308 const_event (DROP_ON)
1309 const_event (PICKUP)
1310 const_event (SAY)
1311 const_event (STOP)
1312 const_event (TIME)
1313 const_event (THROW)
1314 const_event (TRIGGER)
1315 const_event (CLOSE)
1316 const_event (TIMER)
1317 const_event (MOVE)
1318
1319 const_event (BORN)
1320 //const_event (CLOCK)
1321 const_event (CRASH)
1322 const_event (PLAYER_DEATH)
1323 const_event (PLAYER_LOAD)
1324 const_event (PLAYER_SAVE)
1325 const_event (GKILL)
1326 const_event (LOGIN)
1327 const_event (LOGOUT)
1328 const_event (MAPENTER)
1329 const_event (MAPLEAVE)
1330 const_event (MAPRESET)
1331 const_event (MAPLOAD)
1332 const_event (MAPOUT)
1333 const_event (MAPIN)
1334 const_event (MAPCLEAN)
1335 const_event (REMOVE)
1336 const_event (SHOUT)
1337 const_event (TELL)
1338 const_event (MUZZLE)
1339 const_event (KICK)
1340 const_event (PLAYER_USE_SKILL)
1341 const_event (MONSTER_USE_SKILL)
1342 const_event (CAST_SPELL)
1343 const_event (FIND_UNARMED_SKILL)
1344 const_event (EXTCMD)
1345 //const_event (FREE_OB)
1346 };
1347
1348 av = get_av ("cf::PLUGIN_EVENT", 1);
1349
1350 for (event = event_list + sizeof (event_list) / sizeof (event_list [0]); event-- > event_list; )
1351 av_store (av, event->iv, newSVpv ((char *)event->name, 0));
1352 1347
1353 static const struct { 1348 static const struct {
1354 int dtype; 1349 int dtype;
1355 const char *name; 1350 const char *name;
1356 IV idx; 1351 IV idx;
… …
1487 } 1482 }
1488 1483
1489 //I_EVENT_API (PACKAGE); 1484 //I_EVENT_API (PACKAGE);
1490} 1485}
1491 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);
1507}
1508
1492NV floor (NV x) 1509NV floor (NV x)
1493 1510
1494NV ceil (NV x) 1511NV ceil (NV x)
1495 1512
1496void server_tick () 1513void server_tick ()
… …
1539 PROTOTYPE: $ 1556 PROTOTYPE: $
1540 1557
1541int random_roll(int min, int max, object *op, int goodbad); 1558int random_roll(int min, int max, object *op, int goodbad);
1542 1559
1543const char *cost_string_from_value(uint64 cost, int approx = 0) 1560const char *cost_string_from_value(uint64 cost, int approx = 0)
1561
1562int invoke (int event, SV *arg1, ...)
1563 CODE:
1564{
1565 // parse first arg and call invoke_object etc as seen fit
1566 //TODO
1567 //cfperl_invoke (event,
1568}
1544 1569
1545int 1570int
1546exp_to_level (val64 exp) 1571exp_to_level (val64 exp)
1547 CODE: 1572 CODE:
1548{ 1573{
… …
1787{ 1812{
1788 int unused_type; 1813 int unused_type;
1789 RETVAL = (object *)object_insert (&unused_type, ob, 0, where, orig, flag, x, y); 1814 RETVAL = (object *)object_insert (&unused_type, ob, 0, where, orig, flag, x, y);
1790} 1815}
1791 1816
1817SV *registry (object *op)
1818 CODE:
1819 RETVAL = registry_of (op);
1820 OUTPUT:
1821 RETVAL
1822
1792# syntatic sugar for easier use in event callbacks. 1823# syntatic sugar for easier use in event callbacks.
1793const char *options (object *op) 1824const char *options (object *op)
1794 CODE: 1825 CODE:
1795 RETVAL = op->name; 1826 RETVAL = op->name;
1796 OUTPUT: 1827 OUTPUT:
… …
1866 1897
1867void cf_player_set_party (object *op, partylist *party) 1898void cf_player_set_party (object *op, partylist *party)
1868 1899
1869void kill_player (object *op) 1900void kill_player (object *op)
1870 1901
1871MODULE = cf PACKAGE = cf::object::map PREFIX = cf_
1872
1873MODULE = cf PACKAGE = cf::player PREFIX = cf_player_ 1902MODULE = cf PACKAGE = cf::player PREFIX = cf_player_
1903
1904SV *registry (player *pl)
1905 CODE:
1906 RETVAL = registry_of (pl);
1907 OUTPUT:
1908 RETVAL
1874 1909
1875player *cf_player_find (char *name) 1910player *cf_player_find (char *name)
1876 PROTOTYPE: $ 1911 PROTOTYPE: $
1877 1912
1878void cf_player_move (player *pl, int dir) 1913void cf_player_move (player *pl, int dir)
… …
1905 1940
1906char * 1941char *
1907client (player *pl) 1942client (player *pl)
1908 CODE: 1943 CODE:
1909 RETVAL = pl->socket.client; 1944 RETVAL = pl->socket.client;
1945 OUTPUT:
1946 RETVAL
1947
1948char *
1949host (player *pl)
1950 CODE:
1951 RETVAL = pl->socket.host;
1952 OUTPUT:
1953 RETVAL
1954
1955char *
1956killer (player *pl, char *killer = 0)
1957 CODE:
1958 if (killer)
1959 snprintf (pl->killer, sizeof (pl->killer), "%s", killer);
1960 RETVAL = pl->killer;
1910 OUTPUT: 1961 OUTPUT:
1911 RETVAL 1962 RETVAL
1912 1963
1913void 1964void
1914buggy_mapscroll (player *pl, int value = 1) 1965buggy_mapscroll (player *pl, int value = 1)
… …
1980 RETVAL = &pl->last_stats; 2031 RETVAL = &pl->last_stats;
1981 OUTPUT: RETVAL 2032 OUTPUT: RETVAL
1982 2033
1983 2034
1984MODULE = cf PACKAGE = cf::map PREFIX = cf_map_ 2035MODULE = cf PACKAGE = cf::map PREFIX = cf_map_
2036
2037SV *registry (mapstruct *map)
2038 CODE:
2039 RETVAL = registry_of (map);
2040 OUTPUT:
2041 RETVAL
1985 2042
1986SV * 2043SV *
1987get_property (mapstruct *obj, int type, int idx) 2044get_property (mapstruct *obj, int type, int idx)
1988 CODE: 2045 CODE:
1989 RETVAL = newSVcfapi (type, cf_map_get_property (obj, idx)); 2046 RETVAL = newSVcfapi (type, cf_map_get_property (obj, idx));
… …
2133 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; 2190 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;
2134 } 2191 }
2135 OUTPUT: 2192 OUTPUT:
2136 RETVAL 2193 RETVAL
2137 2194
2138# "serialise" map perl data into a ref 2195# "deserialise" perl map data into the map # TODO# compatibility cruft, remove
2139void
2140_get_obs (mapstruct *map)
2141 PPCODE:
2142{
2143 object *o;
2144 int x, y;
2145 AV *obs = newAV ();
2146 int nonnull = 0;
2147
2148 for (y = 0; y < MAP_HEIGHT (map); y++)
2149 for (x = 0; x < MAP_WIDTH (map); x++)
2150 {
2151 AV *av = newAV ();
2152
2153 for (o = GET_MAP_OB (map, x, y); o; o = o->above)
2154 {
2155 SV *sv = SVptr_cache_get (o);
2156
2157 if (sv && HvFILL (SvRV (sv)))
2158 {
2159 nonnull = 1;
2160 sv = newSVsv (sv);
2161 }
2162 else
2163 sv = &PL_sv_undef;
2164
2165 av_push (av, sv);
2166 }
2167
2168 av_store (obs, x + y * MAP_HEIGHT (map), newRV_noinc ((SV *)av));
2169 }
2170
2171 if (nonnull)
2172 XPUSHs (sv_2mortal (newRV_noinc ((SV *)obs)));
2173 else
2174 SvREFCNT_dec (obs);
2175}
2176
2177# "deserialise" perl map data into the map
2178void 2196void
2179_set_obs (mapstruct *map, SV *sv) 2197_set_obs (mapstruct *map, SV *sv)
2180 CODE: 2198 CODE:
2181{ 2199{
2182 object *o; 2200 object *o;

Diff Legend

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