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