Version 22 of Geographic World Maps

Updated 2010-08-20 09:53:10 by GeoffM

The following reference [L1 ] used to provide simple data files that can be imported into a Tk canvas (reference has been moved April 2008) (and again in 2010). You can now find a map at [L2 ] except that these are now binary files (extension .gsb). I have added a small reader to load either format of file.

Each length of border line is labeled with its country, though I am not sure if the common border between (say) Belgium and France is labeled 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. 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


Arts and crafts of Tcl-Tk programming - Category Geography