The following reference [L1 ] provides simple data files that can be imported into a Tk canvas (code to follow later). Download the world.bln file in the section
Mapping -> Mapping - XY->BLN - Blanking/boundary
. Each length of border line is labelled with its country, though I am not sure if the common border between (say) Belgium and France is labelled as Belgium, France or is in the europe.bln file twice. 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 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...
You can zoom in or out with + and -, see the name of a boundary by clicking on it, 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]
}
bind . + {canvas'scale .c 1.25}
bind . - {canvas'scale .c 0.8}
canvas'scale .c 8
bind .c <ButtonPress-1> {%W scan mark %x %y}
bind .c <B1-Motion> {%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