File Coverage

blib/lib/GD/Window.pm

Criterion	Covered	Total	%
statement	15	88	17.0
branch	0	46	0.0
condition	0	9	0.0
subroutine	5	17	29.4
pod	2	10	20.0
total	22	170	12.9

package GD::Window;

use 5.008006;
use strict;
use warnings;
use Carp qw( croak );
use vars qw/$VERSION $AUTOLOAD/;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.02';


my %imWindowedFuncs = (
  setPixel            => {x => [0],       'y' => [1]},
  line                => {x => [0,2],     'y' => [1,3]},
  dashedLine          => {x => [0,2],     'y' => [1,3]},
  rectangle           => {x => [0,2],     'y' => [1,3]},
  filledRectangle     => {x => [0,2],     'y' => [1,3]},
  ellipse             => {x => [0],       'y' => [1],         w => [2],          h => [3]},
  filledEllipse       => {x => [0],       'y' => [1],         w => [2],          h => [3]},
  arc                 => {x => [0],       'y' => [1],         w => [2],          h => [3]},
  filledArc           => {x => [0],       'y' => [1],         w => [2],          h => [3]},
  fill                => {x => [0],       'y' => [1]},
  fillToBorder        => {x => [0],       'y' => [1]},
  copy                => {x => [1],       'y' => [2]},
  copyMerge           => {x => [1],       'y' => [2]},
  copyMergeGray       => {x => [1],       'y' => [2]},
  copyResized         => {x => [1],       'y' => [2],         w => [5],          h => [6]},
  copyResampled       => {x => [1],       'y' => [2],         w => [5],          h => [6]},
  copyRotated         => {x => [1],       'y' => [2]},
  string              => {x => [1],       'y' => [2]},
  stringUp            => {x => [1],       'y' => [2]},
  char                => {x => [1],       'y' => [2]},
  charUp              => {x => [1],       'y' => [2]},
  stringFT            => {x => [4],       'y' => [5]},
  stringFTCircle      => {x => [0],       'y' => [1]},
  clip                => {x => [0,2],     'y' => [1,3]},
);

my %imWindowedPolyFuncs = (openPolygon => 1,
                           unclosedPolygon => 1,
                           filledPolygon => 1);


my $invertY_g = 0;


sub new {
    my $that = shift;
    my $class = ref($that) || $that;
    my ($im, $imX1, $imY1, $imX2, $imY2,
        $winX1, $winY1, $winX2, $winY2,
        %args) = @_;

    if (scalar(@_) < 9) {
      croak "Missing some arguments for new GD::Window";
    }

    # Fill in the window's boundary
    my $self = { im => $im,
                 minX => $winX1 > $winX2 ? $winX2 : $winX1,
                 minY => $winY1 > $winY2 ? $winY2 : $winY1,
                 maxX => $winX1 > $winX2 ? $winX1 : $winX2,
                 maxY => $winY1 > $winY2 ? $winY1 : $winY2,
                 imMinX => $imX1 > $imX2 ? $imX2 : $imX1,
                 imMinY => $imY1 > $imY2 ? $imY2 : $imY1,
                 imMaxX => $imX1 > $imX2 ? $imX1 : $imX2,
                 imMaxY => $imY1 > $imY2 ? $imY1 : $imY2,
                 passThroughIfUnsupported => $args{passThrough},
                 useImage => $args{useImage},
                 invertY => defined $args{invertY} ? $args{invertY} : $invertY_g,
    };

    if ($self->{useImage}) {
      # Need to make our own internal image
      $self->{parentIm} = $im;
      $self->{im} = GD::Image->new(($self->{maxX} - $self->{minX}), ($self->{maxY} - $self->{minY}), 1);
      $self->{scaleX} = 1;
      $self->{scaleY} = 1;
      $self->{srcImMinX} = $self->{imMinX};
      $self->{srcImMinY} = $self->{imMinY};
      $self->{imMinX} = 0;
      $self->{imMinY} = 0;
    }
    else {
      $self->{scaleX} = ($self->{imMaxX} - $self->{imMinX})/($self->{maxX} - $self->{minX});
      $self->{scaleY} = ($self->{imMaxY} - $self->{imMinY})/($self->{maxY} - $self->{minY});
    }

    # print "PostSub: $postSub\n";
    if ($@) {
      die "Failed eval of autoloaded sub: $@";
    }

    bless ($self, $class);
    return $self;
}


