#!/bin/sh
# the next line restarts using /usr/local/bin/wish8.6 \
exec /usr/local/bin/wish8.6 "$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"
