Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

CGI::Imagemap

by japhy (Canon)
on Sep 23, 2000 at 18:18 UTC ( #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

Comment on CGI::Imagemap
Download Code
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
Node Status?
node history
Node Type: perlcraft [id://33774]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (10)
As of 2015-07-06 15:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (77 votes), past polls