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

#	App.pm
#
#	The application object, sort of like a surface
#
#	Copyright (C) 2000,2002,2003,2004 David J. Goehrig
#	Copyright (C) 2009 Kartik Thakore
#
package SDL::App;

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

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 -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);
	
	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_OPENGL()) { 
		$SDL::App::USING_OPENGL = 1;
		SDL::GLSetAttribute(SDL_GL_RED_SIZE(),$r) if ($r);	
		SDL::GLSetAttribute(SDL_GL_GREEN_SIZE(),$g) if ($g);	
		SDL::GLSetAttribute(SDL_GL_BLUE_SIZE(),$b) if ($b);	
		SDL::GLSetAttribute(SDL_GL_ALPHA_SIZE(),$a) if ($a);	

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