lib/SDL/App.pm

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