iMap: an indexed map viewer

if 0 {Richard Suchenwirth 2003-04-15 - In Tclworld I started to draw maps in Tk, which takes a lot of work (and data collection) until it is practically usable. On the other hand, the Web is full of maps available as GIF images (and JPEGs even more, but Tk prefers GIF), so it's easy to get some and display them on a canvas (for smooth vertical scrolling). Such maps get even better usable if you can add an index of place names, where selecting one highlights it on the map (and possibly scrolls it in sight) - this is intended to run well on a PocketPC too. Therefore I added a tiny scrollbuttons device which saves you the physical scrollbars that only eat up pixels: the four little blue triangles at top right scroll the canvas in the given direction. Hardware cursor keys work too, but not every PocketPC has them. On bigger screens, you can just drag the window bigger.

For this implementation I wrapped the related commands into a package, so a Tcl script that requires the iMap package, and supplies the data (image file name, place name index, with position in pixels) works as an indexed map viewer. See the test case at end for an example - the map for which I got from http://www.tplaces.com/images/UK_Map.gif (put it in the same directory as the script to work).

(escargo - I made the mistake of reaping this code and then running it immediately, which meant that the corresponding map file was missing. Perhaps there needs to be a bit more checking to see that the requested file is available and then failing gracefully if it is not.) RS: I have no problems with an error popping up "no such file and directory"... that tells it true enough...

A refinement could be to express place positions in latitude/longitude for portability, and annotate each map with the distortion required to map lat/lon to its pixels. This way, one would only need one gazetteer (maybe starting from Tclworld gazetteer), build a map repository, and could select the best-fitting map to display. But then the whole package wouldn't fit into less than 4KB...

KPV - for another map viewing whizzlet see TkMapper. It isn't indexed like this one but it automatically grabs maps as you need them. }

 package require BWidget
 namespace eval iMap {
    variable version 1.0
    variable data
 }
 proc scrollbuttons {w args} {
    array set opt {-width 18 -fill blue}
    array set opt $args
    set w4 $opt(-width)
    set w1 [expr {$w4/4.}]
    set w2 [expr {$w4/2.}]
    set w3 [expr {$w4*0.75}]
    eval {canvas $w -borderwidth 0 -width $w4 -height $w4} $args
    set Up    [$w create poly $w2 0 $w1 $w1 $w3 $w1 -fill $opt(-fill)]
    set Left  [$w create poly 0 $w2 $w1 $w1 $w1 $w3 -fill $opt(-fill)]
    set Right [$w create poly $w4 $w2 $w3 $w1 $w3 $w3 -fill $opt(-fill)]
    set Down  [$w create poly $w2 $w4 $w1 $w3 $w3 $w3 -fill $opt(-fill)]
    foreach i {Up Down Left Right} {
       $w bind [set $i] <1> "event generate . <$i>"
    }
    set w
 }
 proc iMap::goPlace {c} {
     global place
     variable data
     if {[info exists data($place)]} {
        foreach {x y} $data($place) break
        foreach {- - w h} [$c bbox all] break
        $c xview moveto [expr {1.0*($x-100)/$w}]
        $c yview moveto [expr {1.0*($y-100)/$h}]
        set id [$c create rect [expr $x-20] [expr $y-20] \
          [expr $x+20] [expr $y+20] -fill {} -width 5 \
          -outline red]
        after 300 [list $c itemconfig $id -width 0]
        after 600 [list $c itemconfig $id -width 5]
        after 900 [list $c delete $id]
     }
     focus $c
 }
 proc map: {filename} {
    variable data
    wm geometry . +0+1
    frame .f
    pack [ComboBox .f.c -textvariable place -editable 0\
       -modifycmd {iMap::goPlace .c} ] -side left
    pack [scrollbuttons .f.s] -side right
    pack .f -fill x
    canvas .c -width 236 -height 266 -highlightth 0
    pack .c -fill both -expand 1
    cd [file dirname [info script]]
    image create photo im -file $filename
    .c create image 0 0 -image im -anchor nw
    .c config -scrollregion [.c bbox all]
    bind . <Up>    {.c yview scroll -1 unit}
    bind . <Down>  {.c yview scroll 1 unit}
    bind . <Left>  {.c xview scroll -1 unit}
    bind . <Right> {.c xview scroll 1 unit}
    bind .c <1>    {wm title . [%W canvasx %x],[%W canvasy %y]}
 }
 proc index: pairlist {
    array set ::iMap::data $pairlist
    .f.c configure -values [lsort [array names iMap::data]]
 }
 package provide iMap $iMap::version

#----- (1)

 if {[info exists argv0] && [file tail [info script]]==[file tail $argv0]} {

#--------------- self-test - data files look like this:

 package require iMap
 map:   UK_map.gif
 index: {
        Aberdeen {194 273}
        Belfast {80 410}
        Birmingham {215 528}
        Dover {316 588}
        Edinburgh {166 340}
        Guernsey {193 687}
        Hebrides {56 227}
        Jersey {210 700}
        Liverpool {174 475}
        London {271 573}
        Londonderry {41 387}
        Manchester {195 469}
        {Shetland Islands} {210 100}
        Voe {210 100}
  }
 }

jerry - doesn't seem complete in code somewhere up there... like the self test comment killed the code segment. - RS: The file tail line is already part of the self-test. Don't use it if you don't want it. I added a comment (1) to make the borderline clearer.

Category Application - Category Geography - Category Whizzlet