5 # Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
7 # ------------------------------------------------------------------------------
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.
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.
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
23 # ------------------------------------------------------------------------------
25 # Please feel free to send questions, suggestions or improvements to:
41 our @ISA = qw(SDL::Surface);
48 my $class = ref($proto) || $proto;
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
61 # SDL_INIT_VIDEO() is 0, so check defined instead of truth.
62 my $init = defined $options{-init} ? $options{-init} :
63 SDL_INIT_EVERYTHING();
67 #SDL::Init(SDL::SDL_INIT_EVERYTHING());
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;
86 my $bs = $options{-buffer_size} || $options{-bs} || 0;
87 my $st = $options{-stencil_size} || $options{-st} || 0;
88 my $async = $options{-asyncblit} || 0;
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);
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);
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);
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);
112 $SDL::App::USING_OPENGL = 0;
115 my $self = SDL::SetVideoMode($w,$h,$d,$f)
116 or croak SDL::get_error();
118 if ($ic and -e $ic) {
119 my $icon = new SDL::Surface -name => $ic;
120 SDL::WMSetIcon($$icon);
123 SDL::WMSetCaption($t,$it);
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);
143 $icon = shift || $title;
144 SDL::WMSetCaption($title,$icon);
146 return SDL::WMGetCaption();
156 return SDL::GetTicks();
160 return SDL::get_error();
170 SDL::WMToggleFullScreen($$self);
175 SDL::WMIconifyWindow();
178 sub grab_input ($$) {
179 my ($self,$mode) = @_;
180 SDL::WMGrabInput($mode);
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);
195 if ($SDL::App::USING_OPENGL) {
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);
208 my $returns = SDL::GLGetAttribute($mode);
209 croak "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0);