Permalink
Browse files

merge

  • Loading branch information...
1 parent 4979eb1 commit a44ce7da5e0f95707064c245089114299e4fcc61 @jtpalmer jtpalmer committed Jul 31, 2010
Showing with 367 additions and 59 deletions.
  1. +21 −0 examples/SDLx/app.pl
  2. +2 −0 inc/My/Builder.pm
  3. +1 −1 lib/SDL.pm
  4. +9 −4 lib/SDLx/App.pm
  5. +2 −2 lib/SDLx/Sprite.pm
  6. +13 −50 lib/SDLx/Surface.pm
  7. +167 −0 lib/SDLx/Validate.pm
  8. +3 −0 t/00-load.t
  9. +20 −2 t/sdlx_app.t
  10. +9 −0 t/sdlx_surface.t
  11. +104 −0 t/sdlx_validate.t
  12. +1 −0 tools/SDLBot.pl
  13. +15 −0 tools/perltidy.pl
View
@@ -0,0 +1,21 @@
+use SDL::Event;
+use SDLx::App;
+
+my $app = SDLx::App->new(
+ title => "Lines",
+ width => 640,
+ height => 480,
+);
+
+
+
+sub draw_lines { $app->draw_line( [ 0, 0 ], [ rand( $app->w ), rand( $app->h ) ], 0xFFFFFFFF ); $app->update(); }
+
+sub event_handle { my $e = shift; return if ( $e->type == SDL_QUIT ); return 1 }
+
+$app->add_event_handler( \&event_handle );
+$app->add_show_handler( \&draw_lines );
+
+$app->run();
+
+
View
@@ -124,6 +124,8 @@ sub set_file_flags {
{
$debug .= ' -g -rdynamic ' unless ( $^O =~ /(win|darwin|bsd)/i );
+ } else {
+ $debug .= ' -O2 ';
}
my $arch = ' ';
View
@@ -54,7 +54,7 @@ our %EXPORT_TAGS = (
defaults => $SDL::Constants::EXPORT_TAGS{'SDL/defaults'}
);
-our $VERSION = '2.503';
+our $VERSION = '2.504';
$VERSION = eval $VERSION;
print "$VERSION" if ( defined( $ARGV[0] ) && ( $ARGV[0] eq '--SDLperl' ) );
View
@@ -17,7 +17,8 @@ use SDL::Events;
use SDL::Surface;
use SDL::PixelFormat;
use SDLx::Surface;
-use base 'SDLx::Surface';
+use Data::Dumper;
+use base qw/SDLx::Surface SDLx::Controller/;
sub new {
my $proto = shift;
@@ -34,6 +35,7 @@ sub new {
SDL::init($init);
}
+
my $t = $options{title} || $options{t} || $0;
my $it = $options{icon_title} || $options{it} || $t;
my $ic = $options{icon} || $options{i} || "";
@@ -103,16 +105,19 @@ sub new {
$SDLx::App::USING_OPENGL = 0;
}
- my $self = SDL::Video::set_video_mode( $w, $h, $d, $f )
+ my $surface = SDL::Video::set_video_mode( $w, $h, $d, $f )
or croak SDL::get_error();
- $self = SDLx::Surface->new( surface => $self );
+ $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 = SDLx::Controller->new( %{$self} );
bless $self, $class;
return $self;
}
View
@@ -143,7 +143,7 @@ sub clip {
sub x {
my ( $self, $x ) = @_;
- if ($x) {
+ if ( defined $x ) {
$self->rect->x($x);
}
@@ -153,7 +153,7 @@ sub x {
sub y {
my ( $self, $y ) = @_;
- if ($y) {
+ if ( defined $y ) {
$self->rect->y($y);
}
View
@@ -14,6 +14,7 @@ use SDLx::Surface;
use SDLx::Surface::TiedMatrix;
use SDL::GFX::Primitives;
use SDL::PixelFormat;
+use SDLx::Validate;
use Tie::Simple;
use overload (
@@ -88,9 +89,7 @@ sub display {
sub duplicate {
my $surface = shift;
- Carp::croak 'SDLx::Surface or SDL::Surface for surface required'
- unless ( $surface->isa('SDL::Surface')
- || $surface->isa('SDLx::Surface') );
+ SDLx::Validate::surface($surface);
require SDL::PixelFormat;
return SDLx::Surface->new(
width => $surface->w,
@@ -141,10 +140,7 @@ sub _array {
sub surface {
return $_[0]->{surface} unless $_[1];
my ( $self, $surface ) = @_;
- Carp::croak 'surface accepts only SDL::Surface objects'
- unless $surface->isa('SDL::Surface');
-
- $self->{surface} = $surface;
+ $self->{surface} = SDLx::Validate::surface($surface);
return $self->{surface};
}
@@ -182,34 +178,19 @@ sub clip_rect {
sub blit {
my ( $self, $dest, $src_rect, $dest_rect ) = @_;
- Carp::croak 'SDLx::Surface or SDL::Surface for dest required'
- unless ( $dest->isa('SDL::Surface') || $dest->isa('SDLx::Surface') );
-
- my $self_surface = $self;
- $self_surface = $self->surface if $self->isa('SDLx::Surface');
+ my $self_surface = $self->surface;
- my $dest_surface = $dest;
- $dest_surface = $dest->surface if $dest->isa('SDLx::Surface');
+ my $dest_surface = SDLx::Validate::surface($dest);
$src_rect = SDL::Rect->new( 0, 0, $self_surface->w, $self_surface->h )
unless defined $src_rect;
$dest_rect = SDL::Rect->new( 0, 0, $dest_surface->w, $dest_surface->h )
unless defined $dest_rect;
- Carp::croak 'Array ref or SDL::Rect for source rect required.'
- unless ( ref($src_rect) eq 'ARRAY' ) || $src_rect->isa('SDL::Rect');
- Carp::croak 'Array ref or SDL::Rect for dest rect required'
- unless ( ref($dest_rect) eq 'ARRAY' ) || ( $dest_rect->isa('SDL::Rect') );
-
- my $pass_src_rect = $src_rect;
- $pass_src_rect = SDL::Rect->new( @{$src_rect} ) if ref $src_rect eq 'ARRAY';
+ my $pass_src_rect = SDLx::Validate::rect($src_rect);
- my $pass_dest_rect = $dest_rect;
- $pass_dest_rect = SDL::Rect->new( @{$dest_rect} )
- if ref $dest_rect eq 'ARRAY';
+ my $pass_dest_rect = SDLx::Validate::rect($dest_rect);
- Carp::croak 'Destination was not a surface'
- unless $dest_surface->isa('SDL::Surface');
SDL::Video::blit_surface(
$self_surface, $pass_src_rect, $dest_surface,
$pass_dest_rect
@@ -255,28 +236,15 @@ sub update {
sub draw_rect {
my ( $self, $rect, $color ) = @_;
- Carp::croak "Rect needs to be a SDL::Rect or array ref or undef"
- unless !defined($rect)
- || ref($rect) eq 'ARRAY'
- || $rect->isa('SDL::Rect');
- require Scalar::Util;
- if ( Scalar::Util::looks_like_number($color) ) {
-
- } elsif ( $color->isa('SDL::Color') ) {
- $color = ( $color->r << 24 ) + ( $color->g << 16 ) + ( $color->b << 8 ) + 0xFF;
+ $color = SDLx::Validate::num_rgba($color);
+ if ( defined $rect ) {
+ $rect = SDLx::Validate::rect($rect);
} else {
- Carp::croak "Color needs to be a number or a SDL::Color";
+ $rect = SDL::Rect->new( 0, 0, $self->w, $self->h );
}
- $rect = (
- !defined($rect) ? SDL::Rect->new( 0, 0, $self->w, $self->h )
- : ref($rect) ? SDL::Rect->new( @{$rect} )
- : $rect
- );
-
SDL::Video::fill_rect( $self->surface, $rect, $color )
and Carp::croak "Error drawing rect: " . SDL::get_error();
-
return $self;
}
@@ -327,15 +295,10 @@ sub draw_line {
return $self;
}
-#TODO
-
-=pod
-
-sub draw_cirle{
- my ($self, $center, $radius, $color, $antialias) = @_;
+sub draw_circle {
+ my ( $self, $center, $radius, $color, $antialias ) = @_;
return $self;
}
-=cut
1;
View
@@ -0,0 +1,167 @@
+#Interal Module to validate SDLx types
+package SDLx::Validate;
+use strict;
+use warnings;
+use Carp;
+use Scalar::Util ();
+
+sub surface {
+ my ($arg) = @_;
+ Carp::croak("Wrong amount of arguments")
+ unless @_ == 1;
+ if ( Scalar::Util::blessed($arg) and $arg->isa("SDL::Surface") ) {
+ return $arg;
+ } elsif ( Scalar::Util::blessed($arg) and $arg->isa("SDLx::Surface") ) {
+ require SDLx::Surface;
+ return $arg->surface();
+ } else {
+ Carp::croak("Surface must be SDL::Surface or SDLx::Surface");
+ }
+}
+
+sub rect {
+ my ($arg) = @_;
+ Carp::croak("Wrong amount of arguments")
+ unless @_ == 1;
+ if ( !defined $arg ) {
+ return SDL::Rect->new( 0, 0, 0, 0 );
+ } elsif ( ref $arg eq "ARRAY" ) {
+ Carp::carp("Rect arrayref had more than 4 values")
+ if @$arg > 4;
+ require SDL::Rect;
+ return SDL::Rect->new( map { $_ || 0 } @$arg[ 0 .. 3 ] );
+ } elsif ( Scalar::Util::blessed($arg) and $arg->isa("SDL::Rect") ) {
+ return $arg;
+ } else {
+ Carp::croak("Rect must be arrayref or SDL::Rect or undef");
+ }
+}
+
+sub _make_color {
+ my ( $t, $arg ) = @_;
+ Carp::croak("Wrong amount of arguments")
+ unless @_ == 2;
+ my ( $num_rgb, $num_rgba, $list_rgb, $list_rgba, $error );
+ $t == 0 ? ( $num_rgb = 1 )
+ : $t == 1 ? ( $num_rgba = 1 )
+ : $t == 3 ? ( $list_rgb = 1 )
+ : $t == 4 ? ( $list_rgba = 1 )
+ : ( $error = 1 );
+ Carp::croak("\$t invalid. You shouldn't be calling this directly anyway")
+ if $error;
+ $t += 3 if $t < 3; #$t is 3 if rgb and 4 if rgba
+ my $list = $list_rgb || $list_rgba;
+ if ( !defined $arg or Scalar::Util::looks_like_number($arg) ) {
+
+ if ( !defined $arg or $arg < 0 ) {
+ Carp::carp("Color was a negative number")
+ if defined $arg and $arg < 0;
+ if ($num_rgb) {
+ return 0;
+ } elsif ($num_rgba) {
+ return 0xFF;
+ } elsif ($list_rgb) {
+ return ( 0, 0, 0 );
+ } else {
+ return ( 0, 0, 0, 0xFF );
+ }
+ } elsif ( $arg > 0x100**$t - 1 ) {
+ Carp::carp( "Color was number greater than maximum expected: 0x" . "FF" x $t );
+ return (
+ $num_rgb ? 0xFFFFFF
+ : $num_rgba ? 0xFFFFFFFF
+ : (0xFF) x $t
+ );
+ }
+ if ($list_rgb) {
+ return ( $arg >> 16 & 0xFF, $arg >> 8 & 0xFF, $arg & 0xFF );
+ } elsif ($list_rgba) {
+ return (
+ $arg >> 24, $arg >> 16 & 0xFF, $arg >> 8 & 0xFF,
+ $arg & 0xFF
+ );
+ } else {
+ return $arg;
+ }
+ } elsif ( Scalar::Util::blessed($arg) and $arg->isa("SDL::Color") ) {
+ if ($num_rgb) {
+ return ( ( $arg->r << 16 ) + ( $arg->g << 8 ) + ( $arg->b ) );
+ } elsif ($num_rgba) {
+ return ( ( $arg->r << 24 ) + ( $arg->g << 16 ) + ( $arg->b << 8 ) + (0xFF) );
+ } elsif ($list_rgb) {
+ return ( $arg->r, $arg->g, $arg->b );
+ } else {
+ return ( $arg->r, $arg->g, $arg->b, 0xFF );
+ }
+ } elsif ( ref $arg eq "ARRAY" ) {
+ Carp::carp("Color arrayref had more values than maximum expected: $t")
+ if @$arg > $t;
+ for ( 0 .. $t - 1 ) {
+ my $c = \$$arg[$_];
+ Carp::croak("All values in color arrayref must be numbers or undef")
+ unless !defined $$c
+ or Scalar::Util::looks_like_number($$c);
+ if ( !defined $$c ) {
+ if ( $_ == 3 ) { # $_ is 3 when doing alpha
+ $$c = 0xFF;
+ } else {
+ $$c = 0;
+ }
+ } elsif ( $$c > 0xFF ) {
+ Carp::carp("Number in color arrayref was greater than maximum expected: 0xFF");
+ $$c = 0xFF;
+ } elsif ( $$c < 0 ) {
+ Carp::carp("Number in color arrayref was negative");
+ $$c = 0;
+ }
+ }
+ if ($num_rgb) {
+ return ( ( $arg->[0] << 16 ) + ( $arg->[1] << 8 ) + ( $arg->[2] ) );
+ } elsif ($num_rgba) {
+ return ( ( $arg->[0] << 24 ) + ( $arg->[1] << 16 ) + ( $arg->[2] << 8 ) + ( $arg->[3] ) );
+ } else {
+ return @$arg;
+ }
+ } else {
+ Carp::croak("Color must be number or arrayref or SDLx::Color");
+ }
+}
+
+sub num_rgb {
+ return ( _make_color( 0, @_ ) );
+}
+
+sub num_rgba {
+ return ( _make_color( 1, @_ ) );
+}
+
+sub list_rgb {
+ return ( _make_color( 3, @_ ) );
+}
+
+sub list_rgba {
+ return ( _make_color( 4, @_ ) );
+}
+
+sub color {
+ require SDL::Color;
+ return SDL::Color->new( _make_color( 3, @_ ) );
+}
+
+sub map_rgb {
+ require SDL::Video;
+ return SDL::Video::map_rgb(
+ SDLx::Surface::display->format,
+ _make_color( 3, @_ )
+ );
+}
+
+sub map_rgba {
+ require SDL::Video;
+ return SDL::Video::map_rgba(
+ SDLx::Video::get_display->format,
+ _make_color( 4, @_ )
+ );
+}
+
+1;
Oops, something went wrong.

0 comments on commit a44ce7d

Please sign in to comment.