RS always loves maps (see Tclworld :^) Here's my take at a little viewer to render one or more such bln files. 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 {map_load $a data}
pack [canvas .c -bg white] -fill both -expand 1
foreach item [array names data] { ;# changed from line to polygon
.c create polygon $data($item) -tag [list tx $item] -outline black -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
}
# GWM: load one of the recognised formats
proc map_load {filename _arr} {
upvar 1 $_arr arr
# detect file type; added gsb format.
switch -- [string tolower [file extension $filename]] {
{.bln} {return [bln_load $filename arr]}
{.gsb} {return [gsb_load $filename arr]}
}
}
proc gsb_load {filename _arr} { ;# proc to read gsb format maps.
upvar 1 $_arr arr
puts "load GSB map $filename"
set f [open $filename "rb"] ;# it is binary; pre 8.5 can use
# fconfigure $fpvar -translation binary
set channel stdout
seek $f 982 ;# skip 982 byte header
while { ![eof $f] } {
# start of a country/county area; trim by NULL and space bytes
# since this is binary file NULL has no special meaning (unlike C)
set country [string trim [read $f [expr {16*8+2}]] " \0"]
# Stop if we've reached end of file
if {[string index $country 0] == "\0"} break
set contour {}
# now get variable number of 4 byte ints.
# first int defines total number of points
set s [read $f 4]
binary scan $s n npts
# scan nparts - number of closed curves forming the country
binary scan [read $f 4] n nparts
# read the "islands" - each contains sections[i] points
binary scan [read $f [expr 4*$nparts]] n* sections
set iii 0
set sector 0
while { ![eof $f] } {
# read the lat & long data as 2 doubles.
binary scan [read $f 16] q1q lat long
lappend contour $lat [expr {-$long}]
incr iii
if {$iii == [lindex $sections $sector]} {
# next 'island'
if [llength $contour] {set arr(${country}$sector) $contour}
incr sector
set contour {}
set iii 0
}
incr npts -1
# no more data left:
if {!$npts} break
}
set s [read $f 6] ;# end of each country has 6 extra bytes
if {[llength $contour]>3} {set arr(${country}$sector) $contour}
}
puts $channel "End of file"
close $f
}
proc randomcolor {} { ;# assign a colour randomly
set cols {yellow beige orange green pink gray}
lindex $cols [expr {int(rand()*[llength $cols])}]
}
main $argv