1# maptcl.tcl
2# Pure Tcl imagemap handling.
3#
4# 	read in an image map file, and generate the appropriate canvas
5# 	# sample image map
6#	circle 	/sun-on-net/internet.sol/access.html  664,311 686,311
7#	default	http://www.hal.com/
8#	default 	/sunsoft/index.html
9#	point /sunworldonline/common/swol-subscribe.html 45,134
10#	poly / 182,11 184,88 301,77 365,86 393,57 393,10
11#	rect	/sunsoft/index.html 1,1 119,34
12#
13# Brent Welch (c) 1997 Sun Microsystems
14# Brent Welch (c) 1998-2000 Ajuba Solutions
15# See the file "license.terms" for information on usage and redistribution
16# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
17#
18# RCS: @(#) $Id: maptcl.tcl,v 1.5 2000/10/02 16:58:53 welch Exp $
19
20package provide httpd::ismaptcl 1.0
21package require httpd::imagemap 1.0
22
23# translate an x/y coordinate into a url
24
25proc Map_Lookup {request} {
26    global ImageMaps
27    if {[regexp {([^?]+)\?([0-9]+),([0-9]+)} $request {} map x y]} {
28	if [catch {file mtime $map} mtime] {
29	    return ""
30	}
31	if {![info exists ImageMaps($map)] ||
32		($mtime > $ImageMaps(mtime,$map))} {
33	    set ImageMaps($map) [MapRead $map]
34	    set ImageMaps(mtime,$map) $mtime
35	}
36	return [MapHit $ImageMaps($map) $x $y]
37    } else {
38	return ""
39    }
40}
41
42# MapRead - this parses a map data file and converts it to
43# a Tcl array that contains state about each region.
44# This parser is another famous regsub-subst combo by Steve Uhler
45
46proc MapRead {file} {
47    if {[catch {open $file} fd]} {
48	Log "" "file open" $fd
49	return {}
50    }
51    regsub -all  {\.}  $file _ cookie
52    set data [read $fd]
53    close $fd
54    regsub -all "(^|\n+)#\[^\n]*" $data {} data
55    regsub -all {([][$\\])} $data {\\\1} data
56    set types circle|default|point|poly|rect
57    append exp {[ 	]*(} $types {)[ 	]+([^	}
58    append exp \n { ]+)[ 	]*([^} \n\r {]*)} \[\n\r]+
59    regsub -nocase -all $exp $data "\[MapInsert [list $cookie] \\1 {\\2} {\\3}]" cmd
60    upvar #0 $cookie map
61    catch {unset map}
62    subst $cmd
63    return $cookie
64}
65
66# helper proc for generating the data structure
67
68proc MapInsert {cookie type href coords} {
69    upvar #0 $cookie map
70    if ![info exists map] {
71	set map(N) 0
72    } else {
73	incr map(N)
74    }
75    regsub -all , $coords { } coords
76    set c {}
77    set i 0
78    foreach {X Y} $coords {
79	lappend c $i,X $X $i,Y $Y
80	incr i
81    }
82    set map($map(N),type) $type
83    set map($map(N),coords) $c
84    set map($map(N),href) $href
85    if {$type == "default"} {
86	set map(default) $href
87    }
88}
89
90# MapHit looks up coordinates in a map
91
92proc MapHit {cookie x y} {
93    upvar #0 $cookie map
94    set sawpoint 0
95    for {set i 0} {$i < $map(N)} {incr i} {
96	array set pgon $map($i,coords)
97	switch $map($i,type) {
98	    poly {
99		if [MapPointInPoly $x $y pgon] {
100		    return $map($i,href)
101		}
102	    }
103	    circle {
104		if [MapPointInCircle $x $y pgon] {
105		    return $map($i,href)
106		}
107	    }
108	    rect {
109		if [MapPointInRect $x $y pgon] {
110		    return $map($i,href)
111		}
112	    }
113	    point {
114		set dist [expr ($x - $pgon(0,X)) * ($x - $pgon(0,X)) + \
115				($y - $pgon(0,Y)) * ($y - $pgon(0,Y))]
116		if {!$sawpoint || ($dist < $mindist)} {
117		    set mindist $dist
118		    set default $map($i,href)
119		}
120	    }
121	}
122    }
123    if [info exists default] {
124	return $default
125    }
126    if [info exists map(default)] {
127	return $map(default)
128    }
129    return {}
130}
131
132