-# App.pm
+#!/usr/bin/env perl
#
-# The application object, sort of like a surface
+# App.pm
+#
+# Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
+#
+# ------------------------------------------------------------------------------
+#
+# 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;
-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;
$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;
}
sub error {
- return SDL::GetError();
+ return SDL::geterror();
}
sub warp ($$$) {
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);
}
}
}
if ($SDL::App::USING_OPENGL) {
SDL::GLSwapBuffers()
} else {
- $self->flip();
+ SDL::Flip($self);
}
}
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];
}
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<SDL::App::loop> .
=head1 DESCRIPTION
L<SDL::App> controls the root window of the of your SDL based application.
-It extends the L<SDL_Surface> class, and provides an interface to the window
+It extends the L<SDL::Surface> class, and provides an interface to the window
manager oriented functions.
=head1 METHODS
C<SDL::App::attribute> allows one to set and get GL attributes. By passing a value
in addition to the attribute selector, the value will be set. C<SDL:::App::attribute>
-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
projects / sdlgit/SDL_perl.git / blobdiff