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