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::get_error();
 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::get_error();
 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                 }
 190         }
 191 }
 192
 193 sub sync ($) {
 194         my $self = shift;
 195         if ($SDL::App::USING_OPENGL) {
 196                 SDL::GLSwapBuffers()
 197         } else {
 198                 SDL::Flip($self);
 199         }
 200 }
 201
 202 sub attribute ($$;$) {
 203         my ($self,$mode,$value) = @_;
 204         return undef unless ($SDL::App::USING_OPENGL);
 205         if (defined $value) {
 206                 SDL::GLSetAttribute($mode,$value);
 207         }
 208         my $returns = SDL::GLGetAttribute($mode);
 209         croak "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0);
 210         $$returns[1];
 211 }
 212
 213 1;
 214