Version 19 of World locations

Updated 2007-06-27 14:36:14 by jdc

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]]