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
  38 # NB: there is no palette destructor because most of the time the
  39 # palette will be owned by a surface, so any palettes you create
  40 # with new, won't be destroyed until the program ends!
  41
  42 sub new {
  43         my $proto = shift;
  44         my $class = ref($proto) || $proto;
  45         my $image;
  46         my $self;
  47         if (@_) {
  48                 $image = shift;
  49                 $self = \$image->palette();
  50         } else {
  51                 $self = \SDL::NewPalette(256);
  52         }
  53         die SDL::GetError() unless $$self;
  54         bless $self, $class;
  55         return $self;
  56 }
  57
  58 sub size {
  59         my $self = shift;
  60         return SDL::PaletteNColors($$self);
  61 }
  62
  63 sub color {
  64         my $self = shift;
  65         my $index = shift;
  66         my ($r,$g,$b);
  67         if (@_) {
  68                 $r = shift; $g = shift; $b = shift;
  69                 return SDL::PaletteColors($$self,$index,$r,$g,$b);
  70         } else {
  71                 return SDL::PaletteColors($$self,$index);
  72         }
  73 }
  74
  75 sub red {
  76         my $self = shift;
  77         my $index = shift;
  78         my $c;
  79         if (@_) {
  80                 $c = shift;
  81                 return SDL::ColorR(
  82                         SDL::PaletteColors($$self,$index),$c);
  83         } else {
  84                 return SDL::ColorR(
  85                         SDL::PaletteColors($$self,$index));
  86         }
  87 }
  88
  89 sub green {
  90         my $self = shift;
  91         my $index = shift;
  92         my $c;
  93         if (@_) {
  94                 $c = shift;
  95                 return SDL::ColorG(
  96                         SDL::PaletteColors($$self,$index),$c);
  97         } else {
  98                 return SDL::ColorG(
  99                         SDL::PaletteColors($$self,$index));
 100         }
 101 }
 102
 103 sub blue {
 104         my $self = shift;
 105         my $index = shift;
 106         my $c;
 107         if (@_) {
 108                 $c = shift;
 109                 return SDL::ColorB(
 110                         SDL::PaletteColors($$self,$index),$c);
 111         } else {
 112                 return SDL::ColorB(
 113                         SDL::PaletteColors($$self,$index));
 114         }
 115 }
 116
 117 1;
 118
 119 __END__;
 120
 121 =pod
 122
 123 =head1 NAME
 124
 125 SDL::Palette - a perl extension
 126
 127 =head1 DESCRIPTION
 128
 129 L<SDL::Palette> provides an interface to the SDL_Palette structures,
 130 and can be used to set the color values of an existing palette's indexes.
 131
 132 =head1 METHODS
 133
 134 =head2 blue ( index, [value] )
 135
 136 Fetches and sets the blue component of the color at index.
 137
 138 =head2 green ( index, [value] )
 139
 140 Fetches and sets the green component of the color at index.
 141
 142 =head2 red ( index, [value] )
 143
 144 Fetches and sets the red component of the color at index.
 145
 146 =head2 color ( index, [ r, g, b ] )
 147
 148 Fetches and sets the RGB, returns an SDL_Color *.
 149
 150 =head2 size
 151
 152 Returns the size of the palette.
 153
 154 =head1 AUTHOR
 155
 156 David J. Goehrig
 157
 158 =head1 SEE ALSO
 159
 160 L<perl> L<SDL::Color> L<SDL::Surface>
 161
 162 =cut