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                 SDL::Flip($self);
 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         use SDL;
 226         use SDL::Event;
 227         use SDL::App;
 228
 229         my $app = new SDL::App (
 230         -title => 'Application Title',
 231         -width => 640,
 232         -height => 480,
 233         -depth => 32 );
 234
 235 This is the manual way of doing things
 236
 237         my $event = new SDL::Event;             # create a new event
 238
 239         $event->pump();
 240         $event->poll();
 241
 242         while ($event->wait()) {
 243           my $type = $event->type();      # get event type
 244           print $type;
 245           exit if $type == SDL_QUIT;
 246           }
 247 An alternative to the manual Event processing is the L<SDL::App::loop> .
 248
 249 =head1 DESCRIPTION
 250
 251 L<SDL::App> controls the root window of the of your SDL based application.
 252 It extends the L<SDL::Surface> class, and provides an interface to the window
 253 manager oriented functions.
 254
 255 =head1 METHODS
 256
 257 =head2 new
 258
 259 C<SDL::App::new> initializes the SDL, creates a new screen,
 260 and initializes some of the window manager properties.
 261 C<SDL::App::new> takes a series of named parameters:
 262
 263 =over 4
 264
 265 =item *
 266
 267 -title
 268
 269 =item *
 270
 271 -icon_title
 272
 273 =item *
 274
 275 -icon
 276
 277 =item *
 278
 279 -width
 280
 281 =item *
 282
 283 -height
 284
 285 =item *
 286
 287 -depth
 288
 289 =item *
 290
 291 -flags
 292
 293 =item *
 294
 295 -resizeable
 296
 297 =back
 298
 299 =head2 title
 300
 301 C<SDL::App::title> takes 0, 1, or 2  arguments.  It returns the current
 302 application window title.  If one parameter is passed, both the window
 303 title and icon title will be set to its value.  If two parameters are
 304 passed the window title will be set to the first, and the icon title
 305 to the second.
 306
 307 =head2 delay
 308
 309 C<SDL::App::delay> takes 1 argument, and will sleep the application for
 310 that many ms.
 311
 312 =head2 ticks
 313
 314 C<SDL::App::ticks> returns the number of ms since the application began.
 315
 316 =head2 error
 317
 318 C<SDL::App::error> returns the last error message set by the SDL.
 319
 320 =head2 resize
 321
 322 C<SDL::App::resize> takes a new height and width of the application
 323 if the application was originally created with the -resizable option.
 324
 325 =head2 fullscreen
 326
 327 C<SDL::App::fullscreen> toggles the application in and out of fullscreen mode.
 328
 329 =head2 iconify
 330
 331 C<SDL::App::iconify> iconifies the applicaiton window.
 332
 333 =head2 grab_input
 334
 335 C<SDL::App::grab_input> can be used to change the input focus behavior of
 336 the application.  It takes one argument, which should be one of the following:
 337
 338 =over 4
 339
 340 =item *
 341 SDL_GRAB_QUERY
 342
 343 =item *
 344 SDL_GRAB_ON
 345
 346 =item *
 347 SDL_GRAB_OFF
 348
 349 =back
 350
 351 =head2 loop
 352
 353 C<SDL::App::loop> is a simple event loop method which takes a reference to a hash
 354 of event handler subroutines.  The keys of the hash must be SDL event types such
 355 as SDL_QUIT(), SDL_KEYDOWN(), and the like.  The event method recieves as its parameter
 356 the event object used in the loop.
 357
 358   Example:
 359
 360         my $app = new SDL::App  -title => "test.app",
 361                                 -width => 800,
 362                                 -height => 600,
 363                                 -depth => 32;
 364
 365         my %actions = (
 366                 SDL_QUIT() => sub { exit(0); },
 367                 SDL_KEYDOWN() => sub { print "Key Pressed" },
 368         );
 369
 370         $app->loop(\%actions);
 371
 372 =head2 sync
 373
 374 C<SDL::App::sync> encapsulates the various methods of syncronizing the screen with the
 375 current video buffer.  C<SDL::App::sync> will do a fullscreen update, using the double buffer
 376 or OpenGL buffer if applicable.  This is prefered to calling flip on the application window.
 377
 378 =head2 attribute ( attr, [value] )
 379
 380 C<SDL::App::attribute> allows one to set and get GL attributes.  By passing a value
 381 in addition to the attribute selector, the value will be set.  C<SDL:::App::attribute>
 382 always returns the current value of the given attribute, or croaks on failure.
 383
 384 =head1 AUTHOR
 385
 386 David J. Goehrig
 387 Kartik Thakore
 388
 389 =head1 SEE ALSO
 390
 391 L<perl> L<SDL::Surface> L<SDL::Event>  L<SDL::OpenGL>
 392
 393 =cut