Commit | Line | Data |
bfd90409 |
1 | #!/usr/bin/env perl |
2 | # |
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 |
29 | # |
30 | |
31 | package SDL::Tool::Graphic; |
32 | |
084b921f |
33 | use strict; |
34 | use warnings; |
35 | use Carp; |
bfd90409 |
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 = {}; |
bfd90409 |
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" |
bfd90409 |
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" |
bfd90409 |
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; |
bfd90409 |
77 | if($surface->isa('SDL::Surface')) { |
084b921f |
78 | $workingSurface = $$surface; |
bfd90409 |
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 ) = @_; |
cc6d0c7c |
102 | #Added because of strict if we needed global |
103 | #do $workingSurface init outside subs. |
084b921f |
104 | my $workingSurface; |
bfd90409 |
105 | if($surface->isa('SDL::Surface')) { |
106 | $workingSurface = $$surface; |
107 | } else { |
108 | $workingSurface = $surface; |
109 | } |
110 | my $width = SDL::SurfaceW($workingSurface); |
111 | my $height = SDL::SurfaceH($workingSurface); |
112 | for(my $x = 0; $x < $width; $x++){ |
113 | for(my $y = 0; $y < $height; $y++){ |
114 | my $origValue = SDL::SurfacePixel($workingSurface, $x, $y); |
115 | my $newValue = int(0.3*SDL::ColorR($origValue) + 0.59 * SDL::ColorG($origValue) + 0.11*SDL::ColorB($origValue)); |
116 | SDL::SurfacePixel($workingSurface, $x, $y, SDL::NewColor(255-SDL::ColorR($origValue), 255 - SDL::ColorG($origValue), 255 - SDL::ColorB($origValue))); |
117 | } |
118 | } |
119 | |
120 | if($surface->isa('SDL::Surface')) { |
121 | $$surface = $workingSurface; |
122 | } else { |
123 | $surface = $workingSurface; |
124 | } |
125 | } |
126 | |
084b921f |
127 | croak "SDL::Tool::Graphic requires SDL_gfx support\n" |
bfd90409 |
128 | unless SDL::Config->has('SDL_gfx'); |
129 | |
130 | |
131 | 1; |
132 | |
133 | __END__; |
134 | |
135 | =pod |
136 | |
137 | |
138 | |
139 | =head1 NAME |
140 | |
141 | SDL::Tool::Graphic |
142 | |
143 | =head1 DESCRIPTION |
144 | |
145 | L<SDL::Tool::Graphic> is a module for zooming and rotating L<SDL::Surface> objects. |
146 | |
147 | =head1 METHODS |
148 | |
149 | =head2 zoom ( surface, xzoom, yzoom, smooth ) |
150 | |
151 | C<SDL::Tool::Graphic::zoom> scales a L<SDL::Surface> along the two axis independently. |
152 | |
153 | =head2 rotoZoom ( surface, angle, zoom, smooth ) |
154 | |
155 | C<SDL::Tool::Graphic::rotoZoom> rotates and fixed axis zooms a L<SDL::Surface>. |
156 | |
157 | =head2 grayScale ( surface ) |
158 | |
159 | C<SDL::Tool::Graphic::grayScale> rotates and fixed axis zooms a L<SDL::Surface>. |
160 | |
161 | =head2 invertColor ( surface ) |
162 | |
163 | C<SDL::Tool::Graphic::invertColor> inverts the color of a <SDL::Surface>. |
164 | |
165 | |
166 | =head1 AUTHOR |
167 | |
168 | Russell E. Valentine |
169 | |
170 | =head1 SEE ALSO |
171 | |
172 | L<perl> L<SDL::Surface> |
173 | |
174 | =cut |