tclTiger

Keith Vetter 2007-07-08 : the TIGER GIS dataset [L1 ] [L2 ] from the US Census Bureau is a huge collection of information about roads, rivers, lakes, and other areas the census tracts. It is organized by state and county. The dataset is completely public domain.

It is thought that map quest, yahoo maps, etc. all used the TIGER dataset as the basis for their mapping web services.

This program combines TIGER with Google Maps. It lets you search for road names in TIGER data files, and extract the road course with all its bends and twists. Finally, it will display the result in a web page using Google Maps and its javascript API.

WARNING to run tclTiger you must first download at least one TIGER data file. To do so, first you need a five-digit state/county FIPS code. For this, goto http://www.census.gov/geo/www/fips/fips65/index.html .

Second, you need to download the actual TIGER data. Download the appropriate file from http://www.census.gov/geo/www/tiger/tiger2006se/tgr2006se.html . Then unzip the data file in the tclTiger directory or in a sub-directory below it.


KPV Here's an explanation how it works. There are two separate phases in the process: the first is extracting the data from the TIGER dataset, the second is displaying it in Google Maps.

The first step of the first phase is to locate the user specified entity in the TIGER dataset. The key here is the RT1 file which contains the name of every TIGER entity. So we search that file, comparing the user supplied name with the TIGER field name field for matches. We also match on the field prefix and field type if given. (One nice improvement would be to allow some sort of fuzzy matching here, such as wild cards or Soundex.) For each match, we note the TLID field (TIGER/Line ID) and the starting and ending latitude and longitude.

Even in the simple case of matching a single road, there will still probably be multiple matching lines because most roads are broken into a chain of roads. So the second step is build the chains by matching one segments starting position with another segments ending positions.

The last step is to fill in intermediary positions for each segment. This information is in the RT2 file and is keyed by the TLID field. Each line contains up to 10 additional route positions, and a given TLID may have multiple lines (check the sequence field).

The Google Map phase is pretty simple. Most of the hard work is done in the javascript code in a hard-coded HTML template. The only tcl work is to format the route data into javascript and to insert it into the template.

