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