Skip to content
Snippets Groups Projects
Commit fe3fa96d authored by David Byers's avatar David Byers
Browse files

Clean up code and docs.

parent ec172e17
Branches
Tags
No related merge requests found
Hide whitespace changes
Inline Side-by-side
CHANGELOG
+ 4
− 0
View file @ fe3fa96d
2020-07-21 David Byers <david.byers@liu.se> 2020-07-21 David Byers <david.byers@liu.se>
Clean up
* olc.el: Declare external functions for the byte compiler. Fix
whitespace. Shortened lines. Fixed some docstrings.
More integer math: More integer math:
(olc-decode): Converted to use integer math. (olc-decode): Converted to use integer math.
......
olc.el
+ 205
− 136
View file @ fe3fa96d
;;;; -*-coding: utf-8;-*- ;;; olc.el --- Open location code library
;;;; ;;;
;;;; Copyright (C) 2020 David Byers ;;; Copyright (C) 2020 David Byers
;;;; ;;;
;;;; This program is free software: you can redistribute it and/or ;;; Author: David Byers <david.byers@liu.se>
;;;; modify it under the terms of the GNU General Public License as ;;; Version: 1.0
;;;; published by the Free Software Foundation, either version 3 of ;;; Package-Requires: ((emacs "25.1"))
;;;; the License, or (at your option) any later version. ;;; Keywords: comm, extensions, tools
;;;; ;;; URL: https://gitlab.liu.se/davby02/olc
;;;; This program is distributed in the hope that it will be useful, ;;;
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; This program is free software: you can redistribute it and/or
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; modify it under the terms of the GNU General Public License as
;;;; General Public License for more details. ;;; published by the Free Software Foundation, either version 3 of
;;;; ;;; the License, or (at your option) any later version.
;;;; You should have received a copy of the GNU General Public License ;;;
;;;; along with this program. If not, see ;;; This program is distributed in the hope that it will be useful,
;;;; <https://www.gnu.org/licenses/>. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; ======================================================================== ;;; General Public License for more details.
;;; This program provides basic open location code support in emacs ;;;
;;; lisp. The support for recovering shortened codes depends on the ;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see
;;; <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; This program provides basic open location code support in Emacs
;;; Lisp. The support for recovering shortened codes depends on the
;;; request library and uses OpenStreetMap; please check the terms of ;;; request library and uses OpenStreetMap; please check the terms of
;;; use for the service to ensure that you remain compliant. ;;; use for the service to ensure that you remain compliant.
;;; ;;;
...@@ -26,8 +33,8 @@ ...@@ -26,8 +33,8 @@
;;; provided in some form. The implementation passed the tests present ;;; provided in some form. The implementation passed the tests present
;;; in the open location code github repository at the time of writing ;;; in the open location code github repository at the time of writing
;;; almost cleanly -- there are some minor rounding issues in decode. ;;; almost cleanly -- there are some minor rounding issues in decode.
;;; ========================================================================
;;; Code:
;; This is me being dragged kicking and screaming into the 21st ;; This is me being dragged kicking and screaming into the 21st
;; century because the alternative is to cl-lib is to include my own ;; century because the alternative is to cl-lib is to include my own
...@@ -38,43 +45,59 @@ ...@@ -38,43 +45,59 @@
(require 'request nil t) (require 'request nil t)
;; ======================================================================== ;;; ==================================================================
;; Errors raised by this package ;;; Silence the compiler if request is not on load-path at compile
;; ======================================================================== ;;; time
;;; ==================================================================
(declare-function request "request")
(declare-function request-response-status-code "request")
(declare-function request-response-data "request")
;;; ==================================================================
;;; Errors raised by this package
;;; ==================================================================
(define-error 'olc-error "Error in open location code.") (define-error 'olc-error "Error in open location code.")
(define-error 'olc-parse-error "Parse error in open location code" 'olc-error) (define-error 'olc-parse-error
(define-error 'olc-decode-error "Error decoding open location code" 'olc-error) "Parse error in open location code" 'olc-error)
(define-error 'olc-encode-error "Error encoding open location code" 'olc-error) (define-error 'olc-decode-error
(define-error 'olc-shorten-error "Error shortening open location code" 'olc-error) "Error decoding open location code" 'olc-error)
(define-error 'olc-encode-error
"Error encoding open location code" 'olc-error)
(define-error 'olc-shorten-error
"Error shortening open location code" 'olc-error)
;; ======================================================================== ;;; ==================================================================
;; Mapping of digits to base 20 values ;;; Mapping of digits to base 20 values
;; ======================================================================== ;;; ==================================================================
(defvar olc-value-mapping "23456789CFGHJMPQRVWX" (defvar olc-value-mapping "23456789CFGHJMPQRVWX"
"Mapping from values to olc base 20 digits.") "Mapping from values to olc base 20 digits.")
(defvar olc-digit-mapping (let ((count 0)) (defvar olc-digit-mapping
(mapcan (lambda (letter) (let ((count 0))
(prog1 (list (cons letter count) (mapcan (lambda (letter)
(cons (downcase letter) count)) (prog1 (list (cons letter count)
(setq count (1+ count)))) (cons (downcase letter) count))
olc-value-mapping)) (setq count (1+ count))))
olc-value-mapping))
"Mapping from olc base 20 digits to values.") "Mapping from olc base 20 digits to values.")
(defsubst olc-digit-value (digit) (defsubst olc-digit-value (digit)
"Return the base 20 value of a digit." "Return the base 20 value of DIGIT."
(cdr (assq digit olc-digit-mapping))) (cdr (assq digit olc-digit-mapping)))
(defsubst olc-value-digit (value) (defsubst olc-value-digit (value)
"Return the digit for a value up to 19." "Return the digit for a VALUE up to 19."
(elt olc-value-mapping value)) (elt olc-value-mapping value))
;; ======================================================================== ;;; ==================================================================
;; Data structures ;;; Data structures
;; ======================================================================== ;;; ==================================================================
(cl-defstruct (olc-parse (:copier nil) (cl-defstruct (olc-parse (:copier nil)
(:constructor olc-parse-create)) (:constructor olc-parse-create))
...@@ -92,34 +115,43 @@ ...@@ -92,34 +115,43 @@
(defsubst olc-area-lat (area) (defsubst olc-area-lat (area)
"Get center latitute of AREA." "Get center latitute of AREA."
(min (+ (/ (- (olc-area-lathi area) (olc-area-latlo area)) 2) (olc-area-latlo area)) 90)) (min (+ (/ (- (olc-area-lathi area) (olc-area-latlo area)) 2)
(olc-area-latlo area))
90))
(defsubst olc-area-lon (area) (defsubst olc-area-lon (area)
"Get center longitude of AREA." "Get center longitude of AREA."
(min (+ (/ (- (olc-area-lonhi area) (olc-area-lonlo area)) 2) (olc-area-lonlo area)) 180)) (min (+ (/ (- (olc-area-lonhi area) (olc-area-lonlo area)) 2)
(olc-area-lonlo area))
180))
;; ======================================================================== ;;; ==================================================================
;; (Mostly) internal functions ;;; (Mostly) internal functions
;; ======================================================================== ;;; ==================================================================
(defmacro olc-valid-char (char) (defmacro olc-valid-char (char)
"Check if CHAR is a valid OLC digit." "Check if CHAR is a valid OLC digit."
`(assq ,char olc-digit-mapping)) `(assq ,char olc-digit-mapping))
(defmacro olc-transform-error (spec &rest body) (defmacro olc-transform-error (spec &rest body)
"Catch some errors and throw others." "Catch some errors and throw others.
SPEC is a list consisting of an error to catch, the error to
raise, and args for the raised error.
\(fn (CATCH SIGNAL &rest ARGS) BODY...)"
(declare (indent 1)) (declare (indent 1))
`(condition-case nil `(condition-case nil
,@body ,@body
(,(elt spec 0) (signal ',(elt spec 1) (list ,@(cddr spec)))))) (,(elt spec 0) (signal ',(elt spec 1) (list ,@(cddr spec))))))
(defsubst olc-clip-latitude (lat) (defsubst olc-clip-latitude (lat)
"Clip LAT to -90,90" "Clip LAT to -90,90."
(max -90 (min 90 lat))) (max -90 (min 90 lat)))
(defsubst olc-normalize-latitude (lat len) (defsubst olc-normalize-latitude (lat len)
"Normalize latitude LAT." "Normalize latitude LAT for a LEN character log code."
(setq lat (olc-clip-latitude lat)) (setq lat (olc-clip-latitude lat))
(when (= lat 90.0) (when (= lat 90.0)
(setq lat (- lat (/ (olc-latitude-precision len) 2.0)))) (setq lat (- lat (/ (olc-latitude-precision len) 2.0))))
...@@ -143,69 +175,87 @@ ...@@ -143,69 +175,87 @@
(if (olc-parse-p code) (if (olc-parse-p code)
code code
(let ((pos 0) (let ((pos 0)
(pairs nil) (pairs nil)
(short nil) (short nil)
(precision nil) (precision nil)
(grid nil) (grid nil)
(padding 0)) (padding 0))
;; Parse up to four initial pairs ;; Parse up to four initial pairs
(catch 'break (catch 'break
(while (< pos (length code)) (while (< pos (length code))
(olc-transform-error (args-out-of-range olc-parse-error "code too short" code (1+ pos)) (olc-transform-error
(args-out-of-range olc-parse-error
"code too short" code (1+ pos))
(cond ((eq (elt code pos) ?+) (throw 'break nil)) (cond ((eq (elt code pos) ?+) (throw 'break nil))
((eq (elt code pos) ?0) (throw 'break nil)) ((eq (elt code pos) ?0) (throw 'break nil))
((= (length pairs) 4) (throw 'break nil)) ((= (length pairs) 4) (throw 'break nil))
((not (olc-valid-char (elt code pos))) ((not (olc-valid-char (elt code pos)))
(signal 'olc-parse-error (list "invalid character" pos code))) (signal 'olc-parse-error
((not (olc-valid-char (elt code (1+ pos)))) (list "invalid character" pos code)))
(signal 'olc-parse-error (list "invalid character" (1+ pos) code))) ((not (olc-valid-char (elt code (1+ pos))))
(t (setq pairs (cons (cons (elt code pos) (elt code (1+ pos))) pairs))))) (signal 'olc-parse-error
(setq pos (+ pos 2)))) (list "invalid character" (1+ pos) code)))
(t (setq pairs (cons (cons (elt code pos)
(elt code (1+ pos)))
pairs)))))
(setq pos (+ pos 2))))
;; Measure the padding ;; Measure the padding
(when (string-match "0+" code pos) (when (string-match "0+" code pos)
(setq pos (match-end 0) padding (- (match-end 0) (match-beginning 0)))) (setq pos (match-end 0)
padding (- (match-end 0) (match-beginning 0))))
;; Parse the separator ;; Parse the separator
(olc-transform-error (args-out-of-range olc-parse-error "code too short" code pos) (olc-transform-error
(args-out-of-range olc-parse-error
"code too short" code pos)
(if (eq (elt code pos) ?+) (if (eq (elt code pos) ?+)
(setq pos (1+ pos)) (setq pos (1+ pos))
(signal 'olc-parse-error (list "missing separator" pos code)))) (signal 'olc-parse-error
(list "missing separator" pos code))))
;; Check the length of the padding ;; Check the length of the padding
(unless (and (= (% padding 2) 0) (unless (and (= (% padding 2) 0)
(<= (+ padding (* 2 (length pairs))) 8)) (<= (+ padding (* 2 (length pairs))) 8))
(signal 'olc-parse-error (list "incorrect padding length" pos code))) (signal 'olc-parse-error
(list "incorrect padding length" pos code)))
;; Determine if the code is shortened or not ;; Determine if the code is shortened or not
(setq short (< (+ (* 2 (length pairs)) padding) 8)) (setq short (< (+ (* 2 (length pairs)) padding) 8))
;; We cant be short and have padding (not sure why) ;; We cant be short and have padding (not sure why)
(when (and short (> padding 0)) (when (and short (> padding 0))
(signal 'olc-parse-error (list "padded codes can't be shortened" pos code))) (signal 'olc-parse-error
(list "padded codes can't be shortened" pos code)))
;; Determine the precision of the code ;; Determine the precision of the code
(setq precision (- 8 padding)) (setq precision (- 8 padding))
;; Parse what's after the separator ;; Parse what's after the separator
(when (< pos (length code)) (when (< pos (length code))
(when (> padding 0) (when (> padding 0)
(signal 'olc-parse-error (list "padding followed by data" pos code))) (signal 'olc-parse-error
(list "padding followed by data" pos code)))
;; Parse one more pair
(olc-transform-error (args-out-of-range olc-parse-error "code too short" code (1+ pos)) ;; Parse one more pair
(setq pairs (cons (cons (elt code pos) (elt code (1+ pos))) pairs) (olc-transform-error
pos (+ 2 pos) (args-out-of-range olc-parse-error
"code too short" code (1+ pos))
(setq pairs (cons (cons (elt code pos)
(elt code (1+ pos)))
pairs)
pos (+ 2 pos)
precision (+ 2 precision))) precision (+ 2 precision)))
;; Parse grid ;; Parse grid
(while (< pos (length code)) (while (< pos (length code))
(cond ((not (olc-valid-char (elt code pos))) (cond ((not (olc-valid-char (elt code pos)))
(signal 'olc-parse-error (list "invalid character" pos code))) (signal 'olc-parse-error
((>= (length grid) 5) (setq pos (1+ pos))) (list "invalid character" pos code)))
(t (setq grid (cons (elt code pos) grid) ((>= (length grid) 5) (setq pos (1+ pos)))
pos (1+ pos) (t (setq grid (cons (elt code pos) grid)
pos (1+ pos)
precision (1+ precision)))))) precision (1+ precision))))))
;; Check for an empty code ;; Check for an empty code
...@@ -219,9 +269,9 @@ ...@@ -219,9 +269,9 @@
:precision precision)))) :precision precision))))
;;; ======================================================================== ;;; ==================================================================
;;; Public functions ;;; Public functions
;;; ======================================================================== ;;; ==================================================================
(defun olc-is-valid (code) (defun olc-is-valid (code)
"Return non-nil if CODE is a valid open location code." "Return non-nil if CODE is a valid open location code."
...@@ -278,11 +328,11 @@ differences, however, are extremely small." ...@@ -278,11 +328,11 @@ differences, however, are extremely small."
;; Process the pairs ;; Process the pairs
(mapc (lambda (pair) (mapc (lambda (pair)
(setq lat (+ lat (* latsize (olc-digit-value (car pair)))) (setq lat (+ lat (* latsize (olc-digit-value (car pair))))
lon (+ lon (* lonsize (olc-digit-value (cdr pair)))) lon (+ lon (* lonsize (olc-digit-value (cdr pair))))
latsize (/ latsize 20) latsize (/ latsize 20)
lonsize (/ lonsize 20))) lonsize (/ lonsize 20)))
(olc-parse-pairs parse)) (olc-parse-pairs parse))
;; I'm too tired to figure out why ;; I'm too tired to figure out why
(setq latsize (* latsize 20) lonsize (* lonsize 20)) (setq latsize (* latsize 20) lonsize (* lonsize 20))
...@@ -290,11 +340,11 @@ differences, however, are extremely small." ...@@ -290,11 +340,11 @@ differences, however, are extremely small."
;; Process the grid ;; Process the grid
(when (olc-parse-grid parse) (when (olc-parse-grid parse)
(mapc (lambda (refine) (mapc (lambda (refine)
(setq latsize (/ latsize 5) lonsize (/ lonsize 4)) (setq latsize (/ latsize 5) lonsize (/ lonsize 4))
(let ((coord (olc-digit-value refine))) (let ((coord (olc-digit-value refine)))
(setq lat (+ lat (* latsize (/ coord 4))) (setq lat (+ lat (* latsize (/ coord 4)))
lon (+ lon (* lonsize (% coord 4)))))) lon (+ lon (* lonsize (% coord 4))))))
(olc-parse-grid parse))) (olc-parse-grid parse)))
(olc-area-create :latlo (/ lat (float latscale)) (olc-area-create :latlo (/ lat (float latscale))
:lonlo (/ lon (float lonscale)) :lonlo (/ lon (float lonscale))
...@@ -329,7 +379,8 @@ values cannot (legally) be encoded to the selected length." ...@@ -329,7 +379,8 @@ values cannot (legally) be encoded to the selected length."
;; Calculate the grid part if needed ;; Calculate the grid part if needed
(if (> len 10) (if (> len 10)
(dotimes (i 5) (dotimes (i 5)
(setq code (cons (olc-value-digit (+ (* (% lat 5) 4) (% lon 4))) (setq code (cons (olc-value-digit
(+ (* (% lat 5) 4) (% lon 4)))
code) code)
lat (truncate lat 5) lat (truncate lat 5)
lon (truncate lon 4))) lon (truncate lon 4)))
...@@ -371,7 +422,10 @@ full open location code." ...@@ -371,7 +422,10 @@ full open location code."
(length (olc-parse-grid parse)))) (length (olc-parse-grid parse))))
(resolution (expt 20 (- 2 (/ padlen 2)))) (resolution (expt 20 (- 2 (/ padlen 2))))
(half-resolution (/ resolution 2.0)) (half-resolution (/ resolution 2.0))
(area (olc-decode (concat (substring (olc-encode lat lon 10) 0 padlen) code)))) (area (olc-decode
(concat (substring (olc-encode lat lon 10)
0 padlen)
code))))
(cond ((and (< (+ lat half-resolution) (olc-area-lat area)) (cond ((and (< (+ lat half-resolution) (olc-area-lat area))
(>= (- (olc-area-lat area) resolution) -90)) (>= (- (olc-area-lat area) resolution) -90))
(setq lat (- (olc-area-lat area) resolution))) (setq lat (- (olc-area-lat area) resolution)))
...@@ -384,8 +438,9 @@ full open location code." ...@@ -384,8 +438,9 @@ full open location code."
((> (- lon half-resolution) (olc-area-lon area)) ((> (- lon half-resolution) (olc-area-lon area))
(setq lon (+ (olc-area-lon area) resolution))) (setq lon (+ (olc-area-lon area) resolution)))
(t (setq lon (olc-area-lon area)))) (t (setq lon (olc-area-lon area))))
(cond ((eq format 'latlon) (cons lat lon)) (if (eq format 'latlon)
(t (olc-encode lat lon (olc-parse-precision parse)))))))) (cons lat lon)
(olc-encode lat lon (olc-parse-precision parse)))))))
(defun olc-shorten (code lat lon &optional limit) (defun olc-shorten (code lat lon &optional limit)
...@@ -401,11 +456,14 @@ shortened code, of if LIMIT is not positive and even." ...@@ -401,11 +456,14 @@ shortened code, of if LIMIT is not positive and even."
(area (olc-decode parse))) (area (olc-decode parse)))
(when (null limit) (setq limit 12)) (when (null limit) (setq limit 12))
(unless (and (> limit 0) (= 0 (% limit 2))) (unless (and (> limit 0) (= 0 (% limit 2)))
(signal 'olc-shorten-error (list "limit must be even and positive" code))) (signal 'olc-shorten-error
(list "limit must be even and positive" code)))
(when (olc-is-short parse) (when (olc-is-short parse)
(signal 'olc-shorten-error (list "can't shorten shortened codes" code))) (signal 'olc-shorten-error
(list "can't shorten shortened codes" code)))
(when (< (olc-parse-precision parse) 8) (when (< (olc-parse-precision parse) 8)
(signal 'olc-shorten-error (list "can't shorten padded codes" code))) (signal 'olc-shorten-error
(list "can't shorten padded codes" code)))
(setq lat (olc-clip-latitude lat) (setq lat (olc-clip-latitude lat)
lon (olc-normalize-longitude lon)) lon (olc-normalize-longitude lon))
...@@ -415,42 +473,53 @@ shortened code, of if LIMIT is not positive and even." ...@@ -415,42 +473,53 @@ shortened code, of if LIMIT is not positive and even."
(catch 'break (catch 'break
(dolist (spec '((4 . 0.0025) (3 . 0.05) (2 . 1) (1 . 20))) (dolist (spec '((4 . 0.0025) (3 . 0.05) (2 . 1) (1 . 20)))
(when (< coderange (* (cdr spec) 0.3)) (when (< coderange (* (cdr spec) 0.3))
(throw 'break (substring code (min limit (* (car spec) 2)))))) (throw 'break (substring code
(min limit (* (car spec) 2))))))
code)))) code))))
(defun olc-recover-string (string &optional reference format)
"Recover a location from a shortened open location code and reference.
When called with one argument, it must be a string consisting of a (defun olc-recover-string (arg1 &optional arg2 arg3)
shortened open location code followed by whitespace and a geographical "Recover a location from a short code and reference.
location.
When called with two strings, the first must be a shortened open When called with one argument, ARG1, it must be a string
location code and the second if the geographical location. consisting of a shortened open location code followed by
whitespace and a geographical location.
When called with two strings, ARG1 and ARG2, the first must be a
shortened open location code and the second if the geographical
location.
Optionally, the last argument in either case can be a symbol Optionally, the last argument (ARG2 or ARG3 depencing on the
indicating the format of the return value (see `olc-recover' for other arguments) in either case can be a symbol indicating the
details)." format of the return value (see `olc-recover' for details)."
(unless (fboundp 'request) (unless (fboundp 'request)
(error "request library is not loaded")) (error "`request' library is not loaded"))
(let (code resp)
(cond ((and (stringp string) (not (stringp reference))) (let (code reference format)
(setq format reference) (cond ((and (stringp arg1) (not (stringp arg2)))
(if (string-match "^\\(\\S-+\\)\\s-+\\(.*\\)$" string) (if (string-match "^\\(\\S-+\\)\\s-+\\(.*\\)$" arg1)
(setq code (match-string 1 string) (setq code (match-string 1 arg1)
reference (match-string 2 string)) reference (match-string 2 arg1)
(signal 'wrong-type-argument string))) format arg2)
((and (stringp string) (stringp reference)) (signal 'wrong-type-argument arg1)))
(setq code string)) ((and (stringp arg1) (stringp arg2))
(t (signal 'wrong-type-argument string))) (setq code arg1 reference arg2 format arg3))
(setq resp (request "https://nominatim.openstreetmap.org/search" (t (signal 'wrong-type-argument arg1)))
:params `((q . ,reference) (let ((resp (request "https://nominatim.openstreetmap.org/search"
(format . "json") :params `((q . ,reference)
(limit . 1)) (format . "json")
:parser 'json-read (limit . 1))
:sync t)) :parser 'json-read
(when (eq 200 (request-response-status-code resp)) :sync t)))
(olc-recover code (when (eq 200 (request-response-status-code resp))
(string-to-number (alist-get 'lat (elt (request-response-data resp) 0))) (let ((data (elt (request-response-data resp) 0)))
(string-to-number (alist-get 'lon (elt (request-response-data resp) 0))) (olc-recover code
format)))) (string-to-number (alist-get 'lat data))
(string-to-number (alist-get 'lon data))
format))))))
(provide 'olc)
;;; -*-coding: utf-8;-*-
;;; olc.el ends here
olc.texi
+ 4
− 4
View file @ fe3fa96d
...@@ -140,10 +140,10 @@ is otherwise invalid (i.e. 3, 5, 7, or 9). ...@@ -140,10 +140,10 @@ is otherwise invalid (i.e. 3, 5, 7, or 9).
@defun olc-decode code @defun olc-decode code
Decode @var{code} and return an @code{olc-area} representing the Decode @var{code} and return an @code{olc-area} representing the
location. Raises @code{olc-parse-error} if the code can't be parsed, location. Returns an olc-area structure. Raises @code{olc-parse-error}
and @code{olc-decode-error} if it can't be decoded (e.g. a padded if the code can't be parsed, and @code{olc-decode-error} if it can't
shortened code, a padded code with grid coordinates, an empty code, be decoded (e.g. a padded shortened code, a padded code with grid
and so forth). Returns an olc-area structure. coordinates, an empty code, and so forth).
@example @example
@group @group
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment