Commit | Line | Data |
60891a9e |
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::Game::Palette; |
36 | use strict; |
37 | use warnings; |
38 | use Carp; |
39 | |
40 | # NB: there is no palette destructor because most of the time the |
41 | # palette will be owned by a surface, so any palettes you create |
42 | # with new, won't be destroyed until the program ends! |
43 | |
44 | sub new { |
45 | my $proto = shift; |
46 | my $class = ref($proto) || $proto; |
47 | my $image; |
48 | my $self; |
49 | if (@_) { |
50 | $image = shift; |
51 | $self = \$image->palette(); |
52 | } else { |
53 | $self = \SDL::NewPalette(256); |
54 | } |
55 | croak SDL::GetError() unless $$self; |
56 | bless $self, $class; |
57 | return $self; |
58 | } |
59 | |
60 | sub size { |
61 | my $self = shift; |
62 | return SDL::PaletteNColors($$self); |
63 | } |
64 | |
65 | sub color { |
66 | my $self = shift; |
67 | my $index = shift; |
68 | my ($r,$g,$b); |
69 | if (@_) { |
70 | $r = shift; $g = shift; $b = shift; |
71 | return SDL::PaletteColors($$self,$index,$r,$g,$b); |
72 | } else { |
73 | return SDL::PaletteColors($$self,$index); |
74 | } |
75 | } |
76 | |
77 | sub red { |
78 | my $self = shift; |
79 | my $index = shift; |
80 | my $c; |
81 | if (@_) { |
82 | $c = shift; |
83 | return SDL::ColorR( |
84 | SDL::PaletteColors($$self,$index),$c); |
85 | } else { |
86 | return SDL::ColorR( |
87 | SDL::PaletteColors($$self,$index)); |
88 | } |
89 | } |
90 | |
91 | sub green { |
92 | my $self = shift; |
93 | my $index = shift; |
94 | my $c; |
95 | if (@_) { |
96 | $c = shift; |
97 | return SDL::ColorG( |
98 | SDL::PaletteColors($$self,$index),$c); |
99 | } else { |
100 | return SDL::ColorG( |
101 | SDL::PaletteColors($$self,$index)); |
102 | } |
103 | } |
104 | |
105 | sub blue { |
106 | my $self = shift; |
107 | my $index = shift; |
108 | my $c; |
109 | if (@_) { |
110 | $c = shift; |
111 | return SDL::ColorB( |
112 | SDL::PaletteColors($$self,$index),$c); |
113 | } else { |
114 | return SDL::ColorB( |
115 | SDL::PaletteColors($$self,$index)); |
116 | } |
117 | } |
118 | |
119 | 1; |