[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 -init
		/ ) if ($SDL::DEBUG);

	 # SDL_INIT_VIDEO() is 0, so check defined instead of truth.
	 my $init = defined $options{-init} ? $options{-init} :
	SDL_INIT_EVERYTHING();
	
	 SDL::Init($init);

	#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);			
		}
	}
}

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
c383be07	58	-asyncblit -init
bfd90409	59	/ ) if ($SDL::DEBUG);
bfd90409	60
c383be07	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());
bfd90409	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)
084b921f	116	or croak SDL::GetError();
bfd90409	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::GetError();
	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" ) {
d73cbe8a	188	&{$$href{$event->type()}}($event);
bfd90409	189	}
	190	}
	191	}
	192
	193	sub sync ($) {
	194	my $self = shift;
	195	if ($SDL::App::USING_OPENGL) {
	196	SDL::GLSwapBuffers()
	197	} else {
	198	$self->flip();
	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);
084b921f	209	croak "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0);
bfd90409	210	$$returns[1];
	211	}
	212
	213	1;
	214
	215	__END__;
	216
	217	=pod
	218
	219	=head1 NAME
	220
	221	SDL::App - a SDL perl extension
	222
	223	=head1 SYNOPSIS
	224
	225	my $app = new SDL::App (
	226	-title => 'Application Title',
	227	-width => 640,
	228	-height => 480,
	229	-depth => 32 );
	230
	231	=head1 DESCRIPTION
	232
	233	L<SDL::App> controls the root window of the of your SDL based application.
	234	It extends the L<SDL_Surface> class, and provides an interface to the window
	235	manager oriented functions.
	236
	237	=head1 METHODS
	238
	239	=head2 new
	240
	241	C<SDL::App::new> initializes the SDL, creates a new screen,
	242	and initializes some of the window manager properties.
	243	C<SDL::App::new> takes a series of named parameters:
	244
	245	=over 4
	246
	247	=item *
	248
	249	-title
	250
	251	=item *
	252
	253	-icon_title
	254
	255	=item *
	256
	257	-icon
	258
	259	=item *
	260
	261	-width
	262
	263	=item *
	264
	265	-height
	266
	267	=item *
	268
	269	-depth
	270
	271	=item *
	272
	273	-flags
274
275	=item *
276
277	-resizeable
278
279	=back
280
281	=head2 title
282
283	C<SDL::App::title> takes 0, 1, or 2 arguments. It returns the current
284	application window title. If one parameter is passed, both the window
285	title and icon title will be set to its value. If two parameters are
286	passed the window title will be set to the first, and the icon title
287	to the second.
288
289	=head2 delay
290
291	C<SDL::App::delay> takes 1 argument, and will sleep the application for
292	that many ms.
293
294	=head2 ticks
295
296	C<SDL::App::ticks> returns the number of ms since the application began.
297
298	=head2 error
299
300	C<SDL::App::error> returns the last error message set by the SDL.
301
302	=head2 resize
303
304	C<SDL::App::resize> takes a new height and width of the application
305	if the application was originally created with the -resizable option.
306
307	=head2 fullscreen
308
309	C<SDL::App::fullscreen> toggles the application in and out of fullscreen mode.
310
311	=head2 iconify
312
313	C<SDL::App::iconify> iconifies the applicaiton window.
314
315	=head2 grab_input
316
317	C<SDL::App::grab_input> can be used to change the input focus behavior of
318	the application. It takes one argument, which should be one of the following:
319
320	=over 4
321
322	=item *
323	SDL_GRAB_QUERY
324
325	=item *
326	SDL_GRAB_ON
327
328	=item *
329	SDL_GRAB_OFF
330
331	=back
332
333	=head2 loop
334
335	C<SDL::App::loop> is a simple event loop method which takes a reference to a hash
336	of event handler subroutines. The keys of the hash must be SDL event types such
337	as SDL_QUIT(), SDL_KEYDOWN(), and the like. The event method recieves as its parameter
338	the event object used in the loop.
339
340	Example:
341
342	my $app = new SDL::App -title => "test.app",
343	-width => 800,
344	-height => 600,
345	-depth => 32;
346
347	my %actions = (
348	SDL_QUIT() => sub { exit(0); },
349	SDL_KEYDOWN() => sub { print "Key Pressed" },
350	);
351
352	$app->loop(\%actions);
353
354	=head2 sync
355
356	C<SDL::App::sync> encapsulates the various methods of syncronizing the screen with the
357	current video buffer. C<SDL::App::sync> will do a fullscreen update, using the double buffer
358	or OpenGL buffer if applicable. This is prefered to calling flip on the application window.
359
360	=head2 attribute ( attr, [value] )
361
362	C<SDL::App::attribute> allows one to set and get GL attributes. By passing a value
363	in addition to the attribute selector, the value will be set. C<SDL:::App::attribute>
084b921f	364	always returns the current value of the given attribute, or croaks on failure.
bfd90409	365
	366	=head1 AUTHOR
	367
	368	David J. Goehrig
084b921f	369	Kartik Thakore
bfd90409	370
	371	=head1 SEE ALSO
	372
	373	L<perl> L<SDL::Surface> L<SDL::Event> L<SDL::OpenGL>
	374
	375	=cut