Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

CGI::Imagemap

by japhy (Canon)
on Sep 23, 2000 at 18:18 UTC ( [id://33774]=perlcraft: print w/replies, xml ) Need Help??

   1: package CGI::Imagemap;
   2: 
   3: use Carp;
   4: use strict;
   5: use vars qw( $VERSION );
   6: 
   7: $VERSION = '0.01';
   8: 
   9: 
  10: sub new {
  11:   my $class = shift;
  12:   my $self = bless { SHAPES => [], POINTS => [], }, $class;
  13:   croak "odd number of parameters to CGI::Imagemap::new" if @_ % 2;
  14:   while (@_) {
  15:     my $type = shift;
  16:     my $config = shift;
  17:     croak "configuration not an array reference in CGI::Imagemap::new"
  18:       if ref($config) ne "ARRAY";
  19:     my $shape = CGI::Imagemap::Shape->new($type,$config);
  20:     $self->{DEFAULT} = $shape, next if $type eq 'DEFAULT';
  21:     push @{ $self->{SHAPES} }, $shape unless @{ $self->{POINTS} };
  22:     push @{ $self->{POINTS} }, $shape if $type eq 'POINT';
  23:   }
  24:   return $self;
  25: }
  26: 
  27: 
  28: sub query_eval {
  29:   my ($self, $query, $field) = @_;
  30:   croak "query must be CGI object in CGI::Imagemap::query_eval"
  31:     unless UNIVERSAL::isa($query, 'CGI');
  32:   my ($x,$y) = ($query->param("$field.x"), $query->param("$field.y"));
  33:   $self->manual_eval($x,$y);
  34: }
  35: 
  36: 
  37: sub manual_eval {
  38:   my ($self, $x, $y) = @_;
  39:   for (@{ $self->{SHAPES} }) {
  40:     if ($_->type('POINT')) {
  41:       my ($min,$shape) = ($_->proximity($x,$y),$_);
  42:       for (@{ $self->{POINTS} }) {
  43:         my $dst = $_->proximity($x,$y);
  44:         $dst < $min and ($min,$shape) = ($dst,$_);
  45:       }
  46:       $shape->execute() and return 1;
  47:     }
  48:     $_->proximity($x,$y) and $_->execute() and return 1;
  49:   }
  50:   $self->{DEFAULT} and $self->{DEFAULT}->execute();
  51:   return 0;
  52: }
  53: 
  54: 
  55: 
  56: package CGI::Imagemap::Shape;
  57: 
  58: use Carp;
  59: 
  60: my %types;
  61: @types{qw( CIRCLE OVAL RECT POLY POINT DEFAULT )} = ();
  62: 
  63: sub new {
  64:   my ($class, $type, $config) = @_;
  65:   croak "invalid shape (must be @{[ keys %types ]}) '$type'"
  66:     unless exists $types{uc $type};
  67:   croak "handler must be code ref" if ref($config->[0]) ne 'CODE';
  68:   my $self = bless {}, $class . "::" . uc($type);
  69:   $self->{HANDLER} = shift @$config;
  70:   $self->{COORDS} = $config;
  71:   return $self;
  72: }
  73: 
  74: 
  75: sub coords { return @{ $_[0]{COORDS} } }
  76: 
  77: 
  78: sub execute { $_[0]{HANDLER}->() }
  79: 
  80: 
  81: 
  82: package CGI::Imagemap::Shape::CIRCLE;
  83: 
  84: use vars '@ISA';
  85: @ISA = qw( CGI::Imagemap::Shape );
  86: 
  87: sub proximity {
  88:   my ($shape, $x, $y) = @_;
  89:   my ($Cx, $Cy, $r) = $shape->coords;
  90:   return ($x - $Cx)**2 + ($y - $Cy)**2 <= $r**2; 
  91: }
  92: 
  93: 
  94: 
  95: package CGI::Imagemap::Shape::OVAL;
  96: 
  97: use vars '@ISA';
  98: @ISA = qw( CGI::Imagemap::Shape );
  99: 
 100: sub proximity {
 101:   my ($shape, $x, $y) = @_;
 102:   my ($Cx, $Cy, $a, $b) = $shape->coords;
 103:   return (($x - $Cx)/$a)**2 + (($y - $Cy)/$b)**2 <= 1;
 104: }
 105: 
 106: 
 107: 
 108: package CGI::Imagemap::Shape::RECT;
 109: 
 110: use vars '@ISA';
 111: @ISA = qw( CGI::Imagemap::Shape );
 112: 
 113: sub proximity {
 114:   my ($shape, $x, $y) = @_;
 115:   my ($ULx, $ULy, $LRx, $LRy) = $shape->coords;
 116:   return ($ULx <= $x) && ($x <= $LRx) && ($ULy <= $y) && ($y <= $LRy);
 117: }
 118: 
 119: 
 120: 
 121: package CGI::Imagemap::Shape::POLY;
 122: 
 123: use vars '@ISA';
 124: @ISA = qw( CGI::Imagemap::Shape );
 125: 
 126: sub coords {
 127:   my ($shape) = @_;
 128:   my @x = map $shape->{COORDS}[$_ * 2], 0 .. $#{ $shape->{COORDS} }/2;
 129:   my @y = map $shape->{COORDS}[$_ * 2 + 1], 0 .. $#{ $shape->{COORDS} }/2;
 130:   return (\@x, \@y);
 131: }
 132: 
 133: 
 134: sub proximity {
 135:   my ($shape, $x, $y) = @_;
 136:   my ($Xc, $Yc) = $shape->coords;
 137:   my @X = @$Xc;
 138:   my @Y = @$Yc;
 139:   my $n = @X;
 140:   my ($i,$j);
 141:   my $inside = 0;
 142:   # thanks to "Mastering Algorithms in Perl" (pg. 444-5)
 143:   # point_in_ploygon derived from Wm. Randolph Franklin
 144: 
 145:   for ($i = 0, $j = $n - 1; $i < $n; $j = $i++) {
 146:     if (
 147:          (
 148:            (($Y[$i] <= $y) && ($y < $Y[$j])) ||
 149:            (($Y[$j] <= $y) && ($y < $Y[$i]))
 150:          )
 151:          and
 152:          ($x <
 153:            ($X[$j] - $X[$i]) *
 154:            ($y - $Y[$i]) /
 155:            ($Y[$j] - $Y[$i]) +
 156:            $X[$i]
 157:          )
 158:        ) { $inside = !$inside }
 159:   }
 160: 
 161:   return $inside;
 162: }
 163: 
 164: 
 165: 
 166: package CGI::Imagemap::Shape::POINT;
 167: 
 168: use vars '@ISA';
 169: @ISA = qw( CGI::Imagemap::Shape );
 170: 
 171: sub proximity {
 172:   my ($shape, $x, $y) = @_;
 173:   my ($Px, $Py) = $shape->coords;
 174:   return sqrt(($Px - $x)**2 + ($Py - $y)**2);
 175: }
 176: 
 177: 
 178: 1;
 179: 
 180: 
 181: __END__
 182: 
 183: =head1 NAME
 184: 
 185: CGI::Imagemap - program-handling of X,Y coordinates in an
 186: image
 187: 
 188: =head1 SYNOPSIS
 189: 
 190:   use CGI::Imagemap;
 191:   $request = CGI::Imagemap->new(
 192:     CIRCLE => [\&handler, $center_x, $center_y, $radius],
 193:     OVAL => [\&handler, $axis_x, $axis_y, $den_x, $den_y],
 194:     RECT => [\&handler, $upleft_x, $upleft_y, $lowright_x, $lowright_y],
 195:     POLY => [\&handler, $x0, $y0, $x1, $y1, ..., $xN, $yN],
 196:     POINT => [\&handler, $x, $y],
 197:     DEFAULT => [\&handler],
 198:   );
 199:   $found = $request->query_eval($CGIobj, $fieldname);
 200:   $found = $request->manual_eval($px, $py);
 201:   if (!$found) {
 202:     # resorted to DEFAULT handler
 203:   }
 204: 
 205: =head1 DESCRIPTION
 206: 
 207: Basically, you make a CGI::Imagemap object, and list (in
 208: order of precedence) the zones that the imagemap should map
 209: to.  The shape names are CIRCLE, OVAL, RECT, POLY, POINT,
 210: and DEFAULT.  All POINT shapes will be compared at the same
 211: time, and they should be left for last.
 212: 
 213: The query_eval method takes a CGI query object and a
 214: fieldname, and gets the fieldname.x and fieldname.y values
 215: from the query object.  Then it calls manual_eval.  This
 216: just takes the (x,y) pair of coordinates.
 217: 
 218: The shapes take a handler (code reference) as their first
 219: argument, and this handler will be executed if the point is
 220: within the bounds of the shape.  If the default handler is
 221: resorted to, the query_eval and manual_eval methods will
 222: return 0.  Otherwise, they'll return 1.
 223: 
 224: That's about it.
 225: 
 226: =head1 AUTHOR
 227: 
 228:   Jeff "japhy" Pinyan
 229:   CPAN ID: PINYAN
 230:   japhy@pobox.com
 231: 
 232: =cut

Replies are listed 'Best First'.
RE: CGI::Imagemap
by merlyn (Sage) on Sep 23, 2000 at 20:02 UTC

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlcraft [id://33774]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (4)
As of 2024-03-19 02:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found