branch: externals/osm
commit 7e78000a7a2937f479c25f6c1e97d838f16104b5
Author: Daniel Mendler <[email protected]>
Commit: Daniel Mendler <[email protected]>
Add osm-route command
---
osm.el | 138 ++++++++++++++++++++++++++++++++++++++++++++---------------------
1 file changed, 93 insertions(+), 45 deletions(-)
diff --git a/osm.el b/osm.el
index 9f77e55b17..298c84e1a0 100644
--- a/osm.el
+++ b/osm.el
@@ -34,8 +34,8 @@
;; multiple preconfigured tile servers. You can bookmark your favorite
;; locations using regular Emacs bookmarks or create links from Org files
;; to locations. Furthermore the package provides commands to measure
-;; distances, search for locations by name and to open and display GPX
-;; tracks.
+;; distances, search for locations and routes by name and to open and
+;; display GPX tracks.
;; osm.el requires Emacs 29 and depends on the external `curl' program.
;; Emacs must be built with libxml, libjansson, librsvg, libjpeg, libpng
@@ -266,6 +266,7 @@ Should be at least 7 days according to the server usage
policies."
"t" #'osm-goto
"u" #'osm-url
"j" #'osm-jump
+ "r" #'osm-route
"x" #'osm-gpx-show
"X" #'osm-gpx-hide)
@@ -336,9 +337,11 @@ Should be at least 7 days according to the server usage
policies."
["Go to coordinates" osm-goto]
["Go to URL" osm-url]
["Jump to pin" osm-jump]
- ["Search by name" osm-search]
["Change tile server" osm-server]
"--"
+ ["Search by name" osm-search]
+ ["Plan route" osm-route]
+ "--"
["Org Link" org-store-link]
["Geo URL" osm-save-url]
["Elisp Link" (osm-save-url t)]
@@ -467,15 +470,39 @@ Local per buffer since the overlays depend on the zoom
level.")
(setq lat (* lat (/ float-pi 180.0)))
(- 0.5 (/ (log (+ (tan lat) (/ 1.0 (cos lat)))) float-pi 2)))
-(defun osm--boundingbox-to-zoom (lat1 lat2 lon1 lon2)
- "Compute zoom level from boundingbox LAT1 to LAT2 and LON1 to LON2."
- (let ((w (/ (frame-pixel-width) 256))
- (h (/ (frame-pixel-height) 256)))
+(defun osm--bb-to-zoom (bb)
+ "Zoom level from bounding box BB."
+ (pcase-let ((`(,min-lat ,max-lat ,min-lon ,max-lon) bb)
+ (w (/ (frame-pixel-width) 256))
+ (h (/ (frame-pixel-height) 256)))
(max (osm--server-property :min-zoom)
(min
(osm--server-property :max-zoom)
- (min (logb (/ w (abs (- (osm--lon-to-normalized-x lon1)
(osm--lon-to-normalized-x lon2)))))
- (logb (/ h (abs (- (osm--lat-to-normalized-y lat1)
(osm--lat-to-normalized-y lat2))))))))))
+ (min (logb (/ w (abs (- (osm--lon-to-normalized-x min-lon)
+ (osm--lon-to-normalized-x max-lon)))))
+ (logb (/ h (abs (- (osm--lat-to-normalized-y min-lat)
+ (osm--lat-to-normalized-y max-lat))))))))))
+
+(defun osm--bb-center (bb)
+ "Center of bounding box BB."
+ (pcase-let ((`(,min-lat ,max-lat ,min-lon ,max-lon) bb))
+ (cons (/ (+ min-lat max-lat) 2) (/ (+ min-lon max-lon) 2))))
+
+(defun osm--bb-from-track (track waypoints)
+ "Compute bounding box from TRACK and WAYPOINTS."
+ (let ((min-lat 90) (max-lat -90) (min-lon 180) (max-lon -180))
+ (cl-loop for seg in track do
+ (cl-loop for (lat . lon) in seg do
+ (setq min-lat (min lat min-lat)
+ max-lat (max lat max-lat)
+ min-lon (min lon min-lon)
+ max-lon (max lon max-lon))))
+ (cl-loop for (lat lon . _) in waypoints do
+ (setq min-lat (min lat min-lat)
+ max-lat (max lat max-lat)
+ min-lon (min lon min-lon)
+ max-lon (max lon max-lon)))
+ (list min-lat max-lat min-lon max-lon)))
(defun osm--x-to-lon (x zoom)
"Return longitude in degrees for X/ZOOM."
@@ -730,7 +757,7 @@ Local per buffer since the overlays depend on the zoom
level.")
(length osm--track) (+ len1 len2)
(if (or (= len1 0) (= len2 0))
sel-name
- (format "%.2fkm → %s → %.2fkm"
+ (format "%.2fkm ⟶ %s ⟶ %.2fkm"
len1 sel-name len2))))))
(defun osm--pin-at (event &optional type)
@@ -1738,9 +1765,35 @@ See `osm-search-server' and `osm-search-language' for
customization."
(let ((selected (osm--search-select needle lucky)))
;; TODO: Add search bounded to current viewbox, bounded=1,
viewbox=x1,y1,x2,y2
(osm--goto (cadr selected) (caddr selected)
- (apply #'osm--boundingbox-to-zoom (cdddr selected))
+ (osm--bb-to-zoom (cdddr selected))
nil 'osm-selected (car selected))))
+;;;###autoload
+(defun osm-route ()
+ "Fetch a route between two locations."
+ (interactive)
+ (let* ((from (osm--search-select (osm--search-read "From: ") nil))
+ (to (osm--search-select (osm--search-read "To: ") nil))
+ (by (completing-read "By: " '("car" "bike" "foot") nil t nil t))
+ (data
+ (progn
+ ;; TODO make this configurable, use `format-spec' for url params
+ (message "Contacting routing.openstreetmap.de")
+ (osm--fetch-json
+ (format
"https://routing.openstreetmap.de/routed-%s/route/v1/driving/%.6f,%.6f;%.6f,%.6f?steps=false&overview=full&alternatives=false&geometries=geojson";
+ by (caddr from) (cadr from) (caddr to) (cadr to)))))
+ (route (car (alist-get 'routes data)))
+ (coords (or (alist-get 'coordinates (alist-get 'geometry route))
+ (error "No route available")))
+ (waypoints (alist-get 'waypoints data)))
+ (osm--add-gpx
+ (format "By %s: %s ⟶ %s" by (car from) (car to))
+ (list (mapcar (lambda (x) (cons (cadr x) (car x))) coords))
+ (mapcar (lambda (x)
+ (let ((l (alist-get 'location x)))
+ (list (cadr l) (car l) (alist-get 'name x))))
+ waypoints))))
+
;;;###autoload
(defun osm-gpx-show (file)
"Show the tracks of gpx FILE in an `osm-mode' buffer."
@@ -1748,45 +1801,40 @@ See `osm-search-server' and `osm-search-language' for
customization."
(osm--check-libraries)
(let ((dom (with-temp-buffer
(insert-file-contents file)
- (libxml-parse-xml-region (point-min) (point-max))))
- (min-lat 90) (max-lat -90) (min-lon 180) (max-lon -180))
+ (libxml-parse-xml-region (point-min) (point-max)))))
(unless (eq 'gpx (dom-tag dom))
(setq dom (dom-child-by-tag dom 'gpx)))
(unless (and dom (eq 'gpx (dom-tag dom)))
(error "Not a GPX file"))
- (setf (alist-get (abbreviate-file-name file) osm--gpx-files nil nil
#'equal)
- (cons
- (cl-loop
- for trk in (dom-children dom)
- if (eq (dom-tag trk) 'trk) nconc
- (cl-loop
- for seg in (dom-children trk)
- if (eq (dom-tag seg) 'trkseg) collect
- (cl-loop
- for pt in (dom-children seg)
- if (eq (dom-tag pt) 'trkpt) collect
- (let ((lat (string-to-number (dom-attr pt 'lat)))
- (lon (string-to-number (dom-attr pt 'lon))))
- (setq min-lat (min lat min-lat)
- max-lat (max lat max-lat)
- min-lon (min lon min-lon)
- max-lon (max lon max-lon))
- (cons lat lon)))))
- (cl-loop
- for pt in (dom-children dom)
- if (eq (dom-tag pt) 'wpt) collect
- (let ((lat (string-to-number (dom-attr pt 'lat)))
- (lon (string-to-number (dom-attr pt 'lon))))
- (setq min-lat (min lat min-lat)
- max-lat (max lat max-lat)
- min-lon (min lon min-lon)
- max-lon (max lon max-lon))
- (list lat lon (with-no-warnings
- (dom-text (dom-child-by-tag pt 'name))))))))
+ (osm--add-gpx
+ (abbreviate-file-name file)
+ (cl-loop
+ for trk in (dom-children dom)
+ if (eq (dom-tag trk) 'trk) nconc
+ (cl-loop
+ for seg in (dom-children trk)
+ if (eq (dom-tag seg) 'trkseg) collect
+ (cl-loop
+ for pt in (dom-children seg)
+ if (eq (dom-tag pt) 'trkpt) collect
+ (cons (string-to-number (dom-attr pt 'lat))
+ (string-to-number (dom-attr pt 'lon))))))
+ (cl-loop
+ for pt in (dom-children dom)
+ if (eq (dom-tag pt) 'wpt) collect
+ (list (string-to-number (dom-attr pt 'lat))
+ (string-to-number (dom-attr pt 'lon))
+ (with-no-warnings
+ (dom-text (dom-child-by-tag pt 'name))))))))
+
+(defun osm--add-gpx (name track waypoints)
+ "Add GPX track with NAME consisting of TRACK and WAYPOINTS."
+ (let* ((bb (osm--bb-from-track track waypoints))
+ (center (osm--bb-center bb)))
+ (setf (alist-get name osm--gpx-files nil nil #'equal)
+ (cons track waypoints))
(osm--revert)
- (osm--goto (/ (+ min-lat max-lat) 2) (/ (+ min-lon max-lon) 2)
- (osm--boundingbox-to-zoom min-lat max-lat min-lon max-lon)
- nil nil nil)))
+ (osm--goto (car center) (cdr center) (osm--bb-to-zoom bb) nil nil nil)))
(defun osm-gpx-hide (file)
"Show the tracks of gpx FILE in an `osm-mode' buffer."
