package CGI::Imagemap;

use Carp;
use strict;
use vars qw( $VERSION );

$VERSION = '0.01';


sub new {
  my $class = shift;
  my $self = bless { SHAPES => [], POINTS => [], }, $class;
  croak "odd number of parameters to CGI::Imagemap::new" if @_ % 2;
  while (@_) {
    my $type = shift;
    my $config = shift;
    croak "configuration not an array reference in CGI::Imagemap::new"
      if ref($config) ne "ARRAY";
    my $shape = CGI::Imagemap::Shape->new($type,$config);
    $self->{DEFAULT} = $shape, next if $type eq 'DEFAULT';
    push @{ $self->{SHAPES} }, $shape unless @{ $self->{POINTS} };
    push @{ $self->{POINTS} }, $shape if $type eq 'POINT';
  }
  return $self;
}


sub query_eval {
  my ($self, $query, $field) = @_;
  croak "query must be CGI object in CGI::Imagemap::query_eval"
    unless UNIVERSAL::isa($query, 'CGI');
  my ($x,$y) = ($query->param("$field.x"), $query->param("$field.y"));
  $self->manual_eval($x,$y);
}


sub manual_eval {
  my ($self, $x, $y) = @_;
  for (@{ $self->{SHAPES} }) {
    if ($_->type('POINT')) {
      my ($min,$shape) = ($_->proximity($x,$y),$_);
      for (@{ $self->{POINTS} }) {
        my $dst = $_->proximity($x,$y);
        $dst < $min and ($min,$shape) = ($dst,$_);
      }
      $shape->execute() and return 1;
    }
    $_->proximity($x,$y) and $_->execute() and return 1;
  }
  $self->{DEFAULT} and $self->{DEFAULT}->execute();
  return 0;
}



package CGI::Imagemap::Shape;

use Carp;

my %types;
@types{qw( CIRCLE OVAL RECT POLY POINT DEFAULT )} = ();

sub new {
  my ($class, $type, $config) = @_;
  croak "invalid shape (must be @{[ keys %types ]}) '$type'"
    unless exists $types{uc $type};
  croak "handler must be code ref" if ref($config->[0]) ne 'CODE';
  my $self = bless {}, $class . "::" . uc($type);
  $self->{HANDLER} = shift @$config;
  $self->{COORDS} = $config;
  return $self;
}


sub coords { return @{ $_[0]{COORDS} } }


sub execute { $_[0]{HANDLER}->() }



package CGI::Imagemap::Shape::CIRCLE;

use vars '@ISA';
@ISA = qw( CGI::Imagemap::Shape );

sub proximity {
  my ($shape, $x, $y) = @_;
  my ($Cx, $Cy, $r) = $shape->coords;
  return ($x - $Cx)**2 + ($y - $Cy)**2 <= $r**2; 
}



package CGI::Imagemap::Shape::OVAL;

use vars '@ISA';
@ISA = qw( CGI::Imagemap::Shape );

sub proximity {
  my ($shape, $x, $y) = @_;
  my ($Cx, $Cy, $a, $b) = $shape->coords;
  return (($x - $Cx)/$a)**2 + (($y - $Cy)/$b)**2 <= 1;
}



package CGI::Imagemap::Shape::RECT;

use vars '@ISA';
@ISA = qw( CGI::Imagemap::Shape );

sub proximity {
  my ($shape, $x, $y) = @_;
  my ($ULx, $ULy, $LRx, $LRy) = $shape->coords;
  return ($ULx <= $x) && ($x <= $LRx) && ($ULy <= $y) && ($y <= $LRy);
}



package CGI::Imagemap::Shape::POLY;

use vars '@ISA';
@ISA = qw( CGI::Imagemap::Shape );

sub coords {
  my ($shape) = @_;
  my @x = map $shape->{COORDS}[$_ * 2], 0 .. $#{ $shape->{COORDS} }/2;
  my @y = map $shape->{COORDS}[$_ * 2 + 1], 0 .. $#{ $shape->{COORDS} }/2;
  return (\@x, \@y);
}


sub proximity {
  my ($shape, $x, $y) = @_;
  my ($Xc, $Yc) = $shape->coords;
  my @X = @$Xc;
  my @Y = @$Yc;
  my $n = @X;
  my ($i,$j);
  my $inside = 0;
  # thanks to "Mastering Algorithms in Perl" (pg. 444-5)
  # point_in_ploygon derived from Wm. Randolph Franklin

  for ($i = 0, $j = $n - 1; $i < $n; $j = $i++) {
    if (
         (
           (($Y[$i] <= $y) && ($y < $Y[$j])) ||
           (($Y[$j] <= $y) && ($y < $Y[$i]))
         )
         and
         ($x <
           ($X[$j] - $X[$i]) *
           ($y - $Y[$i]) /
           ($Y[$j] - $Y[$i]) +
           $X[$i]
         )
       ) { $inside = !$inside }
  }

  return $inside;
}



package CGI::Imagemap::Shape::POINT;

use vars '@ISA';
@ISA = qw( CGI::Imagemap::Shape );

sub proximity {
  my ($shape, $x, $y) = @_;
  my ($Px, $Py) = $shape->coords;
  return sqrt(($Px - $x)**2 + ($Py - $y)**2);
}


1;


__END__

=head1 NAME

CGI::Imagemap - program-handling of X,Y coordinates in an
image

=head1 SYNOPSIS

  use CGI::Imagemap;
  $request = CGI::Imagemap->new(
    CIRCLE => [\&handler, $center_x, $center_y, $radius],
    OVAL => [\&handler, $axis_x, $axis_y, $den_x, $den_y],
    RECT => [\&handler, $upleft_x, $upleft_y, $lowright_x, $lowright_y],
    POLY => [\&handler, $x0, $y0, $x1, $y1, ..., $xN, $yN],
    POINT => [\&handler, $x, $y],
    DEFAULT => [\&handler],
  );
  $found = $request->query_eval($CGIobj, $fieldname);
  $found = $request->manual_eval($px, $py);
  if (!$found) {
    # resorted to DEFAULT handler
  }

=head1 DESCRIPTION

Basically, you make a CGI::Imagemap object, and list (in
order of precedence) the zones that the imagemap should map
to.  The shape names are CIRCLE, OVAL, RECT, POLY, POINT,
and DEFAULT.  All POINT shapes will be compared at the same
time, and they should be left for last.

The query_eval method takes a CGI query object and a
fieldname, and gets the fieldname.x and fieldname.y values
from the query object.  Then it calls manual_eval.  This
just takes the (x,y) pair of coordinates.

The shapes take a handler (code reference) as their first
argument, and this handler will be executed if the point is
within the bounds of the shape.  If the default handler is
resorted to, the query_eval and manual_eval methods will
return 0.  Otherwise, they'll return 1.

That's about it.

=head1 AUTHOR

  Jeff "japhy" Pinyan
  CPAN ID: PINYAN
  japhy@pobox.com

=cut