Applied Tels patch for faster Color.pm

diff --git a/Build.PL b/Build.PL
index 8d89fd9..019ea64 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -10,6 +10,7 @@ use lib  'make/lib';
 
 use SDL::Build;
 use YAML;
+use YAML::Node;
 
 my $sdl_compile_flags = `sdl-config --cflags`;
 my $sdl_link_flags    = `sdl-config --libs`;

diff --git a/CHANGELOG b/CHANGELOG
index dde3493..4878558 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,6 +1,10 @@
 Revision history for Perl extension SDL_perl.
 
 
+* Mar 3 2006   Tels 77 Tests
+       - Color.pm: add rgb(), and make new($r,$g,$b) work for speed
+       - add ColorRGB() to src/SDL.xs
+
 * Oct 4 2004   David J. Goehrig <dgoehrig@cpan.org>
        - Patched Cygwin.pm
        - Fixed SDL::Rect documentation

diff --git a/lib/SDL/Color.pm b/lib/SDL/Color.pm
index 537bde7..33bc4e3 100644 (file)
--- a/lib/SDL/Color.pm
+++ b/lib/SDL/Color.pm
@@ -12,8 +12,11 @@ use SDL;
 sub new {
        my $proto = shift;
        my $class = ref($proto) || $proto;
-       my $self;
 
+       # called like SDL::Color->new($red,$green,$blue);
+       return bless \SDL::NewColor(@_), $class if (@_ == 3);
+
+       my $self;
        my (%options) = @_;
 
        verify (%options, qw/ -color -surface -pixel -r -g -b /) if $SDL::DEBUG;
@@ -33,8 +36,7 @@ sub new {
        } 
        die "Could not create color, ", SDL::GetError(), "\n"
                unless ($$self);
-       bless $self,$class;
-       return $self;
+       bless $self, $class;
 }
 
 sub DESTROY {
@@ -56,19 +58,24 @@ sub b {
        SDL::ColorB($$self,@_);
 }
 
+sub rgb {
+       my $self = shift;
+       SDL::ColorRGB($$self,@_);
+}
+
 sub pixel {
        die "SDL::Color::pixel requires an SDL::Surface"
                unless !$SDL::DEBUG || $_[1]->isa("SDL::Surface");
        SDL::MapRGB(${$_[1]},$_[0]->r(),$_[0]->g(),$_[0]->b());
 }
 
-$SDL::Color::black = new SDL::Color -r => 0, -g => 0, -b => 0;
-$SDL::Color::white = new SDL::Color -r => 255, -g => 255, -b => 255;
-$SDL::Color::red = new SDL::Color -r => 255, -g => 0, -b => 0;
-$SDL::Color::blue = new SDL::Color -r => 0, -g => 0, -b => 255;
-$SDL::Color::green = new SDL::Color -r => 0, -g => 255, -b => 0;
-$SDL::Color::purple = new SDL::Color -r => 255, -g => 0, -b => 255;
-$SDL::Color::yellow = new SDL::Color -r => 255, -g => 255, -b => 0;
+$SDL::Color::black = SDL::Color->new(0,0,0);
+$SDL::Color::white = SDL::Color->new(255,255,255);
+$SDL::Color::red = SDL::Color->new(255,0,0);
+$SDL::Color::blue = SDL::Color->new(0,0,255);
+$SDL::Color::green = SDL::Color->new(0,255,0);
+$SDL::Color::purple = SDL::Color->new(255,0,255);
+$SDL::Color::yellow = SDL::Color->new(255,255,0);
 
 1;
 
@@ -82,6 +89,8 @@ SDL::Color - a SDL perl extension
 
 =head1 SYNOPSIS
 
+  $color = SDL::Color->new($red,$green,$blue);         # fastest
+
   $color = new SDL::Color ( -r => 0xde, -g => 0xad, -b =>c0 );
   $color = new SDL::Color -surface => $app, -pixel => $app->pixel($x,$y);
   $color = new SDL::Color -color => SDL::NewColor(0xff,0xaa,0xdd);
@@ -89,13 +98,18 @@ SDL::Color - a SDL perl extension
 =head1 DESCRIPTION
 
 C<SDL::Color> is a wrapper for display format independent color
-representations, with the same interface as L<SDL::Color>.  
+representations.
 
 =head2 new ( -color => )
 
 C<SDL::Color::new> with a C<-color> option will construct a new object
 referencing the passed SDL_Color*.
 
+=head2 new ($r, $g, $b)
+
+C<SDL::Color::new> with three color values will construct both a SDL_Color
+structure, and the associated object with the specified values.
+
 =head2 new (-r => , -g => , -b => )
 
 C<SDL::Color::new> with C<-r,-g,-b> options will construct both a SDL_Color
@@ -113,6 +127,13 @@ C<SDL::Color::r, SDL::Color::g, SDL::Color::b> are accessor methods for
 the red, green, and blue components respectively.  The color value can be set
 by passing a byte value (0-255) to each function.
 
+=head2 rgb ( $red, $green, $blue )
+
+C<SDL::Color::rgb> is an accessor method for the red, green, and blue components
+in one go. It will return a list of three values.
+
+The color value can be set by passing a byte value (0-255) for each color component.
+
 =head2 pixel ( surface )
 
 C<SDL::Color::pixel> takes a C<SDL::Surface> object and r,g,b values, and
@@ -122,8 +143,10 @@ returns the integer representation of the closest color for the given surface.
 
 David J. Goehrig
 
+Additions by Tels 2006.
+
 =head1 SEE ALSO
 
-L<perl> L<SDL::Surface> 
+L<perl> and L<SDL::Surface>.
 
 =cut

diff --git a/src/SDL.xs b/src/SDL.xs
index 56e793b..1ab9d49 100644 (file)
--- a/src/SDL.xs
+++ b/src/SDL.xs
@@ -1208,6 +1208,20 @@ ColorB ( color, ... )
                RETVAL
 
 void
+ColorRGB ( color, ... )
+       SDL_Color *color
+       PPCODE:
+               if (items > 1 ) {
+                       color->r = SvIV(ST(1)); 
+                       color->g = SvIV(ST(2)); 
+                       color->b = SvIV(ST(3)); 
+               }
+               mXPUSHi( color->r );
+               mXPUSHi( color->g );
+               mXPUSHi( color->b );
+               XSRETURN(3);
+
+void
 FreeColor ( color )
        SDL_Color *color
        CODE:

diff --git a/t/colorpm.t b/t/colorpm.t
index 3e40297..4714d65 100644 (file)
--- a/t/colorpm.t
+++ b/t/colorpm.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# Copyright (C) 2003 Tels
+# Copyright (C) 2003,2006 Tels
 # Copyright (C) 2004 David J. Goehrig
 #
 # basic testing of SDL::Color
@@ -13,7 +13,7 @@ use strict;
 
 use Test::More;
 
-plan ( tests => 10 );
+plan ( tests => 15 );
 
 use_ok( 'SDL::Color' ); 
   
@@ -22,6 +22,7 @@ can_ok ('SDL::Color', qw/
        r 
        g 
        b 
+       rgb 
        pixel /);
 
 # some basic tests:
@@ -32,9 +33,19 @@ is ($color->r(),0, 'r is 0');
 is ($color->g(),0, 'g is 0');
 is ($color->b(),0, 'b is 0');
 
+is (join(":", $color->rgb()), '0:0:0', 'r, g and b are 0');
+
 $color = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff);
 is (ref($color), 'SDL::Color', 'new was ok');
 is ($color->r(),255, 'r is 255');
 is ($color->g(),255, 'g is 255');
 is ($color->b(),255, 'b is 255');
 
+is (join(":", $color->rgb()), '255:255:255', 'r, g and b are 255');
+is (join(":", $color->rgb(128,0,80)), '128:0:80', 'r, g and b are set');
+is (join(":", $color->rgb()), '128:0:80', 'r, g and b still set');
+
+# test the new new($r,$g,$b) calling style
+$color = SDL::Color->new( 255,70,128);
+is (join(":", $color->rgb()), '255:70:128', 'r, g and b are set via new($r,$g,$b)');
+