Made palette() a method of SDL::PixelFormat.
Added tests for SDL::Palette.
--- /dev/null
+#!/usr/bin/env perl
+#
+# Palette.pm
+#
+# Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
+#
+# ------------------------------------------------------------------------------
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Lesser General Public
+# License as published by the Free Software Foundation; either
+# version 2.1 of the License, or (at your option) any later version.
+#
+# This library is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public
+# License along with this library; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+#
+# ------------------------------------------------------------------------------
+#
+# Please feel free to send questions, suggestions or improvements to:
+#
+# David J. Goehrig
+# dgoehrig@cpan.org
+#
+
+# NB: there is no palette destructor because most of the time the
+# palette will be owned by a surface, so any palettes you create
+# with new, won't be destroyed until the program ends!
+
+package SDL::Game::Palette;
+use strict;
+use warnings;
+use Carp;
+
+# NB: there is no palette destructor because most of the time the
+# palette will be owned by a surface, so any palettes you create
+# with new, won't be destroyed until the program ends!
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $image;
+ my $self;
+ if (@_) {
+ $image = shift;
+ $self = \$image->palette();
+ } else {
+ $self = \SDL::NewPalette(256);
+ }
+ croak SDL::GetError() unless $$self;
+ bless $self, $class;
+ return $self;
+}
+
+sub size {
+ my $self = shift;
+ return SDL::PaletteNColors($$self);
+}
+
+sub color {
+ my $self = shift;
+ my $index = shift;
+ my ($r,$g,$b);
+ if (@_) {
+ $r = shift; $g = shift; $b = shift;
+ return SDL::PaletteColors($$self,$index,$r,$g,$b);
+ } else {
+ return SDL::PaletteColors($$self,$index);
+ }
+}
+
+sub red {
+ my $self = shift;
+ my $index = shift;
+ my $c;
+ if (@_) {
+ $c = shift;
+ return SDL::ColorR(
+ SDL::PaletteColors($$self,$index),$c);
+ } else {
+ return SDL::ColorR(
+ SDL::PaletteColors($$self,$index));
+ }
+}
+
+sub green {
+ my $self = shift;
+ my $index = shift;
+ my $c;
+ if (@_) {
+ $c = shift;
+ return SDL::ColorG(
+ SDL::PaletteColors($$self,$index),$c);
+ } else {
+ return SDL::ColorG(
+ SDL::PaletteColors($$self,$index));
+ }
+}
+
+sub blue {
+ my $self = shift;
+ my $index = shift;
+ my $c;
+ if (@_) {
+ $c = shift;
+ return SDL::ColorB(
+ SDL::PaletteColors($$self,$index),$c);
+ } else {
+ return SDL::ColorB(
+ SDL::PaletteColors($$self,$index));
+ }
+}
+
+1;
+
+__END__;
+
+=pod
+
+=head1 NAME
+
+SDL::Palette - a perl extension
+
+=head1 DESCRIPTION
+
+L<SDL::Palette> provides an interface to the SDL_Palette structures,
+and can be used to set the color values of an existing palette's indexes.
+
+=head1 METHODS
+
+=head2 blue ( index, [value] )
+
+Fetches and sets the blue component of the color at index.
+
+=head2 green ( index, [value] )
+
+Fetches and sets the green component of the color at index.
+
+=head2 red ( index, [value] )
+
+Fetches and sets the red component of the color at index.
+
+=head2 color ( index, [ r, g, b ] )
+
+Fetches and sets the RGB, returns an SDL_Color *.
+
+=head2 size
+
+Returns the size of the palette.
+
+=head1 AUTHOR
+
+David J. Goehrig
+
+=head1 SEE ALSO
+
+L<perl> L<SDL::Color> L<SDL::Surface>
+
+=cut
-#!/usr/bin/env perl
-#
-# Palette.pm
-#
-# Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
-#
-# ------------------------------------------------------------------------------
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Lesser General Public
-# License as published by the Free Software Foundation; either
-# version 2.1 of the License, or (at your option) any later version.
-#
-# This library is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Lesser General Public License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public
-# License along with this library; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-#
-# ------------------------------------------------------------------------------
-#
-# Please feel free to send questions, suggestions or improvements to:
-#
-# David J. Goehrig
-# dgoehrig@cpan.org
-#
-
-# NB: there is no palette destructor because most of the time the
-# palette will be owned by a surface, so any palettes you create
-# with new, won't be destroyed until the program ends!
-
+#!perl
package SDL::Palette;
use strict;
use warnings;
-use Carp;
-
-# NB: there is no palette destructor because most of the time the
-# palette will be owned by a surface, so any palettes you create
-# with new, won't be destroyed until the program ends!
-
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $image;
- my $self;
- if (@_) {
- $image = shift;
- $self = \$image->palette();
- } else {
- $self = \SDL::NewPalette(256);
- }
- croak SDL::GetError() unless $$self;
- bless $self, $class;
- return $self;
-}
-
-sub size {
- my $self = shift;
- return SDL::PaletteNColors($$self);
-}
-
-sub color {
- my $self = shift;
- my $index = shift;
- my ($r,$g,$b);
- if (@_) {
- $r = shift; $g = shift; $b = shift;
- return SDL::PaletteColors($$self,$index,$r,$g,$b);
- } else {
- return SDL::PaletteColors($$self,$index);
- }
-}
-
-sub red {
- my $self = shift;
- my $index = shift;
- my $c;
- if (@_) {
- $c = shift;
- return SDL::ColorR(
- SDL::PaletteColors($$self,$index),$c);
- } else {
- return SDL::ColorR(
- SDL::PaletteColors($$self,$index));
- }
-}
-
-sub green {
- my $self = shift;
- my $index = shift;
- my $c;
- if (@_) {
- $c = shift;
- return SDL::ColorG(
- SDL::PaletteColors($$self,$index),$c);
- } else {
- return SDL::ColorG(
- SDL::PaletteColors($$self,$index));
- }
-}
-
-sub blue {
- my $self = shift;
- my $index = shift;
- my $c;
- if (@_) {
- $c = shift;
- return SDL::ColorB(
- SDL::PaletteColors($$self,$index),$c);
- } else {
- return SDL::ColorB(
- SDL::PaletteColors($$self,$index));
- }
-}
+require Exporter;
+require DynaLoader;
+our @ISA = qw(Exporter DynaLoader);
+bootstrap SDL::Palette;
1;
-__END__;
+__END__
=pod
=head1 DESCRIPTION
-L<SDL::Palette> provides an interface to the SDL_Palette structures,
+L<SDL::Palette> provides an interface to the C<SDL_Palette> structures,
and can be used to set the color values of an existing palette's indexes.
=head1 METHODS
-=head2 blue ( index, [value] )
-
-Fetches and sets the blue component of the color at index.
+=head2 ncolors ( )
-=head2 green ( index, [value] )
+Fetches the number of colors in palette
-Fetches and sets the green component of the color at index.
+=head2 colors ( index )
-=head2 red ( index, [value] )
+Fetches an array of colors in palette
-Fetches and sets the red component of the color at index.
+=head2 color_index ( index )
-=head2 color ( index, [ r, g, b ] )
-
-Fetches and sets the RGB, returns an SDL_Color *.
+Fetches the SDL_Color at the provide index in palette
=head2 size
Returns the size of the palette.
-=head1 AUTHOR
-
-David J. Goehrig
=head1 SEE ALSO
-L<perl> L<SDL::Color> L<SDL::Surface>
+L<SDL::Color> L<SDL::Surface>
=cut
=head1 METHODS
+=head2 palette
+
+ $surface->format->palette;
+
+Returns the C<SDL_Palette> and L<SDL::Palette> of the format of the surface.
=head2 BitsPerPixel
SDL_Color *
-palette_colors_index ( palette, index )
+palette_color_index ( palette, index )
SDL_Palette *palette
int index
PREINIT:
=cut
+SDL_Palette*
+pixelformat_palette( pixelformat )
+ SDL_PixelFormat *pixelformat
+ PREINIT:
+ char* CLASS = "SDL::Palette";
+ CODE:
+ RETVAL = pixelformat->palette;
+ OUTPUT:
+ RETVAL
+
+
Uint8
pixelformat_BitsPerPixel( pixelformat )
SDL_PixelFormat *pixelformat
--- /dev/null
+#!perl
+use strict;
+use warnings;
+use Test::More tests => 999999999;
+use_ok('SDL::Palette');
+
+can_ok('SDL::Palette', qw/ ncolors colors color_index /);
+
+use SDL;
+use SDL::Surface;
+use SDL::PixelFormat;
+
+SDL::Init(SDL_INIT_VIDEO);
+
+my $display = SDL::SetVideoMode(640,480,32, SDL_SWSURFACE );
+
+isa_ok($display->format, 'SDL::PixelFormat', 'Are we a SDL::PixelFormat?');
+
+is( !defined $display->format->palette , 1, 'Palette is not defined as BitPerPixels is greater then 8');
+
+$display = SDL::SetVideoMode(640,480,8, SDL_SWSURFACE );
+isa_ok($display->format, 'SDL::PixelFormat', 'Are we a SDL::PixelFormat?');
+
+isa_ok( $display->format->palette , 'SDL::Palette', 'Palette is SDL::Palette when BitPerPixels is 8 ');
+
+is( $display->format->palette->ncolors, 256, '256 colors in palette');
+
+isa_ok( $display->format->palette->colors(), 'ARRAY', 'Palette->colors[x] is a color');
+
+isa_ok( $display->format->palette->color_index(23), 'SDL::Color', 'Palette->color_index() is a SDL::Color');
+
plan ( tests => 2 );
-use_ok( 'SDL::Palette' );
+use_ok( 'SDL::Game::Palette' );
-can_ok ('SDL::Palette', qw/
+can_ok ('SDL::Game::Palette', qw/
new
size
red
projects / sdlgit/SDL_perl.git / commitdiff