Commit | Line | Data |
8fde61e3 |
1 | # |
2 | # SDL::GraphicTool - zooming and rotating graphic tool |
3 | # |
4 | # Copyright (C) 2002 Russell E. Valentine |
5 | # Copyright (C) 2002 David J. Goehrig |
6 | |
7 | package SDL::Tool::Graphic; |
8 | |
9 | use SDL; |
10 | use SDL::Config; |
11 | require SDL::Surface; |
12 | |
13 | sub new { |
14 | my $proto = shift; |
15 | my $class = ref($proto) || $proto; |
16 | $self = {}; |
17 | bless $self, $class; |
18 | $self; |
19 | } |
20 | |
21 | |
22 | sub DESTROY { |
23 | # nothing to do |
24 | } |
25 | |
26 | |
27 | sub zoom { |
28 | my ( $self, $surface, $zoomx, $zoomy, $smooth) = @_; |
29 | die "SDL::Tool::Graphic::zoom requires an SDL::Surface\n" |
30 | unless ( ref($surface) && $surface->isa('SDL::Surface')); |
31 | my $tmp = $$surface; |
32 | $$surface = SDL::GFXZoom($$surface, $zoomx, $zoomy, $smooth); |
33 | SDL::FreeSurface($tmp); |
34 | $surface; |
35 | } |
36 | |
37 | sub rotoZoom { |
38 | my ( $self, $surface, $angle, $zoom, $smooth) = @_; |
39 | die "SDL::Tool::Graphic::rotoZoom requires an SDL::Surface\n" |
40 | unless ( ref($surface) && $surface->isa('SDL::Surface')); |
41 | my $tmp = $$surface; |
42 | $$surface = SDL::GFXRotoZoom($$surface, $angle, $zoom, $smooth); |
43 | SDL::FreeSurface($tmp); |
44 | $surface; |
45 | } |
46 | |
47 | sub grayScale { |
48 | my ( $self, $surface ) = @_; |
49 | if($surface->isa('SDL::Surface')) { |
50 | $workingSurface = $$surface; |
51 | } else { |
52 | $workingSurface = $surface; |
53 | } |
54 | my $color; |
55 | my $width = SDL::SurfaceW($workingSurface); |
56 | my $height = SDL::SurfaceH($workingSurface); |
57 | for(my $x = 0; $x < $width; $x++){ |
58 | for(my $y = 0; $y < $height; $y++){ |
59 | my $origValue = SDL::SurfacePixel($workingSurface, $x, $y); |
60 | my $newValue = int(0.3*SDL::ColorR($origValue) + 0.59 * SDL::ColorG($origValue) + 0.11*SDL::ColorB($origValue)); |
61 | SDL::SurfacePixel($workingSurface, $x, $y, SDL::NewColor($newValue, $newValue, $newValue)); |
62 | } |
63 | } |
64 | |
65 | if($surface->isa('SDL::Surface')) { |
66 | $surface = \$workingSurface; |
67 | } else { |
68 | $surface = $workingSurface; |
69 | } |
70 | } |
71 | |
72 | sub invertColor { |
73 | my ( $self, $surface ) = @_; |
74 | if($surface->isa('SDL::Surface')) { |
75 | $workingSurface = $$surface; |
76 | } else { |
77 | $workingSurface = $surface; |
78 | } |
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(255-SDL::ColorR($origValue), 255 - SDL::ColorG($origValue), 255 - SDL::ColorB($origValue))); |
86 | } |
87 | } |
88 | |
89 | if($surface->isa('SDL::Surface')) { |
90 | $$surface = $workingSurface; |
91 | } else { |
92 | $surface = $workingSurface; |
93 | } |
94 | } |
95 | |
96 | die "SDL::Tool::Graphic requires SDL_gfx support\n" |
97 | unless SDL::Config->has('SDL_gfx'); |
98 | |
99 | |
100 | 1; |
101 | |
102 | __END__; |
103 | |
104 | =pod |
105 | |
106 | |
107 | |
108 | =head1 NAME |
109 | |
110 | SDL::Tool::Graphic |
111 | |
112 | =head1 DESCRIPTION |
113 | |
114 | L<SDL::Tool::Graphic> is a module for zooming and rotating L<SDL::Surface> objects. |
115 | |
116 | =head1 METHODS |
117 | |
118 | =head2 zoom ( surface, xzoom, yzoom, smooth ) |
119 | |
120 | C<SDL::Tool::Graphic::zoom> scales a L<SDL::Surface> along the two axis independently. |
121 | |
122 | =head2 rotoZoom ( surface, angle, zoom, smooth ) |
123 | |
124 | C<SDL::Tool::Graphic::rotoZoom> rotates and fixed axis zooms a L<SDL::Surface>. |
125 | |
126 | =head2 grayScale ( surface ) |
127 | |
128 | C<SDL::Tool::Graphic::grayScale> rotates and fixed axis zooms a L<SDL::Surface>. |
129 | |
130 | =head2 invertColor ( surface ) |
131 | |
132 | C<SDL::Tool::Graphic::invertColor> inverts the color of a <SDL::Surface>. |
133 | |
134 | |
135 | =head1 AUTHOR |
136 | |
137 | Russell E. Valentine |
138 | |
139 | =head1 SEE ALSO |
140 | |
141 | L<perl> L<SDL::Surface> |
142 | |
143 | =cut |