1#!/bin/sh 2# the next line restarts using /usr/local/bin/wish8.6 \ 3exec /usr/local/bin/wish8.6 "$0" "$@" 4 5# PTiger.tcl -- 6# 7# This file reads geographic outlines and places for the United States 8# and displays them in an interactive map. See the README file for 9# data sources. 10# 11# Copyright (c) 2003 Gordon D. Carrie 12# 13# Permission is hereby granted, free of charge, to any person obtaining a copy 14# of this software and associated documentation files (the "Software"), to deal 15# in the Software without restriction, including without limitation the rights 16# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 17# copies of the Software, and to permit persons to whom the Software is 18# furnished to do so, subject to the following conditions: 19# 20# The above copyright notice and this permission notice shall be included in 21# all copies or substantial portions of the Software. 22# 23# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 24# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 25# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 26# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 27# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 28# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 29# THE SOFTWARE. 30# 31# Please address questions and bug reports to tkgeomap@users.sourceforge.net 32# 33# @(#) $Id: PTiger.tcl,v 1.25 2003/12/10 01:46:51 tkgeomap Exp $ 34# 35# See the README file for data sources. 36 37# The wdgeomap package is part of the tkgeomap distribution. 38# The us_census package is in the src directory. 39 40lappend auto_path /usr/local/share/ptiger/src 41package require wdgeomap 2 42package require us_census 43 44# Set verbose to true for progress and status messages on the terminal. 45 46set verbose 1 47 48# vputs -- 49# 50# This procedure prints a message if verbose is set. 51# 52# Arguments: 53# msg - message to print 54# 55# Results: 56# If verbose is true, the string is printed to standard error. 57 58proc vputs {msg} { 59 global verbose 60 if $verbose { 61 puts stderr $msg 62 } 63} 64 65# Get dots per inch from DPI environment variable. You should set this if 66# your X server is confused about dot size on your screen. 67# Use the xdpyinfo command to check. 68 69if [info exists env(DPI)] { 70 vputs "Setting resolution to $env(DPI) dots per inch" 71 tk scaling [expr {$env(DPI) / 72.0}] 72} 73 74# Create a wdgeomap widget. See the wdgeomap man page for explanation 75# of the options. Map variables and procedures will go into a namespace 76# called 'map'. The map canvas and menu bar will appear in a new frame 77# called '.map' 78 79set scales {1:2500000 1:5000000 1:10000000 1:20000000 1:30000000 1:45000000 \ 80 1:60000000} 81geomap::wdgeomap::create map .map -refpoint {30 -96} -scale 1:30000000 \ 82 -scales $scales -lazy 1 -width 600 -height 400 -closeenough 3 83geomap::wdgeomap::set_motion_bindings "" 1 84 85# Make a label in the map canvas to display map and population information. 86 87set map_canvas [geomap::wdgeomap::map_canvas map] 88$map_canvas create polygon 0 0 1 0 1 1 0 1 -tags "maplabel background" \ 89 -fill #006666 90$map_canvas create text 0 0 -anchor n -tags "maplabel text" -justify center \ 91 -fill #ffff99 92 93# This script retrieves map projection, scale, and rotation information from 94# the map. It also gets the population threshold from the 95# us_census::places namespace. Then it updates the label with the information. 96 97set Update { 98 set projNm [::geomap::wdgeomap::cget map -projname] 99 set s [::geomap::wdgeomap::cget map -scale] 100 if [string is double $s] { 101 set s [geomap::cartg $s] 102 } 103 set r [::geomap::wdgeomap::cget map -rotation] 104 if {$r == 0.0 || $r == "north"} { 105 set l1 "$projNm $s" 106 } else { 107 set l1 "$projNm $s Rotated $r degrees" 108 } 109 if [info exists us_census::places::MinPop] { 110 set l2 \ 111 "Dots at places with population $us_census::places::MinPop or more" 112 } else { 113 set l2 "" 114 } 115 $map_canvas itemconfigure maplabel&&text -text "$l1\n$l2" 116 117 # Move the label to top center 118 119 set x [expr {[winfo width $map_canvas] / 2}] 120 $map_canvas coords maplabel&&text $x 5 121 set bbox [$map_canvas bbox maplabel&&text] 122 set x1 [lindex $bbox 0] 123 set y1 [lindex $bbox 1] 124 set x2 [lindex $bbox 2] 125 set y2 [lindex $bbox 3] 126 $map_canvas coords maplabel&&background $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 127 $map_canvas raise maplabel 128} 129 130# Call the Update script when the projection, scale, or rotation changes, and 131# when the map changes size. 132 133::geomap::wdgeomap::configure map -update $Update 134bind $map_canvas <Configure> +$Update 135eval $Update 136 137# Load and draw lines. See README for sources. 138 139namespace eval lines { 140 vputs "Loading and drawing lines" 141 142 # Store the current namespace name. We need this because most of the 143 # commands that create, access, and draw linearrays require fully 144 # qualified names. 145 146 set nmspc [namespace current] 147 148 # "ocean" background. The geomap::ocean_list command is part of the 149 # wdgeomap package. 150 151 vputs "Oceans" 152 ::geomap::lnarr fmlist ${nmspc}::oceans [::geomap::ocean_list] 153 ::geomap::wdgeomap::draw map geomap_lnarr ${nmspc}::oceans \ 154 -fill Blue4 -width 0 155 156 # World outlines. 157 158 vputs "World" 159 ::geomap::lnarr fmxdr ${nmspc}::world "/usr/local/share/ptiger/lines/world/World.xdr" 160 ::geomap::wdgeomap::draw map geomap_lnarr ${nmspc}::world -fill Green4 \ 161 -outline Black -width 1 -tags land 162 163 # States and provinces 164 165 vputs "States" 166 foreach stateFl [glob "/usr/local/share/ptiger/lines/states/*.xdr"] { 167 if [regexp "/usr/local/share/ptiger/lines/states/(.*)\.xdr" $stateFl m state] { 168 ::geomap::lnarr fmxdr ${nmspc}::$state $stateFl 169 ::geomap::wdgeomap::draw map geomap_lnarr ${nmspc}::$state \ 170 -fill Green4 -outline Black -width 1 -tags land 171 lappend states $state 172 } 173 } 174 175 # U.S. interstate highways 176 177 vputs "Interstate highways" 178 ::geomap::lnarr fmxdr ${nmspc}::highways /usr/local/share/ptiger/lines/highways/interstate.xdr 179 ::geomap::wdgeomap::draw map geomap_lnarr ${nmspc}::highways \ 180 -outline #336666 181 182 # Grid lines on top. The grid_list procedure is part of the tkgeomap_procs 183 # package. The use of fully qualified names is especially important here 184 # because the Tk core package also has a grid command. If we did not 185 # qualify the linearray name here, the 'geomap::lnarr fmlist' call would 186 # clobber the global grid command with the command for the new linearray. 187 188 vputs "Grid" 189 ::geomap::lnarr fmlist ${nmspc}::grid [::geomap::grid_list] 190 ::geomap::wdgeomap::draw map geomap_lnarr ${nmspc}::grid -outline #006666 \ 191 -linestyle LineOnOffDash -dashes 4 192 193 vputs "Done" 194} 195 196# Make a plus marker - a geomap_place item showing a plus sign. 197# Marker location can be set by double clicking mouse button 3. 198 199geomap::place new plus {45.0 -100.0} 200::geomap::wdgeomap::draw map geomap_place plus -bitmap @/usr/local/share/ptiger/src/plus.bm \ 201 -bitmapcolor Orange -dotsize 0 202bind $map_canvas <Double-3> { 203 plus set [::geomap::wdgeomap::xytolatlon map %x %y] 204} 205 206# Make a label to show bearing and range to from plus marker to cursor. 207 208frame .f -borderwidth 3 -relief raised 209label .f.plus -textvariable FmPlus 210set FmPlus "" 211set PlusFmt {Cursor at : {%.1f %.1f}. Plus to cursor: %.1f %.1f smi} 212bind $map_canvas <Motion> { 213 if {[catch "::geomap::wdgeomap::xytolatlon map %x %y" latLon] == 0} { 214 set lat [geomap::latitude $latLon] 215 set lon [geomap::longitude $latLon] 216 set azRng [geomap::place azrng plus $latLon smi] 217 set az [lindex $azRng 0] 218 set rng [lindex $azRng 1] 219 set FmPlus [format $PlusFmt $lat $lon $az $rng] 220 } else { 221 set FmPlus "Cursor is off world" 222 } 223} 224 225# The following blocks of code load U.S. place data and define scripts and 226# procedures that control how they are displayed. 227 228# Load place data. The read_sorted procedure is part of the us_census 229# package defined in /usr/local/share/ptiger/src/us_census.tcl. 230 231vputs "Loading places" 232set PlcCnt [us_census::places::read_sorted /usr/local/share/ptiger/places/places2k.sort] 233if {$PlcCnt == 0} { 234 error "No places read" 235} 236vputs "Done" 237 238# Initialize some variables to manage populated places in the map. 239# MapPlaces - a list of places currently on display. 240# MinPop - minimum population for a place to be displayed. 241# DotSize - size of the dot at a displayed place. 242 243namespace eval us_census::places { 244 set MapPlaces {} 245 set MinPop [expr {$pop([lindex $places 0]) + 1}] 246 set DotSize 1 247} 248 249# us_census::places::draw -- 250# 251# This procedure draws dots at places with population greater than MinPop. 252# 253# Arguments: 254# args a set of option value pairs. Must be one of: 255# -population number 256# Arranges for display of places with a population 257# greater than or equal to number. 258# -dotsize size 259# Specifies the dot size of displayed places. 260# 261# Results: 262# Places are displayed in the map as requested. 263 264proc us_census::places::draw {args} { 265 global Update 266 global map_canvas 267 variable MapPlaces 268 variable DotSize 269 variable MinPop 270 271 # Memo: 272 # n_places is a variable in the us_census::places namespace. Its value 273 # is a list of fully qualified names of all populated places. 274 275 variable n_places 276 277 foreach {opt val} $args { 278 switch -exact -- $opt { 279 -population { 280 if [string is integer $val] { 281 set m $val 282 } else { 283 error "Expected integer for population, got $val" 284 } 285 286 # The smallest procedure is part of the us_census package. 287 288 set i [smallest $m] 289 if {$m < $MinPop} { 290 # Population threshhold has decreased. Add dots. 291 292 set addPlaces [lrange $n_places [llength $MapPlaces] $i] 293 vputs "Adding [llength $addPlaces] dots" 294 foreach place $addPlaces { 295 ::geomap::wdgeomap::draw map geomap_place $place \ 296 -dotcolor Yellow -dotsize $DotSize \ 297 -textcolor Yellow -anchor s -tags pop_place 298 } 299 } elseif {$m > $MinPop} { 300 # Population threshhold has decreased. Delete dots. 301 302 set delPlaces [lrange $MapPlaces [expr {$i + 1}] end] 303 vputs "Deleting [llength $delPlaces] dots" 304 eval $map_canvas delete $delPlaces 305 } 306 307 # Update variables and labels. 308 309 set MapPlaces [lrange $n_places 0 $i] 310 set MinPop $m 311 uplevel #0 $Update 312 } 313 -dotsize { 314 set DotSize $val 315 $map_canvas itemconfigure pop_place -dotsize $DotSize 316 } 317 default { 318 error "Unknown option $opt" 319 } 320 } 321 } 322} 323 324# Draw some places 325 326us_census::places::draw -population 30000 -dotsize 2 327 328# Provide information about the place under the cursor. 329# Print the place name at the place, and print the full place name 330# and population in a label under the canvas widget. 331 332label .f.nearPlace -textvariable us_census::places::CurrPlace 333$map_canvas bind pop_place <Button-1> { 334 namespace eval us_census::places { 335 set currPlace [%W find withtag CurrPlace] 336 if {$currPlace != ""} { 337 %W itemconfigure $currPlace -text "" 338 %W dtag $currPlace CurrPlace 339 } 340 set id [%W find withtag current] 341 set plc [%W itemcget $id -place] 342 set CurrPlace "$name($plc),$state($plc) (population $pop($plc))" 343 %W itemconfigure $id -text "$name($plc)" 344 %W addtag CurrPlace withtag $id 345 } 346} 347 348# Create the Places menu. 349# This menu controls display of places. 350 351set PlaceMenu [::geomap::wdgeomap::addmenu map Places] 352 353# Places->Population menu item. When activated, an entry window appears 354# in which user enters minimum population for a place to be displayed. 355 356# This script is called when the Population menu is selected, or when keyboard 357# shortcuts associated with the menu are invoked. 358 359set PopScript { 360 namespace eval us_census::places { 361 362 # Create a toplevel in the map area with label and entry widgets. 363 # User should enter desired population threshold in the entry. 364 365 toplevel .population 366 set x [expr {[winfo x $map_canvas] + 200}] 367 set y [expr {[winfo y $map_canvas] + 200}] 368 wm geometry .population +$x+$y 369 label .population.l -text "Draw dot if population is greater than " 370 set ::min $MinPop 371 entry .population.e -textvariable min 372 pack .population.l .population.e 373 374 # When user hits return, call the draw proc with the entry value. 375 376 bind .population.e <Return> [namespace code { 377 if [string is integer $min] { 378 draw -population $min 379 } else { 380 tk_messageBox -type ok -message \ 381 "Population threshhold must be integer, not $min" 382 } 383 destroy .population 384 }] 385 } 386} 387$PlaceMenu add command -label "Population" -command $PopScript 388bind all <Control-p> $PopScript 389 390# Places->Find menu item. When activated, an entry box appears. User enters 391# a text pattern. If any place name matches the pattern, that place becomes 392# the center of the map, the plus marker goes there, and the population 393# threshhold is adjusted so that the place will have a dot. If several places 394# match the pattern, user selects place from a list box. 395 396# This script is called when the Find menu is selected, or when keyboard 397# shortcuts associated with the menu are invoked. 398 399set FindScript { 400 401 # Create an entry box in the map area. 402 403 toplevel .find 404 set x [expr {[winfo x $map_canvas] + 200}] 405 set y [expr {[winfo y $map_canvas] + 200}] 406 wm geometry .find +$x+$y 407 label .find.l -text "Enter name or pattern" 408 entry .find.e -textvariable ::us_census::places::search 409 pack .find.l .find.e 410 411 bind .find.e <Return> { 412 namespace eval ::us_census::places { 413 414 # Seek a match for the pattern the user entered using the 415 # regexp procedure from the us_censu package. 416 417 set found [regexp $search 1] 418 if {[llength $found] == 0} { 419 420 # User pattern does not match any place. 421 422 destroy .find 423 tk_messageBox -type ok -message "No place matches $search" 424 } else { 425 426 # User pattern matches one or more places. 427 428 if {[llength $found] == 1} { 429 430 # User pattern matches one place. 431 432 destroy .find 433 } elseif {[llength $found] > 1} { 434 435 # User pattern matches several places. 436 # Replace entry with list box from which user 437 # will select desired place. 438 439 destroy .find.e 440 .find.l configure -text "Double click desired place" 441 listbox .find.lb 442 pack .find.lb -fill both -expand true 443 foreach f $found { 444 set fullNm $name($f),$state($f) 445 .find.lb insert end $fullNm 446 } 447 bind .find.lb <Double-1> [namespace code { 448 set found [lindex $found [.find.lb curselection]] 449 destroy .find 450 }] 451 tkwait window .find 452 } 453 454 # User has selected a place. Center the map at the place. 455 # Label the place. 456 457 ::geomap::wdgeomap::configure map -refpoint [$found set] 458 plus set [$found set] 459 if {$pop($found) < $MinPop} { 460 draw -population $pop($found) 461 } 462 set currPlace [$map_canvas find withtag CurrPlace] 463 if {$currPlace != ""} { 464 $map_canvas itemconfigure $currPlace -text "" 465 $map_canvas dtag $currPlace CurrPlace 466 } 467 set id [$map_canvas find withtag \ 468 ::us_census::places::${found}&&pop_place] 469 $map_canvas itemconfigure $id -text "$name($found)" 470 $map_canvas addtag CurrPlace withtag $id 471 472 # Update the label below the map with place information. 473 474 set CurrPlace \ 475 "$name($found),$state($found) (population $pop($found))" 476 } 477 unset found 478 } 479 } 480} 481$PlaceMenu add command -label "Find" -command $FindScript 482bind all <Control-f> $FindScript 483 484# Places->Dotsize menu item 485 486set DotSizeMenu ${PlaceMenu}.dotSize 487$PlaceMenu add cascade -label Dotsize -menu $DotSizeMenu 488menu $DotSizeMenu 489foreach dotSize {1 2 3} { 490 $DotSizeMenu add command -label $dotSize \ 491 -command "::us_census::places::draw -dotsize $dotSize" 492} 493 494# Make everything visible 495 496pack .map -fill both -expand true 497pack .f.plus -fill x 498pack .f.nearPlace -fill x 499pack .f -fill x 500 501puts stderr "Click place for name" 502puts stderr "Drag map" 503