Overall summary, as of October 2004: TkMapper is neat stuff--when it works. Mostly it doesn't work, because it depends on extraction of data from Yahoo, and Yahoo sees it as in its best interest to foil such "Web scraping". In principle, we could continue to counter their (monthly? weekly?) efforts by recoding "by hand" the details of the Yahoo interface--or even to work with Yahoo to legitimize our access! It's probably not worth our collective efforts.
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 KPV
escargo 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 map
uniquename 2013aug19
For 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.
I do not have the 'http' package installed, so I commented out the check for that package at the top of this code. On starting up, this GUI tries to go to the Yahoo URL. Even if I had the 'http' package installed, the Yahoo URL is no longer accessible by this code, as indicated by the comments above.
The interpreter fails to execute the http code and shows a Tk traceback error window. So I dummied out the 'MyGetURL' proc, so that I could display this GUI.
Apparently, this GUI is meant to replace the TkMapper title in the big canvas with data retrieved from the Yahoo site. There may be Tclers out there who can repurpose this GUI --- hence I think it is worthwhile providing this image.