1##+##########################################################################
2#
3# gpx.tcl -- Parse gpx files
4# by Keith Vetter, July 7, 2010
5#
6# gpx definition:
7#   http://www.topografix.com/gpx.asp
8#   http://www.topografix.com/GPX/1/1/
9#   GPX 1.0 => http://www.topografix.com/gpx_manual.asp
10#
11# code reference:
12#   http://wiki.tcl.tk/26635
13
14# API
15#  set token [::gpx::Create gpxFilename]
16#  ::gpx::Cleanup $token
17#  ::gpx::GetGPXMetadata $token               => dict of metadata
18#  ::gpx::GetWaypointCount $token             => number of waypoints
19#  ::gpx::GetAllWaypoints $token              => list of waypoint items
20#  ::gpx::GetTrackCount $token                => number of tracks
21#  ::gpx::GetTrackMetadata $token $whichTrack => dict of metadata for this track
22#  ::gpx::GetTrackPoints $token $whichTrack   => list of trkpts for this track
23#  ::gpx::GetRouteCount $token                => number of routes
24#  ::gpx::GetRouteMetadata $token $whichRoute => dict of metadata for this route
25#  ::gpx::GetRoutePoints $token $whichRoute   => list of rtepts for this route
26#
27# o metadata is a dictionary whose keys depends on the which optional elements
28#   are present and whose structure depends on the element's schema
29#
30# o a waypoint/trackpoint is a 3 element list consisting of latitude,
31#   longitude and a dictionary of metadata:
32#   e.g. 41.61716028 -70.61758477 {ele 35.706 time 2010-06-17T16:02:28Z}
33#
34
35package require Tcl 8.5
36package require tdom
37
38namespace eval gpx {
39    variable nameSpaces {
40        gpx "http://www.topografix.com/GPX/1/1"
41        xsi "http://www.w3.org/2001/XMLSchema-instance"
42    }
43    # gpx 1.0 was obsoleted August 9, 2004, but we handle it anyway
44    variable nameSpaces10 {
45        gpx "http://www.topografix.com/GPX/1/0"
46        topografix "http://www.topografix.com/GPX/Private/TopoGrafix/0/2"
47    }
48    variable gpx
49    set gpx(id) 0
50
51    # Cleanup any existing doms if we reload this module
52    ::apply {{} {
53        foreach arr [array names ::gpx::gpx dom,*] {
54            catch {$::gpx::gpx($arr) delete}
55            unset ::gpx::gpx($arr)
56        }
57    }}
58}
59
60##+##########################################################################
61#
62# ::gpx::Create -- Creates a tdom object, returns opaque token to it
63#  parameters: gpxFilename
64#  returns: token for this tdom object
65#
66proc ::gpx::Create {gpxFilename {rawXML {}}} {
67    variable nameSpaces
68    variable gpx
69
70    if {$rawXML eq ""} {
71        set fin [open $gpxFilename r]
72        set rawXML [read $fin] ; list
73        close $fin
74    }
75
76    set token "gpx[incr gpx(id)]"
77    dom parse $rawXML gpx(dom,$token)
78
79    # Check version 1.0, 1.1 or fail
80    set version [[$gpx(dom,$token) documentElement] getAttribute version 0.0]
81    if {[package vcompare $version 1.1] >= 0} {
82        $gpx(dom,$token) selectNodesNamespaces $::gpx::nameSpaces
83    } elseif {[package vcompare $version 1.0] == 0} {
84        $gpx(dom,$token) selectNodesNamespaces $::gpx::nameSpaces10
85    } else {
86        $gpx(dom,$token) delete
87        error "$gpxFilename is version $version, need 1.0 or better"
88    }
89    set gpx(version,$token) $version
90    return $token
91}
92##+##########################################################################
93#
94# ::gpx::Cleanup -- Cleans up an instance of a tdom object
95#   parameter: token returned by ::gpx::Create
96#
97proc ::gpx::Cleanup {token} {
98    variable gpx
99    $gpx(dom,$token) delete
100    unset gpx(dom,$token)
101}
102
103
104##+##########################################################################
105#
106# ::gpx::GetGPXMetadata -- Return metadata dictionary for entire document
107#   parameter: token returned by ::gpx::Create
108#   returns: metadata dictionary for entire document
109#
110proc ::gpx::GetGPXMetadata {token} {
111    set gpxNode [$::gpx::gpx(dom,$token) documentElement]
112    set version $::gpx::gpx(version,$token)
113    set creator [$gpxNode getAttribute creator ?]
114    set attr [dict create version $version creator $creator]
115
116    if {[package vcompare $version 1.0] == 0} {
117        set result [::gpx::_ExtractNodeMetadata $token $gpxNode]
118    } else {
119        set meta [$::gpx::gpx(dom,$token) selectNodes /gpx:gpx/gpx:metadata]
120        set result [::gpx::_ExtractNodeMetadata $token $meta]
121    }
122    set result [dict merge $attr $result]
123    return $result
124}
125
126##+##########################################################################
127#
128# ::gpx::GetWaypointCount -- Return number of waypoints defined in gpx file
129#   parameter: token returned by ::gpx::Create
130#   returns: number of waypoints
131#
132proc ::gpx::GetWaypointCount {token} {
133    set wpts [$::gpx::gpx(dom,$token) selectNodes /gpx:gpx/gpx:wpt]
134    return [llength $wpts]
135}
136##+##########################################################################
137#
138# ::gpx::GetAllWaypoints -- Returns list of waypoints, each item consists
139# of {lat lon <dictionary of metadata>}
140#   parameter: token returned by ::gpx::Create
141#   returns: list of waypoint items
142#
143proc ::gpx::GetAllWaypoints {token} {
144    set wpts [$::gpx::gpx(dom,$token) selectNodes /gpx:gpx/gpx:wpt]
145
146    set result {}
147    foreach wpt $wpts {
148        set lat [$wpt getAttribute "lat" ?]
149        set lon [$wpt getAttribute "lon" ?]
150        set meta [::gpx::_ExtractNodeMetadata $token $wpt]
151        lappend result [list $lat $lon $meta]
152    }
153    return $result
154}
155##+##########################################################################
156#
157# ::gpx::GetTrackCount -- returns how many tracks
158#   parameter: token returned by ::gpx::Create
159#   returns: number of tracks
160#
161proc ::gpx::GetTrackCount {token} {
162    set trks [$::gpx::gpx(dom,$token) selectNodes /gpx:gpx/gpx:trk]
163    return [llength $trks]
164}
165##+##########################################################################
166#
167# ::gpx::GetTrackMetadata -- Returns metadata dictionary for this track
168#   parameter: token returned by ::gpx::Create
169#              whichTrack: which track to get (1 based)
170#   returns: metadata dictionary for this track
171#
172proc ::gpx::GetTrackMetadata {token whichTrack} {
173    set trkNode [$::gpx::gpx(dom,$token) selectNodes \
174                     /gpx:gpx/gpx:trk\[$whichTrack\]]
175
176    set meta [::gpx::_ExtractNodeMetadata $token $trkNode]
177}
178##+##########################################################################
179#
180# ::gpx::GetTrackPoints -- Returns track consisting of a list of track points,
181# each of which consists of {lat lon <dictionary of metadata>}
182#   parameter: token returned by ::gpx::Create
183#              whichTrack: which track to get (1 based)
184#   returns: list of trackpoints for given track
185#
186proc ::gpx::GetTrackPoints {token whichTrack} {
187    set trkpts [$::gpx::gpx(dom,$token) selectNodes \
188                    /gpx:gpx/gpx:trk\[$whichTrack\]//gpx:trkpt]
189    set result {}
190    foreach trkpt $trkpts {
191        set lat [$trkpt getAttribute "lat" ?]
192        set lon [$trkpt getAttribute "lon" ?]
193        set meta [::gpx::_ExtractNodeMetadata $token $trkpt]
194        lappend result [list $lat $lon $meta]
195    }
196    return $result
197}
198##+##########################################################################
199#
200# ::gpx::GetRouteCount -- returns how many routes
201#   parameter: token returned by ::gpx::Create
202#   returns: number of routes
203#
204proc ::gpx::GetRouteCount {token} {
205    set rtes [$::gpx::gpx(dom,$token) selectNodes /gpx:gpx/gpx:rte]
206    return [llength $rtes]
207}
208##+##########################################################################
209#
210# ::gpx::GetRouteMetadata -- Returns metadata dictionary for this route
211#   parameter: token returned by ::gpx::Create
212#              whichRoute: which route to get (1 based)
213#   returns: metadata dictionary for this route
214#
215proc ::gpx::GetRouteMetadata {token whichRoute} {
216    set rteNode [$::gpx::gpx(dom,$token) selectNodes \
217                     /gpx:gpx/gpx:rte\[$whichRoute\]]
218
219    set meta [::gpx::_ExtractNodeMetadata $token $rteNode]
220}
221##+##########################################################################
222#
223# ::gpx::GetRoutePoints -- Returns route consisting of a list of route points,
224# each of which consists of {lat lon <dictionary of metadata>}
225#   parameter: token returned by ::gpx::Create
226#              whichRoute: which route to get (1 based)
227#   returns: list of routepoints for given route
228#
229proc ::gpx::GetRoutePoints {token whichRoute} {
230    set rtepts [$::gpx::gpx(dom,$token) selectNodes \
231                    /gpx:gpx/gpx:rte\[$whichRoute\]//gpx:rtept]
232    set result {}
233    foreach rtept $rtepts {
234        set lat [$rtept getAttribute "lat" ?]
235        set lon [$rtept getAttribute "lon" ?]
236        set meta [::gpx::_ExtractNodeMetadata $token $rtept]
237        lappend result [list $lat $lon $meta]
238    }
239    return $result
240}
241##+##########################################################################
242#
243# ::gpx::_ExtractNodeMetadata -- Internal routine to get all
244# the optional data associated with an xml element. For most
245# elements we just want element name and text value but some
246# we want their attributes and some we want children metadata.
247#
248proc ::gpx::_ExtractNodeMetadata {token node} {
249    set result {}
250    if {$node eq ""} { return $result }
251
252    # author and email elements are different in version 1.0 and 1.1
253    set onlyAttributes [list "bounds" "email"]
254    set attributesAndElements [list "extension" "author" "link" "copyright"]
255    if {$::gpx::gpx(version,$token) == 1.0} {
256        set onlyAttributes [list "bounds"]
257        set attributesAndElements [list "extension" "link" "copyright"]
258    }
259
260    foreach child [$node childNodes] {
261        set nodeName [$child nodeName]
262
263        if {$nodeName in {"wpt" "trk" "trkseg" "trkpt" "rte" "rtept"}} continue
264        if {[string match "topografix:*" $nodeName]} continue
265
266        if {$nodeName in $onlyAttributes} {
267            set attr [::gpx::_GetAllAttributes $child]
268            lappend result $nodeName $attr
269        } elseif {$nodeName in $attributesAndElements} {
270            set attr [::gpx::_GetAllAttributes $child]
271            set meta [::gpx::_ExtractNodeMetadata $token $child]
272            set meta [concat $attr $meta]
273            lappend result $nodeName $meta
274        } else {
275            lappend result $nodeName [$child asText]
276        }
277    }
278    return $result
279}
280##+##########################################################################
281#
282# ::gpx::_GetAllAttributes -- Returns dictionary of attribute name and value
283#
284proc ::gpx::_GetAllAttributes {node} {
285    set result {}
286    foreach attr [$node attributes] {
287        lappend result $attr [$node getAttribute $attr]
288    }
289    return $result
290}
291################################################################
292
293package provide gpx 1
294return
295