Fixed test for hardware or underlying fails
[sdlgit/SDL_perl.git] / lib / SDL / App.pm
CommitLineData
bfd90409 1#!/usr/bin/env perl
2#
3# App.pm
4#
5# Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
6#
7# ------------------------------------------------------------------------------
8#
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.
13#
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.
18#
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
22#
23# ------------------------------------------------------------------------------
24#
25# Please feel free to send questions, suggestions or improvements to:
26#
27# David J. Goehrig
28# dgoehrig@cpan.org
29#
30
31package SDL::App;
32
33use strict;
084b921f 34use warnings;
35use Carp;
bfd90409 36use SDL;
37use SDL::Event;
38use SDL::Surface;
39use SDL::Rect;
40
41our @ISA = qw(SDL::Surface);
bfd90409 42sub DESTROY {
43
44}
45
46sub new {
47 my $proto = shift;
48 my $class = ref($proto) || $proto;
49 my %options = @_;
50
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
c383be07 58 -asyncblit -init
bfd90409 59 / ) if ($SDL::DEBUG);
60
c383be07 61 # SDL_INIT_VIDEO() is 0, so check defined instead of truth.
62 my $init = defined $options{-init} ? $options{-init} :
63 SDL_INIT_EVERYTHING();
64
65 SDL::Init($init);
66
67 #SDL::Init(SDL::SDL_INIT_EVERYTHING());
bfd90409 68
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;
85
86 my $bs = $options{-buffer_size} || $options{-bs} || 0;
87 my $st = $options{-stencil_size} || $options{-st} || 0;
88 my $async = $options{-asyncblit} || 0;
89
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);
95
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);
102
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);
107
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);
111 } else {
112 $SDL::App::USING_OPENGL = 0;
113 }
114
115 my $self = \SDL::SetVideoMode($w,$h,$d,$f)
084b921f 116 or croak SDL::GetError();
bfd90409 117
118 if ($ic and -e $ic) {
119 my $icon = new SDL::Surface -name => $ic;
120 SDL::WMSetIcon($$icon);
121 }
122
123 SDL::WMSetCaption($t,$it);
124
125 bless $self,$class;
126 return $self;
127}
128
129sub resize ($$$) {
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);
135 }
136}
137
138sub title ($;$) {
139 my $self = shift;
140 my ($title,$icon);
141 if (@_) {
142 $title = shift;
143 $icon = shift || $title;
144 SDL::WMSetCaption($title,$icon);
145 }
146 return SDL::WMGetCaption();
147}
148
149sub delay ($$) {
150 my $self = shift;
151 my $delay = shift;
152 SDL::Delay($delay);
153}
154
155sub ticks {
156 return SDL::GetTicks();
157}
158
159sub error {
160 return SDL::GetError();
161}
162
163sub warp ($$$) {
164 my $self = shift;
165 SDL::WarpMouse(@_);
166}
167
168sub fullscreen ($) {
169 my $self = shift;
170 SDL::WMToggleFullScreen($$self);
171}
172
173sub iconify ($) {
174 my $self = shift;
175 SDL::WMIconifyWindow();
176}
177
178sub grab_input ($$) {
179 my ($self,$mode) = @_;
180 SDL::WMGrabInput($mode);
181}
182
183sub loop ($$) {
184 my ($self,$href) = @_;
185 my $event = new SDL::Event;
186 while ( $event->wait() ) {
187 if ( ref($$href{$event->type()}) eq "CODE" ) {
d73cbe8a 188 &{$$href{$event->type()}}($event);
bfd90409 189 }
190 }
191}
192
193sub sync ($) {
194 my $self = shift;
195 if ($SDL::App::USING_OPENGL) {
196 SDL::GLSwapBuffers()
197 } else {
198 $self->flip();
199 }
200}
201
202sub attribute ($$;$) {
203 my ($self,$mode,$value) = @_;
204 return undef unless ($SDL::App::USING_OPENGL);
205 if (defined $value) {
206 SDL::GLSetAttribute($mode,$value);
207 }
208 my $returns = SDL::GLGetAttribute($mode);
084b921f 209 croak "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0);
bfd90409 210 $$returns[1];
211}
212
2131;
214
215__END__;
216
217=pod
218
219=head1 NAME
220
221SDL::App - a SDL perl extension
222
223=head1 SYNOPSIS
224
225 my $app = new SDL::App (
226 -title => 'Application Title',
227 -width => 640,
228 -height => 480,
229 -depth => 32 );
230
231=head1 DESCRIPTION
232
233L<SDL::App> controls the root window of the of your SDL based application.
234It extends the L<SDL_Surface> class, and provides an interface to the window
235manager oriented functions.
236
237=head1 METHODS
238
239=head2 new
240
241C<SDL::App::new> initializes the SDL, creates a new screen,
242and initializes some of the window manager properties.
243C<SDL::App::new> takes a series of named parameters:
244
245=over 4
246
247=item *
248
249-title
250
251=item *
252
253-icon_title
254
255=item *
256
257-icon
258
259=item *
260
261-width
262
263=item *
264
265-height
266
267=item *
268
269-depth
270
271=item *
272
273-flags
274
275=item *
276
277-resizeable
278
279=back
280
281=head2 title
282
283C<SDL::App::title> takes 0, 1, or 2 arguments. It returns the current
284application window title. If one parameter is passed, both the window
285title and icon title will be set to its value. If two parameters are
286passed the window title will be set to the first, and the icon title
287to the second.
288
289=head2 delay
290
291C<SDL::App::delay> takes 1 argument, and will sleep the application for
292that many ms.
293
294=head2 ticks
295
296C<SDL::App::ticks> returns the number of ms since the application began.
297
298=head2 error
299
300C<SDL::App::error> returns the last error message set by the SDL.
301
302=head2 resize
303
304C<SDL::App::resize> takes a new height and width of the application
305if the application was originally created with the -resizable option.
306
307=head2 fullscreen
308
309C<SDL::App::fullscreen> toggles the application in and out of fullscreen mode.
310
311=head2 iconify
312
313C<SDL::App::iconify> iconifies the applicaiton window.
314
315=head2 grab_input
316
317C<SDL::App::grab_input> can be used to change the input focus behavior of
318the application. It takes one argument, which should be one of the following:
319
320=over 4
321
322=item *
323SDL_GRAB_QUERY
324
325=item *
326SDL_GRAB_ON
327
328=item *
329SDL_GRAB_OFF
330
331=back
332
333=head2 loop
334
335C<SDL::App::loop> is a simple event loop method which takes a reference to a hash
336of event handler subroutines. The keys of the hash must be SDL event types such
337as SDL_QUIT(), SDL_KEYDOWN(), and the like. The event method recieves as its parameter
338the event object used in the loop.
339
340 Example:
341
342 my $app = new SDL::App -title => "test.app",
343 -width => 800,
344 -height => 600,
345 -depth => 32;
346
347 my %actions = (
348 SDL_QUIT() => sub { exit(0); },
349 SDL_KEYDOWN() => sub { print "Key Pressed" },
350 );
351
352 $app->loop(\%actions);
353
354=head2 sync
355
356C<SDL::App::sync> encapsulates the various methods of syncronizing the screen with the
357current video buffer. C<SDL::App::sync> will do a fullscreen update, using the double buffer
358or OpenGL buffer if applicable. This is prefered to calling flip on the application window.
359
360=head2 attribute ( attr, [value] )
361
362C<SDL::App::attribute> allows one to set and get GL attributes. By passing a value
363in addition to the attribute selector, the value will be set. C<SDL:::App::attribute>
084b921f 364always returns the current value of the given attribute, or croaks on failure.
bfd90409 365
366=head1 AUTHOR
367
368David J. Goehrig
084b921f 369Kartik Thakore
bfd90409 370
371=head1 SEE ALSO
372
373L<perl> L<SDL::Surface> L<SDL::Event> L<SDL::OpenGL>
374
375=cut