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
Back to
Craft