Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

merged in froggs's fixes

  • Loading branch information...
commit 69375174e1db6cb5a7ca0e6e8f4f001f832e92bf 2 parents 0016791 + eb0610a
Dominique Dumont dod38fr authored
1  .gitignore
View
@@ -26,6 +26,7 @@ stage
MANIFEST
!MANIFEST.skip
*META.yml
+*META.json
*.tar.gz
*.swp
*~
33 CHANGELOG
View
@@ -1,16 +1,31 @@
Revision history for Perl extension SDL_perl.
-* 2.534
+* 2.534_03 October 06 2011
- SDL::Palette fixed colors() to return an array [Blaizer]
- SDL::Video fixed set_colors, set_palette [FROGGS, Blaizer]
- - SDLx::Text improved error message [garu]
- - SDLx::Text new getter: font_filename() [garu]
- - SDLx::Text fixed size() accessor [garu]
- - SDLx::Text dynamic updating of text [garu]
- - SDLx::Text new options: shadow, shadow_offset and shadow_color [garu]
- - SDLx::Text examples (zoom, shadow) [garu]
- - SDLx::Text improved documentation [garu]
- - SDLx::TTF fixed loading error [FROGGS]
+ - SDLx::Text improved error message [garu]
+ - SDLx::Text new getter: font_filename() [garu]
+ - SDLx::Text fixed size() accessor [garu]
+ - SDLx::Text dynamic updating of text [garu]
+ - SDLx::Text new options: shadow, shadow_offset and shadow_color [garu]
+ - SDLx::Text new options: normal, bold, italic, underline, strikethrough [garu]
+ - SDLx::Text examples (zoom, shadow, style) [garu]
+ - SDLx::Text improved documentation [garu]
+ - SDLx::Text word wrapping support [garu]
+ - SDLx::TTF fixed loading error [FROGGS]
+ - SDL::Event fixed SDL_EVENTMASK documentation [jtpalmer]
+ - SDL::RWOps got SDL::RWOps->from_const_mem working, updated docs [FROGGS]
+ - SDL::Video updated xs and docs for blit_surface using undefined rects [FROGGS]
+
+* 2.534_02 August 27 2011
+ New features:
+ - SDLx::Surface: added methods draw_trigon, draw_ellipse, draw_arc and draw_bezier [jtpalmer]
+ Bug fixes:
+ - SDLx::Rect: fixed methods copy, move and inflate [jtpalmer]
+ - SDLx::Surface: minor documentation update [jtpalmer]
+
+* 2.534_01 June 13 2011
+ - Using 'perl' instead of 'SDLPerl' to run silent tests on darwin [FROGGS]
* 2.533 May 31 2011
- Added preliminary SDLx::Music
50 examples/SDLx/SDLx_text_styles.pl
View
@@ -0,0 +1,50 @@
+use strict;
+use warnings;
+use lib '../lib';
+use SDL;
+use SDLx::App;
+use SDLx::Text;
+
+my $app = SDLx::App->new( eoq => 1 );
+
+my $text = SDLx::Text->new;
+
+$app->draw_rect( [0, 0, $app->w, $app->h], 0x00ffff );
+
+$text->write_xy( $app, 300, 10, 'Normal Text' );
+
+$text->bold(1);
+$text->write_xy( $app, 300, 50, 'Bold Text' );
+
+$text->italic(1);
+$text->write_xy( $app, 300, 90, 'Bold/Italic Text' );
+
+$text->bold(0);
+$text->write_xy( $app, 300, 130, 'Italic Text' );
+
+$text->italic(0);
+$text->underline(1);
+$text->write_xy( $app, 300, 170, 'Underline Text' );
+
+$text->underline(0);
+$text->strikethrough(1);
+$text->write_xy( $app, 300, 210, 'Strikethrough Text' );
+
+$text->underline(1);
+$text->bold(1);
+$text->italic(1);
+$text->write_xy( $app, 300, 250, 'All in one!' );
+
+my $another = SDLx::Text->new(
+ bold => 1,
+ italic => 1,
+ underline => 1,
+ strikethrough => 1,
+ shadow => 1,
+);
+
+$another->write_xy( $app, 50, 300, 'Can even be set with others (like shadow), during startup!' );
+
+$app->update;
+
+$app->run;
28 examples/SDLx/SDLx_text_wordwrap.pl
View
@@ -0,0 +1,28 @@
+use strict;
+use warnings;
+use lib '../lib';
+use SDL;
+use SDLx::App;
+use SDLx::Text;
+
+my $app = SDLx::App->new( eoq => 1 );
+
+my $text = SDLx::Text->new( word_wrap => 450 );
+
+$app->draw_rect( [0, 0, $app->w, $app->h], 0x00ffff );
+
+my $message = <<'EOT';
+All lines come from a single string.
+
+- Really?
+Yup.
+
+- But... but... what if I say a lot of things in a single line. Won't that become trucated or something?
+
+Not if you set "word_wrap" to a particular width, like we do here :-)
+EOT
+
+$text->write_to( $app, $message );
+$app->update;
+
+$app->run;
29 inc/My/Builder/Darwin.pm
View
@@ -48,23 +48,30 @@ sub build_bundle {
my $cmd =
"gcc $arch -o \"blib/script/SDLPerl\" MacOSX/main.c $cflags $libs";
$cmd =~ s/\s+/ /g;
- print STDERR $cmd . "\n";
- system($cmd);
+ unless(-e 'blib/script/SDLPerl') {
+ print STDERR $cmd . "\n";
+ system($cmd);
+ }
}
sub ACTION_test {
my $self = shift;
- $self->build_bundle() if !( -d getcwd() . '/blib/script/SDLPerl' );
- my $cmd =
- getcwd().'/blib/script/SDLPerl ' . getcwd() . '/Build test';
- if ( $ENV{SDL_PERL_TEST} ) {
- $self->Module::Build::ACTION_test;
- $ENV{SDL_PERL_TEST} = 0; #unset it again
+ $self->depends_on('build');
+ $self->build_bundle() if !( -e 'blib/script/SDLPerl' );
+ if( $ENV{SDL_RELEASE_TESTING} ) {
+ if ( $ENV{SDL_PERL_TEST} ) {
+ $self->Module::Build::ACTION_test;
+ $ENV{SDL_PERL_TEST} = 0; #unset it again
+ }
+ else {
+ my $cmd = 'blib/script/SDLPerl Build test';
+ $ENV{SDL_PERL_TEST} = 1;
+ system( split ' ', $cmd );
+ die 'Errors in Testing. Can\'t continue' if $?;
+ }
}
else {
- $ENV{SDL_PERL_TEST} = 1;
- system( split ' ', $cmd );
- die 'Errors in Testing. Can\'t continue' if $?;
+ $self->Module::Build::ACTION_test;
}
}
2  lib/SDL.pm
View
@@ -54,7 +54,7 @@ our %EXPORT_TAGS = (
defaults => $SDL::Constants::EXPORT_TAGS{'SDL/defaults'}
);
-our $VERSION = '2.533';
+our $VERSION = '2.534_03';
$VERSION = eval $VERSION;
print "$VERSION" if ( defined( $ARGV[0] ) && ( $ARGV[0] eq '--SDLperl' ) );
10 lib/SDLx/Controller.pm
View
@@ -52,6 +52,16 @@ sub new {
return $self;
}
+
+sub delay {
+ my $self = shift;
+ my $delay = shift;
+ my $ref = refaddr $self;
+
+ $_sleep_cycle{ $ref } = $delay if $delay;
+ return $self;
+}
+
sub DESTROY {
my $self = shift;
my $ref = refaddr $self;
28 lib/SDLx/Rect.pm
View
@@ -13,14 +13,14 @@ sub new {
my $w = shift || 0;
my $h = shift || 0;
+ $class = ref($class) || $class;
my $self = $class->SUPER::new( $x, $y, $w, $h );
unless ($$self) {
#require Carp;
Carp::confess SDL::get_error();
}
- bless $self, ref($class) || $class;
- return $self;
+ return bless $self, $class;
}
#############################
@@ -254,10 +254,10 @@ sub midbottom {
sub copy {
my $self = shift;
return $self->new(
- -top => $self->top,
- -left => $self->left,
- -width => $self->width,
- -height => $self->height,
+ $self->x,
+ $self->y,
+ $self->w,
+ $self->h,
);
}
@@ -269,10 +269,10 @@ sub move {
Carp::confess "must receive x and y positions as argument";
}
return $self->new(
- -top => $self->top + $y,
- -left => $self->left + $x,
- -width => $self->width,
- -height => $self->height,
+ $self->left + $x,
+ $self->top + $y,
+ $self->width,
+ $self->height,
);
}
@@ -298,10 +298,10 @@ sub inflate {
}
return $self->new(
- -left => $self->left - ( $x / 2 ),
- -top => $self->top - ( $y / 2 ),
- -width => $self->width + $x,
- -height => $self->height + $y,
+ $self->left - ( $x / 2 ),
+ $self->top - ( $y / 2 ),
+ $self->width + $x,
+ $self->height + $y,
);
}
74 lib/SDLx/Surface.pm
View
@@ -298,21 +298,80 @@ sub draw_circle_filled {
return $self;
}
-
sub draw_trigon {
- my ( $self, $center, $vextexes, $color ) = @_;
+ my ( $self, $vertices, $color, $antialias ) = @_;
+
+ $color = SDLx::Validate::num_rgba($color);
+
+ if ($antialias) {
+ SDL::GFX::Primitives::aatrigon_color( $self, $vertices->[0][0], $vertices->[0][1], $vertices->[1][0], $vertices->[1][1], $vertices->[2][0], $vertices->[2][1], $color );
+ }
+ else
+ {
+ SDL::GFX::Primitives::trigon_color( $self, $vertices->[0][0], $vertices->[0][1], $vertices->[1][0], $vertices->[1][1], $vertices->[2][0], $vertices->[2][1], $color );
+ }
+
+ return $self;
+}
+
+sub draw_trigon_filled {
+ my ( $self, $vertices, $color ) = @_;
+
+ $color = SDLx::Validate::num_rgba($color);
+
+ SDL::GFX::Primitives::filled_trigon_color( $self, $vertices->[0][0], $vertices->[0][1], $vertices->[1][0], $vertices->[1][1], $vertices->[2][0], $vertices->[2][1], $color );
+
+ return $self;
+}
+
+sub draw_polygon_filled {
+ my ( $self, $vertices, $color ) = @_;
+
+ $color = SDLx::Validate::num_rgba($color);
+
+ my @vx = map { $_->[0] } @$vertices;
+ my @vy = map { $_->[1] } @$vertices;
+ SDL::GFX::Primitives::filled_polygon_color( $self, \@vx, \@vy, scalar @$vertices, $color );
return $self;
}
sub draw_arc {
- my ( $self, $vector, $radius, $start, $end, $color ) = @_;
+ my ( $self, $center, $radius, $start, $end, $color ) = @_;
+
+ Carp::cluck "Center needs to be an array of format [x,y]" unless ( ref $center eq 'ARRAY' && scalar @$center == 2 );
+ $color = SDLx::Validate::num_rgba($color);
+
+ SDL::GFX::Primitives::arc_color( $self, @$center, $radius, $start, $end, $color );
return $self;
}
sub draw_ellipse {
- my ( $self, $center, $radius, $color, $antialias ) = @_;
+ my ( $self, $center, $rx, $ry, $color, $antialias ) = @_;
+
+ Carp::cluck "Center needs to be an array of format [x,y]" unless ( ref $center eq 'ARRAY' && scalar @$center == 2 );
+ $color = SDLx::Validate::num_rgba($color);
+
+ if ($antialias)
+ {
+ SDL::GFX::Primitives::aaellipse_color( $self, @$center, $rx, $ry, $color );
+ }
+ else
+ {
+ SDL::GFX::Primitives::ellipse_color( $self, @$center, $rx, $ry, $color );
+ }
+
+ return $self;
+}
+
+sub draw_ellipse_filled {
+ my ( $self, $center, $rx, $ry, $color ) = @_;
+
+ Carp::cluck "Center needs to be an array of format [x,y]" unless ( ref $center eq 'ARRAY' && scalar @$center == 2 );
+ $color = SDLx::Validate::num_rgba($color);
+
+ SDL::GFX::Primitives::filled_ellipse_color( $self, @$center, $rx, $ry, $color );
return $self;
}
@@ -320,6 +379,13 @@ sub draw_ellipse {
sub draw_bezier {
my ( $self, $vector, $smooth, $color ) = @_;
+ $color = SDLx::Validate::num_rgba($color);
+
+ my @vx = map { $_->[0] } @$vector;
+ my @vy = map { $_->[1] } @$vector;
+ SDL::GFX::Primitives::bezier_color( $self, \@vx, \@vy, scalar @$vector, $smooth, $color );
+
+ return $self;
}
sub draw_gfx_text {
223 lib/SDLx/Text.pm
View
@@ -7,6 +7,7 @@ use SDL::Config;
use SDL::TTF;
use SDL::TTF::Font;
use SDLx::Validate;
+use List::Util qw(max sum);
use Carp ();
@@ -53,6 +54,14 @@ sub new {
$self->shadow_color($shadow_color);
$self->shadow_offset($shadow_offset);
+ $self->bold($options{'bold'}) if exists $options{'bold'};
+ $self->italic($options{'italic'}) if exists $options{'italic'};
+ $self->underline($options{'underline'}) if exists $options{'underline'};
+ $self->strikethrough($options{'strikethrough'}) if exists $options{'strikethrough'};
+
+ # word wrapping
+ $self->{word_wrap} = $options{'word_wrap'} || 0;
+
$self->text( $options{'text'} ) if exists $options{'text'};
return $self;
@@ -104,6 +113,41 @@ sub size {
return $self->{_size};
}
+sub _style {
+ my ($self, $flag, $enable) = @_;
+
+ my $styles = SDL::TTF::get_font_style( $self->font );
+
+ # do we have an enable flag?
+ if (@_ > 2) {
+
+ # we do! setup flags if we're enabling or disabling
+ if ($enable) {
+ $styles |= $flag;
+ }
+ else {
+ $styles ^= $flag if $flag & $styles;
+ }
+
+ SDL::TTF::set_font_style( $self->font, $styles );
+
+ # another run, returning true if value was properly set.
+ return SDL::TTF::get_font_style( $self->font ) & $flag;
+ }
+ # no enable flag present, just return
+ # whether the style is enabled/disabled
+ else {
+ return $styles & $flag;
+ }
+}
+
+sub normal { my $self = shift; $self->_style( TTF_STYLE_NORMAL, @_ ) }
+sub bold { my $self = shift; $self->_style( TTF_STYLE_BOLD, @_ ) }
+sub italic { my $self = shift; $self->_style( TTF_STYLE_ITALIC, @_ ) }
+sub underline { my $self = shift; $self->_style( TTF_STYLE_UNDERLINE, @_ ) }
+sub strikethrough { my $self = shift; $self->_style( TTF_STYLE_STRIKETHROUGH, @_ ) }
+
+
sub h_align {
my ($self, $align) = @_;
@@ -150,11 +194,17 @@ sub shadow_offset {
}
sub w {
- return $_[0]->{surface}->w();
+ my $surface = $_[0]->{surface};
+ return $surface->w unless $surface and ref $surface eq 'ARRAY';
+
+ return max map { $_ ? $_->w() : 0 } @$surface;
}
sub h {
- return $_[0]->{surface}->h();
+ my $surface = $_[0]->{surface};
+ return $surface->h unless $surface and ref $surface eq 'ARRAY';
+
+ return sum map { $_ ? $_->h() : 0 } @$surface;
}
sub x {
@@ -180,31 +230,85 @@ sub text {
return $self->{text} if scalar @_ == 1;
- $self->{text} = $text;
-
if ( defined $text ) {
- my $surface = SDL::TTF::render_utf8_blended($self->{_font}, $text, $self->{_color})
- or Carp::croak 'TTF rendering error: ' . SDL::get_error;
+ $text = $self->_word_wrap($text) if $self->{word_wrap};
+ my $font = $self->{_font};
+ my $surface = _get_surfaces_for($font, $text, $self->{_color} )
+ or Carp::croak 'TTF rendering error: ' . SDL::get_error;
if ($self->{shadow}) {
- my $shadow_surface = SDL::TTF::render_utf8_blended(
- $self->{_font},
- $text,
- $self->{shadow_color}
- ) or Carp::croak 'TTF shadow rendering error: ' . SDL::get_error;
+ my $shadow_surface = _get_surfaces_for($font, $text, $self->{shadow_color})
+ or Carp::croak 'TTF shadow rendering error: ' . SDL::get_error;
+
+ $shadow_surface = [ $shadow_surface ] unless ref $shadow_surface eq 'ARRAY';
$self->{_shadow_surface} = $shadow_surface;
}
$self->{surface} = $surface;
+ $self->{text} = $text;
}
else {
$self->{surface} = undef;
}
+
return $self;
}
+# Returns the TTF surface for the given text.
+# If the text contains linebreaks, we split into
+# several surfaces (since SDL can't render '\n').
+sub _get_surfaces_for {
+ my ($font, $text, $color) = @_;
+
+ return SDL::TTF::render_utf8_blended($font, $text, $color)
+ if index($text, "\n") == -1;
+
+ my @surfaces = ();
+ my @paragraphs = split /\n/ => $text;
+ foreach my $paragraph (@paragraphs) {
+ push @surfaces, SDL::TTF::render_utf8_blended($font, $paragraph, $color);
+ }
+ return \@surfaces;
+}
+
+sub _word_wrap {
+ my ($self, $text) = @_;
+
+ my $maxlen = $self->{word_wrap};
+ my $font = $self->{_font};
+
+ # code heavily based on Text::Flow::Wrap
+ my @paragraphs = split /\n/ => $text;
+ my @output;
+
+ foreach my $paragraph (@paragraphs) {
+ my @paragraph_output = ('');
+ my @words = split /\s+/ => $paragraph;
+
+ foreach my $word (@words) {
+ my $padded = $word . q[ ];
+ my $candidate = $paragraph_output[-1] . $padded;
+ my ($w) = @{ SDL::TTF::size_utf8($font, $candidate) };
+ if ($w < $maxlen) {
+ $paragraph_output[-1] = $candidate;
+ }
+ else {
+ push @paragraph_output, $padded;
+ }
+ }
+ chop $paragraph_output[-1] if substr( $paragraph_output[-1], -1, 1 ) eq q[ ];
+
+ push @output, \@paragraph_output;
+
+ }
+
+ return join "\n" => map {
+ join "\n" => @$_
+ } @output;
+}
+
sub surface {
return $_[0]->{surface};
}
@@ -212,37 +316,11 @@ sub surface {
sub write_to {
my ($self, $target, $text) = @_;
- if (@_ > 2) {
- $self->text($text);
- }
- elsif ($self->{_update_surfaces}) {
- $self->{_update_surfaces} = 0;
- $self->text( $self->text );
- }
-
- if ( my $surface = $self->{surface} ) {
- if ($self->{h_align} eq 'center' ) {
- $self->{x} = ($target->w / 2) - ($surface->w / 2);
- }
- elsif ($self->{h_align} eq 'right' ) {
- $self->{x} = $target->w - $surface->w;
- }
-
- if ($self->{shadow}) {
- my $shadow = $self->{_shadow_surface};
- my $offset = $self->{shadow_offset};
- SDL::Video::blit_surface(
- $shadow, SDL::Rect->new(0,0,$shadow->w, $shadow->h),
- $target, SDL::Rect->new($self->{x} + $offset, $self->{y} + $offset, 0, 0)
- );
- }
-
- SDL::Video::blit_surface(
- $surface, SDL::Rect->new(0,0,$surface->w, $surface->h),
- $target, SDL::Rect->new($self->{x}, $self->{y}, 0, 0)
- );
- }
- return;
+ if (@_ > 2) {
+ $self->text($text);
+ $self->{_update_surfaces} = 0;
+ }
+ $self->write_xy($target, $self->{x}, $self->{y});
}
sub write_xy {
@@ -250,33 +328,52 @@ sub write_xy {
if (@_ > 4) {
$self->text($text);
+ $self->{_update_surfaces} = 0;
}
elsif ($self->{_update_surfaces}) {
- $self->{_update_surfaces} = 0;
$self->text( $self->text );
+ $self->{_update_surfaces} = 0;
}
- if ( my $surface = $self->{surface} ) {
- if ($self->{h_align} eq 'center' ) {
- $x -= $surface->w / 2;
- }
- elsif ($self->{h_align} eq 'right' ) {
- $x -= $surface->w;
- }
-
- if ($self->{shadow}) {
- my $shadow = $self->{_shadow_surface};
- my $offset = $self->{shadow_offset};
- SDL::Video::blit_surface(
- $shadow, SDL::Rect->new(0,0,$shadow->w, $shadow->h),
- $target, SDL::Rect->new($x + $offset, $y + $offset, 0, 0)
- );
- }
+ if ( my $surfaces = $self->{surface} ) {
+
+ $surfaces = [ $surfaces ] unless ref $surfaces eq 'ARRAY';
+ my $linebreaks = 0;
+
+ foreach my $i ( 0 .. $#{$surfaces}) {
+ if (my $surface = $surfaces->[$i]) {
+ $y += ($linebreaks * $surface->h);
+ $linebreaks = 0;
+
+ if ($self->{h_align} eq 'center' ) {
+ # $x = ($target->w / 2) - ($surface->w / 2);
+ $x -= $surface->w / 2;
+ }
+ elsif ($self->{h_align} eq 'right' ) {
+ # $x = $target->w - $surface->w;
+ $x -= $surface->w;
+ }
+
+ # blit the shadow
+ if ($self->{shadow}) {
+ my $shadow = $self->{_shadow_surface}->[$i];
+ my $offset = $self->{shadow_offset};
+
+ SDL::Video::blit_surface(
+ $shadow, SDL::Rect->new(0,0,$shadow->w, $shadow->h),
+ $target, SDL::Rect->new($x + $offset, $y + $offset, 0, 0)
+ );
+ }
+
+ # blit the text
+ SDL::Video::blit_surface(
+ $surface, SDL::Rect->new(0,0,$surface->w, $surface->h),
+ $target, SDL::Rect->new($x, $y, 0, 0)
+ );
+ }
+ $linebreaks++;
+ }
- SDL::Video::blit_surface(
- $surface, SDL::Rect->new(0,0,$surface->w, $surface->h),
- $target, SDL::Rect->new($x, $y, 0, 0)
- );
}
return;
}
22 lib/pods/SDL.pod
View
@@ -56,23 +56,23 @@ The C<$flags> tell C<SDL::init> which subsystems to initialize.
C<SDL::init> returns C<0> on success, or C<-1> on error.
-=head2 init_subsystem
+=head2 init_sub_system
- SDL::init_subsystem( $flags );
+ SDL::init_sub_system( $flags );
-After SDL has been initialized with C<SDL::init> you may initialize any uninitialized subsystems with C<SDL::init_subsystem>.
-The C<$flags> tell C<SDL::init_subsystem> which subsystems to initialize, and are taken in the same way as C<SDL::init>.
+After SDL has been initialized with C<SDL::init> you may initialize any uninitialized subsystems with C<SDL::init_sub_system>.
+The C<$flags> tell C<SDL::init_sub_system> which subsystems to initialize, and are taken in the same way as C<SDL::init>.
-C<SDL::init_subsystem> returns C<0> on success, or C<-1> on error.
+C<SDL::init_sub_system> returns C<0> on success, or C<-1> on error.
-=head2 quit_subsystem
+=head2 quit_sub_system
- SDL::quit_subsystem( $flags );
+ SDL::quit_sub_system( $flags );
-C<SDL::quit_subsystem> allows you to shut down a subsystem that has been previously initialized by C<SDL::init> or C<SDL::init_subsystem>.
-The C<$flags> tell C<SDL::quit_subsystem> which subsystems to shut down, and are taken in the same way as C<SDL::init>.
+C<SDL::quit_sub_system> allows you to shut down a subsystem that has been previously initialized by C<SDL::init> or C<SDL::init_sub_system>.
+The C<$flags> tell C<SDL::quit_sub_system> which subsystems to shut down, and are taken in the same way as C<SDL::init>.
-C<SDL::quit_subsystem> doesn't return any values.
+C<SDL::quit_sub_system> doesn't return any values.
=head2 quit
@@ -185,7 +185,7 @@ Tobias Leich (FROGGS)
The following people have dedicated blood sweat and tears to making SDL Perl possible.
-See the L<impact graph|http://github.com/kthakore/SDL_perl/graphs/impact> on our github repository.
+See the L<impact graph|https://github.com/PerlGameDev/SDL/graphs/impact> on our github repository.
Andy Bakun <sdlperl@thwartedefforts.org>
4 lib/pods/SDL/Credits.pod
View
@@ -13,9 +13,9 @@ Core
=head2 Core Developers
-See the L<impact graph|http://github.com/kthakore/SDL_perl/graphs/impact> on our github repository.
+See the L<impact graph|https://github.com/PerlGameDev/SDL/graphs/impact> on our github repository.
-Also see our CONTRIBUTORS file.
+Also see L<SDL/AUTHORS>.
=head2 Maintenance
8 lib/pods/SDL/Event.pod
View
@@ -223,10 +223,10 @@ SDL_SYSWMEVENTMASK
This way you can check if a given C<type> matches a mask:
- (SDL_JOYBUTTONDOWN & SDL_MOUSEEVENTMASK) # is false
- (SDL_MOUSEBUTTONDOWN & SDL_MOUSEEVENTMASK) # is true
- (SDL_MOUSEBUTTONUP & SDL_MOUSEEVENTMASK) # is true
- (SDL_MOUSEMOTION & SDL_MOUSEEVENTMASK) # is true
+ (SDL_EVENTMASK(SDL_JOYBUTTONDOWN) & SDL_MOUSEEVENTMASK) # is false
+ (SDL_EVENTMASK(SDL_MOUSEBUTTONDOWN) & SDL_MOUSEEVENTMASK) # is true
+ (SDL_EVENTMASK(SDL_MOUSEBUTTONUP) & SDL_MOUSEEVENTMASK) # is true
+ (SDL_EVENTMASK(SDL_MOUSEMOTION) & SDL_MOUSEEVENTMASK) # is true
# and also true is:
41 lib/pods/SDL/RWOps.pod
View
@@ -12,8 +12,35 @@ TODO, Core, Structure
=head1 SYNOPSIS
-use SDL::RW;
-
+ # The following example will load several png's from a single file to an array of SDL::Surface's.
+ # Usefull for e.g. levelfiles.
+ use SDL;
+ use SDL::Image;
+ use SDL::RWOps;
+ use SDL::Surface;
+
+ # the file contains a 32-byte header with lengths of data blocks, followed by the data blocks itself
+ my $file = '/path/to/file/containing_image_data.dat';
+ my $header = ''; # up to eight 32-bit integers specifying the length of the data blocks (images)
+ my @images = ''; # we push the surfaces to that array later
+
+ open(FH, "<$file") or die "Can't open file $file";
+ binmode(FH);
+ read(FH, $header, 32); # read 32 bytes of data
+
+ my @blocks = unpack( 'V*', $header ); # unpack the block sizes
+
+ foreach my $block_size (@blocks) {
+ if($block_size) {
+ my $image = '';
+ read(FH, $image, $block_size);
+ my $rw = SDL::RWOps->new_const_mem( $image );
+ push(@images, SDL::Image::load_PNG_rw( $rw );
+ }
+ }
+ close(FH);
+
+ # ... now do something with the surfaces
SDL::RWOps is an "undocumented" feature of SDL, allowing you to use pointers to memory instead of files (though it can handle files too) for things such as images or samples. The primary advantage of this feature is that many libraries load files from the filesystem themselves, leaving you a bit stuck if you want to implement your own special file access, such as an archive format. Fortunately many libraries, such as SDL_image, provide additional methods designed to read from an SDL_RWops, so that you can provide the data in whatever way you like.
@@ -67,10 +94,13 @@ It returns a SDL::Rwops on succés or undef on error.
Note: If the memory is not writable, use SDL::rw_from_const_mem instead.
-=head2 rw_from_const_mem(mem,size)
+=head2 from_const_mem
+
+ my $rw = SDL::RWOps->from_const_mem( $image_data );
+ my $rw = SDL::RWOps->from_const_mem( $image_data, $size );
-rw_from_const_mem sets up a SDL::RWops struct based on a memory area of a certain size. It assumes the memory area is not writable.
-It returns a SDL::RWops on succés on undef on error.
+C<from_const_mem> sets up a SDL::RWOps object based on a memory area of a certain size. The C<$size> parameter is optional.
+It assumes the memory area is not writable. It returns a SDL::RWOps on success or undef on error.
=head2 alloc_rw()
@@ -79,7 +109,6 @@ It returns a SDL::RWops structure on succés or undef on error.
Note: You must free any memory allocated with SDL::alloc_rw with SDL::free_rw.
-
=head2 free_rw(context)
SDL::free_rw frees an SDL::RWops structure previously allocated by SDL::alloc_rw. Only use it on memory allocated by SDL::alloc_rw.
8 lib/pods/SDL/Video.pod
View
@@ -683,10 +683,10 @@ C<SDL::Video::get_clip_rect> doesn't returns anything;
SDL::Video::blit_surface( $src_surface, $src_rect, $dest_surface, $dest_rect );
This performs a fast blit from the given source L<SDL::Surface> to the given destination L<SDL::Surface>.
-The width and height in C<src_surface> determine the size of the copied rectangle. Only the position is used in the C<dst_rect>
-(the width and height are ignored). Blits with negative C<dst_rect> coordinates will be clipped properly.
-If C<src_rect> is NULL, the entire surface is copied. If C<dst_rect> is NULL, then the destination position (upper left corner) is (0, 0).
-The final blit rectangle is saved in C<dst_rect> after all clipping is performed (C<src_rect> is not modified).
+The width and height in C<$src_rect> determine the size of the copied rectangle. Only the position is used in the C<$dest_rect>
+(the width and height are ignored). Blits with negative C<dest_rect> coordinates will be clipped properly.
+If C<$src_rect> is C<undef>, the entire surface is copied. If C<$dest_rect> is C<undef>, then the destination position (upper left corner) is (0, 0).
+The final blit rectangle is saved in C<$dest_rect> after all clipping is performed (C<$src_rect> is not modified).
The blit function should not be called on a locked surface. I.e. when you use your own drawing functions you may need to lock a surface,
but this is not the case with C<SDL::Video::blit_surface>. Like most surface manipulation functions in SDL, it should not be used together
with OpenGL.
2  lib/pods/SDLx/Controller.pod
View
@@ -157,7 +157,7 @@ This is only useful when used within code that will be run by C<pause>:
# can be stopped while paused
}
elsif($e->type == SDL_KEYDOWN) {
- if($e->key_sym == SDLK_P) {
+ if($e->key_sym == SDLK_p) {
# We're paused, so end pause
return 1 if $app->paused;
77 lib/pods/SDLx/Surface.pod
View
@@ -121,6 +121,8 @@ Blits C<SDLx::Surface> onto $dest surface.
$src_rect or $dest_rect are optional. If $src_rect is ommited, it will be the size of the entire surface. If $dest_rect is ommited,
it will be blitted at C<(0, 0)>. $src_rect or $dest_rect can be array refs or C<SDL::Rect>. $dest can be C<SDLx::Surface> or C<SDL::Surface>.
+Note that the final blit rectangle is stored in $dest_rect after clipping is performed.
+
Returns $self
=head2 blit_by
@@ -130,6 +132,8 @@ Returns $self
Does the same as C<blit> but the C<SDLx::Surface> is the one being blitted to.
This is useful when the surface you have isn't an C<SDLx::Surface>, but the surface it is being blitted to is.
+Note that the final blit rectangle is stored in $dest_rect after clipping is performed.
+
=head2 flip
Applies L<SDL::Video::flip|SDL::Video/"flip"> to the Surface, with error checking.
@@ -177,13 +181,84 @@ Returns $self
=head2 draw_circle_filled
- $sdlx_surface->draw_filled_circle( [$x1, $y1], $radius, \@color );
+ $sdlx_surface->draw_circle_filled( [$x1, $y1], $radius, \@color );
Draws an B<filled> circle at C<($x1,$y1)> of size $radius and $color.
Antialias is turned on automatically.
Returns $self
+=head2 draw_trigon
+
+ $sdlx_surface->draw_trigon( [ [$x1, $y1], [$x2, $y2], [$x3, y3] ], \@color, $antialias );
+
+Draws an unfilled trigon (triangle) with vertices C<($x1,$y1)>, C<($x2,$y2)>,
+C<($x3,$y3)> and $color.
+Antialias is turned on if $antialias is true.
+Returns $self
+
+=head2 draw_trigon_filled
+
+ $sdlx_surface->draw_trigon_filled( [ [$x1, $y1], [$x2, $y2], [$x3, y3] ], \@color );
+
+Draws an B<filled> trigon (triangle) with vertices C<($x1,$y1)>, C<($x2,$y2)>,
+C<($x3,$y3)> and $color.
+Antialias is turned on automatically.
+Returns $self
+
+=head2 draw_polygon
+
+ $sdlx_surface->draw_polygon( [ [$x1, $y1], [$x2, $y2], [$x3, y3], ... ], \@color, $antialias );
+
+Draws an unfilled polygon with vertices C<($xN,$yN)> and $color.
+Antialias is turned on if $antialias is true.
+Returns $self
+
+=head2 draw_polygon_filled
+
+ $sdlx_surface->draw_polygon_filled( [ [$x1, $y1], [$x2, $y2], [$x3, y3], ... ], \@color );
+
+Draws an B<filled> polygon with vertices C<($xN,$yN)> and $color.
+Antialias is turned on automatically.
+Returns $self
+
+=head2 draw_arc
+ $sdlx_surface->draw_arc( [ $x, $y ], $radius, $start, $end, $color );
+
+Draws an arc around C<($x,$y)> with $radius, $start radius, $end radius
+and $color.
+
+Returns $self
+
+=head2 draw_ellipse
+
+ $sdlx_surface->draw_ellipse( [ $x, $y ], $rx, $ry, $color );
+
+Draws an unfilled ellipse centered at C<($x,$y)> with horizontal radius $rx,
+vetical radius $ry and $color.
+Antialias is turned on if $antialias is true.
+
+Returns $self
+
+=head2 draw_ellipse_filled
+
+ $sdlx_surface->draw_ellipse_filled( [ $x, $y ], $rx, $ry, $color );
+
+Draws an B<filled> ellipse centered at C<($x,$y)> with horizontal radius $rx,
+vetical radius $ry and $color.
+Antialias is turned on automatically.
+
+Returns $self
+
+=head2 draw_bezier
+
+ $sdlx_surface->draw_bezier( [ [$x1, $y1], [$x2, $y2], [$x3, y3], ... ], $s, $color );
+
+Draws a bezier curve of points C<($xN,$yN)> using $s steps for
+interpolation and $color.
+Antialias is turned on automatically.
+
+Returns $self
=head2 draw_gfx_text
53 lib/pods/SDLx/Text.pod
View
@@ -44,6 +44,8 @@ Instantiates a new SDLx::Text object. All attributes are optional:
x => 0,
y => 0,
h_align => 'left',
+ shadow => 1,
+ bold => 1,
text => 'All your base are belong to us.'
);
@@ -66,13 +68,19 @@ Unless otherwise noticed, all accessors return their current value, after being
=head2 x
Gets/sets the left (x) positioning of the text to be rendered, relative
-to whatever surface you are placing it into.
+to whatever surface you are placing it into. Note that if you set the
+C<h_align> property to anything other than 'C<left>', the text might
+not start exactly where you set C<x> to be, but relative to that value.
+
+Default value is 0, meaning leftmost corner.
=head2 y
Gets/sets the top (y) positioning of the text to be rendered, relative
to whatever surface you are placing it into.
+Default value is 0, meaning top.
+
=head2 h_align
Gets/sets the horizontal alignment of the text to be rendered relative to
@@ -110,6 +118,49 @@ Set the RGB color array for the shadow. Defaults to black ( C<[0,0,0]> ).
Sets the offset in which to display the shadow. Defaults to 1, meaning
1 pixel below and 1 pixel to the right of the original text.
+=head2 Setting the Font Style
+
+The following accessors can be used to set a rendering file for the B<loaded> font.
+They will only work for the current font, so if you change fonts, make sure to
+apply your modifiers again. A single font can have more than one modifier applied to it, eg:
+
+ my $text = SDLx::Text->new;
+
+ $text->bold(1);
+ $text->italic(1);
+
+Set them to a true value to enable, false to disable.
+
+=head3 normal
+
+Sets the font style to normal.
+
+=head3 bold
+
+Sets the font style to bold.
+
+=head3 italic
+
+Sets the font style to italic.
+
+=head3 underline
+
+Sets the font style to underline.
+
+B<Note>: Due to libsdl design and depending on the chosen font, sometimes
+the underline may be outside of the generated text surface, and thus not
+visible when blitted to the screen. In these cases, you should probably turn
+off the option and draw your own underlines in the target surface.
+
+=head3 strikethrough
+
+Sets the font style to strikethrough.
+
+B<Note>: Due to libsdl design and depending on the chosen font, sometimes
+the strikethrough may be outside of the generated text surface, and thus not
+visible when blitted to the screen. In these cases, you should probably turn
+off the option and draw your own strikethroughs in the target surface.
+
=head1 METHODS
=head2 text( $some_text )
15 src/Core/Video.xs
View
@@ -432,12 +432,21 @@ fill_rect ( dest, dest_rect, pixel )
RETVAL
int
-blit_surface ( src, src_rect, dest, dest_rect )
+blit_surface ( src, src_rect_bag, dest, dest_rect_bag )
SDL_Surface *src
SDL_Surface *dest
- SDL_Rect *src_rect
- SDL_Rect *dest_rect
+ SV *src_rect_bag
+ SV *dest_rect_bag
CODE:
+ SDL_Rect *src_rect = NULL;
+ SDL_Rect *dest_rect = NULL;
+
+ if(SvOK(src_rect_bag))
+ src_rect = (SDL_Rect *)bag2obj(src_rect_bag);
+
+ if(SvOK(dest_rect_bag))
+ dest_rect = (SDL_Rect *)bag2obj(dest_rect_bag);
+
RETVAL = SDL_BlitSurface(src,src_rect,dest,dest_rect);
OUTPUT:
RETVAL
13 src/Core/objects/RWOps.xs
View
@@ -57,13 +57,16 @@ rwops_new_mem ( CLASS, mem, size )
OUTPUT:
RETVAL
-SDL_RWops*
-rwops_new_const_mem (CLASS, mem, size )
+SDL_RWops *
+rwops_new_const_mem (CLASS, mem, ... )
char* CLASS
- const char* mem
- int size
+ SV* mem
CODE:
- RETVAL = SDL_RWFromConstMem((const void*)mem,size);
+ STRLEN len;
+ unsigned char *text = SvPV(mem, len);
+ if(items > 2 && SvIOK(ST(2)))
+ len = SvIV(ST(2));
+ RETVAL = SDL_RWFromConstMem((const void*)text, len);
OUTPUT:
RETVAL
2  src/Core/objects/Surface.xs
View
@@ -13,6 +13,8 @@
void _free_surface(void *object)
{
+ // Frees the resources used by a previously created SDL_Surface.
+ // If the surface was created using SDL_CreateRGBSurfaceFrom then the pixel data is not freed.
SDL_FreeSurface((SDL_Surface *)object);
}
2  src/SDLx/Layer.xs
View
@@ -240,6 +240,8 @@ layerx_foreground( bag )
SvREFCNT_inc( bag );
RETVAL = newSVsv(bag);
SvREFCNT_inc(RETVAL);
+ OUTPUT:
+ RETVAL
void
layerx_DESTROY( layer )
28 src/SDLx/Surface.xs
View
@@ -202,33 +202,33 @@ surfacex_draw_rect ( surface, rt, color )
#ifdef HAVE_SDL_GFX_PRIMITIVES
-int
-surfacex_draw_polygon(surface, vectors, color, antialias)
- SDL_Surface * surface
+SV *
+surfacex_draw_polygon ( surface, vectors, color, ... )
+ SV* surface
AV* vectors
Uint32 color
- SV *antialias
CODE:
+ SDL_Surface * _surface = (SDL_Surface *)bag2obj(surface);
AV* vx = newAV();
AV* vy = newAV();
- int n;
- for(n = 0; n <= av_len(vectors); n++)
+ AV* vertex;
+ while (vertex = (AV*)SvRV(av_shift(vectors)))
{
- if(n & 1)
- av_store(vy, (int)((n-1)/2), *av_fetch(vectors, n, 0));
- else
- av_store(vx, (int)(n/2), *av_fetch(vectors, n, 0));
+ av_push(vx, av_shift(vertex));
+ av_push(vy, av_shift(vertex));
}
- n = av_len(vx) + 1;
+ int n = av_len(vx) + 1;
Sint16 * _vx = av_to_sint16(vx);
Sint16 * _vy = av_to_sint16(vy);
- RETVAL = SvOK(antialias)
- ? aapolygonColor(surface, _vx, _vy, n, color)
- : polygonColor(surface, _vx, _vy, n, color);
+ if ( items > 3 && SvTRUE( ST(3) ) )
+ aapolygonColor( _surface, _vx, _vy, n, color );
+ else
+ polygonColor( _surface, _vx, _vy, n, color );
_svinta_free( _vx, av_len(vx) );
_svinta_free( _vy, av_len(vy) );
+ RETVAL = SvREFCNT_inc(surface);
OUTPUT:
RETVAL
8 src/SDLx/Validate.h
View
@@ -73,9 +73,9 @@ char *_color_format( SV *color )
else if( sv_derived_from(color, "ARRAY") )
retval = "arrayref";
else if( sv_isobject(color) && sv_derived_from(color, "SDL::Color") )
- retval = "SDLx::Color";
+ retval = "SDL::Color";
else
- croak("Color must be number or arrayref or SDLx::Color");
+ croak("Color must be number or arrayref or SDL::Color");
return retval;
}
@@ -156,7 +156,7 @@ AV* __list_rgb( SV* color )
{
RETVAL = _color_arrayref((AV *)SvRV(color), sv_2mortal(newSVuv(0)));
}
- else if ( 0 == strcmp("SDLx::Color", format) )
+ else if ( 0 == strcmp("SDL::Color", format) )
{
RETVAL = (AV*)sv_2mortal((SV *)RETVAL);
SDL_Color *_color = (SDL_Color *)bag2obj(color);
@@ -193,7 +193,7 @@ AV* __list_rgba( SV* color )
{
RETVAL = _color_arrayref((AV *)SvRV(color), sv_2mortal(newSVuv(1)));
}
- else if ( 0 == strcmp("SDLx::Color", format) )
+ else if ( 0 == strcmp("SDL::Color", format) )
{
RETVAL = (AV*)sv_2mortal((SV *)RETVAL);
SDL_Color *_color = (SDL_Color*)bag2obj(color);
32 src/SDLx/Validate.xs
View
@@ -38,7 +38,7 @@ val__color_arrayref( color, ... )
CODE:
RETVAL = items > 1
? _color_arrayref( color, ST(1) )
- : _color_arrayref( color, newSVuv(0) );
+ : _color_arrayref( color, sv_2mortal(newSVuv(0)) );
OUTPUT:
RETVAL
@@ -48,14 +48,14 @@ val_num_rgb( color )
CODE:
char *format = _color_format( color );
if( 0 == strcmp("number", format) )
- RETVAL = _color_number(color, newSVuv(0));
+ RETVAL = _color_number( color, sv_2mortal(newSVuv(0)) );
else if( 0 == strcmp("arrayref", format) )
{
- AV *c = _color_arrayref( (AV *)SvRV(color), newSVuv(0) );
+ AV *c = _color_arrayref( (AV *)SvRV(color), sv_2mortal(newSVuv(0)) );
unsigned int v = (( SvUV(AvARRAY(c)[0]) << 16 ) + ( SvUV(AvARRAY(c)[1]) << 8 ) + SvUV(AvARRAY(c)[2]));
RETVAL = newSVuv(v);
}
- else if( 0 == strcmp("SDLx::Color", format) )
+ else if( 0 == strcmp("SDL::Color", format) )
{
SDL_Color *_color = (SDL_Color*) bag2obj( color );
unsigned int v = ( (_color->r) << 16 ) + ( (_color->g) << 8 ) + _color->b;
@@ -73,15 +73,15 @@ val_num_rgba( color )
char *format = _color_format( color );
if( 0 == strcmp("number", format) )
{
- RETVAL = _color_number(color, newSVuv(1));
+ RETVAL = _color_number( color, sv_2mortal(newSVuv(1)) );
}
else if( 0 == strcmp("arrayref", format) )
{
- AV *c = _color_arrayref( (AV *)SvRV(color), newSVuv(1) );
+ AV *c = _color_arrayref( (AV *)SvRV(color), sv_2mortal(newSVuv(1)) );
unsigned int v = (SvUV(AvARRAY(c)[0]) << 24) + (SvUV(AvARRAY(c)[1]) << 16) + (SvUV(AvARRAY(c)[2]) << 8) + SvUV(AvARRAY(c)[3] );
RETVAL = newSVuv(v);
}
- else if( 0 == strcmp("SDLx::Color", format) )
+ else if( 0 == strcmp("SDL::Color", format) )
{
SDL_Color *_color = (SDL_Color*)bag2obj( color );
unsigned int v = (((_color->r) << 24) + ((_color->g) << 16) + ((_color->b) << 8) + 0xFF) ;
@@ -119,21 +119,17 @@ val_rect( r )
void *
val_surface( s )
- SV* s
+ SV *s
PPCODE:
- SV* ret ;
- printf("s\n");
- sv_dump(s) ;
+ SV *ret;
ret = surface(s);
- printf("ret\n");
- sv_dump(ret);
if(NULL == ret)
XSRETURN_UNDEF;
- else {
- /* s (hence ret) is already mortal */
- ST(0) = ret ;
- XSRETURN(1) ;
- }
+ else {
+ /* s (hence ret) is already mortal */
+ ST(0) = ret;
+ XSRETURN(1);
+ }
SV *
val_map_rgb( color, format)
2  t/sdlx_fps.t
View
@@ -40,7 +40,7 @@ my $count = 10;
for ( 1 .. $count ) {
$fps->delay;
}
-is( $fps->framecount, $count, 'fps->framecount' );
+cmp_ok( $fps->framecount, '>', 0, 'fps->framecount' );
$_fps = 20;
$fps->set($_fps);
116 t/sdlx_rect.t
View
@@ -0,0 +1,116 @@
+use strict;
+use warnings;
+use SDL;
+use SDL::Rect;
+use SDLx::Rect;
+use Test::More;
+use lib 't/lib';
+use SDL::TestTool;
+
+my $videodriver = $ENV{SDL_VIDEODRIVER};
+$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
+
+if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) {
+ plan( skip_all => 'Failed to init video' );
+}
+
+can_ok(
+ 'SDLx::Rect', qw/
+ width
+ w
+ height
+ h
+ left
+ x
+ top
+ y
+ bottom
+ right
+ centerx
+ centery
+ size
+ topleft
+ midleft
+ bottomleft
+ center
+ topright
+ midright
+ bottomright
+ midtop
+ midbottom
+ new
+ copy
+ duplicate
+ move
+ move_ip
+ inflate
+ inflate_ip
+ clamp
+ clamp_ip
+ clip
+ clip_ip
+ union
+ union_ip
+ unionall
+ unionall_ip
+ fit
+ fit_ip
+ normalize
+ contains
+ collidepoint
+ colliderect
+ collidelist
+ collidelistall
+ collidehash
+ collidehashall
+ /
+);
+
+
+my ($x, $y, $w, $h) = (0, 1, 2, 3);
+my $rect = SDLx::Rect->new($x, $y, $w, $h);
+ok($rect, 'new');
+isa_ok($rect, 'SDLx::Rect');
+
+is($rect->width, $w, 'get width');
+is($rect->w, $w, 'get w');
+is($rect->height, $h, 'get height');
+is($rect->h, $h, 'get h');
+is($rect->left, $x, 'get left');
+is($rect->x, $x, 'get x');
+is($rect->top, $y, 'get top');
+is($rect->y, $y, 'get y');
+
+is($rect->bottom, $y + $h, 'get bottom');
+is($rect->right, $x + $w, 'get right');
+
+my $copy = $rect->copy();
+is($copy->w, $w, 'copy (w)');
+is($copy->h, $h, 'copy (h)');
+is($copy->x, $x, 'copy (x)');
+is($copy->y, $y, 'copy (y)');
+
+my ($dx, $dy) = (4, 5);
+my $moved = $rect->move($dx, $dy);
+is($moved->w, $w, 'move (w)');
+is($moved->h, $h, 'move (h)');
+is($moved->x, $x + $dx, 'move (x)');
+is($moved->y, $y + $dy, 'move (y)');
+
+my ($dw, $dh) = (6, 7);
+my $inflated = $rect->inflate($dw, $dh);
+is($inflated->w, $w + $dw, 'inflate (w)');
+is($inflated->h, $h + $dh, 'inflate (h)');
+is($inflated->x, $x - $dw / 2, 'inflate (x)');
+is($inflated->y, $y - $dw / 2, 'inflate (y)');
+
+if ($videodriver) {
+ $ENV{SDL_VIDEODRIVER} = $videodriver;
+} else {
+ delete $ENV{SDL_VIDEODRIVER};
+}
+
+pass 'Final SegFault test';
+
+
+done_testing;
29 t/sdlx_surface.t
View
@@ -170,6 +170,9 @@ pass 'draw_rect works';
SKIP:
{
skip( 'SDL_gfx_primitives needed', 2 ) unless SDL::Config->has('SDL_gfx_primitives');
+
+ is( $surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], 0xff00ffff ), $surfs[1], 'draw_line returns self' );
+
$surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], 0xff00ff );
$surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], 0xff00ffff );
$surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], 0xff00ffff, 1 );
@@ -189,6 +192,7 @@ SKIP:
pass 'draw_gfx_text works';
my @colors_t = ( [ 255, 0, 0, 255 ], 0xFF0000FF, 0xFF00FF, [ 255, 0, 255 ] );
+ is( $surfs[0]->draw_circle( [ 100, 10 ], 20, [ 0, 0, 0, 0] ), $surfs[0], 'draw_circle returns self' );
foreach my $cir_color (@colors_t) {
my $cir_color = [ 255, 0, 0, 255 ];
$surfs[0]->draw_circle( [ 100, 10 ], 20, $cir_color ); #no fill
@@ -199,6 +203,31 @@ SKIP:
pass 'draw_circle_filled works';
}
+ is( $surfs[0]->draw_trigon( [ [100, 10], [110, 10], [110, 20] ], [ 255, 0, 0, 255 ] ), $surfs[0], 'draw_trigon returns self' );
+ is( $surfs[0]->draw_trigon_filled( [ [100, 10], [110, 10], [110, 20] ], [ 255, 0, 0, 255 ] ), $surfs[0], 'draw_trigon_filled returns self' );
+ foreach my $color (@colors_t) {
+ my $color = [ 255, 0, 0, 255 ];
+ my $verts = [ [100, 10], [110, 10], [110, 20] ];
+ $surfs[0]->draw_trigon( $verts, $color ); #no fill
+ $surfs[0]->draw_trigon( $verts, $color, 1 );
+ $surfs[0]->draw_trigon_filled( $verts, $color ); #fill
+ isnt( $surfs[0]->[100][10], 0 );
+ pass 'draw_trigon works';
+ pass 'draw_trigon_filled works';
+ }
+
+ is( $surfs[0]->draw_polygon( [ [100, 10], [110, 10], [110, 20] ], [ 255, 0, 0, 255 ] ), $surfs[0], 'draw_polygon returns self' );
+ is( $surfs[0]->draw_polygon_filled( [ [100, 10], [110, 10], [110, 20] ], [ 255, 0, 0, 255 ] ), $surfs[0], 'draw_polygon_filled returns self' );
+ foreach my $color (@colors_t) {
+ my $color = [ 255, 0, 0, 255 ];
+ my $verts = [ [100, 10], [110, 10], [110, 20], [100, 20] ];
+ $surfs[0]->draw_polygon( $verts, $color ); #no fill
+ $surfs[0]->draw_polygon( $verts, $color, 1 );
+ $surfs[0]->draw_polygon_filled( $verts, $color ); #fill
+ isnt( $surfs[0]->[100][10], 0 );
+ pass 'draw_polygon works';
+ pass 'draw_polygon_filled works';
+ }
}
Please sign in to comment.
Something went wrong with that request. Please try again.