[sdlgit/SDL_perl.git] / lib / SDL / App.pm

#!/usr/bin/env perl
#
# App.pm
#
# Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
#
# ------------------------------------------------------------------------------
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
# 
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
# 
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
#
# ------------------------------------------------------------------------------
#
# Please feel free to send questions, suggestions or improvements to:
#
#	David J. Goehrig
#	dgoehrig@cpan.org
#

package SDL::App;

use strict;
use SDL;
use SDL::Event;
use SDL::Surface;
use SDL::Rect;

our @ISA = qw(SDL::Surface);

sub DESTROY {

}

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my %options = @_;

	verify (%options, qw/	-opengl -gl -fullscreen -full -resizeable
				-title -t -icon_title -it -icon -i 
				-width -w -height -h -depth -d -flags -f 
				-red_size -r -blue_size -b -green_size -g -alpha_size -a
				-red_accum_size -ras -blue_accum_size -bas 
				-green_accum_sizee -gas -alpha_accum_size -aas
				-double_buffer -db -buffer_size -bs -stencil_size -st
				-asyncblit
		/ ) if ($SDL::DEBUG);

	SDL::Init(SDL::SDL_INIT_EVERYTHING());
	
	my $t = $options{-title} 	|| $options{-t} 	|| $0;
	my $it = $options{-icon_title} 	|| $options{-it} 	|| $t;
	my $ic = $options{-icon} 	|| $options{-i}		|| "";
	my $w = $options{-width} 	|| $options{-w}		|| 800;
	my $h = $options{-height} 	|| $options{-h}		|| 600;
	my $d = $options{-depth} 	|| $options{-d}		|| 16;
	my $f = $options{-flags} 	|| $options{-f}		|| SDL::SDL_ANYFORMAT();
	my $r = $options{-red_size}	|| $options{-r}		|| 5;
	my $g = $options{-green_size}	|| $options{-g}		|| 5;
	my $b = $options{-blue_size}	|| $options{-b}		|| 5;
	my $a = $options{-alpha_size}	|| $options{-a}		|| 0;
	my $ras = $options{-red_accum_size}	|| $options{-ras}		|| 0;
	my $gas = $options{-green_accum_size}	|| $options{-gas}		|| 0;
	my $bas = $options{-blue_accum_size}	|| $options{-bas}		|| 0;
	my $aas = $options{-alpha_accum_size}	|| $options{-aas}		|| 0;
	my $db = $options{-double_buffer} 	|| $options{-db}		|| 0;
 
	my $bs = $options{-buffer_size}		|| $options{-bs}		|| 0;
	my $st	= $options{-stencil_size}	|| $options{-st}		|| 0;
	my $async = $options{-asyncblit} || 0;

	$f |= SDL::SDL_OPENGL() if ($options{-gl} || $options{-opengl});
	$f |= SDL::SDL_FULLSCREEN() if ($options{-fullscreen} || $options{-full});
	$f |= SDL::SDL_RESIZABLE() if ($options{-resizeable});
	$f |= SDL::SDL_DOUBLEBUF() if ($db); 
	$f |= SDL::SDL_ASYNCBLIT() if ($async);

	if ($f & SDL::SDL_OPENGL()) { 
		$SDL::App::USING_OPENGL = 1;
		SDL::GLSetAttribute(SDL::SDL_GL_RED_SIZE(),$r) if ($r);	
		SDL::GLSetAttribute(SDL::SDL_GL_GREEN_SIZE(),$g) if ($g);	
		SDL::GLSetAttribute(SDL::SDL_GL_BLUE_SIZE(),$b) if ($b);	
		SDL::GLSetAttribute(SDL::SDL_GL_ALPHA_SIZE(),$a) if ($a);	

		SDL::GLSetAttribute(SDL::SDL_GL_RED_ACCUM_SIZE(),$ras) if ($ras);	
		SDL::GLSetAttribute(SDL::SDL_GL_GREEN_ACCUM_SIZE(),$gas) if ($gas);	
		SDL::GLSetAttribute(SDL::SDL_GL_BLUE_ACCUM_SIZE(),$bas) if ($bas);	
		SDL::GLSetAttribute(SDL::SDL_GL_ALPHA_ACCUM_SIZE(),$aas) if ($aas);	
		
		SDL::GLSetAttribute(SDL::SDL_GL_DOUBLEBUFFER(),$db) if ($db);
		SDL::GLSetAttribute(SDL::SDL_GL_BUFFER_SIZE(),$bs) if ($bs);
		SDL::GLSetAttribute(SDL::SDL_GL_DEPTH_SIZE(),$d);
	} else {
		$SDL::App::USING_OPENGL = 0;
	}

	my $self = \SDL::SetVideoMode($w,$h,$d,$f)
		or die SDL::GetError();
	
	if ($ic and -e $ic) {
	   my $icon = new SDL::Surface -name => $ic;
	   SDL::WMSetIcon($$icon);	   
	}

	SDL::WMSetCaption($t,$it);
	
	bless $self,$class;
	return $self;
}	

