lib/SDL/Palette.pm

   1 #!/usr/bin/env perl
   2 #
   3 # Palette.pm
   4 #
   5 # Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
   6 #
   7 # ------------------------------------------------------------------------------
   8 #
   9 # This library is free software; you can redistribute it and/or
  10 # modify it under the terms of the GNU Lesser General Public
  11 # License as published by the Free Software Foundation; either
  12 # version 2.1 of the License, or (at your option) any later version.
  13 #
  14 # This library is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 # Lesser General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU Lesser General Public
  20 # License along with this library; if not, write to the Free Software
  21 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  22 #
  23 # ------------------------------------------------------------------------------
  24 #
  25 # Please feel free to send questions, suggestions or improvements to:
  26 #
  27 #       David J. Goehrig
  28 #       dgoehrig@cpan.org
  29 #
  30
  31 # NB: there is no palette destructor because most of the time the
  32 # palette will be owned by a surface, so any palettes you create
  33 # with new, won't be destroyed until the program ends!
  34
  35 package SDL::Palette;
  36 use strict;
  37 use warnings;
  38 use Carp;
  39
  40 # NB: there is no palette destructor because most of the time the
  41 # palette will be owned by a surface, so any palettes you create
  42 # with new, won't be destroyed until the program ends!
  43
  44 sub new {
  45         my $proto = shift;
  46         my $class = ref($proto) || $proto;
  47         my $image;
  48         my $self;
  49         if (@_) {
  50                 $image = shift;
  51                 $self = \$image->palette();
  52         } else {
  53                 $self = \SDL::NewPalette(256);
  54         }
  55         croak SDL::GetError() unless $$self;
  56         bless $self, $class;
  57         return $self;
  58 }
  59
  60 sub size {
  61         my $self = shift;
  62         return SDL::PaletteNColors($$self);
  63 }
  64
  65 sub color {
  66         my $self = shift;
  67         my $index = shift;
  68         my ($r,$g,$b);
  69         if (@_) {
  70                 $r = shift; $g = shift; $b = shift;
  71                 return SDL::PaletteColors($$self,$index,$r,$g,$b);
  72         } else {
  73                 return SDL::PaletteColors($$self,$index);
  74         }
  75 }
  76
  77 sub red {
  78         my $self = shift;
  79         my $index = shift;
  80         my $c;
  81         if (@_) {
  82                 $c = shift;
  83                 return SDL::ColorR(
  84                         SDL::PaletteColors($$self,$index),$c);
  85         } else {
  86                 return SDL::ColorR(
  87                         SDL::PaletteColors($$self,$index));
  88         }
  89 }
  90
  91 sub green {
  92         my $self = shift;
  93         my $index = shift;
  94         my $c;
  95         if (@_) {
  96                 $c = shift;
  97                 return SDL::ColorG(
  98                         SDL::PaletteColors($$self,$index),$c);
  99         } else {
 100                 return SDL::ColorG(
 101                         SDL::PaletteColors($$self,$index));
 102         }
 103 }
 104
 105 sub blue {
 106         my $self = shift;
 107         my $index = shift;
 108         my $c;
 109         if (@_) {
 110                 $c = shift;
 111                 return SDL::ColorB(
 112                         SDL::PaletteColors($$self,$index),$c);
 113         } else {
 114                 return SDL::ColorB(
 115                         SDL::PaletteColors($$self,$index));
 116         }
 117 }
 118
 119 1;
 120
 121 __END__;
 122
 123 =pod
 124
 125 =head1 NAME
 126
 127 SDL::Palette - a perl extension
 128
 129 =head1 DESCRIPTION
 130
 131 L<SDL::Palette> provides an interface to the SDL_Palette structures,
 132 and can be used to set the color values of an existing palette's indexes.
 133
 134 =head1 METHODS
 135
 136 =head2 blue ( index, [value] )
 137
 138 Fetches and sets the blue component of the color at index.
 139
 140 =head2 green ( index, [value] )
 141
 142 Fetches and sets the green component of the color at index.
 143
 144 =head2 red ( index, [value] )
 145
 146 Fetches and sets the red component of the color at index.
 147
 148 =head2 color ( index, [ r, g, b ] )
 149
 150 Fetches and sets the RGB, returns an SDL_Color *.
 151
 152 =head2 size
 153
 154 Returns the size of the palette.
 155
 156 =head1 AUTHOR
 157
 158 David J. Goehrig
 159
 160 =head1 SEE ALSO
 161
 162 L<perl> L<SDL::Color> L<SDL::Surface>
 163
 164 =cut