[jdc] 27-jun-2007 **World locations package** A list of 13000 waypoints can be found as a spreadsheet here: http://www.tapr.org/~kh2z/Waypoint/WaypointFiles.htm. The following code uses this file to get information about locations based on name or coordinates: ====== package provide worldlocations 0.1 namespace eval ::worldlocations { variable locations_file WorldLocations.csv variable location_keys {major_location name abbrev state country country_code info airport_id icoa latitude longitude} variable location_csv_keys {major_location name abbrev state country country_code info airport_id icoa latitude ns longitude ew} } proc ::worldlocations::make_num { n } { set n [string trimleft [string trim $n] "0"] if { [string length $n] == 0 } { set n 0 } return $n } proc ::worldlocations::make_num { n } { set n [string trimleft [string trim $n] "0"] if { [string length $n] == 0 } { set n 0 } return $n } proc ::worldlocations::parse_locations { arnm {metar_only 1} } { upvar $arnm ar variable location_keys variable location_csv_keys variable locations_file set f [open $locations_file] set ll [split [read $f] "\n"] close $f foreach l $ll { foreach $location_csv_keys [split $l ";"] break set kname [string trim $name " \""] if { [info exists ar($kname,name)] } { incr locid($kname) append kname "-#$locid($kname)" } else { set locid($kname) 0 } set ar($kname,name) [string trim $name " \""] set ar($kname,major_location) [make_num [string trim $major_location " \""]] set ar($kname,abbrev) [string trim $abbrev " \""] set ar($kname,state) [string trim $state " \""] set ar($kname,country) [string trim $country " \""] set ar($kname,country_code) [string trim $country_code " \""] set ar($kname,info) [string trim $info " \""] set ar($kname,airport_id) [string trim $airport_id " \""] set ar($kname,icoa) [string trim $icoa " \""] set ar($kname,latitude) [make_num [string trim $latitude " \""]] set ar($kname,longitude) [make_num [string trim $longitude " \""]] if { [string trim $ns " \""] eq "South" } { set ar($kname,latitude) -$ar($kname,latitude) } if { [string trim $ew " \""] eq "East" } { set ar($kname,longitude) -$ar($kname,longitude) } } } proc ::worldlocations::get_location_by_key_match { key match {n 1} } { variable statar variable location_keys if { ![info exists statar] } { ::worldlocations::parse_locations statar } set rl {} foreach k [array names statar "*,$key"] { if { [string match -nocase $match $statar($k)] } { set tl {} set location [lindex [split $k ","] 0] foreach sk $location_keys { lappend tl $sk $statar($location,$sk) } lappend rl $tl if { [llength $rl] >= $n } break } } return $rl } proc ::worldlocations::get_location_by_coordinates { lat lon {n 1} } { variable statar variable location_keys if { ![info exists statar] } { ::worldlocations::parse_locations statar } set dl {} foreach k [array names statar "*,latitude"] { foreach {location nm} [split $k ","] break set d [expr {pow($lat - $statar($location,latitude), 2) + pow($lon - $statar($location,longitude), 2)}] lappend dl [list $d $location] } set dl [lsort -real -index 0 $dl] set rl {} foreach sl $dl { set location [lindex $sl 1] set tl {} foreach sk $location_keys { lappend tl $sk $statar($location,$sk) } lappend rl $tl if { [llength $rl] >= $n } break } return $rl } ====== Save the code in a file with name `worldlocations.tcl` and add a pkgIndex.tcl file with this contents: ====== package ifneeded worldlocations 0.1 [list source [file join $dir worldlocations.tcl]] ======