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