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