sub resize ($$$) {
	my ($self,$w,$h) = @_;
	my $flags = SDL::SurfaceFlags($$self);
	if ( $flags & SDL::SDL_RESIZABLE()) {
		my $bpp = SDL::SurfaceBitsPerPixel($$self);
		$self = \SDL::SetVideoMode($w,$h,$bpp,$flags);
	}
}

sub title ($;$) {
	my $self = shift;
	my ($title,$icon);
	if (@_) { 
		$title = shift; 
		$icon = shift || $title;
		SDL::WMSetCaption($title,$icon);
	}
	return SDL::WMGetCaption();
}

sub delay ($$) {
	my $self = shift;
	my $delay = shift;
	SDL::Delay($delay);
}

sub ticks {
	return SDL::GetTicks();
}

sub error {
	return SDL::GetError();
}

sub warp ($$$) {
	my $self = shift;
	SDL::WarpMouse(@_);
}

sub fullscreen ($) {
	my $self = shift;
	SDL::WMToggleFullScreen($$self);
}

sub iconify ($) {
	my $self = shift;
	SDL::WMIconifyWindow();
}

sub grab_input ($$) {
	my ($self,$mode) = @_;
	SDL::WMGrabInput($mode);
}

sub loop ($$) {
	my ($self,$href) = @_;
	my $event = new SDL::Event;
	while ( $event->wait() ) {
		if ( ref($$href{$event->type()}) eq "CODE" ) {
			&{$$href{$event->type()}}($event);
			$self->sync();
		}
	}
}

sub sync ($) {
	my $self = shift;
	if ($SDL::App::USING_OPENGL) {
		SDL::GLSwapBuffers()
	} else {
		$self->flip();
	}
}

sub attribute ($$;$) {
	my ($self,$mode,$value) = @_;
	return undef unless ($SDL::App::USING_OPENGL);
	if (defined $value) {
		SDL::GLSetAttribute($mode,$value);
	}
	my $returns = SDL::GLGetAttribute($mode);	
	die "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0);
	$$returns[1];	
}

1;

__END__;

=pod

=head1 NAME

SDL::App - a SDL perl extension

=head1 SYNOPSIS

	my $app = new SDL::App (
		-title => 'Application Title',
		-width => 640, 
		-height => 480,
		-depth => 32 );

=head1 DESCRIPTION

L<SDL::App> controls the root window of the of your SDL based application.
It extends the L<SDL_Surface> class, and provides an interface to the window
manager oriented functions.

=head1 METHODS

=head2 new

C<SDL::App::new> initializes the SDL, creates a new screen,
and initializes some of the window manager properties.
C<SDL::App::new> takes a series of named parameters:

=over 4

=item *

-title

=item *

-icon_title

=item *

-icon

=item *

-width

=item *

-height

=item *

-depth

=item *

-flags

=item *

-resizeable

=back

=head2 title

C<SDL::App::title> takes 0, 1, or 2  arguments.  It returns the current
application window title.  If one parameter is passed, both the window
title and icon title will be set to its value.  If two parameters are
passed the window title will be set to the first, and the icon title
to the second.

=head2 delay

C<SDL::App::delay> takes 1 argument, and will sleep the application for
that many ms.

=head2 ticks

C<SDL::App::ticks> returns the number of ms since the application began.

=head2 error

C<SDL::App::error> returns the last error message set by the SDL.

=head2 resize

C<SDL::App::resize> takes a new height and width of the application
if the application was originally created with the -resizable option.

=head2 fullscreen

C<SDL::App::fullscreen> toggles the application in and out of fullscreen mode.

=head2 iconify

C<SDL::App::iconify> iconifies the applicaiton window.

=head2 grab_input

C<SDL::App::grab_input> can be used to change the input focus behavior of
the application.  It takes one argument, which should be one of the following:

=over 4

=item *
SDL_GRAB_QUERY

=item *
SDL_GRAB_ON

=item *
SDL_GRAB_OFF

=back

=head2 loop

C<SDL::App::loop> is a simple event loop method which takes a reference to a hash
of event handler subroutines.  The keys of the hash must be SDL event types such
as SDL_QUIT(), SDL_KEYDOWN(), and the like.  The event method recieves as its parameter 
the event object used in the loop.
 
  Example:

	my $app = new SDL::App  -title => "test.app", 
				-width => 800, 
				-height => 600, 
				-depth => 32;
	
	my %actions = (
		SDL_QUIT() => sub { exit(0); },
		SDL_KEYDOWN() => sub { print "Key Pressed" },
	);

	$app->loop(\%actions);

=head2 sync

C<SDL::App::sync> encapsulates the various methods of syncronizing the screen with the
current video buffer.  C<SDL::App::sync> will do a fullscreen update, using the double buffer
or OpenGL buffer if applicable.  This is prefered to calling flip on the application window.

=head2 attribute ( attr, [value] )

C<SDL::App::attribute> allows one to set and get GL attributes.  By passing a value
in addition to the attribute selector, the value will be set.  C<SDL:::App::attribute>
always returns the current value of the given attribute, or dies on failure.

=head1 AUTHOR

David J. Goehrig

=head1 SEE ALSO

L<perl> L<SDL::Surface> L<SDL::Event>  L<SDL::OpenGL>

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