diff --git a/lib/SDLx/Queue.pm b/lib/SDLx/Queue.pm new file mode 100644 index 00000000..50e590af --- /dev/null +++ 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 index d025d975..d19eb412 100644 --- 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) ); - if (!a->data1) + a->data1 = new_data( ST(1) ); + if (!a->data1) XSRETURN_EMPTY; ST(0) = a->data1; XSRETURN(1); diff --git a/t/sdlx_queue.t b/t/sdlx_queue.t new file mode 100644 index 00000000..48f7d491 --- /dev/null +++ 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);