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         #Added because of strict if we needed global
 103     #do $workingSurface init outside subs.
 104         my $workingSurface;
 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
 127 croak "SDL::Tool::Graphic requires SDL_gfx support\n"
 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