##
# The autoload function catches all the supported image functions and
# creates the appropriate transformations for them.
#
# If passThrough is defined on window creation, then unsupported
# functions will simply be forwarded to the image.  Otherwise,
# we will croak.
##
sub AUTOLOAD {
  my ($self) = @_;
  my ($name) = ($AUTOLOAD =~ /::([^:]+)$/);
  my @args = @_;

  if (exists $imWindowedFuncs{$name}) {
    my $fi = $imWindowedFuncs{$name};

    # Create the function that should be called
    my $body = " my \$s = shift;my \@args = \@_;\n";

    foreach my $dim (qw(x y w h)) {
      if ($fi->{$dim}) {
        foreach my $idx (@{$fi->{$dim}}) {
          $body .= " \$args[$idx] = \$s->translate". uc($dim) ."(\$args[$idx]);\n";
        }
      }
    }
    # $body .= "   print \"calling $name with \$s->{im} -> \@args\\n\"; my \$res = \$s->{im}->$name(\@args); \$s->postRenderAdjustment(); return \$res; \n";
    $body .= "   my \$res = \$s->{im}->$name(\@args); \$s->postRenderAdjustment(); return \$res; \n";
    # print "Eval: $body\n";
    eval "sub $name { $body }; return $name(\@args);";
    if ($@) {
      die "Failed eval of autoloaded sub: $@";
    }
  }
  elsif (exists $imWindowedPolyFuncs{$name}) {

    my $body = qq ^
  my (\$self, \$poly, \$color) = \@_;
  my \$transPoly = GD::Polygon->new;

  # Need to go through all the points and adjust them
  foreach my \$vertex (\$poly->vertices) {
    \$transPoly->addPt(\$self->translateX(\$vertex->[0]), \$self->translateY(\$vertex->[1]));
  }
  \$self->{im}->$name(\$transPoly, \$color);
    ^;
#    print "Adding \@{\$vertex}\n";
#  my \@v = \$transPoly->vertices;
#foreach my \$v (\@v) {
#  print "poly: \@{\$v}\n";
#}

#    print "BODY: $body\n";
    eval "sub $name { $body }; return $name(\@args);";
    if ($@) {
      die "Failed eval of autoloaded sub: $@";
    }

  }
  else {
    if ($self->{passThroughIfUnsupported} || $self->{useImage}) {
      eval("sub $name { my \$s = shift; my \$res = \$s->{im}->$name(\@_); \$s->postRenderAdjustment(); return \$res;}; return $name(\@_);");
      if ($@) {
        die "Failed eval of autoloaded sub: $@";
      }
    }
    else {
      croak "Sub $name is not supported by GD::Window";
    }
  }
}



##
# Methods that can't be handled by the AUTOLOAD
##
sub boundsSafe {
  my ($self, $x, $y) = @_;
  return ($x >= $self->{minX} &&
          $x <= $self->{maxX} &&
          $y >= $self->{minY} &&
          $y <= $self->{maxY});
}

sub bounds {
  my ($self) = @_;
  if (!$self->{invertY}) {
    return($self->{minX},
           $self->{minY},
           $self->{maxX},
           $self->{maxY});
  }
  else {
    return($self->{minX},
           $self->{maxY},
           $self->{maxX},
           $self->{minY});
  }
}


sub dimensions {
  my ($self) = @_;
  return($self->{maxX} - $self->{minX},
         $self->{maxY} - $self->{minY});
}


##
# Public Methods for changing globals
##
sub invertY {
  my ($that, $val) = @_;

  if (ref($that)) {
    $that->{invertY} = $val;
  }
  else {
    $invertY_g = $val;
  }

}


##
# Private Methods
##
sub translateX {
  my ($self, $x) = @_;
  my $newX = ($x - $self->{minX}) * $self->{scaleX} + $self->{imMinX};
  # print "translate from $x to $newX, $self->{scaleX}, $self->{minX}, $self->{imMinX}\n";
  return $newX;
}

sub translateY {
  my ($self, $y) = @_;
  if ($self->{invertY}) {
    $y = $self->{maxY} - $y;
  }
  my $newY = ($y - $self->{minY}) * $self->{scaleY} + $self->{imMinY};
  # print "translate from $y to $newY, $self->{scaleY}\n";
  return $newY;
}

sub translateW {
  my ($self, $w) = @_;
  return $w * $self->{scaleX};
}

sub translateH {
  my ($self, $h) = @_;
  return $h * $self->{scaleY};
}

sub postRenderAdjustment {
  my $self = shift;
  return if !$self->{useImage};
  $self->{parentIm}->copyResampled(
    $self->{im}, $self->{srcImMinX}, $self->{srcImMinY}, 0, 0,
    ($self->{imMaxX} - $self->{srcImMinX}), ($self->{imMaxY} - $self->{srcImMinY}),
    ($self->{maxX} - $self->{minX}), ($self->{maxY} - $self->{minY}));
};


sub DESTROY {}


1;
__END__