5 # Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
7 # ------------------------------------------------------------------------------
9 # This library is free software; you can redistribute it and/or
10 # modify it under the terms of the GNU Lesser General Public
11 # License as published by the Free Software Foundation; either
12 # version 2.1 of the License, or (at your option) any later version.
14 # This library is distributed in the hope that it will be useful,
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 # Lesser General Public License for more details.
19 # You should have received a copy of the GNU Lesser General Public
20 # License along with this library; if not, write to the Free Software
21 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
23 # ------------------------------------------------------------------------------
25 # Please feel free to send questions, suggestions or improvements to:
41 our @ISA = qw(SDL::Surface);
48 my $class = ref($proto) || $proto;
51 verify (%options, qw/ -opengl -gl -fullscreen -full -resizeable
52 -title -t -icon_title -it -icon -i
53 -width -w -height -h -depth -d -flags -f
54 -red_size -r -blue_size -b -green_size -g -alpha_size -a
55 -red_accum_size -ras -blue_accum_size -bas
56 -green_accum_sizee -gas -alpha_accum_size -aas
57 -double_buffer -db -buffer_size -bs -stencil_size -st
61 # SDL_INIT_VIDEO() is 0, so check defined instead of truth.
62 my $init = defined $options{-init} ? $options{-init} :
63 SDL_INIT_EVERYTHING();
67 #SDL::Init(SDL::SDL_INIT_EVERYTHING());
69 my $t = $options{-title} || $options{-t} || $0;
70 my $it = $options{-icon_title} || $options{-it} || $t;
71 my $ic = $options{-icon} || $options{-i} || "";
72 my $w = $options{-width} || $options{-w} || 800;
73 my $h = $options{-height} || $options{-h} || 600;
74 my $d = $options{-depth} || $options{-d} || 16;
75 my $f = $options{-flags} || $options{-f} || SDL::SDL_ANYFORMAT();
76 my $r = $options{-red_size} || $options{-r} || 5;
77 my $g = $options{-green_size} || $options{-g} || 5;
78 my $b = $options{-blue_size} || $options{-b} || 5;
79 my $a = $options{-alpha_size} || $options{-a} || 0;
80 my $ras = $options{-red_accum_size} || $options{-ras} || 0;
81 my $gas = $options{-green_accum_size} || $options{-gas} || 0;
82 my $bas = $options{-blue_accum_size} || $options{-bas} || 0;
83 my $aas = $options{-alpha_accum_size} || $options{-aas} || 0;
84 my $db = $options{-double_buffer} || $options{-db} || 0;
86 my $bs = $options{-buffer_size} || $options{-bs} || 0;
87 my $st = $options{-stencil_size} || $options{-st} || 0;
88 my $async = $options{-asyncblit} || 0;
90 $f |= SDL::SDL_OPENGL() if ($options{-gl} || $options{-opengl});
91 $f |= SDL::SDL_FULLSCREEN() if ($options{-fullscreen} || $options{-full});
92 $f |= SDL::SDL_RESIZABLE() if ($options{-resizeable});
93 $f |= SDL::SDL_DOUBLEBUF() if ($db);
94 $f |= SDL::SDL_ASYNCBLIT() if ($async);
96 if ($f & SDL::SDL_OPENGL()) {
97 $SDL::App::USING_OPENGL = 1;
98 SDL::GLSetAttribute(SDL::SDL_GL_RED_SIZE(),$r) if ($r);
99 SDL::GLSetAttribute(SDL::SDL_GL_GREEN_SIZE(),$g) if ($g);
100 SDL::GLSetAttribute(SDL::SDL_GL_BLUE_SIZE(),$b) if ($b);
101 SDL::GLSetAttribute(SDL::SDL_GL_ALPHA_SIZE(),$a) if ($a);
103 SDL::GLSetAttribute(SDL::SDL_GL_RED_ACCUM_SIZE(),$ras) if ($ras);
104 SDL::GLSetAttribute(SDL::SDL_GL_GREEN_ACCUM_SIZE(),$gas) if ($gas);
105 SDL::GLSetAttribute(SDL::SDL_GL_BLUE_ACCUM_SIZE(),$bas) if ($bas);
106 SDL::GLSetAttribute(SDL::SDL_GL_ALPHA_ACCUM_SIZE(),$aas) if ($aas);
108 SDL::GLSetAttribute(SDL::SDL_GL_DOUBLEBUFFER(),$db) if ($db);
109 SDL::GLSetAttribute(SDL::SDL_GL_BUFFER_SIZE(),$bs) if ($bs);
110 SDL::GLSetAttribute(SDL::SDL_GL_DEPTH_SIZE(),$d);
112 $SDL::App::USING_OPENGL = 0;
115 my $self = \SDL::SetVideoMode($w,$h,$d,$f)
116 or croak SDL::GetError();
118 if ($ic and -e $ic) {
119 my $icon = new SDL::Surface -name => $ic;
120 SDL::WMSetIcon($$icon);
123 SDL::WMSetCaption($t,$it);
130 my ($self,$w,$h) = @_;
131 my $flags = SDL::SurfaceFlags($$self);
132 if ( $flags & SDL::SDL_RESIZABLE()) {
133 my $bpp = SDL::SurfaceBitsPerPixel($$self);
134 $self = \SDL::SetVideoMode($w,$h,$bpp,$flags);
143 $icon = shift || $title;
144 SDL::WMSetCaption($title,$icon);
146 return SDL::WMGetCaption();
156 return SDL::GetTicks();
160 return SDL::GetError();
170 SDL::WMToggleFullScreen($$self);
175 SDL::WMIconifyWindow();
178 sub grab_input ($$) {
179 my ($self,$mode) = @_;
180 SDL::WMGrabInput($mode);
184 my ($self,$href) = @_;
185 my $event = new SDL::Event;
186 while ( $event->wait() ) {
187 if ( ref($$href{$event->type()}) eq "CODE" ) {
188 &{$$href{$event->type()}}($event);
195 if ($SDL::App::USING_OPENGL) {
202 sub attribute ($$;$) {
203 my ($self,$mode,$value) = @_;
204 return undef unless ($SDL::App::USING_OPENGL);
205 if (defined $value) {
206 SDL::GLSetAttribute($mode,$value);
208 my $returns = SDL::GLGetAttribute($mode);
209 croak "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0);
221 SDL::App - a SDL perl extension
225 my $app = new SDL::App (
226 -title => 'Application Title',
233 L<SDL::App> controls the root window of the of your SDL based application.
234 It extends the L<SDL_Surface> class, and provides an interface to the window
235 manager oriented functions.
241 C<SDL::App::new> initializes the SDL, creates a new screen,
242 and initializes some of the window manager properties.
243 C<SDL::App::new> takes a series of named parameters:
283 C<SDL::App::title> takes 0, 1, or 2 arguments. It returns the current
284 application window title. If one parameter is passed, both the window
285 title and icon title will be set to its value. If two parameters are
286 passed the window title will be set to the first, and the icon title
291 C<SDL::App::delay> takes 1 argument, and will sleep the application for
296 C<SDL::App::ticks> returns the number of ms since the application began.
300 C<SDL::App::error> returns the last error message set by the SDL.
304 C<SDL::App::resize> takes a new height and width of the application
305 if the application was originally created with the -resizable option.
309 C<SDL::App::fullscreen> toggles the application in and out of fullscreen mode.
313 C<SDL::App::iconify> iconifies the applicaiton window.
317 C<SDL::App::grab_input> can be used to change the input focus behavior of
318 the application. It takes one argument, which should be one of the following:
335 C<SDL::App::loop> is a simple event loop method which takes a reference to a hash
336 of event handler subroutines. The keys of the hash must be SDL event types such
337 as SDL_QUIT(), SDL_KEYDOWN(), and the like. The event method recieves as its parameter
338 the event object used in the loop.
342 my $app = new SDL::App -title => "test.app",
348 SDL_QUIT() => sub { exit(0); },
349 SDL_KEYDOWN() => sub { print "Key Pressed" },
352 $app->loop(\%actions);
356 C<SDL::App::sync> encapsulates the various methods of syncronizing the screen with the
357 current video buffer. C<SDL::App::sync> will do a fullscreen update, using the double buffer
358 or OpenGL buffer if applicable. This is prefered to calling flip on the application window.
360 =head2 attribute ( attr, [value] )
362 C<SDL::App::attribute> allows one to set and get GL attributes. By passing a value
363 in addition to the attribute selector, the value will be set. C<SDL:::App::attribute>
364 always returns the current value of the given attribute, or croaks on failure.
373 L<perl> L<SDL::Surface> L<SDL::Event> L<SDL::OpenGL>