Keith Vetter 2003-01-15 - I got sick of Yahoo maps being too small so I wrote this program that grabs neighboring maps and tiles them in the window letting you build up a larger, more complete map of an area.You first supply a zoom level and either a latitude, longitude or a street and city address and TkMapper goes out to Yahoo and grabs that map. It then determines what the latitude/longitude offsets are to the neighboring maps [surprisingly, these offsets vary depending on map location], and then grabs and tiles the 8 surrounding maps. You can then click on North, South, East or West buttons to extend the map.At any time you can enter and map a new location (alternatively, double clicking anywhere on the map loads in that location into the new map form).Vince -- this looks great! I found one small bug -- if you zoom out a long way, alaska and canada don't match up with the rest of the USA properly....
Beware: this program will not work out of the box. It generates several error messages. The code is long, I'm still trying to figure out what is wrong with it. LES, May 07, 2003 -- fixed now KPVescargo It used to work, but now it doesn't. Maybe something dealing with network connections isn't working now.KPV - I haven't looked closely yet but I'd bet the problem is one common to all web scrapings. Namely, the web pages that the information is extracted from have changed thereby breaking the script. I'll look into the problem shortly.KPV 2003-05-07 : okay, it is fixed, at least for now. It turns out that Yahoo now returns http code 302 for the url I was fetching-actually it redirects you twice. Since the http package doesn't support automatic redirection (grrr), it broke the script. Fixing this was non-trivial because I was using the -command option to http::geturl. Also, Yahoo also changed the url when clicking on the image. I was simulating a mouse click to determine the lat/long distance between neighboring images.Vince 2004-29-04 : Unfortunately broken again. I get this error:
Unsupported URL: /maps_result?ed=hqzBj.p_0Tom2J3DTTitXZ6dbTRJ9dYSEosRsMDW5AOYHYE-&csz=&country=us&mag=9&cat=
Unsupported URL: /maps_result?ed=hqzBj.p_0Tom2J3DTTitXZ6dbTRJ9dYSEosRsMDW5AOYHYE-&csz=&country=us&mag=9&cat=
while executing
"::http::geturl $url"
(procedure "MyGetURL" line 3)
invoked from within
"MyGetURL http://maps.yahoo.com/py/maps.py?Pyt=Tmap&slt=0&sln=0&mlt=38.8987&mln=-77.03645&mag=9&city=abc&ds=n
{GotMapPage 0 0}"
("after" script)[Siva] 2004-15-10: It does not work for me either. It looks like Yahoo does not support long/lat parameters anymore.KPV This has been broken for a while. Yahoo! constantly changing its interface to break people from scrapping their pages--they even insert funny comments to that effect into the html pages. I tracked the changes a couple of times then gave up. #+##########################################################################
#
# TkMapper -- extracts neighboring maps from Yahoo and tiles them for you
# by Keith Vetter, January 2003
# KPV May 07, 2003 - updated to handle HTTP redirects that Yahoo now has;
# ComputeDeltas url changed
#
package require Tk
package require http 2.0
set pname TkMapper
set version 1.1
##+##########################################################################
#
# Init -- creates a blank canvas w/ all variables reset
#
proc Init {} {
if {[winfo exists .c]} {
.c delete all
.over delete all
.sb_x set 0 1
.sb_y set 0 1
foreach img [image names] {
if {[string match map* $img]} {image delete $img}
}
.c create text 0 0 -tag title -text $::pname -anchor s -font {Times 72}
.c create text 0 50 -tag title -font {Times 24} -text "by Keith Vetter"
.c create text 0 100 -tag title -font {Times 12} \
-text "loading center image..."
set h [expr {[winfo height .c] / 2.0}] ;# Recenter display
set w [expr {[winfo width .c] / 2.0}]
if {$h > 1} {
.c config -scrollregion [list -$w -$h $w $h]
}
}
set ::want 0 ;# Count of outstanding requests
catch {unset ::mapInfo}
array set ::mapInfo {minX 0 maxX 0 minY 0 maxY 0}
set ::overview(bbox) 0
set ::delta(cx) 400 ;# Screen offset between maps
set ::delta(cy) 400 ;# try 365 to remove map scale
set ::delta(cy) 365 ;# try 365 to remove map scale
}
##+##########################################################################
#
# DoDisplay -- sets up the GUI display
#
proc DoDisplay {} {
raise .
wm title . $::pname
wm protocol . WM_DELETE_WINDOW exit
frame .ctrl -bd 2 -relief ridge
frame .maps
frame .info
pack .ctrl -side right -fill y
pack .info -side bottom -fill x
pack .maps -side left -fill both -expand 1
label .w -textvariable WANT -anchor w -width 15 -relief ridge
label .l -textvariable INFO -anchor c -relief ridge
canvas .c -width 800 -height 800 -highlightthickness 0 -takefocus 1
.c config -scrollregion [list -400 -400 400 400]
.c config -yscrollcommand {MyScroller y .sb_y}
.c config -xscrollcommand {MyScroller x .sb_x}
.c config -bd 2 -relief ridge
bind .c <1> {focus .c}
bind .c <Double-1> [list canvas2pos %W %x %y]
bind .c <2> [bind Text <2>]
bind .c <B2-Motion> [bind Text <B2-Motion>]
set mw {%W yview scroll [expr {- (%D / 120) * 1}] units}
regsub yview $mw xview mw2
bind .c <MouseWheel> $mw
bind .c <Shift-MouseWheel> $mw2
scrollbar .sb_x -command {.c xview} -orient horizontal
scrollbar .sb_y -command {.c yview} -orient vertical
grid .c .sb_y -in .maps -row 0 -sticky news
grid .sb_x -in .maps -sticky ew
grid rowconfigure .maps 0 -weight 1
grid columnconfigure .maps 0 -weight 1
pack .w -in .info -side left
pack .l -in .info -side left -expand 1 -fill x
focus .c
DoControls
bind all <Alt-c> {console show}
update
wm geom . [wm geom .]
.c config -scrollregion {}
return
}
##+##########################################################################
#
# DoControls -- displays GUI for the control panel
#
proc DoControls {} {
# Overview window
frame .fover -bd 2 -relief ridge
label .lover -text "Overview"
canvas .over -width 204 -height 204 -highlightthickness 0 -takefocus 0
.over config -bd 0 -bg gray50
bind .over <Button-1> [list OverviewX %W %x %y down]
bind .over <B1-Motion> [list OverviewX %W %x %y move]
bind .over <ButtonRelease-1> [list OverviewX %W %x %y done]
bind .over <Button-2> [list OverviewX %W %x %y down]
bind .over <B2-Motion> [list OverviewX %W %x %y move]
bind .over <ButtonRelease-2> [list OverviewX %W %x %y done]
.over xview moveto 0; .over yview moveto 0
grid .over -in .fover -row 0
grid .lover -in .fover
button .bn -text N -command {GoDir N}
button .be -text E -command {GoDir E}
button .bw -text W -command {GoDir W}
button .bs -text S -command {GoDir S}
frame .fnew -bd 2 -relief ridge
grid rowconfigure .ctrl 0 -minsize 5 ;# Top spacing
grid .fover - - - - -in .ctrl -row 1 -sticky ew -padx 10 -pady 10
grid rowconfigure .ctrl 50 -minsize 10 ;# Spacing
grid x x .bn x x -in .ctrl -row 51
grid x .bw x .be x -in .ctrl
grid x x .bs x x -in .ctrl
grid rowconfigure .ctrl 60 -minsize 10 ;# Spacing
grid rowconfigure .ctrl 100 -weight 1 ;# Push everything to top
grid columnconfigure .ctrl {0 4} -weight 1 ;# Push everything to right
grid .fnew - - - - -in .ctrl -row 100 -stick news
# FNEW pane
label .new -text "New Maps" -font "[.lover cget -font] bold"
label .llat -text "Latitude:"
entry .elat -textvariable UI(mlt)
label .llong -text "Longitude:"
entry .elong -textvariable UI(mln)
label .lzoom1 -text "Zoom:"
tk_optionMenu .ezoom1 UI(zoom1) 1 2 3 4 5 6 7 8 9 10
button .getmap1 -text "Get Map" -command {GetNewMap 1}
label .lstreet -text "Street:"
entry .estreet -textvariable UI(addr)
label .lcity -text "City:"
entry .ecity -textvariable UI(csz)
label .lzoom2 -text "Zoom:"
tk_optionMenu .ezoom2 UI(zoom2) 1 2 3 4 5 6 7 8 9 10
button .getmap2 -text "Get Map" -command {GetNewMap 2}
grid .new - - - -in .fnew -row 0
grid rowconfigure .fnew 1 -minsize 10
grid .llat .elat - - -in .fnew -row 10
grid .llong .elong - - -in .fnew
grid .lzoom1 .ezoom1 - - -in .fnew -sticky ew
grid .getmap1 - - - -in .fnew -pady 10
grid rowconfigure .fnew 20 -minsize 50
grid .lstreet .estreet - - -in .fnew -row 21
grid .lcity .ecity - - -in .fnew
grid .lzoom2 .ezoom2 - - -in .fnew -sticky ew
grid .getmap2 - - - -in .fnew -pady 10
grid rowconfigure .fnew 100 -weight 1
catch {image create photo ::img::blank -width 1 -height 1}
button .about -image ::img::blank -command About -highlightthickness 0
place .about -in .fnew -relx 1 -rely 1 -anchor se
}
##+##########################################################################
#
# MyScroller -- catches scroll requests so we can update overview window
#
proc MyScroller {xy w top bottom} {
$w set $top $bottom ;# Call the scrollbar
DoOverview ;# Update overview window
}
##+##########################################################################
#
# GoDir -- gets new maps on specified edge.
#
proc GoDir {dir} {
global mapInfo delta
if {! [info exists delta(dx)]} return
if {$dir == "E" || $dir == "W"} {
if {$dir == "E"} {
set x [expr {$mapInfo(maxX) + 1}]
} else {
set x [expr {$mapInfo(minX) - 1}]
}
for {set y $mapInfo(minY)} {$y <= $mapInfo(maxY)} {incr y} {
GetMapDelta $x $y
}
} else { ;# North/south
if {$dir == "N"} {
set y [expr {$mapInfo(minY) - 1}]
} else {
set y [expr {$mapInfo(maxY) + 1}]
}
for {set x $mapInfo(minX)} {$x <= $mapInfo(maxX)} {incr x} {
GetMapDelta $x $y
}
}
}
##+##########################################################################
#
# INFO -- prints out information messages
#
proc INFO {msg} {
#puts stderr $msg
set ::INFO $msg
update
}
proc ERROR {msg} {
set msg "ERROR: $msg"
tk_messageBox -icon error -title "$::pname Error" -message $msg
return -code error ;# This clears call stack
}
##+##########################################################################
#
# GetRootMap -- Gets the center map, computes deltas then gets
# neighboring cells.
#
proc GetRootMap {mlt mln} {
global want
Init ;# Erase everything
GetMapAt $mlt $mln 0 0 ;# Get center map
while {1} {
vwait want
if {$want == 0} break
}
.c delete title
ComputeDeltas $mlt $mln
# Get all neighboring cells
#GetMapDelta 0 -1 0 1 -1 0 1 0 -1 -1 1 -1 -1 1 1 1
GetMapDelta -1 -1 0 -1 1 -1 -1 0 1 0 -1 1 0 1 1 1
}
##+##########################################################################
#
# ComputeDeltas -- computes how many lat/long units the map image is.
#
# This varies per location so we ask Yahoo for this info by simulating
# a mouse click exactly one image unit away.
#
proc ComputeDeltas {mlt mln} {
global delta mag
foreach w [list .bn .be .bs .bw] { $w config -state disabled }
INFO "Computing map offsets"
SetWantInfo 1
set data $::mapInfo(data,0,0)
set n [regexp -nocase {<form name=.map.*?</form>} $data form]
if {! $n} {ERROR "can't determine map deltas"}
# Extract the form action plus all the hidden variables for this image map
regexp -nocase {action="(.*?)"} $form _ xurl
append xurl "?"
set start 0
while {1} {
set n [regexp -nocase -indices -line -start $start \
{<input .*name=(.*?) value="(.*)"} $form all name value]
if {! $n} break
set nname [eval string range [list $form] $name]
set vvalue [eval string range [list $form] $value]
append xurl "$nname=$vvalue&"
set start [lindex $value 1]
}
append xurl "map.x=599&map.y=599"
#set token [::http::geturl $xurl]
set token [MyGetURL $xurl]
SetWantInfo -1
if {$token == {}} {return -code error}
set data [::http::data $token]
::http::cleanup $token
set n1 [regexp {mlt=([-0-9.]+)} $data => mlt2]
set n2 [regexp {mln=([-0-9.]+)} $data => mln2]
if {! $n1 || ! $n2} {ERROR "can't get map to compute deltas"}
set delta(dx,$mag) [expr {$mln2 - $mln}]
set delta(dy,$mag) [expr {$mlt2 - $mlt}]
set delta(dx) [expr {$delta(dx,$mag) * $delta(cx) / 400.0}]
set delta(dy) [expr {$delta(dy,$mag) * $delta(cy) / 400.0}]
foreach w [list .bn .be .bs .bw] { $w config -state normal }
INFO "Computing map offsets: $delta(dx,$mag), $delta(dy,$mag)"
}
##+##########################################################################
#
# GetMapAt -- gets the map at lat, long and puts it onto the canvas at x,y
#
proc GetMapAt {mlt mln x y} {
global mag mapInfo
SetWantInfo 2
SetMapInfo $x $y $mlt $mln
INFO "Want $x, $y ($mlt $mln)"
set xurl http://maps.yahoo.com/py/maps.py?Pyt=Tmap&slt=0&sln=0
append xurl &mlt=$mlt&mln=$mln&mag=$mag
append xurl &city=abc&ds=n
set mapInfo(url,$x,$y) $xurl
#INFO "url is $xurl"
#::http::geturl $xurl -command [list GotMapPage $x $y]
after 1 [list MyGetURL $xurl [list GotMapPage $x $y]]
}
##+##########################################################################
#
# GetMapDelta -- like GetMapAt but lat, long is derived from units from
# the image at 0,0.
#
proc GetMapDelta {args} {
global mapInfo delta
if ![info exists mapInfo(0,0)] {ERROR "missing root map"}
foreach {mlt0 mln0} $mapInfo(0,0) break
foreach {dx dy} $args {
set mlt1 [expr {$mlt0 + $dy * $delta(dy)}]
set mln1 [expr {$mln0 + $dx * $delta(dx)}]
GetMapAt $mlt1 $mln1 $dx $dy
}
}
##+##########################################################################
#
# GotMapPage -- callback when a map page is gotten. Extracts the GIF
# info and requests that page.
#
proc GotMapPage {x y token} {
global mapInfo
set ncode [::http::ncode $token] ;# What http code we got
if {$ncode != 200} {
SetWantInfo -1
ERROR "Couldn't get map for cell $x $y: status => [::http::code $token]"
}
INFO "got map page for $x $y"
SetWantInfo -1
set data [::http::data $token]
if {$x == 0 && $y == 0} {set mapInfo(data,$x,$y) $data}
::http::cleanup $token
set n [regexp -- {name="map"[^>]+src="([^ ]*)"} $data {} url]
if {$n} {
set mapInfo(gifurl,$x,$y) $url
#::http::geturl $url -command [list GotMapGif $x $y]
after 1 [list MyGetURL $url [list GotMapGif $x $y]]
} else {
SetWantInfo -1
ERROR "couldn't get map for cell $x $y"
}
}
proc MyGetURL {url {cmd {}}} {
while {1} {
set token [::http::geturl $url]
set ncode [::http::ncode $token]
if {$ncode < 300 || $ncode >= 400} break ;# Not a redirect
array set meta [set [set token](meta)]
::http::cleanup $token
set n [lsearch -regexp [array names meta] (?i)location]
if {$n == -1} {ERROR "bad redirection, no location given"}
set url $meta([lindex [array names meta] $n])
INFO "redirecting to $url"
}
if {$cmd != {}} {
eval $cmd $token
}
return $token
}
##+##########################################################################
#
# GotMapGif -- callback when a GIF map image is gotten.
#
proc GotMapGif {x y token} {
global delta mapInfo ;# Canvas deltas
SetWantInfo -1
INFO "got map gif for $x $y"
set mapInfo(done,$x,$y) 1
set gif [::http::data $token]
::http::cleanup $token
set id "${x}_$y"
image create photo ::map::$id
::map::$id put $gif
set xx [expr {$x * $delta(cx)}] ;# This is were it goes
set xy [expr {$y * $delta(cy)}]
set tag "c,$x,$y"
.c create image $xx $xy -image ::map::$id -tag $tag
#.c create rect [.c bbox $tag] -tag [list $tag frill]
#.c create text $xx $xy -text "$x $y" -font {{MS Sans Serif} 16 bold} \
# -tag [list $tag frill]
#.c lower frill
RaiseMaps $x $y
OverviewCell $x $y
update
.c config -scrollregion [Expand [.c bbox all] 20]
}
##+##########################################################################
#
# RaiseMaps -- when we have overlap, make sure the correct image is on top
#
proc RaiseMaps {x y} {
global mapInfo delta
RaiseMapsAll
return
set me "c,$x,$y"
if {$delta(cy) != 400} { ;# Fix up vertical overlap
set y1 [expr {$y - 1}]
set y2 [expr {$y + 1}]
RaiseMap2 $me "c,$x,$y1"
RaiseMap2 "c,$x,$y2" $me
}
if {$delta(cx) != 400} {
RaiseMap2 $me "c,[expr {$x + 1}],$y"
RaiseMap2 "c,[expr {$x - 1}],$y" $me
}
#.c lower frill
}
proc RaiseMap2 {m1 m2} {
if {[llength [.c find withtag $m1]] == 0} return
if {[llength [.c find withtag $m2]] == 0} return
.c raise $m1 $m2
}
proc RaiseMapsAll {} {
global mapInfo delta
if {$delta(cy) == 400 && $delta(cx) == 400} return
for {set x $mapInfo(minX)} {$x <= $mapInfo(maxX)} {incr x} {
for {set y $mapInfo(maxY)} {$y >= $mapInfo(minY)} {incr y -1} {
.c lower c,$x,$y
}
}
.c lower frill
}
##+##########################################################################
#
# SetMapInfo -- updates global data on which maps have been read in.
#
proc SetMapInfo {x y mlt mln} {
global mapInfo
set mapInfo($x,$y) [list $mlt $mln]
if {$x < $mapInfo(minX)} { set mapInfo(minX) $x }
if {$x > $mapInfo(maxX)} { set mapInfo(maxX) $x }
if {$y < $mapInfo(minY)} { set mapInfo(minY) $y }
if {$y > $mapInfo(maxY)} { set mapInfo(maxY) $y }
}
##+##########################################################################
#
# SetWantInfo -- gives some GUI information on outstanding HTTP requests.
#
proc SetWantInfo {dw} {
global want WANT
incr want $dw
if {$want} { ;# Waiting for some pages
.w config -fg red
set WANT "Want: $want page"
if {$WANT != 1} {append WANT "s"}
} else {
.w config -fg SystemButtonText
set WANT "Done"
}
}
##+##########################################################################
#
# DoOverview -- updates viewport on the overview window
#
proc DoOverview {} {
global mapInfo overview
if {! [winfo exists .over]} return
set bbox [.c bbox all]
if {[llength $bbox] != 4} return
foreach {left top right bottom} $bbox break
set width [expr {$right - $left}]
set height [expr {$bottom - $top}]
# Create the grid here
if {[string compare $bbox $overview(bbox)]} { ;# Did size change
if {$width > $height} {
set scale [expr {200.0 / $width}]
} else {
set scale [expr {200.0 / $height}]
}
.over delete outline
set x2 [expr {2 + $width * $scale}]
set y2 [expr {2 + $height * $scale}]
.over create rectangle 2 2 $x2 $y2 -outline black -width 3 \
-tag outline -fill [.c cget -bg]
set overview(r) [list 2 2 $x2 $y2]
set x_ticks [expr {$mapInfo(maxX) - $mapInfo(minX) + 1}]
set y_ticks [expr {$mapInfo(maxY) - $mapInfo(minY) + 1}]
set xstep [expr {$width * $scale / $x_ticks}]
set ystep [expr {$height * $scale / $y_ticks}]
for {set i 1} {$i < $x_ticks} {incr i} {
set x [expr {2 + $i * $xstep}]
.over create line $x 2 $x $y2 -tag {grid outline} -dash 1
}
for {set i 1} {$i < $y_ticks} {incr i} {
set y [expr {2 + $i * $ystep}]
.over create line 2 $y $x2 $y -tag {grid outline} -dash 1
}
set overview(bbox) $bbox ;# Determines if things changed
set overview(scale) $scale
set overview(xstep) $xstep
set overview(ystep) $ystep
}
# Now draw the viewport
.over delete view
set scale $overview(scale)
foreach {left right} [.c xview] break
set x1 [expr {2 + $width * $scale * $left}]
set x2 [expr {2 + $width * $scale * $right}]
foreach {top bottom} [.c yview] break
set y1 [expr {2 + $height * $scale * $top}]
set y2 [expr {2 + $height * $scale * $bottom}]
.over create rectangle $x1 $y1 $x2 $y2 -outline blue -width 2 -tag view
set overview(v) [list $x1 $y1 $x2 $y2]
OverviewCell
}
proc OverviewCell {args} {
global mapInfo
if {[llength $args] == 0} {
set args [array names mapInfo done,*]
regsub -all {done|,} $args " " args
}
foreach {x y} $args {
set tag "${x}_$y"
set xy [OverviewCellXY $x $y]
.over delete $tag
.over create rect $xy -tag $tag -fill beige -outline beige
}
.over raise grid
.over raise view
}
proc OverviewCellXY {x y} {
global mapInfo overview
set dx [expr {$x - $mapInfo(minX)}]
set dy [expr {$y - $mapInfo(minY)}]
set l [expr {2 + 1 + $dx * $overview(xstep)}]
set t [expr {2 + 1 + $dy * $overview(ystep)}]
set r [expr {-2 + $l + $overview(xstep)}]
set b [expr {-2 + $t + $overview(ystep)}]
return [list $l $t $r $b]
}
##+##########################################################################
#
# OverviewX -- handles mousing in the overview window. It moves the
# view box to follow the cursor.
#
proc OverviewX {W x y what} {
global overview
if {$what == "done"} {
$W config -cursor {}
focus .c
return
}
if {![info exists overview(r)]} return
if {![info exists overview(v)]} return
focus $W
$W config -cursor dotbox
set px [$W canvasx $x] ;# Convert into canvas coords
set py [$W canvasy $y]
foreach {rl rt rr rb} $overview(r) break ;# Region box
foreach {vl vt vr vb} $overview(v) break ;# View box
set vw2 [expr {($vr - $vl) / 2.0}] ;# View width & height
set vh2 [expr {($vb - $vt) / 2.0}]
# Now constrain box to be w/i the region box
set nl [expr {$px - $vw2}]
set nr [expr {$px + $vw2}]
if {$nl < $rl} {
set d [expr {$nl - $rl}]
set nl [expr {$nl - $d}]
set nr [expr {$nr - $d}]
} elseif {$nr > $rr} {
set d [expr {$nr - $rr}]
set nl [expr {$nl - $d}]
set nr [expr {$nr - $d}]
}
set nt [expr {$py - $vh2}]
set nb [expr {$py + $vh2}]
if {$nt < $rt} {
set d [expr {$nt - $rt}]
set nt [expr {$nt - $d}]
set nb [expr {$nb - $d}]
} elseif {$nb > $rb} {
set d [expr {$nb - $rb}]
set nt [expr {$nt - $d}]
set nb [expr {$nb - $d}]
}
# Create the new view box
$W delete view
$W create rectangle $nl $nt $nr $nb -outline blue \
-tag view -width 2
set overview(v2) [list $nl $nt $nr $nb]
OverviewLink $nl $nt
}
##+##########################################################################
#
# OverviewLink -- scrolls the main canvas so that it matches the
# overview view box
#
proc OverviewLink {vl vt} {
global overview
foreach {rl rt rr rb} $overview(r) break
set rw [expr {double($rr - $rl)}]
set rh [expr {double($rb - $rt)}]
set l [expr { ($vl - $rl) / $rw}]
set t [expr { ($vt - $rt) / $rh}]
.c yview moveto $t
.c xview moveto $l
}
##+##########################################################################
#
# Expand -- grows a box by delta amount
#
proc Expand {xy delta} {
foreach {a b c d} $xy break
incr a -$delta ; incr b -$delta ; incr c $delta ; incr d $delta
return [list $a $b $c $d]
}
##+##########################################################################
#
# canvas2pos -- converts a canvas position into lat/long
#
proc canvas2pos {W X Y} {
global mapInfo delta mag mln UI
if {$W != ".c"} return
focus .c
set x [$W canvasx $X]
set y [$W canvasy $Y]
# Point (0, 0) is at (lat,long) = $mapInfo(0,0)
foreach {lat long} $mapInfo(0,0) break
set UI(mlt) [expr {$lat + $y * $delta(dy) / 400}]
set UI(mln) [expr {$long + $x * $delta(dx) / 400}]
}
##+##########################################################################
#
# GetNewMap -- remapping with a new root map based on the form values.
#
proc GetNewMap {how} {
global UI mag
if {$how == 2} { ;# By address
set UI(addr) [string trim $UI(addr)]
set UI(csz) [string trim $UI(csz)]
if {$UI(csz) == ""} return
Init
set url "http://maps.yahoo.com/py/maps.py?"
append url [::http::formatQuery addr $UI(addr) csz $UI(csz)]
INFO "fetching $url"
#set token [::http::geturl $url]
set token [MyGetURL $url]
if {$token == {}} return
set data [::http::data $token]
::http::cleanup $token
set n1 [regexp {slt=([-0-9.]+)} $data => slt]
set n2 [regexp {sln=([-0-9.]+)} $data => sln]
if {! $n1 || ! $n2} {ERROR "can't get map for $UI(addr) / $UI(csz)"}
foreach {UI(mln) UI(mlt)} [list $sln $slt] break
set mag $UI(zoom2)
} else {
set UI(mln) [string trim $UI(mln) " 0"]
set UI(mlt) [string trim $UI(mlt) " 0"]
if {$UI(mln) == "" || $UI(mlt) == ""} return
set mag $UI(zoom1)
Init
}
set UI(zoom1) [set UI(zoom2) $mag]
GetRootMap $UI(mlt) $UI(mln)
}
proc About {} {
set msg "$::pname\n\nby Keith Vetter\nJanuary 2003"
tk_messageBox -title "About $::pname" -message $msg -icon info
}
##+##########################################################################
#############################################################################
#############################################################################
Init
DoDisplay
set mag 9
set UI(zoom1) $mag
set UI(zoom2) $mag
if {$argc == 2} {
foreach {UI(mlt) UI(mln)} $argv break
} else {
set UI(mlt) 38.8987
set UI(mln) -77.03645
set UI(addr) "1600 Pennsylvania Ave"
set UI(csz) "Washington, DC"
}
GetRootMap $UI(mlt) $UI(mln) ;# Center of our mapuniquename 2013aug19For readers who do not have the time/facilities/whatever to setup this code and execute it, here is an image that shows the GUI created by this code.

