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 -init
  59                 / ) if ($SDL::DEBUG);
  60
  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());
  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)
 116                 or croak SDL::GetError();
 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
 129 sub 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
 138 sub 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
 149 sub delay ($$) {
 150         my $self = shift;
 151         my $delay = shift;
 152         SDL::Delay($delay);
 153 }
 154
 155 sub ticks {
 156         return SDL::GetTicks();
 157 }
 158
 159 sub error {
 160         return SDL::GetError();
 161 }
 162
 163 sub warp ($$$) {
 164         my $self = shift;
 165         SDL::WarpMouse(@_);
 166 }
 167
 168 sub fullscreen ($) {
 169         my $self = shift;
 170         SDL::WMToggleFullScreen($$self);
 171 }
 172
 173 sub iconify ($) {
 174         my $self = shift;
 175         SDL::WMIconifyWindow();
 176 }
 177
 178 sub grab_input ($$) {
 179         my ($self,$mode) = @_;
 180         SDL::WMGrabInput($mode);
 181 }
 182
 183 sub loop ($$) {
 184         my ($self,$href) = @_;
 185         my $event = new SDL::Event;
 186         while ( $event->wait() ) {
 187                 if ( ref($$href{$event->type()}) eq "CODE" ) {
 188                         &{$$href{$event->type()}}($event);
 189                 }
 190         }
 191 }
 192
 193 sub sync ($) {
 194         my $self = shift;
 195         if ($SDL::App::USING_OPENGL) {
 196                 SDL::GLSwapBuffers()
 197         } else {
 198                 $self->flip();
 199         }
 200 }
 201
 202 sub 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);
 209         croak "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0);
 210         $$returns[1];
 211 }
 212
 213 1;
 214
 215 __END__;
 216
 217 =pod
 218
 219 =head1 NAME
 220
 221 SDL::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
 233 L<SDL::App> controls the root window of the of your SDL based application.
 234 It extends the L<SDL_Surface> class, and provides an interface to the window
 235 manager oriented functions.
 236
 237 =head1 METHODS
 238
 239 =head2 new
 240
 241 C<SDL::App::new> initializes the SDL, creates a new screen,
 242 and initializes some of the window manager properties.
 243 C<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
 283 C<SDL::App::title> takes 0, 1, or 2  arguments.  It returns the current
 284 application window title.  If one parameter is passed, both the window
 285 title and icon title will be set to its value.  If two parameters are
 286 passed the window title will be set to the first, and the icon title
 287 to the second.
 288
 289 =head2 delay
 290
 291 C<SDL::App::delay> takes 1 argument, and will sleep the application for
 292 that many ms.
 293
 294 =head2 ticks
 295
 296 C<SDL::App::ticks> returns the number of ms since the application began.
 297
 298 =head2 error
 299
 300 C<SDL::App::error> returns the last error message set by the SDL.
 301
 302 =head2 resize
 303
 304 C<SDL::App::resize> takes a new height and width of the application
 305 if the application was originally created with the -resizable option.
 306
 307 =head2 fullscreen
 308
 309 C<SDL::App::fullscreen> toggles the application in and out of fullscreen mode.
 310
 311 =head2 iconify
 312
 313 C<SDL::App::iconify> iconifies the applicaiton window.
 314
 315 =head2 grab_input
 316
 317 C<SDL::App::grab_input> can be used to change the input focus behavior of
 318 the application.  It takes one argument, which should be one of the following:
 319
 320 =over 4
 321
 322 =item *
 323 SDL_GRAB_QUERY
 324
 325 =item *
 326 SDL_GRAB_ON
 327
 328 =item *
 329 SDL_GRAB_OFF
 330
 331 =back
 332
 333 =head2 loop
 334
 335 C<SDL::App::loop> is a simple event loop method which takes a reference to a hash
 336 of event handler subroutines.  The keys of the hash must be SDL event types such
 337 as SDL_QUIT(), SDL_KEYDOWN(), and the like.  The event method recieves as its parameter
 338 the 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
 356 C<SDL::App::sync> encapsulates the various methods of syncronizing the screen with the
 357 current video buffer.  C<SDL::App::sync> will do a fullscreen update, using the double buffer
 358 or OpenGL buffer if applicable.  This is prefered to calling flip on the application window.
 359
 360 =head2 attribute ( attr, [value] )
 361
 362 C<SDL::App::attribute> allows one to set and get GL attributes.  By passing a value
 363 in addition to the attribute selector, the value will be set.  C<SDL:::App::attribute>
 364 always returns the current value of the given attribute, or croaks on failure.
 365
 366 =head1 AUTHOR
 367
 368 David J. Goehrig
 369 Kartik Thakore
 370
 371 =head1 SEE ALSO
 372
 373 L<perl> L<SDL::Surface> L<SDL::Event>  L<SDL::OpenGL>
 374
 375 =cut