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