App.pm

#!/usr/bin/env perl
#
# App.pm
#


package SDL::App;

use strict;
use warnings;
use Carp;
use SDL;
use SDL::Rect;
use SDL::Video;
use SDL::Event;
use SDL::Events;
use SDL::Surface;
use SDL::PixelFormat;
our @ISA = qw(SDL::Surface);
sub DESTROY {

}

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my %options = @_;

	 # 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::Video::GL_set_attribute(SDL::SDL_GL_RED_SIZE(),$r) if ($r);	
		SDL::Video::GL_set_attribute(SDL::SDL_GL_GREEN_SIZE(),$g) if ($g);	
		SDL::Video::GL_set_attribute(SDL::SDL_GL_BLUE_SIZE(),$b) if ($b);	
		SDL::Video::GL_set_attribute(SDL::SDL_GL_ALPHA_SIZE(),$a) if ($a);	

		SDL::Video::GL_set_attribute(SDL::SDL_GL_RED_ACCUM_SIZE(),$ras) if ($ras);	
		SDL::Video::GL_set_attribute(SDL::SDL_GL_GREEN_ACCUM_SIZE(),$gas) if ($gas);	
		SDL::Video::GL_set_attribute(SDL::SDL_GL_BLUE_ACCUM_SIZE(),$bas) if ($bas);	
		SDL::Video::GL_set_attribute(SDL::SDL_GL_ALPHA_ACCUM_SIZE(),$aas) if ($aas);	
		
		SDL::Video::GL_set_attribute(SDL::SDL_GL_DOUBLEBUFFER(),$db) if ($db);
		SDL::Video::GL_set_attribute(SDL::SDL_GL_BUFFER_SIZE(),$bs) if ($bs);
		SDL::Video::GL_set_attribute(SDL::SDL_GL_DEPTH_SIZE(),$d);
	} else {
		$SDL::App::USING_OPENGL = 0;
	}

	my $self = SDL::Video::set_video_mode($w,$h,$d,$f)
		or croak SDL::get_error();
	
	if ($ic and -e $ic) {
	   my $icon =  SDL::Video::load_BMP($ic);
	   SDL::Video::wm_set_icon($$icon);
	}

	SDL::Video::wm_set_caption($t,$it);
	
	bless $self,$class;
	return $self;
}	

sub resize ($$$) {
	my ($self,$w,$h) = @_;
	my $flags = $self->flags;
	if ( $flags & SDL_RESIZABLE) {
		my $bpp = $self->format->BitsPerPixel;
		$self = SDL::Video::set_video_mode($w,$h,$bpp,$flags) or die "SDL cannot set video:".SDL::get_error;
	}
}

sub title ($;$) {
	my $self = shift;
	my ($title,$icon);
	if (@_) { 
		$title = shift; 
		$icon = shift || $title;
		SDL::Video::wm_set_caption($title,$icon);
	}
	return SDL::Video::wm_get_caption();
}

sub delay ($$) {
	my $self = shift;
	my $delay = shift;
	SDL::delay($delay);
}

sub ticks {
	return SDL::get_ticks();
}

sub error {
	return SDL::get_error();
}

sub warp ($$$) {
	my $self = shift;
	SDL::Mouse::warp_mouse(@_);
}

sub fullscreen ($) {
	my $self = shift;
	SDL::Video::wm_toggle_full_screen($self);
}

sub iconify ($) {
	my $self = shift;
	SDL::Video::wm_iconify_window();
}

sub grab_input ($$) {
	my ($self,$mode) = @_;
	SDL::Video::wm_grab_input($mode);
}

sub loop ($$) {
	my ($self,$href) = @_;
	my $event = SDL::Event->new();
	while ( SDL::Events::wait_event($event) ) {
		if ( ref($$href{$event->type()}) eq "CODE" ) {
			&{$$href{$event->type()}}($event);			
		}
	}
}

sub sync ($) {
	my $self = shift;
	if ($SDL::App::USING_OPENGL) {
		SDL::Video::GL_swap_buffers()
	} else {
		SDL::Video::flip($self);
	}
}

sub attribute ($$;$) {
	my ($self,$mode,$value) = @_;
	return undef unless ($SDL::App::USING_OPENGL);
	if (defined $value) {
		SDL::Video::GL_set_attribute($mode,$value);
	}
	my $returns = SDL::Video::GL_get_attribute($mode);	
	croak "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0);
	$$returns[1];	
}

1;