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