Skip to content

Commit

Permalink
Merge branch 'master' of https://github.com/jl2/gpxtools
Browse files Browse the repository at this point in the history
  • Loading branch information
@jl2
jl2 committed Aug 1, 2016
2 parents 0122890 + e165bed commit 1524129
Show file tree
Hide file tree
Showing 2 changed files with 117 additions and 22 deletions.
124 changes: 102 additions & 22 deletions gpxtools.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,61 +23,102 @@
(defstruct gpx-pt
(lat 0.0 :type double-float)
(lon 0.0 :type double-float)
(ele 0.0 :type double-float))
(ele 0.0 :type double-float)
(time "" :type string))

(defun to-utm (pt &key (zone nil))
(let ((utm (utm:lat-lon-to-utm (gpx-pt-lat pt) (gpx-pt-lon pt) :zone zone)))
(make-utm-pt :easting (car utm) :northing (cadr utm) :zone (caddr utm) :ele (gpx-pt-ele pt))))

(defstruct gpx-segment
(points () :type list)
(name "" :type string)
(num-points 0 :type integer)
(point-count 0 :type integer)
(max-lat -361.0d0 :type double-float)
(min-lat 361.0d0 :type double-float)
(max-lon -361.0d0 :type double-float)
(min-lon 361.0d0 :type double-float))

(defstruct gpx-track
(name "" :type string)
(segments () :type list))

(defstruct gpx-file
(tracks () :type list))


(defun format-iso (tm)
(multiple-value-bind (sec min hr day mon yr dow dst-p tz)
(decode-universal-time tm)
(declare (ignore dow dst-p tz))
(format nil "~4,'0d-~2,'0d-~2,'0dT~2,'0d:~2,'0d:~2,'0dZ" yr mon day hr min sec)))

(defgeneric write-gpx (el stream)
(:documentation "Write a GPX element to a file."))

(defmethod write-gpx ((pt gpx-pt) (stm stream))
(format stm "<trkpt lat=\"~,9f\" lon=\"~,9f\"><ele>~,9f</ele><time>~a</time></trkpt>~%"
(gpx-pt-lat pt)
(gpx-pt-lon pt)
(gpx-pt-ele pt)
(gpx-pt-time pt)))

(defmethod write-gpx ((seg gpx-segment) (stm stream))
(format stm "<trkseg>")
(loop for i in (gpx-segment-points seg) do
(write-gpx i stm))
(format stm "</trkseg>"))

(defmethod write-gpx ((track gpx-track) (stm stream))
(format stm "<trk><name>~a</name>" (gpx-track-name track))
(loop for seg in (gpx-track-segments track) do
(write-gpx seg stm))
(format stm "</trk>"))

(defmethod write-gpx ((file gpx-file) (file-name string))
(with-open-file
(stream file-name :direction :output)
(format stream "<?xml version=\"1.0\" encoding=\"UTF-8\"?><gpx version=\"1.0\" creator=\"gpxtools\" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xmlns=\"http://www.topografix.com/GPX/1/0\" xsi:schemaLocation=\"http://www.topografix.com/GPX/1/0 http://www.topografix.com/GPX/1/0/gpx.xsd\">")
(format stream "<time>~a</time>" (format-iso (get-universal-time)))
(loop for track in (gpx-file-tracks file) do
(write-gpx track stream))
(format stream "</gpx>")))

(defun read-gpx (file-name)
(let ((doc (cxml:parse-file file-name (cxml-dom:make-dom-builder)))
(rval ()))
(labels
((process-track
(track-node)
(let ((segs ()))
(xpath:do-node-set
(node (xpath:evaluate "gpx:trkseg" track-node))
(let ((name (xpath:evaluate "string(gpx:name)" track-node)))
(format t "Processing track: ~a~%" name)
(setf segs (cons (process-trackseg node name) segs))))
(make-gpx-track :segments segs)))
(let ((segs ())
(tname ""))
(xpath:do-node-set
(node (xpath:evaluate "gpx:trkseg" track-node))
(let ((name (xpath:evaluate "string(gpx:name)" track-node)))
(format t "Processing track: ~a~%" name)
(setf tname name))
(setf segs (cons (process-trackseg node) segs)))
(make-gpx-track :segments segs :name tname)))

(process-trackseg
(seg-node name)
(let ((track (make-gpx-segment :name name)))
(xpath:do-node-set
(node (xpath:evaluate "gpx:trkpt" seg-node))
(let ((np (process-trackpt node)))
(seg-node)
(let ((track (make-gpx-segment)))
(xpath:do-node-set
(node (xpath:evaluate "gpx:trkpt" seg-node))
(let ((np (process-trackpt node)))
(setf (gpx-segment-points track) (cons np (gpx-segment-points track)))
(setf (gpx-segment-max-lat track) (max (gpx-pt-lat np) (gpx-segment-max-lat track)))
(setf (gpx-segment-min-lat track) (min (gpx-pt-lat np) (gpx-segment-min-lat track)))
(setf (gpx-segment-max-lon track) (max (gpx-pt-lon np) (gpx-segment-max-lon track)))
(setf (gpx-segment-min-lon track) (min (gpx-pt-lon np) (gpx-segment-min-lon track)))
(incf (gpx-segment-num-points track))))
(incf (gpx-segment-point-count track))))
track))

(process-trackpt
(pt-node)
(let ((lat (string-to-float (xpath:evaluate "string(@lat)" pt-node)))
(lon (string-to-float (xpath:evaluate "string(@lon)" pt-node)))
(ele (string-to-float (xpath:evaluate "string(gpx:ele)" pt-node))))
(make-gpx-pt :lat lat :lon lon :ele ele))))
(ele (string-to-float (xpath:evaluate "string(gpx:ele)" pt-node)))
(time (xpath:evaluate "string(gpx:time)" pt-node)))
(make-gpx-pt :lat lat :lon lon :ele ele :time time))))

