[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 warnings;
use Carp;
use SDL;
use SDL::Event;
use SDL::Surface;
use SDL::Rect;

sub DESTROY {

}

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

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 croak 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);	
	croak "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 croaks on failure.

=head1 AUTHOR

David J. Goehrig
Kartik Thakore

=head1 SEE ALSO

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

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