[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;

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