The ultimate step is to save the javascript and HTML to a file and start up a browser. Thanks here to Invoking Browsers.


 ##+##########################################################################
 #
 # tclTiger.tcl -- extracts route data from TIGER RT1 files and them
 # views them using Google Maps javascipt
 # by Keith Vetter. July 2007
 #
 package require Tk
 package require tile
 
 set D(fips) "39 089"
 set D(prefix) "E"
 set D(name) College
 set D(type) St
 set D(roadNames) "<empty>"
 
 set S(colors) [list \#FF0000 \#0000FF \#00FF00 \#FFFF00 \#00FFFF \#FF00FF]
 set S(width) 6
 set S(noRT2) 0
 
 proc DoDisplay {} {
    global D
 
    set fipsList [GetFipsList]
 
    wm title . "Tcl Tiger"
    DoMenus
    label .b1
    option add *Label.font "[font actual [.b1 cget -font]] -weight bold"
    option add *Labelframe.font "[font actual [.b1 cget -font]] -weight bold"
    destroy .b1
 
    . config -padx 10 -pady 10
    label .title -text "Tcl Tiger" -font "Times 48 bold" -relief raised
    labelframe .left -text "User Input" -padx 10 -pady 20 
    label .middle -font {Times 48 bold} -text \u2192
    labelframe .right -text "Tiger Names" -padx 10 -pady 20
 
    grid .title - - -sticky ew -pady {0 20}
    grid .left .middle .right -sticky news
    grid config .middle -pady {0 20}
    grid config .right -sticky news 
    grid columnconfigure . 2 -weight 1
    grid rowconfigure . 1 -weight 1
 
    # Left side
    set w .left
    label $w.fips -text "FIPS:"
    ::ttk::combobox $w.efips -values $fipsList -width 8 \
        -state readonly -textvariable ::D(fips)
    label $w.prefix -text "Prefix:"
    entry $w.eprefix -textvariable ::D(prefix) -justify center
    label $w.name -text "Name:"
    entry $w.ename -textvariable ::D(name) -justify center
    label $w.type -text "Type:"
    entry $w.etype -textvariable ::D(type) -justify center
 
    ::ttk::button $w.lookup -text "Lookup Road" -command Lookup
 
    grid $w.fips $w.efips -sticky w -pady {0 10}
    grid $w.prefix $w.eprefix
    grid $w.name $w.ename
    grid $w.type $w.etype
    grid $w.lookup - -pady {10 0}
    grid rowconfigure $w 1000 -weight 1
    focus $w.eprefix
 
    # Right side
    set w .right
    listbox .roadnames -listvariable ::D(roadNames) -height 6 \
        -yscrollcommand ".sb_y set"
    scrollbar .sb_y -orient v -command ".roadnames yview"
 
    ::ttk::button .browse -text "Google Maps" -command Browser
    ConfigRight disabled
 
    grid .roadnames .sb_y -in $w -sticky ns
    grid config .roadnames -sticky news
    grid .browse - -in $w -pady {10 0}
    grid rowconfig $w 1000 -weight 1
 
    foreach arr [trace info variable D] {
        eval trace remove variable D $arr
    }
    trace add variable D write DTracer
    bind all <Key-F2> {console show}
    update
    event generate .left.eprefix <<TraverseIn>>
 }
 proc DoMenus {} {
 
    menu .m -tearoff 0
    . configure -menu .m
    .m add cascade -menu .m.file -label "File" -underline 0
    .m add cascade -menu .m.help -label "Help" -underline 0
    
    menu .m.file -tearoff 0
    .m.file add command -label "Remove temp files" -underline 0 -command Cleanup
    .m.file add separator
    .m.file add command -label "Exit" -command exit -underline 1
 
    menu .m.help -tearoff 0
    .m.help add command -label "Help" -underline 0 -command MissingFIPS
    .m.help add separator
    .m.help add command -label "About" -underline 0 -command About
 }
 proc MissingFIPS {{die 0}} {
    set txt "tclTiger Instructions\n\n"
    append txt "tclTiger needs you to have downloaded at least one RT1\n"
    append txt "file from the US Census web site.\n"
    append txt "\n"
    append txt "To do so, first you need a five-digit state/county FIPS code.\n"
    append txt "For this, goto:\n"
    append txt "\n"
    append txt "   http://www.census.gov/geo/www/fips/fips65/index.html\n"
    append txt "\n"
    append txt "Second, you need to download the actual TIGER data. Goto the\n"
    append txt "following web site, then goto the state you picked and then\n"
    append txt "download the appropriate data file. You'll need to unzip the\n"
    append txt "data file in the same directory as tclTiger or in a\n"
    append txt "sub-directory below it.\n"
    append txt "\n"
    append txt "  http://www.census.gov/geo/www/tiger/tiger2006se/tgr2006se.html\n"
 
    if {$die} {wm withdraw .}
    tk_messageBox -icon error -message $txt
    if {$die} exit
 }
 proc ConfigRight {how} {
    if {$how eq "normal"} {
        .roadnames config -bg [lindex [.roadnames config -bg] 3]
        .browse config -state normal
    } else {
        .roadnames config -bg grey75
        .browse config -state disabled
    }
 }
 proc DTracer {var1 var2 op} {
    .left.lookup config -state [expr {$::D(name) eq "" ? "disabled" : "normal"}]
    ConfigRight disabled
 }
 proc GetFipsList {} {
    global FIPS
    
    set fips {}
    set dirs [concat . [glob -nocomplain -type d *]]
    foreach dir $dirs {
        foreach fname [glob -directory $dir -nocomplain TGR*.RT1] {
            set tail [file tail $fname]
            set this "[string range $tail 3 4] [string range $tail 5 7]"
            lappend fips $this
            set FIPS($this) $fname
        }
    }
    if {$fips eq ""} { MissingFIPS 1 }
    if {[lindex $fips $::D(fips)] == -1} {
        set ::D(fips) [lindex $fips 0]
    }
 
    return $fips
 }
 proc Lookup {} {
    global D FIPS
 
    set tigerFile $FIPS($D(fips))
    ::tclTiger::BuildRoad $tigerFile $D(prefix) $D(name) $D(type)
    set all [::tclTiger::GetAllNames]
    set how normal
 
    if {$all eq ""} {
        set all [list "No match"]
        set how disabled
    }
    set D(roadNames) $all
    ConfigRight $how
 }
 proc InitBrowser {} {
    if {[info exists ::S(web,cmd)]} return
    
    package require registry
    set app [registry get {HKEY_CLASSES_ROOT\.html} {}]
    set ::S(web,cmd) \
        [registry get HKEY_CLASSES_ROOT\\$app\\shell\\open\\command {}]
 }
 
 
 proc Browser {} {
    InitBrowser
    
    set fname [::tclTiger::BuildWebpage]
    #set url "file:///[file nativename [file normalize $fname]]"
    set url "file:///[file normalize $fname]"
    
    if {[string first "%1" $::S(web,cmd)] != -1} {
        set cmd [string map [list "%1" $url] $::S(web,cmd)]
    } else {
        set cmd "$S(web,cmd) $url"
    }
 
    #regsub -all {\\} $cmd / cmd
    eval exec $cmd &
 }
 # https://wiki.tcl-lang.org/557
 proc InitBrowser {} {
    if {[info exists ::S(web,cmd)]} return
 
    # It *is* generally a mistake to switch on $tcl_platform(os), particularly
    # in comparison to $tcl_platform(platform).  For now, let's just regard it
    # as a stylistic variation subject to debate.
    switch $::tcl_platform(os) {
        Darwin {
            set command [list open %1]
        }
        HP-UX -
        Linux  -
        SunOS {
            foreach executable {mozilla netscape iexplorer opera konqueror lynx
                w3m links galeon konqueror mosaic firefox amaya
                browsex elinks} {
                set executable [auto_execok $executable]
                if [string length $executable] {
                    # Do you want to mess with -remote?  How about other browsers?
                    set command [list $executable %1]
                    break
                }
            }
        }
        {Windows 95} -
        {Windows NT} {
            #set command "[auto_execok start] {} [list $url]"
            package require registry
            set app [registry get {HKEY_CLASSES_ROOT\.html} {}]
            set command \
                [registry get HKEY_CLASSES_ROOT\\$app\\shell\\open\\command {}]
            regsub -all {\\} $command / command
            
        }
    }
    if {! [info exists command]} {
        tk_messageBox -icon error -message \
            "Please tell CL that ($::tcl_platform(os), $::tcl_platform(platform)) is not yet ready for browsing."
        exit
    }
    set ::S(web,cmd) $command
 }
 proc Cleanup {} {
    catch {eval file delete [glob -nocomplain _*.html]}
 }
 proc About {} {
    package require textutil
    set width 60
    
    set txt "tcl Tiger\nby Keith Vetter, July 2007"
    set para(0)  "Topologically Integrated Geographic Encoding and "
    append para(0) "Referencing, or TIGER, is a format used "
    append para(0) "by the United States Census Bureau to describe "
    append para(0) "land attributes such as roads, buildings, rivers, and "
    append para(0) "lakes, as well as areas such as census tracts. TIGER was "
    append para(0) "developed to support and improve the Bureau's process of "
    append para(0) "taking the Decennial Census. (source: wikipedia)"
    set para(0) [::textutil::adjust $para(0) -length $width]
 
    set para(1) "This program combines TIGER with Google Maps. It "
    append para(1) "lets you extract from TIGER data files a road "
    append para(1) "(or other geographical item) and have it displayed "
    append para(1) "on a web page utilizing the Google Maps API."
    set para(1) [::textutil::adjust $para(1) -length $width]
 
    set para(2) "WARNING: to run tclTiger you must first download "
    append para(2) "at least one TIGER data file. See HELP for "
    append para(2) "download instructions."
    set para(2) [::textutil::adjust $para(2) -length $width]
    
    set txt "$txt\n\n$para(0)\n\n$para(1)\n\n$para(2)"
    tk_messageBox -message $txt
 }
 ################################################################
 #
 # TIGER CODE
 #
 catch {namespace delete ::tclTiger}             ;# Clean up for debugging
 namespace eval ::tclTiger {
    variable ROUTE
    variable STREETS
    variable NAMES
    variable SS
    variable htmlFile
    variable template
 
    set template {
 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
 <html xmlns="http://www.w3.org/1999/xhtml" 
  xmlns:v="urn:schemas-microsoft-com:vml">
  <head>
    <meta http-equiv="content-type" content="text/html; charset=UTF-8"/>
    <title>tclTiger</title>
    <!--[if IE]>
    <style type="text/css"> v\:* {behavior:url(#default#VML);} </style>
    <![endif]-->
    <script src="http://maps.google.com/maps?file=api&v=2&key=abcdefg"
             type="text/javascript"></script>
    <script type="text/javascript">
    //<![CDATA[
    SUBSTITUTE_COLORS_HERE
    SUBSTITUTE_NAMES_HERE
    SUBSTITUTE_ROUTE_HERE
 
    var map;
    var sZoom = 13;
    var rWidth = 6;
 
    function init() {
        if (! GBrowserIsCompatible()) return;
        map = new GMap2(document.getElementById("map"));
 
        map.addControl(new GLargeMapControl());
        map.addControl(new GScaleControl());
        map.addControl(new GMapTypeControl());
        map.addControl(new GOverviewMapControl())
        map.setCenter(routes[0][0], sZoom);
 
        PlotAllRoutes();
    }
    function PlotAllRoutes () {
        for (var rid in routes) {
            PlotOneRoute(rid);
        }
    }
    function PlotOneRoute (rid) {
        var r = routes[rid];
        addMarker(r[0], names[rid]);
        addMarker(r[r.length-1], names[rid]);
        var polyline = new GPolyline(r, colors[rid], rWidth);
        map.addOverlay(polyline);
    }
    function addMarker (latlon, txt) {
        var marker = new GMarker(latlon);
        if (txt != "") {
            GEvent.addListener(marker, 'click',
                function() {
                    marker.openInfoWindowHtml(txt);
                }
            );
        }
        map.addOverlay(marker);
    }
 
    window.onload = init;
    window.onunload = GUnload;
    //]]>
    </script>
  </head>
  <body>
     <center>
     <h1>Tcl Tiger</h1>
     <div id="map" style="border-style: solid; border-width: 1px; width: 90%; height: 700px"></div>
     </center>
  </body>
 </html>
 }    
    
 }
 ##+##########################################################################
 # 
 # BuildRoad -- extracts from the specified tiger file the
 # road route info for the specified road.
 # 
 proc ::tclTiger::BuildRoad {tigerFile prefix name type} {
    variable htmlFile
 
    set htmlFile [string tolower [string trim "$prefix $name $type"]]
    set htmlFile _[string map {" " _} $htmlFile.html]
    
    ::tclTiger::GetStreet $tigerFile $prefix $name $type
    ::tclTiger::MakeChain
 }
 ##+##########################################################################
 # 
 # BuildWebpage -- creates web page with Google Map javascript to show
 # the road extracted by BuildRoad.
 # 
 proc ::tclTiger::BuildWebpage {} {
    variable htmlFile
    variable template
    
    set clrs  [::tclTiger::GetAllColors]
    set names [::tclTiger::GetAllNames 1]
    set rTxt  [::tclTiger::GetAllRoutesHTML]
 
    #set fin [open template.html r]
    #set template [read $fin] ; list
    #close $fin
 
    set html [string map [list "SUBSTITUTE_COLORS_HERE" $clrs] $template] ; list
    set html [string map [list "SUBSTITUTE_NAMES_HERE" $names] $html] ; list
    set html [string map [list "SUBSTITUTE_ROUTE_HERE" $rTxt] $html] ; list
    
    set fout [open $htmlFile w]
    puts -nonewline $fout $html
    close $fout
    return $htmlFile
 }
 ##+##########################################################################
 # 
 # GetStreet -- extracts all lines matching our road name. If prefix or
 # type is empty then it matches all.
 # 
 proc ::tclTiger::GetStreet {tigerFile prefix name type} {
    variable NAMES
    variable STREETS
 
    unset -nocomplain NAMES
 
    set prefix [string tolower $prefix]
    set name [string tolower $name]
    set type [string tolower $type]
    set tlids {}
    
    set fin [open $tigerFile r]
    while {[gets $fin line] >= 0} {
        foreach {fullName tprefix tname ttype} [::tclTiger::ExtractName $line] break
        if {$name ne $tname} continue
        if {$prefix ne "" && $prefix ne $tprefix} continue
        if {$type ne "" && $type ne $ttype} continue
 
        set tlid [string range $line 5 14]
        set latlon [::tclTiger::ExtractLatLon $line]
        lappend tlids [concat $tlid $latlon]
        set NAMES([string trim $tlid]) $fullName
    }
    close $fin
    set STREETS $tlids
    ::tclTiger::GetFullLatLon $tigerFile
 }
 ##+##########################################################################
 # 
 # ExtractName -- extracts road name with prefix and type from a RT1 line
 # 
 proc ::tclTiger::ExtractName {line} {
    set FEDIRP [string trim [string range $line 17 18]]
    set FENAME [string trim [string range $line 19 48]]
    set FETYPE [string trim [string range $line 49 52]]
    set name [string trim "$FEDIRP $FENAME $FETYPE"]
    
    set FEDIRP [string tolower $FEDIRP]
    set FENAME [string tolower $FENAME]
    set FETYPE [string tolower $FETYPE]
    return [list $name $FEDIRP $FENAME $FETYPE]
 }
 ##+##########################################################################
 # 
 # ExtractLatLon -- extracts latitude and longitude from a RT1 line
 # 
 proc ::tclTiger::ExtractLatLon {line} {
    set lat1 [string range $line 200 208]
    set lon1 [string range $line 190 199]
    set lat2 [string range $line 219 227]
    set lon2 [string range $line 209 218]
 
    set lat1 "[string range $lat1 0 end-6].[string range $lat1 end-5 end]"
    set lon1 "[string range $lon1 0 end-6].[string range $lon1 end-5 end]"
    set lat2 "[string range $lat2 0 end-6].[string range $lat2 end-5 end]"
    set lon2 "[string range $lon2 0 end-6].[string range $lon2 end-5 end]"
    
    set lat1 [string trim $lat1]
    set lon1 [string trim $lon1]
    set lat2 [string trim $lat2]
    set lon2 [string trim $lon2]
 
    return [list $lat1 $lon1 $lat2 $lon2]
 }
 ##+##########################################################################
 # 
 # MakeChain -- links streets together which share end points.
 # Result is put into ROUTE
 # 
 proc ::tclTiger::MakeChain {} {
    variable STREETS
    variable ROUTE
    variable SS
    variable NAMES
 
    unset -nocomplain ROUTE
    unset -nocomplain SS
    unset -nocomplain OPP
 
    foreach datum $STREETS {
        foreach {tlid lat1 lon1 lat2 lon2} $datum break
        lappend SS($lat1,$lon1) $tlid
        lappend SS($lat2,$lon2) $tlid
        set OPP($lat1,$lon1,$tlid) $lat2,$lon2
        set OPP($lat2,$lon2,$tlid) $lat1,$lon1
    }
 
    set ends {}
    foreach arr [array names SS] {
        if {[llength $SS($arr)] == 1} {
            lappend ends $arr
        }
    }
    set n [expr {[llength $ends]/2}]
 
    set seg 0
    while {$ends ne {}} {
        
        set nextNode [lindex $ends 0]
        set ends [lrange $ends 1 end]
        set nextRoad $SS($nextNode)
        set rChain {}
        set nChain $nextNode
 
        while {1} {
            lappend rChain $nextRoad
            set lastRoad $nextRoad
            set lastNode $nextNode
            
            set nextNode $OPP($lastNode,$lastRoad)
            lappend nChain $nextNode
            set nextRoad [::tclTiger::OtherRoad $lastRoad $nextNode]
            if {$nextRoad == ""} break
        }
        set ROUTE($seg,rChain) $rChain
        set ROUTE($seg,nChain) $nChain
        set ROUTE($seg,name) $NAMES($lastRoad)
        incr seg
 
        set n [lsearch $ends $nextNode]
        set ends [lreplace $ends $n $n]
    }
    set ROUTE(cnt) $seg
 }
 ##+##########################################################################
 # 
 # OtherRoad -- returns the other road which enters a given node
 # 
 proc ::tclTiger::OtherRoad {road node} {
    variable SS
 
    set n [lsearch $SS($node) $road]
    if {$n == -1} { return "" }
    return [lindex $SS($node) [expr {1 - $n}]]
 }
 ##+##########################################################################
 # 
 # GetAllColors -- returns javascript for the color for each road drawn
 # 
 proc ::tclTiger::GetAllColors {} {
    variable ROUTE
 
    set clrs {}
    for {set i 0} {$i < $ROUTE(cnt)} {incr i} {
        set clr [lindex $::S(colors) [expr {$i % [llength $::S(colors)]}]]
        lappend clrs "'$clr'"
    }
    set txt "var colors = \["
    append txt [join $clrs ", "]
    append txt "];"
    return $txt
 }
 ##+##########################################################################
 # 
 # GetAllNames -- gets the names for each matching road
 # 
 proc ::tclTiger::GetAllNames {{javascript 0}} {
    variable ROUTE
    variable NAMES
 
    set rnames {}
    for {set i 0} {$i < $ROUTE(cnt)} {incr i} {
        set tlid [lindex $ROUTE($i,rChain) 0]
        lappend rnames $NAMES($tlid)
    }
    if {! $javascript} { return $rnames}
    
    set txt "var names = \['"
    append txt [join [string map {' \\'} $rnames] "', '"]
    append txt "'];"
    
    return $txt
 }
 ##+##########################################################################
 # 
 # GetAllRoutesHTML -- returns javascript for every road we're drawing
 # 
 proc ::tclTiger::GetAllRoutesHTML {} {
    variable ROUTE
 
    set txt "var routes = \[\n";
    for {set i 0} {$i < $ROUTE(cnt)} {incr i} {
        set txt2 [::tclTiger::GetRouteHTML $i]
        append txt $txt2
    }
    set txt [string trimright $txt ","]
    append txt "    ];";
    return $txt
 }
 ##+##########################################################################
 # 
 # GetRouteHTML -- returns javascript for a given road
 # 
 proc ::tclTiger::GetRouteHTML {idx} {
    set latlon [::tclTiger::GetRouteXY $idx]
 
    set txt ""
    append txt "        \[\n"
    foreach {lat lon} $latlon {
        append txt "            new GLatLng($lat,$lon),\n"
    }
    set txt [string trimright $txt "\n,"]
    append txt "\n        ],\n";
    return $txt
    
    variable ROUTE
    set nChain $ROUTE($idx,nChain)
    set txt ""
    append txt "        \[\n"
    foreach datum $nChain {
        foreach {lat lon} [split $datum ","] break
        append txt "            new GLatLng($lat,$lon),\n"
    }
    append txt "        ],\n";
    return $txt
 }
 ##+##########################################################################
 # 
 # GetRouteXY -- returns the lat,lon for every point on a road
 # 
 proc ::tclTiger::GetRouteXY {idx} {
    variable ROUTE
    variable LATLON
 
    set nChain $ROUTE($idx,nChain)
    set rChain $ROUTE($idx,rChain)
 
    set xy {}
    foreach {latlon} $nChain tlid $rChain {
        if {$tlid eq ""} break
        foreach {sLat sLon} [split $latlon ","] break
        foreach {rLat rLon} $LATLON($tlid) break
        
        set rxy $LATLON($tlid)
        if {$rLat ne $sLat || $rLon ne $sLon} {
            set rxy [::tclTiger::LatLonReverse $rxy]
        }
        set xy [concat $xy $rxy]
    }
    return $xy
 }
 ##+##########################################################################
 # 
 # LatLonReverse -- reverses a lat lon list
 # 
 proc ::tclTiger::LatLonReverse {xy} {
    set a {}
    foreach {lat lon} $xy {
        set a [concat $lat $lon $a]
    }
    return $a
 }
 ##+##########################################################################
 # 
 # GetFullLatLon -- digs out of RT2 all the bends in a road
 # 
 proc ::tclTiger::GetFullLatLon {tigerFile} {
    variable LATLON
    variable STREETS
 
    unset -nocomplain LATLON
    set tlids {}
    foreach datum $STREETS {
        set tlid [lindex $datum 0]
        if {! [info exists LATLON($tlid)]} {
            lappend tlids $tlid
            set LATLON($tlid) [lrange $datum 1 end]
        }
    }
 
    if {$tlids eq {}} return
    if {$::S(noRT2)} return
 
    regsub -nocase {1$} $tigerFile {2} tigerFile2
    if {! [file readable $tigerFile2]} return
    
    set fin [open $tigerFile2 r]
    while {[gets $fin line] >= 0} {
        set tlid [string trim [string range $line 5 14]]
        if {[lsearch $tlids $tlid] == -1} continue
 
        set seq [string index $line 17]
        set idx [expr {2 + 20*($seq-1)}]
        set ten [::tclTiger::Extract10LatLon $line]
        set LATLON($tlid) [eval linsert [list $LATLON($tlid)] $idx $ten]
    }
    close $fin
 }
 ##+##########################################################################
 # 
 # Extract10LatLon -- extracts the 10 lat,lon pairs in a RT2 line
 # 
 proc ::tclTiger::Extract10LatLon {line} {
    set line2 [string range $line 18 end]
    set latlons {}
    foreach {. lon lat} [regexp -all -inline {(.{10})(.{9})} $line2] {
        if {$lon eq "+000000000"} continue
        set lat "[string range $lat 0 end-6].[string range $lat end-5 end]"
        set lon "[string range $lon 0 end-6].[string range $lon end-5 end]"
        set lat [string trim $lat]
        set lon [string trim $lon]
        
        lappend latlons $lat $lon
    }
    return $latlons
 }
 ##+##########################################################################
 # 
 # ToMappoint -- debugging routine that saves a lat,lon list to a
 # format which mappoint can import.
 # 
 proc ToMappoint {tlid {fname foo.txt}} {
    set txt "name\tlatitude\tlongitude\n"
    set idx -1
    foreach {lat lon} $::tclTiger::LATLON($tlid) {
        append txt "p[incr idx]\t$lat\t$lon\n"
    }
    set fout [open $fname w]
    puts -nonewline $fout $txt
    close $fout
 }
 ################################################################
 
 DoDisplay
 return

uniquename 2013aug19

For readers who do not have the time/facilities/whatever to setup this code and then execute it, here is an image of the GUI created by this code.

vetter_TclTiger_wiki19704_screenshot_532x376.jpg

To get this code to present the GUI, I had to comment out a statement at the top of the 'DoDisplay' proc that calls on the 'GetFipsList' proc.

Also I had to provide an empty list to a '::ttk::combobox' statement.

So there are some list items missing from the GUI, but this image can serve until a 'realistic' image of the GUI replaces this image.


osiris4isis 2014feb6

Below is the correct code that allow the starting of the program.

proc GetFipsList {} {
    global FIPS
    
    set fips {}
    set dirs [concat . [glob -nocomplain -type d *]]
    foreach dir $dirs {
        foreach fname [glob -directory $dir -nocomplain TGR*.RT1] {
            set tail [file tail $fname]
            set this "[string range $tail 3 4] [string range $tail 5 7]"
            lappend fips $this
            set FIPS($this) $fname
        }
    }
    if {$fips eq ""} { MissingFIPS 1 }
################################################################
# should be lsearch instead of lindex below
################################################################
    if {[lsearch $fips $::D(fips)] == -1} {
        set ::D(fips) [lindex $fips 0]
    }
 
    return $fips
}

There is still problem after launching the google map javascript (map is shown for a second then it went blank!) This is due to v2 not working, so to use v3, change

    <script src="http://maps.google.com/maps?file=api&v=2&key=abcdefg"

to

    <script src="http://maps.google.com/maps?file=api&amp;v=3"

To download 2006se (last release that uses the RT1, RT2, etc... format) go here: http://www.icpsr.umich.edu/icpsrweb/ICPSR/themes/tiger/