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