Skip to content
This repository
Browse code

remove CLONE_SKIP frmo Event and Surface, but associates the object w…

…ith the interpreter which owns it so it only gets destroyed once... seems to work, but needs more testing...
  • Loading branch information...
commit 2be22bab99983d4330b300725d197f08f87a4997 1 parent a4394c0
Daniel Ruoso ruoso authored
2  lib/SDL/Event.pm
@@ -5,5 +5,5 @@ require Exporter;
5 5 require DynaLoader;
6 6 our @ISA = qw(Exporter DynaLoader);
7 7 bootstrap SDL::Event;
8   -sub CLONE_SKIP { 1 };
  8 +#sub CLONE_SKIP { 1 };
9 9 1;
2  lib/SDL/Surface.pm
@@ -5,5 +5,5 @@ require Exporter;
5 5 require DynaLoader;
6 6 our @ISA = qw(Exporter DynaLoader);
7 7 bootstrap SDL::Surface;
8   -sub CLONE_SKIP { 1 };
  8 +#sub CLONE_SKIP { 1 };
9 9 1;
33 src/Core/objects/Event.xs
@@ -963,17 +963,26 @@ event_syswm_msg ( event, ... )
963 963 RETVAL
964 964
965 965 void
966   -event_DESTROY(self)
967   - SDL_Event *self
  966 +event_DESTROY(bag)
  967 + SV* bag
968 968 CODE:
969   - if(self->type == SDL_USEREVENT)
970   - {
971   - if( (self->user).data1 != NULL )
972   - SvREFCNT_dec( (self->user).data1);
973   - if( (self->user).data2 != NULL )
974   - SvREFCNT_dec( (self->user).data2);
975   - }
976   - safefree(self);
977   -
978   -
  969 + if( sv_isobject(bag) && (SvTYPE(SvRV(bag)) == SVt_PVMG) ) {
  970 + void** pointers = (void**)(SvIV((SV*)SvRV( bag )));
  971 + SDL_Event* self = (SDL_Event*)(pointers[0]);
  972 + if (my_perl == pointers[1]) {
  973 + //warn("Freed surface %p and pixels %p \n", surface, surface->pixels);
  974 + if(self->type == SDL_USEREVENT) {
  975 + if( (self->user).data1 != NULL )
  976 + SvREFCNT_dec( (self->user).data1);
  977 + if( (self->user).data2 != NULL )
  978 + SvREFCNT_dec( (self->user).data2);
  979 + }
  980 + safefree(self);
  981 + free(pointers);
  982 + }
  983 + } else if (bag == 0) {
  984 + XSRETURN(0);
  985 + } else {
  986 + XSRETURN_UNDEF;
  987 + }
979 988
19 src/Core/objects/Surface.xs
@@ -144,9 +144,20 @@ surface_set_pixels(surface, index, value)
144 144 ((unsigned int*)surface->pixels)[index] = value;
145 145
146 146 void
147   -surface_DESTROY(surface)
148   - SDL_Surface *surface
  147 +surface_DESTROY(bag)
  148 + SV* bag
149 149 CODE:
150   - //warn("Freed surface %p and pixels %p \n", surface, surface->pixels);
151   - SDL_FreeSurface(surface);
  150 + if( sv_isobject(bag) && (SvTYPE(SvRV(bag)) == SVt_PVMG) ) {
  151 + void** pointers = (void**)(SvIV((SV*)SvRV( bag )));
  152 + SDL_Surface* surface = (SDL_Surface*)(pointers[0]);
  153 + if (my_perl == pointers[1]) {
  154 + //warn("Freed surface %p and pixels %p \n", surface, surface->pixels);
  155 + SDL_FreeSurface(surface);
  156 + free(pointers);
  157 + }
  158 + } else if (bag == 0) {
  159 + XSRETURN(0);
  160 + } else {
  161 + XSRETURN_UNDEF;
  162 + }
152 163
20 typemap
@@ -102,18 +102,22 @@ OUTPUT
102 102 # The Perl object is blessed into 'CLASS', which should be a
103 103 # char* having the name of the package for the blessing.
104 104 O_OBJECT
105   - sv_setref_pv( $arg, CLASS, (void*)$var );
  105 + void** pointers = malloc(2 * sizeof(void*));
  106 + pointers[0] = (void*)$var;
  107 + pointers[1] = (void*)my_perl;
  108 + sv_setref_pv( $arg, CLASS, (void*)pointers );
106 109
107 110
108 111 INPUT
109 112
110 113 O_OBJECT
111   - if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) )
112   - { $var = ($type)SvIV((SV*)SvRV( $arg )); }
113   - else if ($arg == 0)
114   - { XSRETURN(0); }
115   - else{
116   - XSRETURN_UNDEF;
117   - }
  114 + if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) ) {
  115 + void** pointers = (void**)(SvIV((SV*)SvRV( $arg )));
  116 + $var = ($type)(pointers[0]);
  117 + } else if ($arg == 0) {
  118 + XSRETURN(0);
  119 + } else {
  120 + XSRETURN_UNDEF;
  121 + }
118 122
119 123

0 comments on commit 2be22ba

Please sign in to comment.
Something went wrong with that request. Please try again.