#!/usr/bin/env perl
#
# App.pm
#
package SDLx::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;
use SDL::VideoInfo;
use SDLx::Surface;
use Data::Dumper;
use Scalar::Util 'refaddr';
use base qw/SDLx::Surface SDLx::Controller/;
my $screen_w;
my $screen_h;
my $screen_d;
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my %options = @_;
unless($screen_w && $screen_h && $screen_d) {
my $video_info = SDL::Video::get_video_info();
if($video_info) {
$screen_w = $video_info->current_w;
$screen_h = $video_info->current_h;
$screen_d = $video_info->vfmt->BitsPerPixel;
}
}
# SDL_INIT_VIDEO() is 0, so check defined instead of truth.
unless ( exists( $options{noinit} ) ) # we shouldn't do init always
{
my $init =
defined $options{init}
? $options{init}
: SDL::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::Video::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::Video::SDL_OPENGL if ( $options{gl} || $options{opengl} );
$f |= SDL::Video::SDL_FULLSCREEN
if ( $options{fullscreen} || $options{full} );
$f |= SDL::Video::SDL_RESIZABLE if ( $options{resizeable} );
$f |= SDL::Video::SDL_DOUBLEBUF if ($db);
$f |= SDL::Video::SDL_ASYNCBLIT if ($async);
if ( $f & SDL::Video::SDL_OPENGL ) {
$SDLx::App::USING_OPENGL = 1;
SDL::Video::GL_set_attribute( SDL::Constants::SDL_GL_RED_SIZE(), $r )
if ($r);
SDL::Video::GL_set_attribute( SDL::Constants::SDL_GL_GREEN_SIZE(), $g )
if ($g);
SDL::Video::GL_set_attribute( SDL::Constants::SDL_GL_BLUE_SIZE(), $b )
if ($b);
SDL::Video::GL_set_attribute( SDL::Constants::SDL_GL_ALPHA_SIZE(), $a )
if ($a);
SDL::Video::GL_set_attribute(
SDL::Constants::SDL_GL_RED_ACCUM_SIZE(),
$ras
) if ($ras);
SDL::Video::GL_set_attribute(
SDL::Constants::SDL_GL_GREEN_ACCUM_SIZE(),
$gas
) if ($gas);
SDL::Video::GL_set_attribute(
SDL::Constants::SDL_GL_BLUE_ACCUM_SIZE(),
$bas
) if ($bas);
SDL::Video::GL_set_attribute(
SDL::Constants::SDL_GL_ALPHA_ACCUM_SIZE(),
$aas
) if ($aas);
SDL::Video::GL_set_attribute(
SDL::Constants::SDL_GL_DOUBLEBUFFER(),
$db
) if ($db);
SDL::Video::GL_set_attribute(
SDL::Constants::SDL_GL_BUFFER_SIZE(),
$bs
) if ($bs);
SDL::Video::GL_set_attribute( SDL::Constants::SDL_GL_DEPTH_SIZE(), $d );
} else {
$SDLx::App::USING_OPENGL = 0;
}
my $surface = SDL::Video::set_video_mode( $w, $h, $d, $f )
or Carp::confess SDL::get_error();
$options{surface} = $surface;
my $self = SDLx::Surface->new(%options);
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 );
$self = $self->SDLx::Controller::new(%options);
bless $self, $class;
return $self;
}
sub resize {
my ( $self, $w, $h ) = @_;
my $flags = $self->flags;
if ( $flags & SDL::Video::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;
} else {
die "Application surface not resizable";
}
}
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_fullscreen($self);
}
sub iconify {
my $self = shift;
SDL::Video::wm_iconify_window();
}
sub grab_input {
my ( $self, $mode ) = @_;
SDL::Video::wm_grab_input($mode);
}
sub sync {
my $self = shift;
if ($SDLx::App::USING_OPENGL) {
SDL::Video::GL_swap_buffers();
} else {
$self->flip();
}
}
sub attribute {
my ( $self, $mode, $value ) = @_;
return undef unless ($SDLx::App::USING_OPENGL);
if ( defined $value ) {
SDL::Video::GL_set_attribute( $mode, $value );
}
my $returns = SDL::Video::GL_get_attribute($mode);
Carp::confess "SDLx::App::attribute failed to get GL attribute"
if ( $$returns[0] < 0 );
$$returns[1];
}
my %_stash;
sub stash :lvalue{
my $ref = refaddr($_[0]);
$_stash{ $ref } = {} unless $_stash{ $ref };
return $_stash{ $ref }
}
sub DESTROY {
if($screen_w && $screen_h && $screen_d) {
SDL::Video::set_video_mode( $screen_w, $screen_h, $screen_d, SDL_ANYFORMAT );
}
}
1;