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.7 by root, Fri Aug 25 13:24:50 2006 UTC vs.
Revision 1.8 by root, Fri Aug 25 15:21:57 2006 UTC

… …
87} CFPContext; 87} CFPContext;
88 88
89static HV *obj_cache; 89static HV *obj_cache;
90static PerlInterpreter *perl; 90static PerlInterpreter *perl;
91 91
92static AV *cb_global, *cb_object, *cb_player, *cb_type, *cb_map;
93
92#define PUSHcfapi(type,value) PUSHs (sv_2mortal (newSVcfapi (CFAPI_ ## type, (value)))) 94#define PUSHcfapi(type,value) PUSHs (sv_2mortal (newSVcfapi (CFAPI_ ## type, (value))))
93#define PUSHcfapi_va(type,ctype) PUSHcfapi (type, va_arg (args, ctype)) 95#define PUSHcfapi_va(type,ctype) PUSHcfapi (type, va_arg (args, ctype))
94#define PUSH_OB PUSHcfapi_va(POBJECT, object *) 96#define PUSH_OB PUSHcfapi_va(POBJECT, object *)
95#define PUSH_PL PUSHcfapi_va(PPLAYER, player *) 97#define PUSH_PL PUSHcfapi_va(PPLAYER, player *)
96#define PUSH_MAP PUSHcfapi_va(PMAP, mapstruct *) 98#define PUSH_MAP PUSHcfapi_va(PMAP, mapstruct *)
… …
682 684
683 exit (EXIT_FAILURE); 685 exit (EXIT_FAILURE);
684 //perl_destruct (perl); 686 //perl_destruct (perl);
685 //perl_free (perl); 687 //perl_free (perl);
686 //perl = 0; 688 //perl = 0;
689 //return;
687 } 690 }
688 else 691
689 obj_cache = newHV (); 692 obj_cache = newHV ();
690} 693}
691 694
692void cfperl_main () 695void cfperl_main ()
693{ 696{
694 dSP; 697 dSP;
… …
704 707
705 if (sv) 708 if (sv)
706 clearSVptr (sv); 709 clearSVptr (sv);
707} 710}
708 711
712static event_klass klass_of[NUM_EVENT_TYPES] = {
713# define def(type,name) KLASS_ ## type,
714# include "eventinc.h"
715# undef def
716};
717
718static void
719gather_callbacks (AV *&callbacks, AV *registry, event_type event)
720{
721 // event must be in array
722 if (event >= 0 && event <= AvFILLp (registry))
723 {
724 SV *cbs_ = AvARRAY (registry)[event];
725
726 // element must be list of callback entries
727 if (cbs_ && SvROK (cbs_) && SvTYPE (SvRV (cbs_)) == SVt_PVAV)
728 {
729 AV *cbs = (AV *)SvRV (cbs_);
730
731 // no callback entries, no callbacks to call
732 if (AvFILLp (cbs) >= 0)
733 {
734 if (!callbacks)
735 {
736 callbacks = newAV ();
737 av_extend (callbacks, 16);
738 }
739
740 // never use SvREFCNT_inc to copy values, but its ok here :)
741 for (int i = 0; i <= AvFILLp (cbs); ++i)
742 av_push (callbacks, SvREFCNT_inc (AvARRAY (cbs)[i]));
743 }
744 }
745 }
746}
747
709int cfperl_invoke (event_type event, ...) 748bool cfperl_invoke (event_type event, ...)
710{ 749{
750 data_type dt;
751 va_list ap;
752
753 va_start (ap, event);
754
755 AV *callbacks = 0;
756
757 object *op;
758 player *pl;
759 mapstruct *map;
760
761 // callback call ordering is:
762 // 1. per-object callback (NYI)
763 // 2. per-class object
764 // 2a. per-type callback
765 // 4. global callbacks
766
767 gather_callbacks (callbacks, cb_global, event);
768
769 switch (klass_of [event])
770 {
771 case KLASS_GLOBAL:
772 break;
773
774 case KLASS_OBJECT:
775 dt = (data_type) va_arg (ap, int);
776 assert (("first argument must be of type object", dt == DT_OBJECT));
777
778 op = va_arg (ap, object *);
779
780 gather_callbacks (callbacks, cb_object, event);
781 //TODO: per-object
782
783 if (op->type > 0 && op->type <= AvFILLp (cb_type))
784 {
785 SV *registry = AvARRAY (cb_type)[op->type];
786
787 if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
788 gather_callbacks (callbacks, (AV *)SvRV (registry), event);
789 }
790
791 break;
792
793 case KLASS_PLAYER:
794 dt = (data_type) va_arg (ap, int);
795 assert (("first argument must be of type player", dt == DT_PLAYER));
796
797 pl = va_arg (ap, player *);
798 gather_callbacks (callbacks, cb_player, event);
799 break;
800
801 case KLASS_MAP:
802 dt = (data_type) va_arg (ap, int);
803 assert (("first argument must be of type object", dt == DT_MAP));
804
805 map = va_arg (ap, mapstruct *);
806 gather_callbacks (callbacks, cb_map, event);
807 break;
808
809 default:
810 assert (("unsupported event klass in cfperl_invoke", 0));
811 }
812
813 if (!callbacks) fprintf (stderr, "short-circuit processing of event %d\n", event);//D
814
815 // short-circuit processing if no callbacks found/defined
816 if (!callbacks)
817 return 0;
818
711 dSP; 819 dSP;
712 va_list ap;
713
714 ENTER; 820 ENTER;
715 SAVETMPS; 821 SAVETMPS;
716 822
717 va_start (ap, event);
718 PUSHMARK (SP); 823 PUSHMARK (SP);
719 EXTEND (SP, 2); 824 EXTEND (SP, 3);
720 PUSHs (sv_2mortal (newSViv (event)));
721 825
722 // todo, optimise here wether we actually want to invoke an event 826 PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays
827 PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks)));
828
829 switch (klass_of [event])
830 {
831 case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break;
832 case KLASS_PLAYER: PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl))); break;
833 case KLASS_MAP: PUSHs (sv_2mortal (newSVdt (DT_MAP, map))); break;
834 }
723 835
724 for (;;) 836 for (;;)
725 { 837 {
726 data_type dt = (data_type) va_arg (ap, int); 838 dt = (data_type) va_arg (ap, int);
727 839
728 if (dt == DT_END) 840 if (dt == DT_END)
729 break; 841 break;
730 842
731 PUSHs (sv_2mortal (newSVdt_va (ap, dt))); 843 XPUSHs (sv_2mortal (newSVdt_va (ap, dt)));
732 } 844 }
733 845
734 va_end (ap); 846 va_end (ap);
735 847
736 PUTBACK; 848 PUTBACK;
… …
1436 { 1548 {
1437 hv_store (prop_type, cprop->name, strlen (cprop->name), newSViv (cprop->dtype), 0); 1549 hv_store (prop_type, cprop->name, strlen (cprop->name), newSViv (cprop->dtype), 0);
1438 hv_store (prop_idx, cprop->name, strlen (cprop->name), newSViv (cprop->idx ), 0); 1550 hv_store (prop_idx, cprop->name, strlen (cprop->name), newSViv (cprop->idx ), 0);
1439 } 1551 }
1440 1552
1553 cb_global = get_av ("cf::CB_GLOBAL", 1);
1554 cb_object = get_av ("cf::CB_OBJECT", 1);
1555 cb_player = get_av ("cf::CB_PLAYER", 1);
1556 cb_type = get_av ("cf::CB_TYPE" , 1);
1557 cb_map = get_av ("cf::CB_MAP" , 1);
1558
1441 //I_EVENT_API (PACKAGE); 1559 //I_EVENT_API (PACKAGE);
1442} 1560}
1443 1561
1444NV floor (NV x) 1562NV floor (NV x)
1445 1563

Diff Legend

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