From: Kartik Thakore Date: Sun, 2 Aug 2009 15:02:20 +0000 (-0400) Subject: Applied Tels patch for faster Color.pm X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=789195afac20de3071da25df167bbc2e910efd14;p=sdlgit%2FSDL_perl.git Applied Tels patch for faster Color.pm --- diff --git a/Build.PL b/Build.PL index 8d89fd9..019ea64 100644 --- 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 --- 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 - Patched Cygwin.pm - Fixed SDL::Rect documentation diff --git a/lib/SDL/Color.pm b/lib/SDL/Color.pm index 537bde7..33bc4e3 100644 --- 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 is a wrapper for display format independent color -representations, with the same interface as L. +representations. =head2 new ( -color => ) C with a C<-color> option will construct a new object referencing the passed SDL_Color*. +=head2 new ($r, $g, $b) + +C 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 with C<-r,-g,-b> options will construct both a SDL_Color @@ -113,6 +127,13 @@ C 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 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 takes a C 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 L +L and L. =cut diff --git a/src/SDL.xs b/src/SDL.xs index 56e793b..1ab9d49 100644 --- 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 --- 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)'); +