3 # The application object, sort of like a surface
5 # Copyright (C) 2000,2002,2003,2004 David J. Goehrig
6 # Copyright (C) 2009 Kartik Thakore
16 our @ISA = qw(SDL::Surface);
20 my $class = ref($proto) || $proto;
23 verify (%options, qw/ -opengl -gl -fullscreen -full -resizeable
24 -title -t -icon_title -it -icon -i
25 -width -w -height -h -depth -d -flags -f
26 -red_size -r -blue_size -b -green_size -g -alpha_size -a
27 -red_accum_size -ras -blue_accum_size -bas
28 -green_accum_sizee -gas -alpha_accum_size -aas
29 -double_buffer -db -buffer_size -bs -stencil_size -st
33 # SDL_INIT_VIDEO() is 0, so check defined instead of truth.
34 my $init = defined $options{-init} ? $options{-init} : SDL_INIT_EVERYTHING();
38 my $t = $options{-title} || $options{-t} || $0;
39 my $it = $options{-icon_title} || $options{-it} || $t;
40 my $ic = $options{-icon} || $options{-i} || "";
41 my $w = $options{-width} || $options{-w} || 800;
42 my $h = $options{-height} || $options{-h} || 600;
43 my $d = $options{-depth} || $options{-d} || 16;
44 my $f = $options{-flags} || $options{-f} || SDL::SDL_ANYFORMAT();
45 my $r = $options{-red_size} || $options{-r} || 5;
46 my $g = $options{-green_size} || $options{-g} || 5;
47 my $b = $options{-blue_size} || $options{-b} || 5;
48 my $a = $options{-alpha_size} || $options{-a} || 0;
49 my $ras = $options{-red_accum_size} || $options{-ras} || 0;
50 my $gas = $options{-green_accum_size} || $options{-gas} || 0;
51 my $bas = $options{-blue_accum_size} || $options{-bas} || 0;
52 my $aas = $options{-alpha_accum_size} || $options{-aas} || 0;
53 my $db = $options{-double_buffer} || $options{-db} || 0;
55 my $bs = $options{-buffer_size} || $options{-bs} || 0;
56 my $st = $options{-stencil_size} || $options{-st} || 0;
57 my $async = $options{-asyncblit} || 0;
59 $f |= SDL::SDL_OPENGL() if ($options{-gl} || $options{-opengl});
60 $f |= SDL::SDL_FULLSCREEN() if ($options{-fullscreen} || $options{-full});
61 $f |= SDL::SDL_RESIZABLE() if ($options{-resizeable});
62 $f |= SDL::SDL_DOUBLEBUF() if ($db);
63 $f |= SDL::SDL_ASYNCBLIT() if ($async);
65 if ($f & SDL_OPENGL()) {
66 $SDL::App::USING_OPENGL = 1;
67 SDL::GLSetAttribute(SDL_GL_RED_SIZE(),$r) if ($r);
68 SDL::GLSetAttribute(SDL_GL_GREEN_SIZE(),$g) if ($g);
69 SDL::GLSetAttribute(SDL_GL_BLUE_SIZE(),$b) if ($b);
70 SDL::GLSetAttribute(SDL_GL_ALPHA_SIZE(),$a) if ($a);
72 SDL::GLSetAttribute(SDL_GL_RED_ACCUM_SIZE(),$ras) if ($ras);
73 SDL::GLSetAttribute(SDL_GL_GREEN_ACCUM_SIZE(),$gas) if ($gas);
74 SDL::GLSetAttribute(SDL_GL_BLUE_ACCUM_SIZE(),$bas) if ($bas);
75 SDL::GLSetAttribute(SDL_GL_ALPHA_ACCUM_SIZE(),$aas) if ($aas);
77 SDL::GLSetAttribute(SDL_GL_DOUBLEBUFFER(),$db) if ($db);
78 SDL::GLSetAttribute(SDL_GL_BUFFER_SIZE(),$bs) if ($bs);
79 SDL::GLSetAttribute(SDL_GL_DEPTH_SIZE(),$d);
81 $SDL::App::USING_OPENGL = 0;
83 my $self = \SDL::SetVideoMode($w,$h,$d,$f);
85 or die SDL::GetError();
88 my $icon = new SDL::Surface -name => $ic;
89 SDL::WMSetIcon($$icon);
92 SDL::WMSetCaption($t,$it);
99 my ($self,$w,$h) = @_;
100 my $flags = SDL::SurfaceFlags($$self);
101 if ( $flags & SDL::SDL_RESIZABLE()) {
102 my $bpp = SDL::SurfaceBitsPerPixel($$self);
103 $$self = SDL::SetVideoMode($w,$h,$bpp,$flags);
112 $icon = shift || $title;
113 SDL::WMSetCaption($title,$icon);
115 return SDL::WMGetCaption();
125 return SDL::GetTicks();
129 return SDL::GetError();
139 SDL::WMToggleFullScreen($$self);
144 SDL::WMIconifyWindow();
147 sub grab_input ($$) {
148 my ($self,$mode) = @_;
149 SDL::WMGrabInput($mode);
153 my ($self,$href) = @_;
154 my $event = new SDL::Event;
155 while ( $event->wait() ) {
156 if ( ref($$href{$event->type()}) eq "CODE" ) {
157 &{$$href{$event->type()}}($event);
165 if ($SDL::App::USING_OPENGL) {
172 sub attribute ($$;$) {
173 my ($self,$mode,$value) = @_;
174 return undef unless ($SDL::App::USING_OPENGL);
175 if (defined $value) {
176 SDL::GLSetAttribute($mode,$value);
178 my $returns = SDL::GLGetAttribute($mode);
179 die "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0);
191 SDL::App - a SDL perl extension
195 my $app = new SDL::App (
196 -title => 'Application Title',
203 L<SDL::App> controls the root window of the of your SDL based application.
204 It extends the L<SDL_Surface> class, and provides an interface to the window
205 manager oriented functions.
211 C<SDL::App::new> initializes the SDL, creates a new screen,
212 and initializes some of the window manager properties.
213 C<SDL::App::new> takes a series of named parameters:
253 C<SDL::App::title> takes 0, 1, or 2 arguments. It returns the current
254 application window title. If one parameter is passed, both the window
255 title and icon title will be set to its value. If two parameters are
256 passed the window title will be set to the first, and the icon title
261 C<SDL::App::delay> takes 1 argument, and will sleep the application for
266 C<SDL::App::ticks> returns the number of ms since the application began.
270 C<SDL::App::error> returns the last error message set by the SDL.
274 C<SDL::App::resize> takes a new height and width of the application
275 if the application was originally created with the -resizable option.
279 C<SDL::App::fullscreen> toggles the application in and out of fullscreen mode.
283 C<SDL::App::iconify> iconifies the applicaiton window.
287 C<SDL::App::grab_input> can be used to change the input focus behavior of
288 the application. It takes one argument, which should be one of the following:
305 C<SDL::App::loop> is a simple event loop method which takes a reference to a hash
306 of event handler subroutines. The keys of the hash must be SDL event types such
307 as SDL_QUIT(), SDL_KEYDOWN(), and the like. The event method recieves as its parameter
308 the event object used in the loop.
312 my $app = new SDL::App -title => "test.app",
318 SDL_QUIT() => sub { exit(0); },
319 SDL_KEYDOWN() => sub { print "Key Pressed" },
322 $app->loop(\%actions);
326 C<SDL::App::sync> encapsulates the various methods of syncronizing the screen with the
327 current video buffer. C<SDL::App::sync> will do a fullscreen update, using the double buffer
328 or OpenGL buffer if applicable. This is prefered to calling flip on the application window.
330 =head2 attribute ( attr, [value] )
332 C<SDL::App::attribute> allows one to set and get GL attributes. By passing a value
333 in addition to the attribute selector, the value will be set. C<SDL:::App::attribute>
334 always returns the current value of the given attribute, or dies on failure.
342 L<perl> L<SDL::Surface> L<SDL::Event> L<SDL::OpenGL>