(xpath:with-namespaces
(("gpx" (xpath:evaluate "namespace-uri(/*)" doc)))
Expand Down Expand Up @@ -152,8 +193,6 @@
(:documentation "Traverse the GPX element and sum the results of (func point[i] point[i+1])"))

(defmethod collect-points ((seg gpx-segment))

(format t "collect-points returning ~a points~%" (length (gpx-segment-points seg)))
(gpx-segment-points seg))

(defmethod collect-points ((track gpx-track))
Expand All @@ -177,6 +216,17 @@
(defun distance (el)
(traverse2 el #'distance-between))

(defun get-summary (gpx &key (units 'imperial))
(let ((eg (elevation-gain gpx))
(el (elevation-loss gpx))
(dist (distance gpx))
(shortunit (if (eq units 'imperial) "feet" "meters"))
(longunit (if (eq units 'imperial) "miles" "kilometers")))
(list
(list 'total-elevation-gain (if (eq units 'imperial) (meters-to-feet eg) eg) shortunit)
(list 'total-elevation-lost (if (eq units 'imperial) (meters-to-feet el) el) shortunit)
(list 'total-distance (if (eq units 'imperial) (meters-to-miles dist) (/ dist 1000.0)) longunit))))

(defun summarize (gpx &key (units 'imperial))
(let ((eg (elevation-gain gpx))
(el (elevation-loss gpx))
Expand All @@ -196,9 +246,39 @@
do
(incf total-distance (distance-between i j))
(push (list (meters-to-miles total-distance) (meters-to-feet (gpx-pt-ele i))) new-points))
(format t "Plotting ~a points.~%" (length new-points))
(adw-charting:with-chart (:line 1600 1200)
(adw-charting:add-series "Elevation" new-points)
(adw-charting:set-axis :y "Elevation (feet)")
(adw-charting:set-axis :x "Distance (miles)")
(adw-charting:save-file file-name))))

(defun find-loop (gpx &key (eps 0.001))
(let* ((all-pts (collect-points gpx))
(first-pt (car all-pts)))
(format t "Checking ~a points~%" (length all-pts))
(loop for i in (cdr all-pts)
for j upto (- (length all-pts) 1) do
(let ((this-dist (distance-between first-pt i)))
(if (< this-dist eps)
(format t "Point ~a is ~a meters away from the start!~%" j this-dist))))))

(defun simplify (gpx &key (dist 0.1))
(let* ((all-pts (collect-points gpx))
(cur-pt (car all-pts))
(new-pts (list cur-pt)))

(loop for i in (cdr all-pts) do
(let ((this-dist (distance-between cur-pt i)))
(cond ((> this-dist dist)
(setf cur-pt i)
(push cur-pt new-pts)))))


(make-gpx-file
:tracks (list (make-gpx-track
:segments (list (make-gpx-segment :points (reverse new-pts) :point-count (length new-pts)))
:name "Simplified")))))


(defun gpx-file-from-track (track)
(make-gpx-file :tracks (list track)))
15 changes: 15 additions & 0 deletions package.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,8 +10,23 @@
#:elevation-diff
#:meters-to-feet
#:meters-to-miles
#:get-summary
#:summarize
#:collect-points
#:elevation-plot
#:find-loop
#:simplify
#:write-gpx
#:gpx-file-tracks
#:gpx-track-segments
#:gpx-segment-points
#:gpx-segment-point-count

#:gpx-point-lat
#:gpx-point-lon
#:gpx-point-ele
#:gpx-point-time

#:gpx-file-from-track
))

0 comments on commit 1524129

Please sign in to comment.