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

http://kh.google.com/kh?v=1&t=tqstqqrtstrqrqq

http://kh.google.com/kh?v=1&t=trtqttssq

 ##+##########################################################################
 #
 # 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
    speed 800 url "http://kh.google.com/kh?v=1&t="
    latitude,deg 38 latitude,min 53 latitude,sec 21.96
    longitude,deg -77 longitude,min 2 longitude,sec 6.84
 }
 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 .buttons -relief ridge -bd 2 -padx 5 -pady 5] \
        -side bottom -fill both -ipady 5
    pack [frame .ctrl -relief ridge -bd 2 -padx 5 -pady 5] \
        -side right -fill both -ipady 5 -expand 1
    pack [frame .top -relief raised -bd 2] -side top -fill x
    pack [frame .screen -bd 2 -relief raised] -side top -fill both

    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
    .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
    .c create rect 0 0 128 128     -outline {} -tag {quad tl}
    .c create rect 128 0 256 128   -outline {} -tag {quad tr}
    .c create rect 0 128 128 256   -outline {} -tag {quad bl}
    .c create rect 128 128 256 256 -outline {} -tag {quad br}

    bind .c <Button-1> [list Click %x %y]
    bind all <Button-3> WhichQuad
    bind all <Key-F2> {console show}
    DoCtrlFrame
    .msg config -font [.undo cget -font]
 }
 proc DoCtrlFrame {} {
    button .undo -text Undo -command Undo
    .undo configure -font "[font actual [.undo cget -font]] -weight bold"
    option add *Button.font [.undo cget -font]
    option add *Scale.font [.undo cget -font]
    button .reset -text Reset -command Reset
    button .slideshow -text "Slide Show" -command DoSlideShow
    button .about -text About -command About

    frame .where
    set row -1
    foreach v {north equator south east meridian west} {
        if {[incr row] == 3} {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 .where -sticky ew -row $row
    }
    .equator config -text "Center"
    .meridian config -text "Center"

    grid rowconfigure .where 3 -minsize 10
    grid columnconfigure .where 1 -weight 1

    labelframe .ffind -text "Find Location" -font [.undo cget -font]
    pack .where -in .ctrl -side top -expand 1 -fill x
    pack .ffind -in .ctrl -side bottom -expand 1 -fill x
    grid columnconfigure .ffind {1 2 3} -weight 1
    foreach v {latitude longitude} {
        label .$v -text "[string totitle $v]:" -anchor e
        entry .deg$v -textvariable S($v,deg) -width 3
        entry .min$v -textvariable S($v,min) -width 3
        entry .sec$v -textvariable S($v,sec) -width 6
        grid .$v .deg$v .min$v .sec$v -in .ffind -sticky ew -padx 2
    }
    button .find -text "Which Quad" -command WhichQuad
    grid .find - - - -in .ffind -padx 10 -pady 10 -sticky ew

    pack .undo .reset .slideshow .about -in .buttons -side left -expand 1
    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} {;# Level 2 porkchop
        set quad [string map {q t t q r s s r} $quad]
    }
    if {[string length $::S(quad)] != 1} { ;# Level 2 porkchop
        set ::S($lat) [expr {($::S(north) + $::S(south))/2.0}]
    }
    append ::S(quad) $quad
    if {! $noGUI} GetImage
 }
 proc GetImage {} {
    . config -cursor watch
    .c itemconfig quad -fill {} -stipple {}
    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 ;# Level 2 porkchop

    SlideShowSave

    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 {abs(int($frac))}]
    set sec [expr {abs(($frac - int($frac))*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 {} {  ;# Level 2 porkchop
    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} {                        ;# Level 2 porkchop
            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 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
 }

 proc WhichQuad {} {
    .c itemconfig quad -fill {} -stipple {}
    set lat [ReadLat latitude]
    set lon [ReadLat longitude]
    while {1} {
        if {! [string is double $lat] || abs($lat) > 90} break
        if {! [string is double $lon] || abs($lon) > 180} break
        set tag [where $lat $lon]
        if {$tag eq ""} break
        .c itemconfig $tag -fill white -stipple gray12
        return
    }
    .ffind config -bg red
    .find config -bg red
    update
    after 300
    .ffind config -bg [lindex [.ffind config -bg] 3]
    .find config -bg [lindex [.find config -bg] 3]
 }
 proc where {wlat wlon} {
    global S

    if {$wlat > $S(north) || $wlat < $S(south)} { return }
    if {$wlon > $S(east) || $wlon < $S(west)} { return }
    set top [expr {$wlat >= $S(equator) ? "t" : "b"}]
    set left [expr {$wlon >= $S(meridian) ? "r" : "l"}]
    return "$top$left"
 }
 proc ReadLat {who} {
    global S

    foreach v {deg min sec} {
        set val [string map {" " ""} $S($who,$v)]
        set val [string map -nocase {N "" S - E "" W -} $val]
        if {$val eq ""} {set val 0}
        if {! [string is double -strict $val]} {return "bad"}
        set $v $val
    }
    if {$deg < 0} {
        set ll [expr {$deg - $min/60.0 - $sec/60.0/60.0}]
    } else {
        set ll [expr {$deg + $min/60.0 + $sec/60.0/60.0}]
    }
    return $ll
 }

 proc SlideShowSave {} {
    set len [string length $::S(quad)]
    set iname ::img::map$len
    if {[lsearch [image names] $iname] == -1} {
        image create photo $iname
    }
    $iname copy ::img::map
 }
 proc DisplaySlideShow {} {
    set W .slide
    if {[winfo exists $W]} return

    toplevel $W
    wm title $W "$::S(title) Slide Show"
    wm transient $W .
    label $W.l -image ::img::map1
    pack $W.l

    scale $W.speed -orient h -label Speed -showvalue 0 -bd 2 -relief ridge \
        -variable S(speed) -from 2000 -to 10 -length 75
    button $W.in -text "Zoom In" -command [list DoSlideShow in]
    button $W.out -text "Zoom Out" -command [list DoSlideShow out]
    pack $W.speed $W.in $W.out -side left -expand 1

    set y [expr {3 + [winfo y .]}]               ;# Top of main window
    set x [expr {15 + [winfo x .] + [winfo width .]}] ;# Right side

    if {$x + [winfo reqwidth $W] > [winfo screenwidth .]} {
        wm geom $W -10+$y        ;# Nope, put on right edge
    } else {
        wm geom $W +$x+$y
    }
 }
 proc DoSlideShow {{dir in}} {
    DisplaySlideShow
    .slide.in config -state disabled
    .slide.out config -state disabled
    set max [string length $::S(quad)]
    if {$dir eq "in"} {
        StepSlideShow 1 $max 1
    } else {
        StepSlideShow $max $max -1
    }
 }
 proc StepSlideShow {step max dir} {
    .slide.l config -image ::img::map$step
    incr step $dir
    if {$step <= $max && $step > 0} {
        after $::S(speed) [list StepSlideShow $step $max $dir]
    } else {
        .slide.in config -state normal
        .slide.out config -state normal
    }
 }

 DoDisplay
 Reset
 update
 wm geom . [wm geom .]

 return

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References