[Keith Vetter] 2010-07-05 : Have you ever looked at all
the modules available in Tcllib and wondered what half 
of them do? Most have a man page but usually it
assumes you already know what the module does and doesn't
really explain anything.

How about the module '''map::slippy.''' The man page
description is ''This package provides a number of
methods doing things needed by all types of
slippy-based map packages.''
I've always been intrigued by maps and have written
several short programs that interact with various
internet map servers, such as [TkTopoMap], [TkMapper]
(broken), and [My House] (broken), so I got interested
in understanding this further.

Slippy Map is a web front end
[http://www.openstreetmap.org/index.html] to the
OpenStreet Map project
[http://wiki.openstreetmap.org/wiki/Slippy_map_tilenames]
[http://wiki.openstreetmap.org/wiki/Slippy_Map]
[http://en.wikipedia.org/wiki/OpenLayers], which shows
public domain maps. The [tcllib] '''map::slippy''' module
provides routines to map between a latitude, longitude
location to map tile and vice versa. The
'''map::slippy::fetcher''' module provides routines for
downloading slippy map tiles. The '''map::slippy::cache'''
manages a local file based cache of map tiles.

Putting that all together, I put together a small program that
displays a 3x3 grid of map tiles from the OpenStreetMap project
It lets you select any location, choose between the different 
map sources and zoom levels. Once the map is displayed, you can
scroll in any of the 8 cardinal directions.
----
[http://wiki.tcl.tk/_repo/wiki_images/slippy_demo.png]
----

======
##+##########################################################################
#
# slippy.tcl -- demo of the slippy tcllib package
# by Keith Vetter, July 2010
#
# Slippy is a partial front end to the OpenStreet Map project
# http://wiki.openstreetmap.org/wiki/Slippy_map_tilenames#Tiles
#
##+##########################################################################
#############################################################################

package require Tk
package require Img
package require http
package require map::slippy
catch {package require -exact map::slippy::fetcher 0.2} ;# Preferred version
package require map::slippy::fetcher
package require map::slippy::cache
catch {package require pixane} ;# I need this to get Img 1.4 working (???why???)

lassign {37.77 -122.43} S(lat) S(lon)
set V(map,schemes) {Mapnik Osmerander "Cycle Maps"}
set V(map,overlays) {MapLint}
set V(cacheDir) ""
catch {set V(cacheDir) [file join $env(tmp) slippy.cache]}

set S(zoom) 12
set S(lastZoom) -1
set S(scheme) [lindex $V(map,schemes) 0]
set S(lastScheme) ""
set S(loaded) 0
set S(pending) 0
set S(cached) 0
set S(grid) 0

# Urls for the various map types
set V(url,Mapnik) http://tile.openstreetmap.org
set V(url,Osmerander) http://tah.openstreetmap.org/Tiles/tile
set V(url,Cycle\ Maps) http://andy.sandbox.cloudmade.com/tiles/cycle
set V(url,Maplint) http://tah.openstreetmap.org/Tiles/maplint
set V(url,Google\ Terrain) http://mt0.google.com/vt/lyrs=t@125,r@129&hl=en&x=\${c}&y=\${r}&z=\${z}
set V(url,Google)          http://mt0.google.com/vt/lyrs=m@129&hl=en&x=\${c}&y=\${r}&z=\${z}
# Valid zoom ranges for various map types
set V(zoom,Mapnik) {0 18}
set V(zoom,Osmerander) {0 17}
set V(zoom,Cycle\ Maps) {2 12}
set V(zoom,Maplint) {12 16}
set V(zoom,Google\ Terrain) {0 15}
set V(zoom,Google) {0 22}

set D(upleft,center) {-1 -1}
set D(upleft,shift) {22 11 11 00 12 01 21 10}
set D(upleft,blank) {20 10 00 01 02}
set D(up,center) {-1 0}
set D(up,shift) {20 10 21 11 22 12 10 00 11 01 12 02}
set D(up,blank) {00 01 02}
set D(upright,center) {-1 1}
set D(upright,shift) {20 11 11 02 10 01 21 12}
set D(upright,blank) {00 01 02 12 22}
set D(right,center) {0 1}
set D(right,shift) {00 01 10 11 20 21 01 02 11 12 21 22}
set D(right,blank) {02 12 22}
set D(downright,center) {1 1}
set D(downright,shift) {00 11 11 22 10 21 01 12 }
set D(downright,blank) {02 12 22 21 20}
set D(down,center) {1 0}
set D(down,shift) {00 10 01 11 02 12 10 20 11 21 12 22}
set D(down,blank) {20 21 22}
set D(downleft,center) {1 -1}
set D(downleft,shift) {02 11 11 20 01 10 12 21}
set D(downleft,blank) {00 10 20 21 22}
set D(left,center) {0 -1}
set D(left,shift) {02 01 12 11 22 21 01 00 11 10 21 20}
set D(left,blank) {00 10 20}

array set cities {
    Anchorage {61.218333 -149.899167}
    Boston  {42.35 -71.066666}
    "Buenos Aires" {-34.603333 -58.381667}
    Chicago {41.8675 -87.6243}
    Denver {39.75 -104.98}
    "Granville, OH" {40.068088 -82.517967}
    Honolulu {21.31 -157.83}
    "Los Angeles" {34.054 -118.245}
    "Mexico City" {19.433333 -99.133333}
    "New York" {40.7563 -73.9865}
    "San Francisco" {37.77 -122.43}
    "Washington DC" {38.9136 -77.0132}
    Beijing {39.913889 116.391667}
    Johannesburg {-26.204444 28.045556}
    London {51.508056 -0.124722}
    Moscow {55.751667 37.617778}
    Paris {48.856667 2.350833}
    "Palo Alto" {37.429167 -122.138056}
    Sydney {-33.859972 151.211111}
    Tokyo {35.700556 139.715}
    "Woods Hole" {41.607219 -70.62011}
}

proc DoDisplay {} {
    global S
    
    wm title . "Slippy Map Demo"
    wm resizable . 0 0
    bind all <F2> {console show}
    
    set sz [expr {3*256}]
    canvas .c -highlightthickness 0 -bd 2 -relief solid -width $sz -height $sz \
        -bg #bbeeff
    .c yview moveto 0; .c xview moveto 0
    DoCanvas
    
    ::ttk::frame .ctrl
    ::ttk::frame .bottom -borderwidth 2 -relief ridge
    pack .ctrl -side top -fill x
    pack .c -side top -fill both -expand 1
    pack .bottom -side bottom -fill x
    
    ::ttk::menubutton .ctrl.city -menu .ctrl.city.menu -textvariable S(city)
    menu .ctrl.city.menu -tearoff 0
    foreach city [lsort -dictionary [array names ::cities]] {
        .ctrl.city.menu add radiobutton -label $city -variable S(city) \
            -command [list NewCity $city]
    }
    ::ttk::label .ctrl.llat -text "Latitude:"
    ::ttk::entry .ctrl.elat -textvariable S(lat)
    ::ttk::label .ctrl.llon -text "Longitude:" -justify right
    ::ttk::entry .ctrl.elon -textvariable S(lon)
    ::ttk::button .ctrl.go -image ::img::star -command ReMapIt

    ::ttk::checkbutton .ctrl.grid -text "Show grid" -variable S(grid) \
        -command ToggleGrid
    ::ttk::checkbutton .ctrl.cache -text "Use caching" -variable S(caching)
    ::ttk::button .ctrl.about -text About -command About

    ::ttk::label .bottom.msg -borderwidth 2 -relief solid -textvariable S(msg) \
        -anchor c
    ::ttk::frame .bottom.load -borderwidth 2 -relief solid
    ::ttk::label .bottom.load.loaded -text "Loaded:"
    ::ttk::label .bottom.load.vloaded -textvariable S(loaded) -width 4
    ::ttk::frame .bottom.pend -borderwidth 2 -relief solid
    ::ttk::label .bottom.pend.pending -text "Pending:"
    ::ttk::label .bottom.pend.vpending -textvariable S(pending) -width 4
    ::ttk::frame .bottom.cache -borderwidth 2 -relief solid
    ::ttk::label .bottom.cache.cached -text "Cached:"
    ::ttk::label .bottom.cache.vcached -textvariable S(cached) -width 4

    pack .bottom.load.loaded .bottom.load.vloaded -side left
    pack .bottom.pend.pending .bottom.pend.vpending -side left
    pack .bottom.cache.cached .bottom.cache.vcached -side left
    grid .bottom.msg .bottom.load .bottom.pend .bottom.cache -sticky news
    grid columnconfig .bottom 0 -weight 1
    
    grid .ctrl.city .ctrl.llat .ctrl.elat .ctrl.go x .ctrl.grid -sticky ew
    grid x          .ctrl.llon .ctrl.elon  x       x .ctrl.cache -sticky ew
    grid config .ctrl.go -sticky w
    grid .ctrl.about -row 0 -column 6 -pady {5 0}
    grid columnconfigure .ctrl 4 -weight 1
    .ctrl config -pad {.1i 5 .2i 5}
    update
}
proc DoCanvas {} {
    foreach d {upleft up upright right downright down downleft left} {
        ::ttk::button .c.$d -image ::bit::$d -command [list Shift $d]
    }
    
    place .c.upleft -x .1i -y .1i -anchor nw
    place .c.up -relx .5 -y .1i -anchor n
    place .c.upright -relx 1 -x -.1i -y .1i -anchor ne
    place .c.right -relx 1 -x -.1i -rely .5 -anchor e
    place .c.downright -relx 1 -x -.1i -rely 1 -y -.1i -anchor se
    place .c.down -relx .5 -rely 1 -y -.1i -anchor s
    place .c.downleft -x .1i -rely 1 -y -.1i -anchor sw
    place .c.left -x .1i -rely .5 -anchor w

    ::ttk::frame .c.zoom -relief solid -borderwidth 2
    ::ttk::button .c.zoom.plus -image ::bmp::plus -command {Zoom 1}
    ::ttk::label .c.zoom.zoom -textvariable S(zoom) -justify c -anchor c
    ::ttk::button .c.zoom.minus -image ::bmp::minus -command {Zoom -1}
    pack {*}[winfo child .c.zoom] -side top -fill x
    place .c.zoom -x .1i -y .5i -anchor nw 

    ::ttk::frame .c.scheme -relief solid -borderwidth 2
    ::ttk::menubutton .c.scheme.mb -menu .c.scheme.mb.menu -textvariable S(scheme)
    menu .c.scheme.mb.menu -tearoff 0
    foreach v $::V(map,schemes) {
        .c.scheme.mb.menu add radiobutton -label $v -variable S(scheme) \
            -command NewScheme
    }
    pack .c.scheme.mb -fill both
    place .c.scheme -relx 1 -x -.5i -y .1i -anchor ne
    
    set sz [expr {3*256}]
    foreach ab {00 01 02 10 11 12 20 21 22} {
        set iname "::map::$ab"
        image create photo $iname -width 256 -height 256
    }

    set sz [expr {3*256}]
    .c create line 256 0 256 $sz -dash 1 -tag grid
    .c create line 512 0 512 $sz -dash 1 -tag grid
    .c create line 0 256 $sz 256 -dash 1 -tag grid
    .c create line 0 512 $sz 512 -dash 1 -tag grid
    
    .c create image   0 0   -image ::map::00 -anchor nw
    .c create image 256 0   -image ::map::01 -anchor nw
    .c create image 512 0   -image ::map::02 -anchor nw
    .c create image   0 256 -image ::map::10 -anchor nw
    .c create image 256 256 -image ::map::11 -anchor nw
    .c create image 512 256 -image ::map::12 -anchor nw
    .c create image   0 512 -image ::map::20 -anchor nw
    .c create image 256 512 -image ::map::21 -anchor nw
    .c create image 512 512 -image ::map::22 -anchor nw
    
    .c create text 128 128 -tag {txt ::map::00} -anchor c -font {Times 32 bold} 
    .c create text 384 128 -tag {txt ::map::01} -anchor c -font {Times 32 bold}
    .c create text 640 128 -tag {txt ::map::02} -anchor c -font {Times 32 bold}
    .c create text 128 384 -tag {txt ::map::10} -anchor c -font {Times 32 bold}
    .c create text 384 384 -tag {txt ::map::11} -anchor c -font {Times 32 bold}
    .c create text 640 384 -tag {txt ::map::12} -anchor c -font {Times 32 bold}
    .c create text 128 640 -tag {txt ::map::20} -anchor c -font {Times 32 bold}
    .c create text 384 640 -tag {txt ::map::21} -anchor c -font {Times 32 bold}
    .c create text 640 640 -tag {txt ::map::22} -anchor c -font {Times 32 bold}
}
proc RegisterFetchers {} {
    global V

    foreach urlScheme [array names V url,*] {
        lassign [split $urlScheme ,] . scheme
        set scheme2 [string map {{ } {}} $scheme]
        
        catch {rename $scheme2 {}}
        set level [expr {1 + [lindex $V(zoom,$scheme) 1]}]
        set level 99 ;# We'll validate ourselves instead
        set V(fetcher,$scheme) [::map::slippy::fetcher $scheme2 $level \
                                    $V(url,$scheme)]
        if {$V(cacheDir) ne ""} {
            set cacherName "c$scheme2"
            catch {rename $cacherName {}}
            set cacheDir [file join $V(cacheDir) $scheme2]
            file mkdir $cacheDir
        
            set V(cacher,$scheme) \
                [::map::slippy::cache $cacherName $cacheDir $V(fetcher,$scheme)]
        }
    }
    if {[package present map::slippy::fetcher] eq "0.2"} {
        set urlOf [info body map::slippy::fetcher::urlOf]
        if {[string first "subst" $urlOf] > -1} {
            lappend V(map,schemes) "Google" "Google Terrain"
        }
    }
}
proc NewCity {which} {
    global cities S
    if {! [info exists cities($which)]} return
    lassign $cities($which) S(lat) S(lon)
    ReMapIt
}
proc GetCenterTile {} {
    global S
    set geo [list $S(zoom) $S(lat) $S(lon)]
    set tile [::map::slippy geo 2tile $geo]
    PrettyLat
    return $tile
}
proc ReMapIt {} { set ::S(lastZoom) -1; MapIt}
proc MapIt {} {
    global S

    if {$S(lastZoom) == $S(zoom) && $S(lastScheme) eq $S(scheme)} return
    if {! [IsLegal]} return

    set center [GetCenterTile]
    lassign $center zoom crow ccol

    EraseMaps
    TitleWindow    

    set S(center) [list $crow $ccol]
    foreach {drow dcol} {-1 -1 -1 0 -1 1 0 -1 0 0 0 1 1 -1 1 0 1 1} {
        set row [expr {$crow + $drow}]
        set col [expr {$ccol + $dcol}]
        set iname "::map::[expr {$drow+1}][expr {$dcol+1}]"
        set n [catch {FetchMap $zoom $row $col $iname} emsg]
        if {$n} {
            .c itemconfigure $iname -text ""
            $iname put [.c cget -bg] -to 0 0 256 256
            continue
        }
    }
    set S(lastZoom) $S(zoom)
    set S(lastScheme) $S(scheme)
}
proc Shift {dir} {
    global S D
    if {! [IsLegal]} return
    
    lassign $S(center) crow ccol
    lassign $D($dir,center) drow dcol
    incr crow $drow
    incr ccol $dcol
    set S(center) [list $crow $ccol]
    lassign [GetCenterLatLon] S(lat) S(lon)
    TitleWindow    
    
    foreach {dst src} $D($dir,shift) { ::map::$dst copy ::map::$src }
    foreach src $D($dir,blank) { ::map::$src put [.c cget -bg] -to 0 0 256 256 }

    foreach src $D($dir,blank) {
        lassign [split $src ""] a b
        set row [expr {$crow + $a - 1}]
        set col [expr {$ccol + $b - 1}]
        
        set iname "::map::$src"
        set n [catch {FetchMap $::S(zoom) $row $col $iname} emsg]
        if {$n} {
            .c itemconfigure $iname -text ""
            $iname put [.c cget -bg] -to 0 0 256 256
            continue
        }
    }
}
proc FetchMap {zoom row col iname} {
    global S V
    
    $iname put yellow -to 0 0 256 256
    .c itemconfig $iname -text "Loading..."
    update
    
    set tile [list $zoom $row $col]
    set ::tile $tile; set ::cmd [list FetcjDone $iname]
    if {$S(caching) == 0 || $V(cacheDir) eq ""} {
        $V(fetcher,$S(scheme)) get $tile [list FetchDone $iname]
    } else {
        if {[$V(cacher,$S(scheme)) exists $tile]} {
            incr S(cached)
        }
        $V(cacher,$S(scheme)) get $tile [list FetchDone $iname]
    }
    incr S(pending)
}
proc FetchDone {iname cmd tile {newImage ""}} {
    incr ::S(loaded)
    incr ::S(pending) -1
    if {$cmd eq "set"} {
        if {$newImage in [image names]} {
            $iname copy $newImage
            image delete $newImage
        }
        .c itemconfig $iname -text ""
    } else {
        .c itemconfig $iname -text "error"
    }
        
}
proc Debug {drow dcol} {
    global S V
    global zoom row col iname url
    set ::drow $drow ; set ::dcol $dcol
    
    set center [GetCenterTile]
    lassign $center zoom crow ccol
    set row [expr {$crow + $drow}]
    set col [expr {$ccol + $dcol}]
    set iname "::map::[expr {$drow+1}][expr {$dcol+1}]"

    set url $V(url,$S(scheme))
    append url /$zoom/$col/${row}.png

    set token [::http::geturl $url]
    ::http::wait $token
    set ncode [::http::ncode $token]
    if {$ncode != 200} {
        ::http::cleanup $token
        error "Bad reply from web server: '$ncode'"
    }
    
    set data [::http::data $token] ; list
    ::http::cleanup $token
    $iname config -data $data

}
proc Google {drow dcol} {
    global S
    global zoom row col iname url
    set ::drow $drow ; set ::dcol $dcol
    
    set center [GetCenterTile]
    lassign $center zoom crow ccol
    set row [expr {$crow + $drow}]
    set col [expr {$ccol + $dcol}]
    set iname "::map::[expr {$drow+1}][expr {$dcol+1}]"

    # http://mt0.google.com/vt/lyrs=t@125,r@129&hl=en&x=4436&y=6198&z=14
    set url http://mt0.google.com/vt/lyrs=t@125,r@129&hl=en&x=${col}&y=${row}&z=${zoom}
    
    set token [::http::geturl $url]
    ::http::wait $token
    set ncode [::http::ncode $token]
    if {$ncode != 200} {
        ::http::cleanup $token
        error "Bad reply from web server: '$ncode'"
    }
    
    set data [::http::data $token] ; list
    ::http::cleanup $token
    $iname config -data $data

}
proc EraseMaps {} {
    foreach ab {00 01 02 10 11 12 20 21 22} {
        ::map::$ab put [.c cget -bg] -to 0 0 256 256
    }
    .c itemconfig txt -text ""
}
proc IsLegal {} {
    global S V
    lassign $V(zoom,$S(scheme)) lo hi
    if {$S(zoom) >= $lo && $S(zoom) <= $hi} { return 1 }
    WARN "$S(scheme) maps must have zoom between $lo and $hi"
    return 0
}
proc WARN {emsg} {
    tk_messageBox -icon error -message $emsg
}
image create bitmap ::bit::up -data {
    #define up_width 11
    #define up_height 11
    static char up_bits = {
        0x00, 0x00, 0x20, 0x00, 0x70, 0x00, 0xf8, 0x00, 0xfc, 0x01, 0xfe,
        0x03, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0x00, 0x00, 0x00, 0x00
    }
}
image create bitmap ::bit::down -data {
    #define down_width 11
    #define down_height 11
    static char down_bits = {
        0x00, 0x00, 0x00, 0x00, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0xfe,
        0x03, 0xfc, 0x01, 0xf8, 0x00, 0x70, 0x00, 0x20, 0x00, 0x00, 0x00
    }
}
image create bitmap ::bit::left -data {
    #define left_width 11
    #define left_height 11
    static char left_bits = {
        0x00, 0x00, 0x20, 0x00, 0x30, 0x00, 0x38, 0x00, 0xfc, 0x01, 0xfe,
        0x01, 0xfc, 0x01, 0x38, 0x00, 0x30, 0x00, 0x20, 0x00, 0x00, 0x00
    }
}
image create bitmap ::bit::right -data {
    #define right_width 11
    #define right_height 11
    static char right_bits = {
        0x00, 0x00, 0x20, 0x00, 0x60, 0x00, 0xe0, 0x00, 0xfc, 0x01, 0xfc,
        0x03, 0xfc, 0x01, 0xe0, 0x00, 0x60, 0x00, 0x20, 0x00, 0x00, 0x00
    }
}
image create bitmap ::bit::upleft -data {
    #define upleft_width 11
    #define upleft_height 11
    static char upleft_bits = {
        0x00, 0x00, 0x7e, 0x00, 0x3e, 0x00, 0x3e, 0x00, 0x7e, 0x00, 0xfe,
        0x00, 0xf2, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00
    }    
}
image create bitmap ::bit::upright -data {
    #define upright_width 11
    #define upright_height 11
    static char upright_bits = {
        0x00, 0x00, 0xf0, 0x03, 0xe0, 0x03, 0xe0, 0x03, 0xf0, 0x03, 0xf8,
        0x03, 0x7c, 0x02, 0x38, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00
    }
}
image create bitmap ::bit::downleft -data {
    #define downleft_width 11
    #define downleft_height 11
    static char downleft_bits = {
        0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0xe0, 0x00, 0xf2, 0x01, 0xfe,
        0x00, 0x7e, 0x00, 0x3e, 0x00, 0x3e, 0x00, 0x7e, 0x00, 0x00, 0x00
    }
}
image create bitmap ::bit::downright -data {
    #define downright_width 11
    #define downright_height 11
    static char downright_bits = {
        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x38, 0x00, 0x7c, 0x02, 0xf8,
        0x03, 0xf0, 0x03, 0xe0, 0x03, 0xe0, 0x03, 0xf0, 0x03, 0x00, 0x00
    }
}
image create bitmap ::img::star -data {
    #define plus_width        11
    #define plus_height 9
    static char plus_bits[] = {
        0x00,0x00, 0x24,0x01, 0xa8,0x00, 0x70,0x00, 0xfc,0x01,
        0x70,0x00, 0xa8,0x00, 0x24,0x01, 0x00,0x00 }
}
image create bitmap ::bmp::plus -data {
    #define bullet_width 8
    #define bullet_height 8
    static char bullet_bits = {
        0x18, 0x18, 0x18, 0xff, 0xff, 0x18, 0x18, 0x18
    }
}
image create bitmap ::bmp::minus -data {
    #define bullet_width 8
    #define bullet_height 8
    static char bullet_bits = {
        0x00, 0x00, 0x00, 0xff, 0xff, 0x00, 0x00, 0x00
    }
}

proc GetCenterLatLon {} {
    global S

    lassign $S(center) crow ccol
    set tile1 [list $S(zoom) $crow $ccol]
    set tile2 [list $S(zoom) [expr {$crow+1}] [expr {$ccol+1}]]
    set geo1 [::map::slippy tile 2geo $tile1]
    set geo2 [::map::slippy tile 2geo $tile2]

    lassign $geo1 . lat1 lon1
    lassign $geo2 . lat2 lon2
    set lat [expr {($lat1+$lat2)/2}]
    set lon [expr {($lon1+$lon2)/2}]
    return [list $lat $lon]
}
proc TitleWindow {} {
    global S

    set location [ReverseCity]
    set title [format "Slippy Map Demo : %s %s %d" \
                   $S(scheme) $location $S(zoom)]
    wm title . $title
}
proc ReverseCity {} {
    global cities S
    
    lassign $cities($S(city)) lat lon
    set dlat [expr {abs($S(lat)-$lat)}]
    set dlon [expr {abs($S(lon)-$lon)}]
    if {$dlat < .5 && $dlon < .5} { return $S(city) }
    set ns [expr {$S(lat) >= 0 ? "N" : "S"}]
    set ew [expr {$S(lon) >= 0 ? "E" : "W"}]
    return [format "$ns%.4g $ew%.4g" [expr {abs($S(lat))}] [expr {abs($S(lon))}]]
    
    set where [list $S(lat) $S(lon)]
    foreach {city latlon} [array get cities] {
        if {$where eq $latlon} { return $city}
    }
    set ns [expr {$S(lat) >= 0 ? "N" : "S"}]
    set ew [expr {$S(lon) >= 0 ? "E" : "W"}]
    return [format "$ns%.4g $ew%.4g" [expr {abs($S(lat))}] [expr {abs($S(lon))}]]
}
proc About {} {
    set txt "Slippy Map Demo\nby Keith Vetter  July 2010\n\n"
    append txt "What exactly is the tcllib module map::slippy? How about\n"
    append txt "map::slippy::fetcher and map::slippy::cache? The man pages\n"
    append txt "have all the details but explain nothing.\n\n"

    append txt "Actually, these modules are really interesting and this\n"
    append txt "program will show you why, and also how to use them.\n\n"

    append txt "Slippy Map is part of the OpenStreetMap project\n"
    append txt "which provides free geographical data\n\n"
    
    append txt "The map::slippy module provides an API to map latitude,\n"
    append txt "longitude and zoom level to an OpenStreetMap tile. The\n"
    append txt "map::slippy::fetcher module provides an API to fetch maps\n"
    append txt "from the OpenStreetMap servers. The map::slippy::cache\n"
    append txt "module provides a means of caching map tiles locally.\n\n"

    append txt "see http://wiki.openstreetmap.org/wiki/Slippy_map_tilenames"

    tk_messageBox -icon info -message $txt -title "About Slippy Map Demo"
}
proc ToggleGrid {} {
    .c [expr {$::S(grid) ? "raise" : "lower"}] grid
}
proc int2lat {lat} {
    set deg [expr {int($lat)}]
    set lat [expr {($lat - $deg)*60}]
    set min [expr {int($lat)}]
    set sec [format "%.2f" [expr {($lat - $min)*60}]]
    regsub {(.)\.?0*$} $sec {\1} sec
    return [list $deg $min $sec]
}
proc PrettyLat {} {
    global S
    
    lassign [int2lat [expr {abs($S(lat))}]] lat1 lat2 lat3
    lassign [int2lat [expr {abs($S(lon))}]] lon1 lon2 lon3
    set N [expr {$S(lat) >= 0 ? "N" : "S"}]
    set W [expr {$S(lon) >= 0 ? "E" : "W"}]
    set lat "$N $lat1\xB0 $lat2' $lat3\x22"
    set lon "$W $lon1\xB0 $lon2' $lon3\x22"

    set S(msg) "$lat   $lon"
}

proc Zoom {dir} {
    global S V

    set newZoom [expr {$S(zoom) + $dir}]
    lassign $V(zoom,$S(scheme)) lo hi
    if {$newZoom >= $lo && $newZoom <= $hi} {
        set S(zoom) $newZoom
        MapIt
    }
}
proc NewScheme {} {
    global S V

    lassign $V(zoom,$S(scheme)) lo hi
    if {$S(zoom) > $hi} { set S(zoom) $hi}
    if {$S(zoom) < $lo} { set S(zoom) $lo}
    MapIt
}
################################################################
################################################################

set S(caching) 0
if {$V(cacheDir) eq ""} {set S(caching) 0}

RegisterFetchers
DoDisplay

set clist [array names cities]
set S(city) [lindex $clist [expr {int(rand()*[llength $clist])}]]
NewCity $S(city)
return


======

----

!!!!!!
%| [Category Application] | [Category Geography] |%
!!!!!!