Commit | Line | Data |
7b6a53a1 |
1 | #!/usr/bin/env perl |
8fde61e3 |
2 | # |
7b6a53a1 |
3 | # Graphic.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::Tool::Graphic; |
32 | |
084b921f |
33 | use strict; |
34 | use warnings; |
35 | use Carp; |
8fde61e3 |
36 | use SDL; |
37 | use SDL::Config; |
38 | require SDL::Surface; |
39 | |
40 | sub new { |
41 | my $proto = shift; |
42 | my $class = ref($proto) || $proto; |
084b921f |
43 | my $self = {}; |
8fde61e3 |
44 | bless $self, $class; |
45 | $self; |
46 | } |
47 | |
48 | |
49 | sub DESTROY { |
50 | # nothing to do |
51 | } |
52 | |
53 | |
54 | sub zoom { |
55 | my ( $self, $surface, $zoomx, $zoomy, $smooth) = @_; |
084b921f |
56 | croak "SDL::Tool::Graphic::zoom requires an SDL::Surface\n" |
8fde61e3 |
57 | unless ( ref($surface) && $surface->isa('SDL::Surface')); |
58 | my $tmp = $$surface; |
59 | $$surface = SDL::GFXZoom($$surface, $zoomx, $zoomy, $smooth); |
60 | SDL::FreeSurface($tmp); |
61 | $surface; |
62 | } |
63 | |
64 | sub rotoZoom { |
65 | my ( $self, $surface, $angle, $zoom, $smooth) = @_; |
084b921f |
66 | croak "SDL::Tool::Graphic::rotoZoom requires an SDL::Surface\n" |
8fde61e3 |
67 | unless ( ref($surface) && $surface->isa('SDL::Surface')); |
68 | my $tmp = $$surface; |
69 | $$surface = SDL::GFXRotoZoom($$surface, $angle, $zoom, $smooth); |
70 | SDL::FreeSurface($tmp); |
71 | $surface; |
72 | } |
73 | |
74 | sub grayScale { |
75 | my ( $self, $surface ) = @_; |
084b921f |
76 | my $workingSurface; |
8fde61e3 |
77 | if($surface->isa('SDL::Surface')) { |
084b921f |
78 | $workingSurface = $$surface; |
8fde61e3 |
79 | } else { |
80 | $workingSurface = $surface; |
81 | } |
82 | my $color; |
83 | my $width = SDL::SurfaceW($workingSurface); |
84 | my $height = SDL::SurfaceH($workingSurface); |
85 | for(my $x = 0; $x < $width; $x++){ |
86 | for(my $y = 0; $y < $height; $y++){ |
87 | my $origValue = SDL::SurfacePixel($workingSurface, $x, $y); |
88 | my $newValue = int(0.3*SDL::ColorR($origValue) + 0.59 * SDL::ColorG($origValue) + 0.11*SDL::ColorB($origValue)); |
89 | SDL::SurfacePixel($workingSurface, $x, $y, SDL::NewColor($newValue, $newValue, $newValue)); |
90 | } |
91 | } |
92 | |
93 | if($surface->isa('SDL::Surface')) { |
94 | $surface = \$workingSurface; |
95 | } else { |
96 | $surface = $workingSurface; |
97 | } |
98 | } |
99 | |
100 | sub invertColor { |
101 | my ( $self, $surface ) = @_; |
084b921f |
102 | my $workingSurface; |
8fde61e3 |
103 | if($surface->isa('SDL::Surface')) { |
104 | $workingSurface = $$surface; |
105 | } else { |
106 | $workingSurface = $surface; |
107 | } |
108 | my $width = SDL::SurfaceW($workingSurface); |
109 | my $height = SDL::SurfaceH($workingSurface); |
110 | for(my $x = 0; $x < $width; $x++){ |
111 | for(my $y = 0; $y < $height; $y++){ |
112 | my $origValue = SDL::SurfacePixel($workingSurface, $x, $y); |
113 | my $newValue = int(0.3*SDL::ColorR($origValue) + 0.59 * SDL::ColorG($origValue) + 0.11*SDL::ColorB($origValue)); |
114 | SDL::SurfacePixel($workingSurface, $x, $y, SDL::NewColor(255-SDL::ColorR($origValue), 255 - SDL::ColorG($origValue), 255 - SDL::ColorB($origValue))); |
115 | } |
116 | } |
117 | |
118 | if($surface->isa('SDL::Surface')) { |
119 | $$surface = $workingSurface; |
120 | } else { |
121 | $surface = $workingSurface; |
122 | } |
123 | } |
124 | |
084b921f |
125 | croak "SDL::Tool::Graphic requires SDL_gfx support\n" |
8fde61e3 |
126 | unless SDL::Config->has('SDL_gfx'); |
127 | |
128 | |
129 | 1; |
130 | |
131 | __END__; |
132 | |
133 | =pod |
134 | |
135 | |
136 | |
137 | =head1 NAME |
138 | |
139 | SDL::Tool::Graphic |
140 | |
141 | =head1 DESCRIPTION |
142 | |
143 | L<SDL::Tool::Graphic> is a module for zooming and rotating L<SDL::Surface> objects. |
144 | |
145 | =head1 METHODS |
146 | |
147 | =head2 zoom ( surface, xzoom, yzoom, smooth ) |
148 | |
149 | C<SDL::Tool::Graphic::zoom> scales a L<SDL::Surface> along the two axis independently. |
150 | |
151 | =head2 rotoZoom ( surface, angle, zoom, smooth ) |
152 | |
153 | C<SDL::Tool::Graphic::rotoZoom> rotates and fixed axis zooms a L<SDL::Surface>. |
154 | |
155 | =head2 grayScale ( surface ) |
156 | |
157 | C<SDL::Tool::Graphic::grayScale> rotates and fixed axis zooms a L<SDL::Surface>. |
158 | |
159 | =head2 invertColor ( surface ) |
160 | |
161 | C<SDL::Tool::Graphic::invertColor> inverts the color of a <SDL::Surface>. |
162 | |
163 | |
164 | =head1 AUTHOR |
165 | |
166 | Russell E. Valentine |
167 | |
168 | =head1 SEE ALSO |
169 | |
170 | L<perl> L<SDL::Surface> |
171 | |
172 | =cut |