lib/SDL/Color.pm

   1 #       Color.pm
   2 #
   3 #       A package for manipulating SDL_Color *
   4 #
   5 #       Copyright (C) 2002,2003,2004 David J. Goehrig
   6
   7 package SDL::Color;
   8
   9 use strict;
  10 use warnings;
  11 use Carp;
  12 use SDL;
  13
  14 sub new {
  15         my $proto = shift;
  16         my $class = ref($proto) || $proto;
  17
  18         # called like SDL::Color->new($red,$green,$blue);
  19         return bless \SDL::NewColor(@_), $class if (@_ == 3);
  20
  21         my $self;
  22         my (%options) = @_;
  23
  24         verify (%options, qw/ -color -surface -pixel -r -g -b /) if $SDL::DEBUG;
  25
  26         if ($options{-color}) {
  27                 $self = \$options{-color};
  28         } elsif ($options{-pixel} && $options{-surface}) {
  29                 croak "SDL::Color::new requires an SDL::Surface"
  30                         unless !$SDL::DEBUG || $options{-surface}->isa("SDL::Surface");
  31                 $self = \SDL::NewColor(SDL::GetRGB(${$options{-surface}}, $options{-pixel}));
  32         } else {
  33                 my @color;
  34                 push @color, $options{-red}     || $options{-r} || 0;
  35                 push @color, $options{-green}   || $options{-g} || 0;
  36                 push @color, $options{-blue}    || $options{-b} || 0;
  37                 $self = \SDL::NewColor(@color);
  38         }
  39         croak "Could not create color, ", SDL::GetError(), "\n"
  40                 unless ($$self);
  41         bless $self, $class;
  42 }
  43
  44 sub DESTROY {
  45         SDL::FreeColor(${$_[0]});
  46 }
  47
  48 sub r {
  49         my $self = shift;
  50         SDL::ColorR($$self,@_);
  51 }
  52
  53 sub g {
  54         my $self = shift;
  55         SDL::ColorG($$self,@_);
  56 }
  57
  58 sub b {
  59         my $self = shift;
  60         SDL::ColorB($$self,@_);
  61 }
  62
  63 sub rgb {
  64         my $self = shift;
  65         SDL::ColorRGB($$self,@_);
  66 }
  67
  68 sub pixel {
  69         croak "SDL::Color::pixel requires an SDL::Surface"
  70                 unless !$SDL::DEBUG || $_[1]->isa("SDL::Surface");
  71         SDL::MapRGB(${$_[1]},$_[0]->r(),$_[0]->g(),$_[0]->b());
  72 }
  73
  74 $SDL::Color::black = SDL::Color->new(0,0,0);
  75 $SDL::Color::white = SDL::Color->new(255,255,255);
  76 $SDL::Color::red = SDL::Color->new(255,0,0);
  77 $SDL::Color::blue = SDL::Color->new(0,0,255);
  78 $SDL::Color::green = SDL::Color->new(0,255,0);
  79 $SDL::Color::purple = SDL::Color->new(255,0,255);
  80 $SDL::Color::yellow = SDL::Color->new(255,255,0);
  81
  82 1;
  83
  84 __END__;
  85
  86 =pod
  87
  88 =head1 NAME
  89
  90 SDL::Color - a SDL perl extension
  91
  92 =head1 SYNOPSIS
  93
  94   $color = SDL::Color->new($red,$green,$blue);          # fastest
  95
  96   $color = new SDL::Color ( -r => 0xde, -g => 0xad, -b =>c0 );
  97   $color = new SDL::Color -surface => $app, -pixel => $app->pixel($x,$y);
  98   $color = new SDL::Color -color => SDL::NewColor(0xff,0xaa,0xdd);
  99
 100 =head1 DESCRIPTION
 101
 102 C<SDL::Color> is a wrapper for display format independent color
 103 representations.
 104
 105 =head2 new ( -color => )
 106
 107 C<SDL::Color::new> with a C<-color> option will construct a new object
 108 referencing the passed SDL_Color*.
 109
 110 =head2 new ($r, $g, $b)
 111
 112 C<SDL::Color::new> with three color values will construct both a SDL_Color
 113 structure, and the associated object with the specified values.
 114
 115 =head2 new (-r => , -g => , -b => )
 116
 117 C<SDL::Color::new> with C<-r,-g,-b> options will construct both a SDL_Color
 118 structure, and the associated object with the specified vales.
 119
 120 =head2 new (-pixel =>, -surface =>)
 121
 122 C<SDL::Color::new> with C<-pixel,-surface> options will generate a SDL_Color*
 123 with the r,g,b values associated with the integer value passed by C<-pixel>
 124 for the given C<-surface>'s format.
 125
 126 =head2 r ( [ red ] ), g( [ green ] ), b( [ blue ] )
 127
 128 C<SDL::Color::r, SDL::Color::g, SDL::Color::b> are accessor methods for
 129 the red, green, and blue components respectively.  The color value can be set
 130 by passing a byte value (0-255) to each function.
 131
 132 =head2 rgb ( $red, $green, $blue )
 133
 134 C<SDL::Color::rgb> is an accessor method for the red, green, and blue components
 135 in one go. It will return a list of three values.
 136
 137 The color value can be set by passing a byte value (0-255) for each color component.
 138
 139 =head2 pixel ( surface )
 140
 141 C<SDL::Color::pixel> takes a C<SDL::Surface> object and r,g,b values, and
 142 returns the integer representation of the closest color for the given surface.
 143
 144 =head1 AUTHOR
 145
 146 David J. Goehrig
 147
 148 Additions by Tels 2006.
 149
 150 =head1 SEE ALSO
 151
 152 L<perl> and L<SDL::Surface>.
 153
 154 =cut