X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSDL%2FApp.pm;h=542b79fb4c31043459286daa8d014889c5973db7;hb=e853497ac6c8b125554ca0f7e1c8463798717317;hp=f28eb0316a548e1b3c410dc3371442f7ee01f026;hpb=8fde61e3e900d5000c94503679d735221acc1882;p=sdlgit%2FSDL_perl.git diff --git a/lib/SDL/App.pm b/lib/SDL/App.pm index f28eb03..542b79f 100644 --- a/lib/SDL/App.pm +++ b/lib/SDL/App.pm @@ -1,18 +1,47 @@ -# App.pm +#!/usr/bin/env perl # -# The application object, sort of like a surface +# App.pm +# +# Copyright (C) 2005 David J. Goehrig +# +# ------------------------------------------------------------------------------ +# +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; either +# version 2.1 of the License, or (at your option) any later version. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +# +# ------------------------------------------------------------------------------ +# +# Please feel free to send questions, suggestions or improvements to: +# +# David J. Goehrig +# dgoehrig@cpan.org # -# Copyright (C) 2000,2002,2003,2004 David J. Goehrig package SDL::App; use strict; +use warnings; +use Carp; use SDL; use SDL::Event; use SDL::Surface; use SDL::Rect; our @ISA = qw(SDL::Surface); +sub DESTROY { + +} sub new { my $proto = shift; @@ -26,10 +55,16 @@ sub new { -red_accum_size -ras -blue_accum_size -bas -green_accum_sizee -gas -alpha_accum_size -aas -double_buffer -db -buffer_size -bs -stencil_size -st - -asyncblit + -asyncblit -init / ) if ($SDL::DEBUG); - SDL::Init(SDL_INIT_EVERYTHING()); + # SDL_INIT_VIDEO() is 0, so check defined instead of truth. + my $init = defined $options{-init} ? $options{-init} : + SDL_INIT_EVERYTHING(); + + SDL::init($init); + + #SDL::Init(SDL::SDL_INIT_EVERYTHING()); my $t = $options{-title} || $options{-t} || $0; my $it = $options{-icon_title} || $options{-it} || $t; @@ -58,27 +93,27 @@ sub new { $f |= SDL::SDL_DOUBLEBUF() if ($db); $f |= SDL::SDL_ASYNCBLIT() if ($async); - if ($f & SDL_OPENGL()) { + if ($f & SDL::SDL_OPENGL()) { $SDL::App::USING_OPENGL = 1; - SDL::GLSetAttribute(SDL_GL_RED_SIZE(),$r) if ($r); - SDL::GLSetAttribute(SDL_GL_GREEN_SIZE(),$g) if ($g); - SDL::GLSetAttribute(SDL_GL_BLUE_SIZE(),$b) if ($b); - SDL::GLSetAttribute(SDL_GL_ALPHA_SIZE(),$a) if ($a); - - SDL::GLSetAttribute(SDL_GL_RED_ACCUM_SIZE(),$ras) if ($ras); - SDL::GLSetAttribute(SDL_GL_GREEN_ACCUM_SIZE(),$gas) if ($gas); - SDL::GLSetAttribute(SDL_GL_BLUE_ACCUM_SIZE(),$bas) if ($bas); - SDL::GLSetAttribute(SDL_GL_ALPHA_ACCUM_SIZE(),$aas) if ($aas); + SDL::GLSetAttribute(SDL::SDL_GL_RED_SIZE(),$r) if ($r); + SDL::GLSetAttribute(SDL::SDL_GL_GREEN_SIZE(),$g) if ($g); + SDL::GLSetAttribute(SDL::SDL_GL_BLUE_SIZE(),$b) if ($b); + SDL::GLSetAttribute(SDL::SDL_GL_ALPHA_SIZE(),$a) if ($a); + + SDL::GLSetAttribute(SDL::SDL_GL_RED_ACCUM_SIZE(),$ras) if ($ras); + SDL::GLSetAttribute(SDL::SDL_GL_GREEN_ACCUM_SIZE(),$gas) if ($gas); + SDL::GLSetAttribute(SDL::SDL_GL_BLUE_ACCUM_SIZE(),$bas) if ($bas); + SDL::GLSetAttribute(SDL::SDL_GL_ALPHA_ACCUM_SIZE(),$aas) if ($aas); - SDL::GLSetAttribute(SDL_GL_DOUBLEBUFFER(),$db) if ($db); - SDL::GLSetAttribute(SDL_GL_BUFFER_SIZE(),$bs) if ($bs); - SDL::GLSetAttribute(SDL_GL_DEPTH_SIZE(),$d); + SDL::GLSetAttribute(SDL::SDL_GL_DOUBLEBUFFER(),$db) if ($db); + SDL::GLSetAttribute(SDL::SDL_GL_BUFFER_SIZE(),$bs) if ($bs); + SDL::GLSetAttribute(SDL::SDL_GL_DEPTH_SIZE(),$d); } else { $SDL::App::USING_OPENGL = 0; } - my $self = \SDL::SetVideoMode($w,$h,$d,$f) - or die SDL::GetError(); + my $self = SDL::SetVideoMode($w,$h,$d,$f) + or croak SDL::geterror(); if ($ic and -e $ic) { my $icon = new SDL::Surface -name => $ic; @@ -122,7 +157,7 @@ sub ticks { } sub error { - return SDL::GetError(); + return SDL::geterror(); } sub warp ($$$) { @@ -150,8 +185,7 @@ sub loop ($$) { my $event = new SDL::Event; while ( $event->wait() ) { if ( ref($$href{$event->type()}) eq "CODE" ) { - &{$$href{$event->type()}}($event); - $self->sync(); + &{$$href{$event->type()}}($event); } } } @@ -161,7 +195,7 @@ sub sync ($) { if ($SDL::App::USING_OPENGL) { SDL::GLSwapBuffers() } else { - $self->flip(); + SDL::Flip($self); } } @@ -172,7 +206,7 @@ sub attribute ($$;$) { SDL::GLSetAttribute($mode,$value); } my $returns = SDL::GLGetAttribute($mode); - die "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0); + croak "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0); $$returns[1]; } @@ -187,17 +221,35 @@ __END__; SDL::App - a SDL perl extension =head1 SYNOPSIS - - my $app = new SDL::App ( - -title => 'Application Title', - -width => 640, - -height => 480, - -depth => 32 ); + + use SDL; + use SDL::Event; + use SDL::App; + + my $app = new SDL::App ( + -title => 'Application Title', + -width => 640, + -height => 480, + -depth => 32 ); + +This is the manual way of doing things + + my $event = new SDL::Event; # create a new event + + $event->pump(); + $event->poll(); + + while ($event->wait()) { + my $type = $event->type(); # get event type + print $type; + exit if $type == SDL_QUIT; + } +An alternative to the manual Event processing is the L . =head1 DESCRIPTION L controls the root window of the of your SDL based application. -It extends the L class, and provides an interface to the window +It extends the L class, and provides an interface to the window manager oriented functions. =head1 METHODS @@ -327,11 +379,12 @@ or OpenGL buffer if applicable. This is prefered to calling flip on the applica C allows one to set and get GL attributes. By passing a value in addition to the attribute selector, the value will be set. C -always returns the current value of the given attribute, or dies on failure. +always returns the current value of the given attribute, or croaks on failure. =head1 AUTHOR David J. Goehrig +Kartik Thakore =head1 SEE ALSO