[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

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

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