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