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 strict;
  34 use warnings;
  35 use Carp;
  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;
  43         my $self = {};
  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) = @_;
  56         croak "SDL::Tool::Graphic::zoom requires an SDL::Surface\n"
  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) = @_;
  66         croak "SDL::Tool::Graphic::rotoZoom requires an SDL::Surface\n"
  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 ) = @_;
  76         my $workingSurface;
  77         if($surface->isa('SDL::Surface')) {
  78                  $workingSurface = $$surface;
  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 ) = @_;
 102         my $workingSurface;
 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
 125 croak "SDL::Tool::Graphic requires SDL_gfx support\n"
 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