#!/bin/sh # The next line is executed by /bin/sh, but not tcl \ exec wish $0 ${1+"$@"} ##+########################################################################## # # TkTopoMap # # Simple front end to Microsoft's terraserver which servers up topo # maps and images. Has to convert from latitude and longitude into # Universal Transverse Mercator coordinates. The conversion is performed # using the WGS-84 datum. # by Keith Vetter # # Revisions: # KPV Aug 20, 2002 - initial revision # ##+########################################################################## package require Tk if {[catch {package require Img}]} { wm withdraw . tk_messageBox -icon error -title TkTopoMap \ -message "TkTopoMap\n\nError: this program requires the Img package." exit } package require http 2.0 proc Init {} { global env state set state(latitude) "" ;# Value we'll map set state(longitude) "" ;# Value we'll map set state(utm) "" ;# utm of lat/long set state(vscale) "16 m/p" ;# Resolution of image set state(vtheme) Topo ;# Type of image set state(fetching) 0 # Terraserver chunks images so we must adjust utm by this value array set state { mult,10 200 mult,11 400 mult,12 800 mult,13 1600 mult,14 3200 mult,15 6400 mult,16 12800 mult,17 25600 mult,18 51200 mult,19 102400 } # Map resolutions available from the server set state(resolutions) [list "1 m/p" "2 m/p" "4 m/p" \ "8 m/p" "16 m/p" "32 m/p" \ "64 m/p" "128 m/p" \ "256 m/p" "512 m/p"] set s 9 foreach r $state(resolutions) { set state(res,$r) [incr s] ;# String => scale set state(i,res,$s) $r ;# Scale => string } set state(themes) [list Topo Image] ;# Type of images available set state(theme,Image) 1 set state(theme,Topo) 2 set state(url) "http://terraserver-usa.com/tile.ashx" append state(url) "?T=\$TTHEME&S=\$SSCALE&X=\$XX&Y=\$YY&Z=\$ZZONE&W=0" if {[info exists env(temp)]} { ;# We put image into here set state(tempfile) [file join $env(temp) get_topo.temp] } elseif {[info exists env(tmp)]} { set state(tempfile) [file join $env(tmp) get_topo.temp] } elseif {[file isdirectory /tmp]} { set state(tempfile) [file join /tmp get_topo.temp] } else { set state(tempfile) get_topo.temp } trace variable state w DoTrace } ##+########################################################################## # # Display # # Sets up our simple dialog # proc Display {} { global state wm title . TkTopoMap label .l frame .f0 frame .f1a -relief sunken -bd 2 frame .f1b -relief sunken -bd 2 frame .f2 -relief sunken -bd 2 frame .f2.a ; frame .f2.b frame .f3 -relief sunken -bd 2 pack .f0 -side top -fill x -ipady 3 -ipadx 3 pack .f3 .f2 -side bottom -fill x -ipady 3 -ipadx 3 pack .f2.a .f2.b -side left -fill both -expand 1 pack .f1a .f1b -side left -fill both -ipady 3 -ipadx 3 label .title -text TkTopoMap \ -font [eval font create [font actual [.l cget -font]] -size 18] label .title2 -text "by Keith Vetter" \ -font [eval font create [font actual [.l cget -font]] -size 10] button .b -text "About TkTopoMap" -command about -font [.title2 cget -font] pack .title -in .f0 -side top pack .b -in .f0 -expand 1 -side left -pady 5 label .latlong -text "Latitude/Longitude" \ -font [eval font create [font actual [.l cget -font]] -size 10] label .lat -text Latitude label .long -text Longitude entry .elat -width 15 -justify center -textvariable state(latitude) entry .elong -width 15 -justify center -textvariable state(longitude) label .spacer -text "" button .go1a -text " GetMap " -command GoLatLong grid .latlong - -in .f1a grid .lat .elat -sticky ew -in .f1a grid .long .elong -sticky ew -in .f1a grid .spacer - -sticky ew -in .f1a grid .go1a - -in .f1a -pady 10 label .utm -text "UTM" \ -font [eval font create [font actual [.l cget -font]] -size 10] label .northing -text "Northing" entry .enorthing -width 15 -justify center -textvariable state(northing) label .easting -text Easting entry .eeasting -width 15 -justify center -textvariable state(easting) label .zone -text Zone entry .ezone -width 15 -justify center -textvariable state(zone) button .go1b -text " GetMap " -command GoUTM grid .utm - -in .f1b grid .northing .enorthing -sticky ew -in .f1b grid .easting .eeasting -sticky ew -in .f1b grid .zone .ezone -sticky ew -in .f1b grid .go1b - -in .f1b -pady 10 label .sc -text "Resolution" eval tk_optionMenu .esc state(vscale) $state(resolutions) .esc config -width 8 label .theme -text Theme eval tk_optionMenu .etheme state(vtheme) $state(themes) .etheme config -width 8 pack .sc .esc -side left -in .f2.a pack .theme .etheme -side left -in .f2.b label .terra -text "TerraServer:" -justify right label .eterra -textvariable state(terra) -width 30 -relief sunken canvas .c -bd 1 -relief ridge -width 200 -height 200 .c create text 100 100 -anchor c -text "no image" -tag what image create photo map .c create image 0 0 -anchor nw -image map grid .terra .eterra -sticky ew -in .f3 grid .c - -in .f3 } ##+########################################################################## # # DoTrace # # Traces the state variable so we know when to enable certain buttons. # proc DoTrace {arg1 arg2 op} { global state if {$state(fetching)} { ;# Always off while fetching .go1a config -state disabled .go1b config -state disabled return } set new disabled ;# Check the lat/long button if {$state(latitude) != "" && $state(longitude) != ""} { set new normal } .go1a config -state $new set new disabled ;# Check the utm button if {$state(northing) != "" && $state(easting) != "" && $state(zone) != ""} { set new normal } .go1b config -state $new } ##+########################################################################## # # GoUTM # # Handles getting map from UTM coordinates. # proc GoUTM {} { global state set emsg "" if {! [string is double $state(northing)]} { set emsg "Can't figure out northing: '$state(northing)'" } elseif {! [string is double $state(easting)]} { set emsg "Can't figure out easting: '$state(easting)'" } elseif {! [string is double $state(zone)]} { set emsg "Can't figure out zone: '$state(zone)'" } if {$emsg != ""} { tk_messageBox -icon error -message $emsg return } set state(latitude) "" set state(longitude) "" GetMap } ##+########################################################################## # # GoLatLong # # Handles getting map from latitude and longitude. # proc GoLatLong {} { global state # Extract the lat/long from the entry boxes set state(latitude) [string trim $state(latitude)] set lat $state(latitude) regsub -nocase {N *(.*)} $lat {\1} lat regsub -nocase {S *(.*)} $lat {-\1} lat if {[regexp {^[\d.]+$} $lat]} { ; } elseif {[regexp {^([\d.]+)\s+([\d.]+)\s+([\d.]+)$} $lat => a b c]} { set lat [expr {$a + $b/60.0 + $c/60.0/60.0}] } else { set emsg "Can't figure out $state(latitude)" tk_messageBox -icon error -message $emsg return } set state(longitude) [string trim $state(longitude)] set long $state(longitude) regsub -nocase {W *(.*)} $long {-\1} long regsub -nocase {E *(.*)} $long {\1} long if {[regexp {^-?[\d.]+$} $long]} { ; } elseif {[regexp {^(-?)([\d.]+)\s+([\d.]+)\s+([\d.]+)$} $long \ => west a b c]} { set long [expr {$a + $b/60.0 + $c/60.0/60.0}] if {$west != ""} { set long [expr {-1 * $long}]} } else { set emsg "Can't figure out $state(longitude)" tk_messageBox -icon error -message $emsg return } # Convert first to UTM coordinates set state(utm) [ll2utm $lat $long] foreach {state(northing) state(easting) state(zone)} $state(utm) break GetMap } ##+########################################################################## # # GetMap # # Fetches and displays the map for this utm from the terraserver. We # fetch the image straight into a temp file for efficiency. # proc GetMap {} { global state # Adjust scale for this image's theme set state(scale) $state(res,$state(vscale)) set state(theme) $state(theme,$state(vtheme)) if {$state(theme) == 2 && $state(scale) == 10} { set state(scale) 11 } if {$state(theme) == 1 && $state(scale) >= 17} { set state(scale) 16 } set state(vscale) $state(i,res,$state(scale)) catch {image delete map} .c itemconfig what -text "fetching image" set state(fetching) 1 # Chunk utm for set mult $state(mult,$state(scale)) set XX [expr {int($state(easting) / $mult)}] set YY [expr {int($state(northing) / $mult)}] set SSCALE $state(scale) set TTHEME $state(theme) set ZZONE $state(zone) set state(xurl) [subst $state(url)] set state(terra) "X=$XX Y=$YY Z=$ZZONE MULT=$mult" after 1 GetMap2 } ##+########################################################################## # # GetMap2 # # This gets the actual map. It's a separate procedure so we can call it # as an after task. # proc GetMap2 {} { global state ;# Fetch the image from terraserver into our tempfile set f [open $state(tempfile) w] set token [::http::geturl $state(xurl) -channel $f] ::http::wait $token close $f ;# Display the image image create photo map -file $state(tempfile) file delete $state(tempfile) set state(fetching) 0 } ##+########################################################################## # # ll2utm # # Convert latitude and longitude into Universal Transverse Mercator (UTM) # coordinates. Lots of fun math which I got off the web. # proc ll2utm {latitude longitude} { set PI [expr {atan(1) * 4}] set K0 0.9996 # WGS-84 set er 6378137 ;# EquatorialRadius set es2 0.00669438 ;# EccentricitySquared set es4 [expr {$es2 * $es2}] set es6 [expr {$es2 * $es2 * $es2}] # Must be in the range -180 <= long < 180 while {$longitude < -180} { set longitude [expr {$longitude + 360}]} while {$longitude >= 180} { set longitude [expr {$longitude - 360}]} # Now convert set lat_rad [expr {$latitude * $PI / 180.0}] set long_rad [expr {$longitude * $PI / 180.0}] set zone [expr {int(($longitude + 180) / 6) + 1}] if {$latitude >= 56.0 && $latitude < 64.0 && $longitude >= 3.0 && $longitude < 12.0} { $zone = 32 } if { $latitude >= 72.0 && $latitude < 84.0 } { if { $longitude >= 0.0 && $longitude < 9.0 } {$zone = 31;} if { $longitude >= 9.0 && $longitude < 21.0 } {$zone = 33;} if { $longitude >= 21.0 && $longitude < 33.0 } {$zone = 35;} if { $longitude >= 33.0 && $longitude < 42.0 } {$zone = 37;} } # +3 puts origin in middle of zone set long_origin [expr {( $zone - 1 ) * 6 - 180 + 3}] set long_origin_rad [expr {$long_origin * $PI / 180.0}] set eccPrimeSquared [expr {$es2 / ( 1.0 - $es2 )}] set N [expr {$er / sqrt( 1.0 - $es2 * sin( $lat_rad ) * sin( $lat_rad ) )}] set T [expr {tan( $lat_rad ) * tan( $lat_rad )}] set C [expr {$eccPrimeSquared * cos( $lat_rad ) * cos( $lat_rad )}] set A [expr {cos( $lat_rad ) * ( $long_rad - $long_origin_rad )}] set M [expr { $er * ( \ (1.0 - $es2 / 4 - 3 * $es4 / 64 - 5 * $es6 / 256) * $lat_rad \ - (3 * $es2 / 8 + 3 * $es4 / 32 + 45 * $es6 / 1024) * sin(2 * $lat_rad) \ + (15 * $es4 / 256 + 45 * $es6 / 1024 ) * sin(4 * $lat_rad) \ - (35 * $es6 / 3072 ) * sin(6 * $lat_rad) \ )}] set easting [expr {$K0 * $N * ( $A + ( 1 - $T + $C ) * $A * $A * $A / 6 \ + ( 5 - 18 * $T + $T * $T + 72 * $C - 58 * $eccPrimeSquared ) * \ $A * $A * $A * $A * $A / 120 ) + 500000.0}] set northing [expr {$K0 * ( $M + $N * tan( $lat_rad ) * \ ( $A * $A / 2 + ( 5 - $T + 9 * $C + 4 * $C * $C ) * \ $A * $A * $A * $A / 24 + ( 61 - 58 * $T + $T * $T + \ 600 * $C - 330 * $eccPrimeSquared ) * \ $A * $A * $A * $A * $A * $A / 720 ) )}] if {$latitude < 0} { ;# 1e7 meter offset for southern hemisphere set northing [expr {$northing + 10000000.0}] } set northing [expr {int($northing)}] set easting [expr {int($easting)}] return [list $northing $easting $zone] } ##+########################################################################## # # about # # Your basic about box. # proc about {} { set msg "" append msg "TkTopoMap\nby Keith Vetter\n\n" append msg "TkTopoMap is a simple front end for TerraServer, Microsoft's\n" append msg "database of USGS aerial images and topographic maps.\n" append msg "This data is free to everyone.\n\n" append msg "Fetching images from TerraServer is straightforward except\n" append msg "for the conversion from latitude and longitude into\n" append msg "Universal Transverse Mercator (UTM) coordinates. The\n" append msg "conversion is done using the WGS-84 datum.\n\n" append msg "For more details see http://terraserver.homeadvisor.msn.com." tk_messageBox -message $msg -title TkTopoMap } Init Display set state(latitude) 40.069 set state(longitude) -82.517 set state(latitude) "37 48 9" set state(longitude) "-122 13 29" if {0} { ;# Beale Airforce base set state(latitude) 32.15112 set state(longitude) -110.83032 set state(vscale) "4 m/p" set state(vtheme) Image }
uniquename 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 presented by this code.Even though I do not have the 'Img' and 'http' packages installed, I commented out the statements at the top of the script that check for those packages, so that the GUI would come up.I do not know if this map server still works, but even if it does not, a Tcler could probably adapt this code to retrieve maps from another map server.