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:
45 our @ISA = qw(SDL::Surface);
49 my $class = ref($proto) || $proto;
52 verify (%options, qw/ -opengl -gl -fullscreen -full -resizeable
53 -title -t -icon_title -it -icon -i
54 -width -w -height -h -depth -d -flags -f
55 -red_size -r -blue_size -b -green_size -g -alpha_size -a
56 -red_accum_size -ras -blue_accum_size -bas
57 -green_accum_sizee -gas -alpha_accum_size -aas
58 -double_buffer -db -buffer_size -bs -stencil_size -st
62 SDL::Init(SDL::SDL_INIT_EVERYTHING());
64 my $t = $options{-title} || $options{-t} || $0;
65 my $it = $options{-icon_title} || $options{-it} || $t;
66 my $ic = $options{-icon} || $options{-i} || "";
67 my $w = $options{-width} || $options{-w} || 800;
68 my $h = $options{-height} || $options{-h} || 600;
69 my $d = $options{-depth} || $options{-d} || 16;
70 my $f = $options{-flags} || $options{-f} || SDL::SDL_ANYFORMAT();
71 my $r = $options{-red_size} || $options{-r} || 5;
72 my $g = $options{-green_size} || $options{-g} || 5;
73 my $b = $options{-blue_size} || $options{-b} || 5;
74 my $a = $options{-alpha_size} || $options{-a} || 0;
75 my $ras = $options{-red_accum_size} || $options{-ras} || 0;
76 my $gas = $options{-green_accum_size} || $options{-gas} || 0;
77 my $bas = $options{-blue_accum_size} || $options{-bas} || 0;
78 my $aas = $options{-alpha_accum_size} || $options{-aas} || 0;
79 my $db = $options{-double_buffer} || $options{-db} || 0;
81 my $bs = $options{-buffer_size} || $options{-bs} || 0;
82 my $st = $options{-stencil_size} || $options{-st} || 0;
83 my $async = $options{-asyncblit} || 0;
85 $f |= SDL::SDL_OPENGL() if ($options{-gl} || $options{-opengl});
86 $f |= SDL::SDL_FULLSCREEN() if ($options{-fullscreen} || $options{-full});
87 $f |= SDL::SDL_RESIZABLE() if ($options{-resizeable});
88 $f |= SDL::SDL_DOUBLEBUF() if ($db);
89 $f |= SDL::SDL_ASYNCBLIT() if ($async);
91 if ($f & SDL::SDL_OPENGL()) {
92 $SDL::App::USING_OPENGL = 1;
93 SDL::GLSetAttribute(SDL::SDL_GL_RED_SIZE(),$r) if ($r);
94 SDL::GLSetAttribute(SDL::SDL_GL_GREEN_SIZE(),$g) if ($g);
95 SDL::GLSetAttribute(SDL::SDL_GL_BLUE_SIZE(),$b) if ($b);
96 SDL::GLSetAttribute(SDL::SDL_GL_ALPHA_SIZE(),$a) if ($a);
98 SDL::GLSetAttribute(SDL::SDL_GL_RED_ACCUM_SIZE(),$ras) if ($ras);
99 SDL::GLSetAttribute(SDL::SDL_GL_GREEN_ACCUM_SIZE(),$gas) if ($gas);
100 SDL::GLSetAttribute(SDL::SDL_GL_BLUE_ACCUM_SIZE(),$bas) if ($bas);
101 SDL::GLSetAttribute(SDL::SDL_GL_ALPHA_ACCUM_SIZE(),$aas) if ($aas);
103 SDL::GLSetAttribute(SDL::SDL_GL_DOUBLEBUFFER(),$db) if ($db);
104 SDL::GLSetAttribute(SDL::SDL_GL_BUFFER_SIZE(),$bs) if ($bs);
105 SDL::GLSetAttribute(SDL::SDL_GL_DEPTH_SIZE(),$d);
107 $SDL::App::USING_OPENGL = 0;
110 my $self = \SDL::SetVideoMode($w,$h,$d,$f)
111 or croak SDL::GetError();
113 if ($ic and -e $ic) {
114 my $icon = new SDL::Surface -name => $ic;
115 SDL::WMSetIcon($$icon);
118 SDL::WMSetCaption($t,$it);
125 my ($self,$w,$h) = @_;
126 my $flags = SDL::SurfaceFlags($$self);
127 if ( $flags & SDL::SDL_RESIZABLE()) {
128 my $bpp = SDL::SurfaceBitsPerPixel($$self);
129 $self = \SDL::SetVideoMode($w,$h,$bpp,$flags);
138 $icon = shift || $title;
139 SDL::WMSetCaption($title,$icon);
141 return SDL::WMGetCaption();
151 return SDL::GetTicks();
155 return SDL::GetError();
165 SDL::WMToggleFullScreen($$self);
170 SDL::WMIconifyWindow();
173 sub grab_input ($$) {
174 my ($self,$mode) = @_;
175 SDL::WMGrabInput($mode);
179 my ($self,$href) = @_;
180 my $event = new SDL::Event;
181 while ( $event->wait() ) {
182 if ( ref($$href{$event->type()}) eq "CODE" ) {
183 &{$$href{$event->type()}}($event);
191 if ($SDL::App::USING_OPENGL) {
198 sub attribute ($$;$) {
199 my ($self,$mode,$value) = @_;
200 return undef unless ($SDL::App::USING_OPENGL);
201 if (defined $value) {
202 SDL::GLSetAttribute($mode,$value);
204 my $returns = SDL::GLGetAttribute($mode);
205 croak "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0);
217 SDL::App - a SDL perl extension
221 my $app = new SDL::App (
222 -title => 'Application Title',
229 L<SDL::App> controls the root window of the of your SDL based application.
230 It extends the L<SDL_Surface> class, and provides an interface to the window
231 manager oriented functions.
237 C<SDL::App::new> initializes the SDL, creates a new screen,
238 and initializes some of the window manager properties.
239 C<SDL::App::new> takes a series of named parameters:
279 C<SDL::App::title> takes 0, 1, or 2 arguments. It returns the current
280 application window title. If one parameter is passed, both the window
281 title and icon title will be set to its value. If two parameters are
282 passed the window title will be set to the first, and the icon title
287 C<SDL::App::delay> takes 1 argument, and will sleep the application for
292 C<SDL::App::ticks> returns the number of ms since the application began.
296 C<SDL::App::error> returns the last error message set by the SDL.
300 C<SDL::App::resize> takes a new height and width of the application
301 if the application was originally created with the -resizable option.
305 C<SDL::App::fullscreen> toggles the application in and out of fullscreen mode.
309 C<SDL::App::iconify> iconifies the applicaiton window.
313 C<SDL::App::grab_input> can be used to change the input focus behavior of
314 the application. It takes one argument, which should be one of the following:
331 C<SDL::App::loop> is a simple event loop method which takes a reference to a hash
332 of event handler subroutines. The keys of the hash must be SDL event types such
333 as SDL_QUIT(), SDL_KEYDOWN(), and the like. The event method recieves as its parameter
334 the event object used in the loop.
338 my $app = new SDL::App -title => "test.app",
344 SDL_QUIT() => sub { exit(0); },
345 SDL_KEYDOWN() => sub { print "Key Pressed" },
348 $app->loop(\%actions);
352 C<SDL::App::sync> encapsulates the various methods of syncronizing the screen with the
353 current video buffer. C<SDL::App::sync> will do a fullscreen update, using the double buffer
354 or OpenGL buffer if applicable. This is prefered to calling flip on the application window.
356 =head2 attribute ( attr, [value] )
358 C<SDL::App::attribute> allows one to set and get GL attributes. By passing a value
359 in addition to the attribute selector, the value will be set. C<SDL:::App::attribute>
360 always returns the current value of the given attribute, or croaks on failure.
369 L<perl> L<SDL::Surface> L<SDL::Event> L<SDL::OpenGL>