[http://mini.net/pub/tclworld02.gif]

[Richard Suchenwirth] - Here's version 0.2 of the map viewer [tkWorld]. Still preliminary, but contains better color scheme (light blue for lakes, shades of green for land, white for polar regions) and, best of all, an improved zooming that reacts on left/right mouse click as well.

----
 namespace eval geo {variable db ;# array that holds our database}
 proc geo::Set args {
    variable db
    if {[llength $args]==1} {set args [lindex $args 0]}
    foreach line [split $args \n] {
        set name [lindex $line 0]
        if {[llength $line]>2 && $name !="#"} {
             set db($name) [lrange $line 1 end]
        }
    }
 }
 proc geo::Get arg {
    variable db
    if {[info exists db($arg)]} {
        set value $db($arg)
    } elseif {![catch {expr [join $arg +]}]} {
        set value [concat point $arg]
    } else {return ""}
    set rest [lrange $value 1 end]
    if {[llength $rest]==1} {set res [lindex $rest 0]}
    switch -glob -- [lindex $value 0] {
        area - lake {set res [Make polygon $rest]}
        bound*      {set res [Make line    $rest]}
        city        {set res [city $arg]}
        point       {
            if {[llength $rest] != 2} return
            foreach {x y} $rest break
            set res [list point [expr {-$x}] [expr {-$y}]]
        }
        road        {set res [Make line $rest]}
        default     {return -code error "cannot get $arg"}
    }
    set res
 }
 proc geo::Make {item argl} {
    foreach arg $argl {
        eval lappend item [lrange [Get $arg] 1 end]
    }
    Join $item
 }
 proc geo::city name {
    variable db
    foreach {x y} [lrange $db($name) 1 2] break
    concat oval [expr {-$x-.01}] [expr {-$y-.01}] \
        [expr {-$x+.01}] [expr {-$y+.01}]
 }
 proc geo::Join list {
    set res [lrange $list 0 2]
    set lastx [lindex $res 1]
    set lasty [lindex $res 2]
    foreach {x y} [lrange $list 3 end] {
        if {$x!=$lastx || $y!=$lasty} {
            lappend res $x $y
        }
        set lastx $x
        set lasty $y
    }
    join $res
 }
# Rendering is done with an overloaded canvas:
 proc geo::swapxy L {
    variable zoom
    set res [lindex $L 0]
    foreach {lat lon} [lrange $L 1 end] {
        lappend res [expr {$lon*$zoom}] [expr {$lat*$zoom}]}
    set res
 }
 proc geo::Canvas {} {
    variable canvas
    set canvas
 }
 proc geo::Map {w args} {
    variable zoom 2. canvas
    eval canvas $w $args ;# create the base widget
    set canvas $w
    rename ::$w ::_$w
    proc ::$w {cmd args} [string map [list @w@ _$w] {
        variable db
        set w [lindex [info level 1] 0]
        set name [lindex $args 0]
        set rest [lrange $args 1 end]
        switch -- $cmd {
            show    {
                set data [geo::swapxy [geo::Get $name]]
                #if {[llength $data]<4} return
                set item [eval _$w create $data -tag [list $name]]
                eval _$w itemconfig $item $rest
                set type [lindex $geo::db($name) 0]
                if {$type=="city"} {
                    _$w itemconfig $item -fill red
                } elseif {$type=="lake"} {
                    _$w addtag lake withtag $item
                    _$w itemconfig $item -fill lightblue
                }
                set item
            }
            default {eval @w@ $cmd $args}
        }
    }]
    set w
 }
 proc geo::Names {{pat *}} {
    variable db
    array names db $pat
 }
 #----------------------------------------------------------------------
 proc scrolled {type w args} {
    frame $w
	set res [eval $type $w.0 \
	    [list -xscrollc "$w.x set" -yscrollc "$w.y set"] $args]
    scrollbar $w.x -ori hori -command "$w.0 xview"
    scrollbar $w.y -ori vert -command "$w.0 yview"
    grid $w.0 $w.y -sticky news
    grid $w.x      -sticky news
    grid columnconfigure $w 0 -weight 1
    grid rowconfigure    $w 0 -weight 1
    set res
 }

 proc lpick L {lindex $L [expr {int(rand()*[llength $L])}]}

 proc scale {w factor} {
    if {$factor==0} {set factor [expr {2./$::scale}]}
    $w scale all 0 0 $factor $factor
    $w config -scrollregion [$w bbox all]
    set ::scale [expr {$::scale*$factor}]
 }
 proc scale2 {w x y factor} {
    if {$x=="."} {
        set x [expr [$w cget -width]/2]
        set y [expr [$w cget -height]/2]
    }
    foreach {x0 y0 x1 y1} [$w bbox all] break
    set width [expr double($x1-$x0)]
    set height [expr double($y1-$y0)]
    set cx [$w canvasx $x]
    set cy [$w canvasy $y]
    
    set relw [expr {($cx-$x0-$x/$factor)/$width}]
    set relh [expr {($cy-$y0-$y/$factor)/$height}]
    #scale $w $factor
    if {$factor==0} {set factor [expr {2./$::scale}]}
    $w scale all 0 0 $factor $factor
    $w config -scrollregion [$w bbox all]
    set ::scale [expr {$::scale*$factor}]
    $w xview moveto $relw
    $w yview moveto $relh    
 }
 proc where {w x y} {
    global scale
    set here [$w find withtag current]    
    if {[llength $here]} {
        set ::where [string map {
            current {} lake {}
            } [$w itemcget $here -tags]]
    } else {set ::where ""}
    set lat [format %.2f [expr {-[$w canvasy $y]/$scale}]]
    if {$lat>0} {append lat N} else {set lat [expr {-$lat}]S}
    set lon [format %.2f [expr {-[$w canvasx $x]/$scale}]]
    if {$lon>0} {append lon W} else {set lon [expr {-$lon}]E}
    set ::position "$lat $lon"
 }
 #----------------------------------------------------------------------
 set c [scrolled geo::Map .m  -width 720 -height 360 -bg lightblue]
 frame .top
 label .top.scale -textvar scale -width 10
 button .top.plus  -text + -width 3 -pady 0 -command [list scale2 $c . . 2.0]
 button .top.minus -text - -width 3 -pady 0 -command [list scale2 $c . . 0.5]
 button .top.all -text {[]} -width 3 -pady 0 \
    -command [list scale $c 0]
 label  .top.pos   -textvar position -width 20 -bg white
 label  .top.where -textvar where
 eval pack [winfo children .top] -side left
 pack .top .m -fill x
 pack .m -fill both -expand 1
 wm title . Wait...
 $c create line -360 0 360 0 -fill white 
 $c create line 0 -180 0 180 -fill white
 $c config -scrollregion [$c bbox all]
 $c create text 0 0 -text "TkWorld..." -font "Helvetica 96 italic" \
    -fill blue -tag wait
 . config -cursor watch
 update
 set scale 2.0
 set colors {
    green2 green3 green4 olivedrab2 olivedrab3 olivedrab4
    palegreen3 palegreen4
    }
 cd [file dirname [info script]] ;# requires all files in one dir
 source world.tg
 foreach name [geo::Names] {
    set id [$c show $name -fill [lpick $colors]]
    set bbox [$c bbox $id]
    if {[lindex $bbox 3]>120 || [lindex $bbox 3]<-117} {
        $c itemconfig $id -fill white
    }
    update
 }
 $c raise lake
 cities $c
 $c delete wait
 . config -cursor {}

 wm title . "Welcome to TkWorld 0.2!"
 bind $c <Motion> [list where $c %x %y]
 focus $c
 bind $c + [list scale2 $c . . 2.0]
 bind $c - [list scale2 $c . . 0.5]
 bind $c <1> [list scale2 $c %x %y 2.0] 
 bind $c <3> [list scale2 $c %x %y 0.5] 


 update
 bind . ? {console show}
 if [catch {source bodensee.tg}] {puts $errorInfo}
----
world.tg is too big to put here (110kB). mailto:Richard.Suchenwirth-Bauersachs@siemens.com for a complimentary copy, or, if you have tkWorld 0.1, modify the end after the data to read like this:
 proc cities w {
    foreach {city lat lon} {
        Beijing         40  -117
        Berlin          52.5 -13.5
        "Buenos Aires" -35    58
        London          51.8   0.1
        Madrid          40.5   3.5
        Melbourne      -38  -144.5
        "Mexico City"   20    99
        Moskva          55.9 -37.5
        "New Delhi"     28   -77
        "New York"      41    73.5
        Paris           48.8  -2.4
        Roma            41.9 -12.4
        "Sao Paulo"    -23    46
        Tokyo           36  -138
        Varna           43.5 -27.9
    } {
        set lon2 [expr {-$lon-$lon-.5}]
        set lat2 [expr {-$lat-$lat-.5}]
        $w create oval $lon2 $lat2 [expr {$lon2+.5}] [expr {$lat2+.5}]\
            -fill red -tag $city
        update
    }
 }
 foreach {id coords} $data {
        set t [lrange $coords 6 end]
        if {[llength $t]>=4} {
            set type [expr {[string match {[~A-Z]*} $id]? "area": "bound"}]
            if {[string index $id 0]=="~"} {
                set type lake
                set id [string range $id 1 end]
            }
            set cmd [list geo::Set $id $type]
            foreach {lat lon} $t {lappend cmd [list $lat [expr {-$lon}]]}
            eval $cmd
        }
    }
----
bodensee.tg is short enough to go here completely:
# sample extension for Tkworld, displaying Lake Constance (Bodensee)

    geo::Set {
        Bodensee lake Bo-DE Bo-CH AT-Bo
        Bo-DE bound AT.Bo.DE Lindau Nonnenhorn \
           Langenargen Friedrichshafen \
           Immenstaad Meersburg Bodman-Ludwigshafen Bodman \
           KN-Dingelsdorf KN-Staad KN-H�rnle Konstanz Allensbach \
           {47.75 -8.95} {47.72 -9.01} Radolfzell Moos Gaienhofen-Horn \
           Gaienhofen �hningen
        Bo-CH bound Eschenz Steckborn Ermatingen Kreuzlingen Romanshorn \
           Rorschach AT.Bo.CH
        AT-Bo bound AT.Bo.CH Bregenz AT.Bo.DE
        AT.Bo.DE   point 47.6 -9.72
        AT.Bo.CH   point 47.51 -9.6
        Bodman     point 47.8 -9.03
        Bodman-Ludwigshafen point 47.81 -9.05
        Bregenz    city 47.55 -9.69
        Eschenz    point 47.64 -8.73
        Friedrichshafen city 47.7 -9.48
        Gaienhofen point 47.68 -8.98
        Gaienhofen-Horn point 47.7 -9.0
        Immenstaad city  47.7 -9.37
        Konstanz   city  47.7 -9.13
        KN-Dingelsdorf point 47.74 -9.14
        KN-H�rnle   point 47.7 -9.15
        Kreuzlingen city 47.69 -9.13
        Langenargen point 47.65 -9.55
        Lindau      city  47.63 -9.7
        Nonnenhorn  point 47.651 -9.65
        �hningen    point 47.66 -8.75
        Radolfzell  city  47.75 -8.92
        Romanshorn  city  47.6 -9.37
        Rorschach   city  47.49 -9.5
    }
    foreach i {
        Bodensee Lindau Bregenz Radolfzell Konstanz Kreuzlingen
        Friedrichshafen Rorschach Romanshorn
    } {
        [geo::Canvas] show $i
    }