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