Slippy Map Demo
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 [L1 ] to the OpenStreet Map project [L2 ] [L3 ] [L4 ], 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.
##+##########################################################################
#
# 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
AK - 2010-07-06 19:32:52
I should note that we have an example application for map::slippy, in Tklib. The file is examples/canvas/osm.tcl. It is actually the example application for the canvas::sqmap package, which is a tile-based map display widget on top of canvas, and agnostic of tile source. The map::slippy parts simply fit the API :)
AK - 2010-07-06 19:39:05
And I believe I now understand what the recently added diagonal arrow buttons were for :) Thanks Keith.