#!/bin/sh
# the next line restarts using /usr/local/bin/wish8.4 \
exec /usr/local/bin/wish8.4 "$0" "$@"
# PTiger.tcl --
#
# This file reads geographic outlines and places for the United States
# and displays them in an interactive map. See the README file for
# data sources.
#
# Copyright (c) 2003 Gordon D. Carrie
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
# THE SOFTWARE.
#
# Please address questions and bug reports to tkgeomap@users.sourceforge.net
#
# @(#) $Id: PTiger.tcl,v 1.25 2003/12/10 01:46:51 tkgeomap Exp $
#
# See the README file for data sources.
# The wdgeomap package is part of the tkgeomap distribution.
# The us_census package is in the src directory.
lappend auto_path /usr/local/share/ptiger/src
package require wdgeomap 2
package require us_census
# Set verbose to true for progress and status messages on the terminal.
set verbose 1
# vputs --
#
# This procedure prints a message if verbose is set.
#
# Arguments:
# msg - message to print
#
# Results:
# If verbose is true, the string is printed to standard error.
proc vputs {msg} {
global verbose
if $verbose {
puts stderr $msg
}
}
# Get dots per inch from DPI environment variable. You should set this if
# your X server is confused about dot size on your screen.
# Use the xdpyinfo command to check.
if [info exists env(DPI)] {
vputs "Setting resolution to $env(DPI) dots per inch"
tk scaling [expr {$env(DPI) / 72.0}]
}
# Create a wdgeomap widget. See the wdgeomap man page for explanation
# of the options. Map variables and procedures will go into a namespace
# called 'map'. The map canvas and menu bar will appear in a new frame
# called '.map'
set scales {1:2500000 1:5000000 1:10000000 1:20000000 1:30000000 1:45000000 \
1:60000000}
geomap::wdgeomap::create map .map -refpoint {30 -96} -scale 1:30000000 \
-scales $scales -lazy 1 -width 600 -height 400 -closeenough 3
geomap::wdgeomap::set_motion_bindings "" 1
# Make a label in the map canvas to display map and population information.
set map_canvas [geomap::wdgeomap::map_canvas map]
$map_canvas create polygon 0 0 1 0 1 1 0 1 -tags "maplabel background" \
-fill #006666
$map_canvas create text 0 0 -anchor n -tags "maplabel text" -justify center \
-fill #ffff99
# This script retrieves map projection, scale, and rotation information from
# the map. It also gets the population threshold from the
# us_census::places namespace. Then it updates the label with the information.
set Update {
set projNm [::geomap::wdgeomap::cget map -projname]
set s [::geomap::wdgeomap::cget map -scale]
if [string is double $s] {
set s [geomap::cartg $s]
}
set r [::geomap::wdgeomap::cget map -rotation]
if {$r == 0.0 || $r == "north"} {
set l1 "$projNm $s"
} else {
set l1 "$projNm $s Rotated $r degrees"
}
if [info exists us_census::places::MinPop] {
set l2 \
"Dots at places with population $us_census::places::MinPop or more"
} else {
set l2 ""
}
$map_canvas itemconfigure maplabel&&text -text "$l1\n$l2"
# Move the label to top center
set x [expr {[winfo width $map_canvas] / 2}]
$map_canvas coords maplabel&&text $x 5
set bbox [$map_canvas bbox maplabel&&text]
set x1 [lindex $bbox 0]
set y1 [lindex $bbox 1]
set x2 [lindex $bbox 2]
set y2 [lindex $bbox 3]
$map_canvas coords maplabel&&background $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2
$map_canvas raise maplabel
}
# Call the Update script when the projection, scale, or rotation changes, and
# when the map changes size.
::geomap::wdgeomap::configure map -update $Update
bind $map_canvas <Configure> +$Update
eval $Update
# Load and draw lines. See README for sources.
namespace eval lines {
vputs "Loading and drawing lines"
# Store the current namespace name. We need this because most of the
# commands that create, access, and draw linearrays require fully
# qualified names.
set nmspc [namespace current]
# "ocean" background. The geomap::ocean_list command is part of the
# wdgeomap package.
vputs "Oceans"
::geomap::lnarr fmlist ${nmspc}::oceans [::geomap::ocean_list]
::geomap::wdgeomap::draw map geomap_lnarr ${nmspc}::oceans \
-fill Blue4 -width 0
# World outlines.
vputs "World"
::geomap::lnarr fmxdr ${nmspc}::world "/usr/local/share/ptiger/lines/world/World.xdr"
::geomap::wdgeomap::draw map geomap_lnarr ${nmspc}::world -fill Green4 \
-outline Black -width 1 -tags land
# States and provinces
vputs "States"
foreach stateFl [glob "/usr/local/share/ptiger/lines/states/*.xdr"] {
if [regexp "/usr/local/share/ptiger/lines/states/(.*)\.xdr" $stateFl m state] {
::geomap::lnarr fmxdr ${nmspc}::$state $stateFl
::geomap::wdgeomap::draw map geomap_lnarr ${nmspc}::$state \
-fill Green4 -outline Black -width 1 -tags land
lappend states $state
}
}
# U.S. interstate highways
vputs "Interstate highways"
::geomap::lnarr fmxdr ${nmspc}::highways /usr/local/share/ptiger/lines/highways/interstate.xdr
::geomap::wdgeomap::draw map geomap_lnarr ${nmspc}::highways \
-outline #336666
# Grid lines on top. The grid_list procedure is part of the tkgeomap_procs
# package. The use of fully qualified names is especially important here
# because the Tk core package also has a grid command. If we did not
# qualify the linearray name here, the 'geomap::lnarr fmlist' call would
# clobber the global grid command with the command for the new linearray.
vputs "Grid"
::geomap::lnarr fmlist ${nmspc}::grid [::geomap::grid_list]
::geomap::wdgeomap::draw map geomap_lnarr ${nmspc}::grid -outline #006666 \
-linestyle LineOnOffDash -dashes 4
vputs "Done"
}
# Make a plus marker - a geomap_place item showing a plus sign.
# Marker location can be set by double clicking mouse button 3.
geomap::place new plus {45.0 -100.0}
::geomap::wdgeomap::draw map geomap_place plus -bitmap @/usr/local/share/ptiger/src/plus.bm \
-bitmapcolor Orange -dotsize 0
bind $map_canvas <Double-3> {
plus set [::geomap::wdgeomap::xytolatlon map %x %y]
}
# Make a label to show bearing and range to from plus marker to cursor.
frame .f -borderwidth 3 -relief raised
label .f.plus -textvariable FmPlus
set FmPlus ""
set PlusFmt {Cursor at : {%.1f %.1f}. Plus to cursor: %.1f %.1f smi}
bind $map_canvas <Motion> {
if {[catch "::geomap::wdgeomap::xytolatlon map %x %y" latLon] == 0} {
set lat [geomap::latitude $latLon]
set lon [geomap::longitude $latLon]
set azRng [geomap::place azrng plus $latLon smi]
set az [lindex $azRng 0]
set rng [lindex $azRng 1]
set FmPlus [format $PlusFmt $lat $lon $az $rng]
} else {
set FmPlus "Cursor is off world"
}
}
# The following blocks of code load U.S. place data and define scripts and
# procedures that control how they are displayed.
# Load place data. The read_sorted procedure is part of the us_census
# package defined in /usr/local/share/ptiger/src/us_census.tcl.
vputs "Loading places"
set PlcCnt [us_census::places::read_sorted /usr/local/share/ptiger/places/places2k.sort]
if {$PlcCnt == 0} {
error "No places read"
}
vputs "Done"
# Initialize some variables to manage populated places in the map.
# MapPlaces - a list of places currently on display.
# MinPop - minimum population for a place to be displayed.
# DotSize - size of the dot at a displayed place.
namespace eval us_census::places {
set MapPlaces {}
set MinPop [expr {$pop([lindex $places 0]) + 1}]
set DotSize 1
}
# us_census::places::draw --
#
# This procedure draws dots at places with population greater than MinPop.
#
# Arguments:
# args a set of option value pairs. Must be one of:
# -population number
# Arranges for display of places with a population
# greater than or equal to number.
# -dotsize size
# Specifies the dot size of displayed places.
#
# Results:
# Places are displayed in the map as requested.
proc us_census::places::draw {args} {
global Update
global map_canvas
variable MapPlaces
variable DotSize
variable MinPop
# Memo:
# n_places is a variable in the us_census::places namespace. Its value
# is a list of fully qualified names of all populated places.
variable n_places
foreach {opt val} $args {
switch -exact -- $opt {
-population {
if [string is integer $val] {
set m $val
} else {
error "Expected integer for population, got $val"
}
# The smallest procedure is part of the us_census package.
set i [smallest $m]
if {$m < $MinPop} {
# Population threshhold has decreased. Add dots.
set addPlaces [lrange $n_places [llength $MapPlaces] $i]
vputs "Adding [llength $addPlaces] dots"
foreach place $addPlaces {
::geomap::wdgeomap::draw map geomap_place $place \
-dotcolor Yellow -dotsize $DotSize \
-textcolor Yellow -anchor s -tags pop_place
}
} elseif {$m > $MinPop} {
# Population threshhold has decreased. Delete dots.
set delPlaces [lrange $MapPlaces [expr {$i + 1}] end]
vputs "Deleting [llength $delPlaces] dots"
eval $map_canvas delete $delPlaces
}
# Update variables and labels.
set MapPlaces [lrange $n_places 0 $i]
set MinPop $m
uplevel #0 $Update
}
-dotsize {
set DotSize $val
$map_canvas itemconfigure pop_place -dotsize $DotSize
}
default {
error "Unknown option $opt"
}
}
}
}
# Draw some places
us_census::places::draw -population 30000 -dotsize 2
# Provide information about the place under the cursor.
# Print the place name at the place, and print the full place name
# and population in a label under the canvas widget.
label .f.nearPlace -textvariable us_census::places::CurrPlace
$map_canvas bind pop_place <Button-1> {
namespace eval us_census::places {
set currPlace [%W find withtag CurrPlace]
if {$currPlace != ""} {
%W itemconfigure $currPlace -text ""
%W dtag $currPlace CurrPlace
}
set id [%W find withtag current]
set plc [%W itemcget $id -place]
set CurrPlace "$name($plc),$state($plc) (population $pop($plc))"
%W itemconfigure $id -text "$name($plc)"
%W addtag CurrPlace withtag $id
}
}
# Create the Places menu.
# This menu controls display of places.
set PlaceMenu [::geomap::wdgeomap::addmenu map Places]
# Places->Population menu item. When activated, an entry window appears
# in which user enters minimum population for a place to be displayed.
# This script is called when the Population menu is selected, or when keyboard
# shortcuts associated with the menu are invoked.
set PopScript {
namespace eval us_census::places {
# Create a toplevel in the map area with label and entry widgets.
# User should enter desired population threshold in the entry.
toplevel .population
set x [expr {[winfo x $map_canvas] + 200}]
set y [expr {[winfo y $map_canvas] + 200}]
wm geometry .population +$x+$y
label .population.l -text "Draw dot if population is greater than "
set ::min $MinPop
entry .population.e -textvariable min
pack .population.l .population.e
# When user hits return, call the draw proc with the entry value.
bind .population.e <Return> [namespace code {
if [string is integer $min] {
draw -population $min
} else {
tk_messageBox -type ok -message \
"Population threshhold must be integer, not $min"
}
destroy .population
}]
}
}
$PlaceMenu add command -label "Population" -command $PopScript
bind all <Control-p> $PopScript
# Places->Find menu item. When activated, an entry box appears. User enters
# a text pattern. If any place name matches the pattern, that place becomes
# the center of the map, the plus marker goes there, and the population
# threshhold is adjusted so that the place will have a dot. If several places
# match the pattern, user selects place from a list box.
# This script is called when the Find menu is selected, or when keyboard
# shortcuts associated with the menu are invoked.
set FindScript {
# Create an entry box in the map area.
toplevel .find
set x [expr {[winfo x $map_canvas] + 200}]
set y [expr {[winfo y $map_canvas] + 200}]
wm geometry .find +$x+$y
label .find.l -text "Enter name or pattern"
entry .find.e -textvariable ::us_census::places::search
pack .find.l .find.e
bind .find.e <Return> {
namespace eval ::us_census::places {
# Seek a match for the pattern the user entered using the
# regexp procedure from the us_censu package.
set found [regexp $search 1]
if {[llength $found] == 0} {
# User pattern does not match any place.
destroy .find
tk_messageBox -type ok -message "No place matches $search"
} else {
# User pattern matches one or more places.
if {[llength $found] == 1} {
# User pattern matches one place.
destroy .find
} elseif {[llength $found] > 1} {
# User pattern matches several places.
# Replace entry with list box from which user
# will select desired place.
destroy .find.e
.find.l configure -text "Double click desired place"
listbox .find.lb
pack .find.lb -fill both -expand true
foreach f $found {
set fullNm $name($f),$state($f)
.find.lb insert end $fullNm
}
bind .find.lb <Double-1> [namespace code {
set found [lindex $found [.find.lb curselection]]
destroy .find
}]
tkwait window .find
}
# User has selected a place. Center the map at the place.
# Label the place.
::geomap::wdgeomap::configure map -refpoint [$found set]
plus set [$found set]
if {$pop($found) < $MinPop} {
draw -population $pop($found)
}
set currPlace [$map_canvas find withtag CurrPlace]
if {$currPlace != ""} {
$map_canvas itemconfigure $currPlace -text ""
$map_canvas dtag $currPlace CurrPlace
}
set id [$map_canvas find withtag \
::us_census::places::${found}&&pop_place]
$map_canvas itemconfigure $id -text "$name($found)"
$map_canvas addtag CurrPlace withtag $id
# Update the label below the map with place information.
set CurrPlace \
"$name($found),$state($found) (population $pop($found))"
}
unset found
}
}
}
$PlaceMenu add command -label "Find" -command $FindScript
bind all <Control-f> $FindScript
# Places->Dotsize menu item
set DotSizeMenu ${PlaceMenu}.dotSize
$PlaceMenu add cascade -label Dotsize -menu $DotSizeMenu
menu $DotSizeMenu
foreach dotSize {1 2 3} {
$DotSizeMenu add command -label $dotSize \
-command "::us_census::places::draw -dotsize $dotSize"
}
# Make everything visible
pack .map -fill both -expand true
pack .f.plus -fill x
pack .f.nearPlace -fill x
pack .f -fill x
puts stderr "Click place for name"
puts stderr "Drag map"
syntax highlighted by Code2HTML, v. 0.9.1