Version 0 of iMap: an indexed map viewer

Updated 2003-04-15 15:41:46

if 0 {Richard Suchenwirth 2003-04-15 - In Tclworld I started to draw maps in Tk, which takes a lot of work until it is practically usable. On the other hand, the Web is full of maps available as GIF images, 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 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.

For this implementation I plan to wrap the related commands in 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). See the test case at end for an example.}

 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 $opt(-width) -height $opt(-width)} $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

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

 if {[file tail [info script]]==[file tail $argv0]} {
 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}
  }
 }