[Keith Vetter] 2005-06-15

'''Can you find your house?'''

As part of Google Maps, Google recently acquired Keyhole and
all its satellite images. This applet lets you view individual
images at various locations and zoom levels.

The url to a given images is a quad-tree descent path. Put in
English, it's like this:

   1. Start with the whole world: http://kh.google.com/kh?v=1&t=t
   1. Select a quadrant, appending ''q'', ''r'', ''s'' or ''t'' for top left, top right, bottom right, bottom left.
   1. Repeat

My house is at: http://kh.google.com/kh?v=1&t=tqstqqrtstrqrqq

The 2nd level map is weird--it's swapped vertically and actually represents
the entire top or bottom half.

The terms ''equator'' and ''meridian'' are technically inaccurate but 
I couldn't think of better ones.

----

 #!/usr/bin/env tclsh
 # Restart with tcl: -*- mode: tcl; tab-width: 8; -*-
  
 ##+##########################################################################
 #
 # MyHouse.tcl - gets satellite images from Google at deeper resolution
 # by Keith Vetter, June 15, 2005
 #
 # See About for an explanation. NB. the second stage map is weird
 #
 
 package require Tk
 package require http
 package require Img
 
 array set S {title "My House" quad "t" west -180 east 180 north 90 south -90}
 set S(url) "http://kh.google.com/kh?v=1&t="
 array set D {0 {south east q} 1 {south west r} 2 {north east t} 3 {north west s}}
 
 proc DoDisplay {} {
    wm title . $::S(title)
    pack [frame .ctrl -relief ridge -bd 2 -padx 5 -pady 5] \
        -side right -fill both -ipady 5
    pack [frame .top -relief raised -bd 2] -side top -fill x
    pack [frame .screen -bd 2 -relief raised] -side top -fill both -expand 1
    
    canvas .c -height 256 -width 256 -bd 0 -highlightthickness 0
    label .msg -textvariable ::S(quad) -bd 2 -bg white -relief ridge
    pack .msg -in .screen -side bottom -fill both
    pack .c   -in .screen -side top    -fill both -expand 1
 
    catch {image delete ::img::map}
    image create photo ::img::map ;#-width 256 -height 256
    .c create image 0 0 -anchor nw -image ::img::map
    .c create line 0 128 256 128 -fill white -dash 1
    .c create line 128 0 128 256 -fill white -dash 1
 
    bind .c <Button-1> [list Click %x %y]
    bind all <Key-F2> {console show}
    DoCtrlFrame
    .msg config -font [.reset cget -font]
 }
 proc DoCtrlFrame {} {
    set row -1
    foreach v {north south east west equator meridian} {
        if {[incr row] == 4} {incr row}
        label .$v -text "[string totitle $v]:" -anchor e
        label .v$v -textvariable S(p,$v) -bd 2 -relief sunken
        grid .$v .v$v -in .ctrl -row $row -sticky ew
    }
    button .reset -text Reset -command Reset -bd 4
    .reset configure -font "[font actual [.reset cget -font]] -weight bold"
    option add *Button.font [.reset cget -font]
    button .undo -text Undo -command Undo -bd 4
    button .about -text About -command About
 
    grid rowconfigure .ctrl 4 -minsize 20    
    grid rowconfigure .ctrl 50 -weight 1
    grid .undo -   -in .ctrl -row 100 -sticky ew
    grid .reset -  -in .ctrl -row 101 -sticky ew
    grid rowconfigure .ctrl 102 -minsize 10
    grid .about -  -in .ctrl -row 103 -sticky ew
    PrettyLats
 }
 proc Click {x y {noGUI 0}} {
    foreach {lat lon quad} $::D([expr {($x > 128) + 2*($y > 128)}]) break
    
    set ::S($lon) [expr {($::S(east) + $::S(west))/2.0}]
    if {[string length $::S(quad)] == 2} {
        set quad [string map {q t t q r s s r} $quad]
    }
    if {[string length $::S(quad)] != 1} {
        set ::S($lat) [expr {($::S(north) + $::S(south))/2.0}]
    }
    append ::S(quad) $quad
    if {! $noGUI} GetImage
 }
 proc GetImage {} {
    . config -cursor watch
    set url "$::S(url)$::S(quad)"
    set token [::http::geturl $url]
    ::http::wait $token
    set data [::http::data $token]; list
    ::http::cleanup $token
    ::img::map config -data $data
    if {[string length $::S(quad)] == 2} SwapHalves
    PrettyLats
    . config -cursor {}
    .undo config -state [expr {$::S(quad) eq "t" ? "disabled" : "normal"}]
 }
 proc PrettyLats {} {
    set ::S(meridian) [expr {($::S(east) + $::S(west))/2.0}]
    set ::S(equator) [expr {($::S(north) + $::S(south))/2.0}]
 
    foreach v {north south east west meridian equator} {
        set ::S(p,$v) [PrettyLat $::S($v)]
    }
 }
 proc PrettyLat {lat} {
    set deg [expr {int($lat)}]
    set frac [expr {($lat - $deg)*60}]
    set min [expr {int($frac)}]
    set sec [expr {($frac - $min)*60}]
    return [format "% 3d\xB0 %02d' %.2g\x22" $deg $min $sec]
 }
 proc Reset {} {
    array set ::S {quad "t" west -180 east 180 north 90 south -90}
    GetImage
 }
 proc SwapHalves {} {
    image create photo ::img::tmp -width 256 -height 256
    ::img::tmp copy ::img::map -from 0 0 256 128 -to 0 128
    ::img::tmp copy ::img::map -from 0 128 256 256 -to 0 0
    ::img::map copy ::img::tmp
    image delete ::img::tmp
 }
 proc Undo {} {
    array set Q {q {0 0} r {200 0} s {200 200} t {0 200}}
    set quads [split [string range $::S(quad) 1 end-1] ""]
    array set ::S {quad "t" west -180 east 180 north 90 south -90}
 
    set cnt -1
    foreach quad $quads {
        incr cnt
        set q $quad
        if {$cnt == 1} {
            set quad [string map {q t t q r s s r} $quad]
        }
        foreach {x y} $Q($quad) break
        Click $x $y 1
        
    }
    GetImage
 }
 proc where {wlat wlon} {
    global S
 
    set top "top"
    if {$wlat < $S(equator)} { set top "bottom"}
    set left "right"
    if {$wlon < $S(meridian)} {set left "left"}
    set where "$top $left"
    puts $where
    return $where
 }
 proc About {} {
    set msg "$::S(title)\nby Keith Vetter, June 15, 2005\n\n"
    append msg "Can you find your house?\n\n"
    append msg "This applet lets you view satellite images from\n"
    append msg "Google's recently Keyhole imagery data set.\n\n"
    append msg "The url for an actual image represents a quad-tree\n"
    append msg "descent path. Put in English, it's like this:\n"
    append msg "  o start with the whole world:\n"
    append msg "     http://kh.google.com/kh?v=1&t=t\n"
    append msg "  o select a quadrant, adding q, r, s or t to the URL\n"
    append msg "     for top left, top right, bottom right, bottom left\n"
    append msg "  o repeat\n\n"
    append msg "My house is at:\n"
    append msg "      http://kh.google.com/kh?v=1&t=tqstqqrtstrqrqq"
 
    tk_messageBox -title "About $::S(title)" -message $msg
 }
 
 DoDisplay
 Reset
 update
 wm geom . [wm geom .]
 
 return

----
[RS]: Very cool! A pity that they don't have detail maps for my house, but at least you can see Lake Constance on http://kh.google.com/kh?v=1&t=trtqttssq (top right) :)
----
[LV] ACK!  I tried the above, but after about 5 or 6 selections, I was no longer able to
determine where I was on the map, so as to better select the quandrant....
----
''[escargo] 17 Jun 2005'' - I had an interesting problem because the Twin Cities is right near the 45th parallel.  It's easy to get on
the wrong side of the quadrent.  It might be nice if the limits that were shown also included the Lat/Lon of the center of the cross.
Also I was able to determine better where to zoom based on the Lat/Lon of my ZIP code, which I found by using this site:
[http://www.zipinfo.com/search/zipcode.htm].  I was able to choose based on the ranges shown in the entry fields.

[LV] Wouldn't it be nice to tie that zip together with the program, so that someone could
type in either their zip code or lat./long. and get the full home URL?

[escargo] I guess because most of the world doesn't have ZIP codes, I think allowing the entry of a Lat/Lon and then
let some algorithm step from the whole world to a small box that contained the supplied values might be interesting.
Sort of a "powers of 2" zoom (instead of "Powers of Ten."
----
[Category Toys]