lib/SDL/Tool/Graphic.pm

   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