Fixed a retrival bug in SDL::Event from user_data when data enter is …

…out of scope. Also made a preliminary SDLx::Queue. Not sure if dequeue is blocking or not though.
PerlGameDev · Aug 22, 2010 · 425fad4 · 425fad4
1 parent e22d5a3
commit 425fad4
Show file tree

Hide file tree

Showing 3 changed files with 124 additions and 4 deletions.
diff --git a/lib/SDLx/Queue.pm b/lib/SDLx/Queue.pm
@@ -0,0 +1,73 @@
+package SDLx::Queue;
+use strict;
+use warnings;
+use Carp;
+use SDL;
+use SDL::Event;
+use SDL::Events;
+
+use Data::Dumper;
+
+
+sub enqueue
+{
+  my ($queue_name, $event) = @_;
+
+
+my $userdata = SDL::Event->new();
+$userdata->type(SDL_USEREVENT);
+$userdata->user_data1( $queue_name );
+$userdata->user_data2( $event );
+
+  if( SDL::Events::push_event( $userdata ) < 0 )
+  {
+	  Carp::carp 'Cannot push_event :'.SDL::get_error();
+  }
+
+  return $userdata;
+
+}
+
+sub dequeue
+{
+   my ($queue_name) = @_;
+
+   my $peep_event = SDL::Event->new();
+   my $event = SDL::Event->new();
+
+   my $queue_ref = '';
+   my $data_ref = '';
+
+   SDL::Events::pump_events;
+  while( my $peepd = SDL::Events::peep_events( $peep_event, 1, SDL_GETEVENT, SDL_ALLEVENTS ) )
+  {
+	  return -1 if $peepd == 0;
+
+	  if ($peepd == -1) { Carp::croak 'Cannot peep events : '.SDL::get_error(); };
+
+	  if (  $peep_event->type == SDL_USEREVENT) 
+	  {
+		  $queue_ref = $peep_event->user_data1;
+		  $data_ref = $peep_event->user_data2;	   	   
+		  if( defined $queue_ref && $$queue_ref eq $queue_name )
+	  	  { 
+		 	return $$data_ref ;
+		  }
+		  else
+		  {
+
+			  SDL::Events::peep_events( $peep_event, 1, SDL_ADDEVENT, SDL_ALLEVENTS )
+
+		  }
+	   }
+
+
+  }
+   return $data_ref;
+
+}
+
+
+1;
+
+
diff --git a/src/Core/objects/Event.xs b/src/Core/objects/Event.xs
@@ -11,10 +11,13 @@
 
 SV* new_data( SV* thing )
 {
+  SV* new_thing;
  if (  SvROK( thing ) ) 
-    return  newRV_inc(SvRV(thing ) );
+  {  new_thing = SvRV(thing); }
  else
-    return  SvREFCNT_inc(thing); 
+   { new_thing = thing;  }
+
+    return  SvREFCNT_inc(newRV_inc(new_thing)); 
 
 }
 
@@ -901,8 +904,8 @@ event_user_data1 ( event, ... )
 	PPCODE: 
 		SDL_UserEvent * a = &(event->user);
 		if ( items > 1)
-			a->data1 = new_data( ST(1) ); 
+			 a->data1 = new_data( ST(1) );
-		 if (!a->data1)
+ 		 if (!a->data1)
 		  XSRETURN_EMPTY;
 		  ST(0) = a->data1;
 		  XSRETURN(1);

diff --git a/t/sdlx_queue.t b/t/sdlx_queue.t
@@ -0,0 +1,44 @@
+#!/usr/bin/perl -w
+use strict;
+use SDL;
+use SDL::Video;
+use SDLx::Queue;
+use Test::More;
+use lib 't/lib';
+use SDL::TestTool;
+
+my $videodriver = $ENV{SDL_VIDEODRIVER};
+$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
+
+if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) {
+	plan( skip_all => 'Failed to init video' );
+}
+
+
+SDLx::Queue::enqueue( 'foo', 'Data' );
+SDLx::Queue::enqueue( 'foo1', 'Data' );
+
+SDLx::Queue::enqueue( 'foo1', 'Data 1' );
+SDLx::Queue::enqueue( 'foo', 'Data 1' );
+
+
+is( SDLx::Queue::dequeue( 'foo1' ), 'Data' , 'Got data for foo queue');
+
+is( SDLx::Queue::dequeue( 'foo' ), 'Data 1', 'Got data for foo1 queue');
+
+is( SDLx::Queue::dequeue( 'foo' ), 'Data', 'Got data for foo1 queue');
+
+is( SDLx::Queue::dequeue( 'foo1' ), 'Data 1' , 'Got data for foo queue');
+
+
+if ($videodriver) {
+	$ENV{SDL_VIDEODRIVER} = $videodriver;
+} else {
+	delete $ENV{SDL_VIDEODRIVER};
+}
+
+#SDL::quit();
+pass 'Are we still alive? Checking for segfaults';
+
+done_testing;
+sleep(2);