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