lib/SDL/App.pm

   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
  31 package SDL::App;
  32
  33 use strict;
  34 use warnings;
  35 use Carp;
  36 use SDL;
  37 use SDL::Event;
  38 use SDL::Surface;
  39 use SDL::Rect;
  40
  41 our @ISA = qw(SDL::Surface);
  42 sub DESTROY {
  43
  44 }
  45
  46 sub 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
  58                                 -asyncblit
  59                 / ) if ($SDL::DEBUG);
  60
  61         SDL::Init(SDL::SDL_INIT_EVERYTHING());
  62
  63         my $t = $options{-title}        || $options{-t}         || $0;
  64         my $it = $options{-icon_title}  || $options{-it}        || $t;
  65         my $ic = $options{-icon}        || $options{-i}         || "";
  66         my $w = $options{-width}        || $options{-w}         || 800;
  67         my $h = $options{-height}       || $options{-h}         || 600;
  68         my $d = $options{-depth}        || $options{-d}         || 16;
  69         my $f = $options{-flags}        || $options{-f}         || SDL::SDL_ANYFORMAT();
  70         my $r = $options{-red_size}     || $options{-r}         || 5;
  71         my $g = $options{-green_size}   || $options{-g}         || 5;
  72         my $b = $options{-blue_size}    || $options{-b}         || 5;
  73         my $a = $options{-alpha_size}   || $options{-a}         || 0;
  74         my $ras = $options{-red_accum_size}     || $options{-ras}               || 0;
  75         my $gas = $options{-green_accum_size}   || $options{-gas}               || 0;
  76         my $bas = $options{-blue_accum_size}    || $options{-bas}               || 0;
  77         my $aas = $options{-alpha_accum_size}   || $options{-aas}               || 0;
  78         my $db = $options{-double_buffer}       || $options{-db}                || 0;
  79
  80         my $bs = $options{-buffer_size}         || $options{-bs}                || 0;
  81         my $st  = $options{-stencil_size}       || $options{-st}                || 0;
  82         my $async = $options{-asyncblit} || 0;
  83
  84         $f |= SDL::SDL_OPENGL() if ($options{-gl} || $options{-opengl});
  85         $f |= SDL::SDL_FULLSCREEN() if ($options{-fullscreen} || $options{-full});
  86         $f |= SDL::SDL_RESIZABLE() if ($options{-resizeable});
  87         $f |= SDL::SDL_DOUBLEBUF() if ($db);
  88         $f |= SDL::SDL_ASYNCBLIT() if ($async);
  89
  90         if ($f & SDL::SDL_OPENGL()) {
  91                 $SDL::App::USING_OPENGL = 1;
  92                 SDL::GLSetAttribute(SDL::SDL_GL_RED_SIZE(),$r) if ($r);
  93                 SDL::GLSetAttribute(SDL::SDL_GL_GREEN_SIZE(),$g) if ($g);
  94                 SDL::GLSetAttribute(SDL::SDL_GL_BLUE_SIZE(),$b) if ($b);
  95                 SDL::GLSetAttribute(SDL::SDL_GL_ALPHA_SIZE(),$a) if ($a);
  96
  97                 SDL::GLSetAttribute(SDL::SDL_GL_RED_ACCUM_SIZE(),$ras) if ($ras);
  98                 SDL::GLSetAttribute(SDL::SDL_GL_GREEN_ACCUM_SIZE(),$gas) if ($gas);
  99                 SDL::GLSetAttribute(SDL::SDL_GL_BLUE_ACCUM_SIZE(),$bas) if ($bas);
 100                 SDL::GLSetAttribute(SDL::SDL_GL_ALPHA_ACCUM_SIZE(),$aas) if ($aas);
 101
 102                 SDL::GLSetAttribute(SDL::SDL_GL_DOUBLEBUFFER(),$db) if ($db);
 103                 SDL::GLSetAttribute(SDL::SDL_GL_BUFFER_SIZE(),$bs) if ($bs);
 104                 SDL::GLSetAttribute(SDL::SDL_GL_DEPTH_SIZE(),$d);
 105         } else {
 106                 $SDL::App::USING_OPENGL = 0;
 107         }
 108
 109         my $self = \SDL::SetVideoMode($w,$h,$d,$f)
 110                 or croak SDL::GetError();
 111
 112         if ($ic and -e $ic) {
 113            my $icon = new SDL::Surface -name => $ic;
 114            SDL::WMSetIcon($$icon);
 115         }
 116
 117         SDL::WMSetCaption($t,$it);
 118
 119         bless $self,$class;
 120         return $self;
 121 }
 122
 123 sub resize ($$$) {
 124         my ($self,$w,$h) = @_;
 125         my $flags = SDL::SurfaceFlags($$self);
 126         if ( $flags & SDL::SDL_RESIZABLE()) {
 127                 my $bpp = SDL::SurfaceBitsPerPixel($$self);
 128                 $self = \SDL::SetVideoMode($w,$h,$bpp,$flags);
 129         }
 130 }
 131
 132 sub title ($;$) {
 133         my $self = shift;
 134         my ($title,$icon);
 135         if (@_) {
 136                 $title = shift;
 137                 $icon = shift || $title;
 138                 SDL::WMSetCaption($title,$icon);
 139         }
 140         return SDL::WMGetCaption();
 141 }
 142
 143 sub delay ($$) {
 144         my $self = shift;
 145         my $delay = shift;
 146         SDL::Delay($delay);
 147 }
 148
 149 sub ticks {
 150         return SDL::GetTicks();
 151 }
 152
 153 sub error {
 154         return SDL::GetError();
 155 }
 156
 157 sub warp ($$$) {
 158         my $self = shift;
 159         SDL::WarpMouse(@_);
 160 }
 161
 162 sub fullscreen ($) {
 163         my $self = shift;
 164         SDL::WMToggleFullScreen($$self);
 165 }
 166
 167 sub iconify ($) {
 168         my $self = shift;
 169         SDL::WMIconifyWindow();
 170 }
 171
 172 sub grab_input ($$) {
 173         my ($self,$mode) = @_;
 174         SDL::WMGrabInput($mode);
 175 }
 176
 177 sub loop ($$) {
 178         my ($self,$href) = @_;
 179         my $event = new SDL::Event;
 180         while ( $event->wait() ) {
 181                 if ( ref($$href{$event->type()}) eq "CODE" ) {
 182                         &{$$href{$event->type()}}($event);
 183                         $self->sync();
 184                 }
 185         }
 186 }
 187
 188 sub sync ($) {
 189         my $self = shift;
 190         if ($SDL::App::USING_OPENGL) {
 191                 SDL::GLSwapBuffers()
 192         } else {
 193                 $self->flip();
 194         }
 195 }
 196
 197 sub attribute ($$;$) {
 198         my ($self,$mode,$value) = @_;
 199         return undef unless ($SDL::App::USING_OPENGL);
 200         if (defined $value) {
 201                 SDL::GLSetAttribute($mode,$value);
 202         }
 203         my $returns = SDL::GLGetAttribute($mode);
 204         croak "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0);
 205         $$returns[1];
 206 }
 207
 208 1;
 209
 210 __END__;
 211
 212 =pod
 213
 214 =head1 NAME
 215
 216 SDL::App - a SDL perl extension
 217
 218 =head1 SYNOPSIS
 219
 220         my $app = new SDL::App (
 221                 -title => 'Application Title',
 222                 -width => 640,
 223                 -height => 480,
 224                 -depth => 32 );
 225
 226 =head1 DESCRIPTION
 227
 228 L<SDL::App> controls the root window of the of your SDL based application.
 229 It extends the L<SDL_Surface> class, and provides an interface to the window
 230 manager oriented functions.
 231
 232 =head1 METHODS
 233
 234 =head2 new
 235
 236 C<SDL::App::new> initializes the SDL, creates a new screen,
 237 and initializes some of the window manager properties.
 238 C<SDL::App::new> takes a series of named parameters:
 239
 240 =over 4
 241
 242 =item *
 243
 244 -title
 245
 246 =item *
 247
 248 -icon_title
 249
 250 =item *
 251
 252 -icon
 253
 254 =item *
 255
 256 -width
 257
 258 =item *
 259
 260 -height
 261
 262 =item *
 263
 264 -depth
 265
 266 =item *
 267
 268 -flags
 269
 270 =item *
 271
 272 -resizeable
 273
 274 =back
 275
 276 =head2 title
 277
 278 C<SDL::App::title> takes 0, 1, or 2  arguments.  It returns the current
 279 application window title.  If one parameter is passed, both the window
 280 title and icon title will be set to its value.  If two parameters are
 281 passed the window title will be set to the first, and the icon title
 282 to the second.
 283
 284 =head2 delay
 285
 286 C<SDL::App::delay> takes 1 argument, and will sleep the application for
 287 that many ms.
 288
 289 =head2 ticks
 290
 291 C<SDL::App::ticks> returns the number of ms since the application began.
 292
 293 =head2 error
 294
 295 C<SDL::App::error> returns the last error message set by the SDL.
 296
 297 =head2 resize
 298
 299 C<SDL::App::resize> takes a new height and width of the application
 300 if the application was originally created with the -resizable option.
 301
 302 =head2 fullscreen
 303
 304 C<SDL::App::fullscreen> toggles the application in and out of fullscreen mode.
 305
 306 =head2 iconify
 307
 308 C<SDL::App::iconify> iconifies the applicaiton window.
 309
 310 =head2 grab_input
 311
 312 C<SDL::App::grab_input> can be used to change the input focus behavior of
 313 the application.  It takes one argument, which should be one of the following:
 314
 315 =over 4
 316
 317 =item *
 318 SDL_GRAB_QUERY
 319
 320 =item *
 321 SDL_GRAB_ON
 322
 323 =item *
 324 SDL_GRAB_OFF
 325
 326 =back
 327
 328 =head2 loop
 329
 330 C<SDL::App::loop> is a simple event loop method which takes a reference to a hash
 331 of event handler subroutines.  The keys of the hash must be SDL event types such
 332 as SDL_QUIT(), SDL_KEYDOWN(), and the like.  The event method recieves as its parameter
 333 the event object used in the loop.
 334
 335   Example:
 336
 337         my $app = new SDL::App  -title => "test.app",
 338                                 -width => 800,
 339                                 -height => 600,
 340                                 -depth => 32;
 341
 342         my %actions = (
 343                 SDL_QUIT() => sub { exit(0); },
 344                 SDL_KEYDOWN() => sub { print "Key Pressed" },
 345         );
 346
 347         $app->loop(\%actions);
 348
 349 =head2 sync
 350
 351 C<SDL::App::sync> encapsulates the various methods of syncronizing the screen with the
 352 current video buffer.  C<SDL::App::sync> will do a fullscreen update, using the double buffer
 353 or OpenGL buffer if applicable.  This is prefered to calling flip on the application window.
 354
 355 =head2 attribute ( attr, [value] )
 356
 357 C<SDL::App::attribute> allows one to set and get GL attributes.  By passing a value
 358 in addition to the attribute selector, the value will be set.  C<SDL:::App::attribute>
 359 always returns the current value of the given attribute, or croaks on failure.
 360
 361 =head1 AUTHOR
 362
 363 David J. Goehrig
 364 Kartik Thakore
 365
 366 =head1 SEE ALSO
 367
 368 L<perl> L<SDL::Surface> L<SDL::Event>  L<SDL::OpenGL>
 369
 370 =cut