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