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