The following reference [http://ioc.unesco.org/oceanteacher/OceanTeacher2/07_Examples/examples.htm] provides simple data files that can be imported into a Tk canvas. Download the world.bln file in the section: Mapping -> Mapping - XY->BLN - Blanking/boundary Each length of border line is labelled with its country. The common border between (say) Belgium and France is in the europe.bln file twice, once as part of the border of France, once as part of Belgium. The source of data is UNESCO; accuracy may not be ideal (it omits the Isle of Wight off the south coast of England, which is larger than Andorra and some of the other islands included). ---- [RS] always loves maps (see [Tclworld] :^) Here's my take at a little viewer to render one or more such bln files. In fact, the data are polygons, so one can just render them as such... [http://tclerswiki.googlepages.com/tclworld2.jpg] You can zoom in or out with + and -, see the name of a polygon by clicking on it (the number probably just says how many coordinates there are), and pan the canvas by dragging with left mouse button pressed: package require Tk proc main argv { foreach a $argv {bln_load $a data} pack [canvas .c -bg lightblue] -fill both -expand 1 foreach item [array names data] { .c create polygon $data($item) -tag [list tx $item] -fill [randomcolor] \ -outline black } bind . + {canvas'scale .c 1.25} bind . - {canvas'scale .c 0.8} canvas'scale .c 8 bind .c {%W scan mark %x %y} bind .c {%W scan dragto %x %y 1} .c bind tx <1> {display %W %x %y} } proc bln_load {filename _arr} { upvar 1 $_arr arr set contour {} set recordname "" set f [open $filename] while {[gets $f line] >= 0} { set fields [split $line ,] switch [llength $fields] { 4 { if [llength $contour] {set arr($recordname) $contour} set cnt([lindex $fields 2]) "" set recordname [string trim [lindex $fields 2] \"],[lindex $fields 0] set contour {} } 2 {lappend contour [lindex $fields 0] [expr {-[lindex $fields 1]}]} } } } proc canvas'scale {w factor} { $w scale all 0 0 $factor $factor $w config -scrollregion [$w bbox all] } proc display {w x y} { $w delete txt set tags [lindex [$w gettags current] 1] $w create text [$w canvasx $x] [$w canvasy $y] -text $tags -tag txt } proc randomcolor {} { set cols {yellow beige orange green pink gray} lindex $cols [expr {int(rand()*[llength $cols])}] } main $argv ----- [GWM] In order to improve this I found some useful census data from the US census bureau. If you request and save a table from [http://www.census.gov/cgi-bin/ipc/idbsprd.html] it can be loaded into the maps above to provide a less random colour scheme for the countries. I have also fixed a small bug in that some countries have more than one border - the above can overwrite older borders when a new border with the same number of vertices is found (e.g. Lesotho in South Africa is hidden). This version saves all the borders of a country as a list in a single element of the data array. [http://tclerswiki.googlepages.com/africamap.jpg] # world census data in the form of tables can be obtained from # http://www.census.gov/cgi-bin/ipc/idbsprd.html, # Use the option "Present all stub information on each data line" to produce the format used here. # copy entire page and paste into any text editor (notepad...) # In this format, a typical file looks like this: if 0 { "Table 008. Vital Rates" "-----------------------------------","-------","----------","----------","----------------","---------------","-----------" " "," "," Births"," Deaths"," Net number of","Rate of natural"," " " "," "," per 1,000"," per 1,000"," migrants per"," increase","Growth rate" "Country or area ","Year ","population","population","1,000 population"," (percent)"," (percent)" "-----------------------------------","-------","----------","----------","----------------","---------------","-----------" "" "Afghanistan ",2007 , 46.21, 19.96, 0.00, 2.625, 2.625 "Albania ",2007 , 15.16, 5.33, -4.54, 0.983, 0.529 "Algeria ",2007 , 17.11, 4.62, -0.33, 1.249, 1.216 "American Samoa ",2007 , 21.83, 3.24, -21.21, 1.859, -0.262 "Andorra ",2007 , 8.45, 6.45, 6.42, 0.200, 0.842 } package require Tk global scale set scale 8 proc main argv { foreach a $argv {bln_load $a data} set make 0 if {![winfo exists .c]} { pack [canvas .c -bg lightblue] -fill both -expand 1 set make 1 } foreach item [array names data] { foreach curv $data($item) { set ip [.c create polygon $curv -tag [list tx $item] -fill [randomcolor] \ -outline black] .c scale $ip 0 0 $::scale $::scale } } if {$make} { bind . + {canvas'scale .c 1.25} bind . - {canvas'scale .c 0.8} bind .c {%W scan mark %x %y} bind .c {%W scan dragto %x %y 1} .c bind tx <1> {display %W %x %y} } } proc bln_load {filename _arr} { upvar 1 $_arr arr set contour {} set recordname "" set f [open $filename] while {[gets $f line] >= 0} { set fields [split $line ,] switch [llength $fields] { 4 { if [llength $contour] { ;# multiple contours exist for some countries so make list of contours lappend arr($recordname) $contour} set cnt([lindex $fields 2]) "" set recordname [string trim [lindex $fields 2] \"] set contour {} } 2 {lappend contour [lindex $fields 0] [expr {-[lindex $fields 1]}]} } } close $f } proc canvas'scale {w factor} { $w scale all 0 0 $factor $factor $w config -scrollregion [$w bbox all] set ::scale [expr {$::scale*$factor}] ;# used for new maps to be loaded. } proc display {w x y} { $w delete txt set tags [lindex [$w gettags current] 1] $w create text [$w canvasx $x] [$w canvasy $y] -text $tags -tag txt } proc randomcolor {} { set cols {yellow beige orange green pink gray} lindex $cols [expr {int(rand()*[llength $cols])}] } # GWM's interface items proc addmap {} { update ;# this needs to be called before openfile to ensure that binds work # particularly +/_ for zooming set mapfile [ tk_getOpenFile -multiple true] main $mapfile } proc divideatstring {line split} { set fields {} set ok 1 while {$ok} { set endoffield -1 set sp -1 while {$endoffield<0 && $sp<[llength $split]} { incr sp set endoffield [string first [lindex $split $sp] $line] } if {$endoffield>=0} { lappend fields [string trim [string range $line 0 [expr {$endoffield-1}]] " -\""] set start [expr {$endoffield+[string length [lindex $split $sp]]}] set line [string range $line $start end] } else { set ok 0; lappend fields [string trim $line " -\""] } } return $fields } proc loadcensus {filename} { if {$filename != ""} { set f [open $filename] set section 1 ;# 1 title, headers # country, values gets $f line ;# jump title while {[gets $f line] >= 0} { set fields [divideatstring $line {"\",\"" "\"," ","}] switch [llength $fields] { 1 { ;# demarks title/data incr section } default { ;# table country name, one value per column switch $section { 1 { ;# get title labels set ic 0 foreach column $fields { append arr(Column_$ic) " " $column incr ic } } default { set arr([lindex $fields 0]) [lrange $fields 1 end] } } } } } close $f # create an interface to select the map colours: catch { destroy .color.menu } catch { destroy .color.menu.opts } set optmenu [menubutton .color.menu -menu .color.menu.opts -text "Choose display"] set opmen [menu $optmenu.opts] foreach col [array names arr Column_*] { $opmen add command -label $arr($col) -command \ "recolormap {[array get arr]} \"$arr($col)\"" } pack $optmenu -side left -expand f -fill y } } proc makecolour {frac} { if {$frac<0.5} { ;# range blue to green set col [format "#%02x%02x%02x" 0 [expr {int(127+255*$frac)}] [expr {int(127+255*(.5-$frac))}] ] } else { ;# green to red set col [format "#%02x%02x%02x" [expr {int(127+255*($frac-0.5))}] [expr {int(127+255*(1-$frac))}] 0 ] } return $col } proc recolormap {_arr coltitle} { array set arr $_arr set icol 0 set thec 0 # find the column of data to use foreach col [array names arr Column_*] { if {$arr($col)==$coltitle} { set thec $icol } incr icol } incr thec -1 if {$thec>=0} { set vmin 1.e30 set vmax -1.e30 foreach tag [.c find withtag tx] { ;# all countries in map set cname [lindex [.c gettags $tag] 1] if {[array names arr $cname]!=""} { set v [lindex [split $arr($cname)] $thec] if {[string is double -strict $v]} { set vmin [expr {$v<$vmin?$v:$vmin}] set vmax [expr {$v>$vmax?$v:$vmax}] } } } .color.menu configure -text "$coltitle: data range $vmin to $vmax" if {($vmax-$vmin)>0} { foreach tag [.c find withtag tx] { set cname [lindex [.c gettags $tag] 1] if {[array names arr $cname]!=""} { set v [lindex [split $arr($cname)] $thec] if {[string is double -strict $v]} { .c itemconfigure $tag -fill [makecolour [expr {double($v-$vmin)/double($vmax-$vmin)}]] } } else { .c itemconfigure $tag -fill #dddddd } } } } } proc addcensus {} { set censusfile [ tk_getOpenFile ] loadcensus $censusfile } pack [button .addmap -text "Load Map" -command "addmap"] -side top -expand f -fill y pack [frame .color] -side top -expand f -fill y pack [button .color.addcen -text "Load Census" -command "addcensus"] -side left -expand f -fill y # prompt for a bln map file. addmap ---- [Arts and crafts of Tcl-Tk programming] - [Category Geography]