X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/607304435b649bdd1185719f919c53b0e1d0d9a0..8c5bf82469389a02fe9fe41228d25922deda5595:/packages/metar/metar.el diff --git a/packages/metar/metar.el b/packages/metar/metar.el index 43a72db34..7b78f07f3 100644 --- a/packages/metar/metar.el +++ b/packages/metar/metar.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2007, 2014 Free Software Foundation, Inc. ;; Author: Mario Lang -;; Version: 0 +;; Version: 0.1 ;; Package-Requires: ((cl-lib "0.5")) ;; Keywords: comm @@ -30,24 +30,82 @@ ;; With `C-u M-x metar RET', country and station name need to be entered. ;; `C-u C-u M-x metar RET' will prompt for the METAR station code (4 letters). ;; +;; Customize `metar-units' to change length, speed, temperature or pressure +;; units to your liking. +;; ;; For programmatic access to decoded weather reports, use: ;; ;; (metar-decode (metar-get-record "CODE")) ;;; Code: +(require 'calc-units) (require 'cl-lib) +(require 'format-spec) (require 'rx) (require 'solar) (require 'url) -(defvar metar-stations-info-url "http://weather.noaa.gov/data/nsd_bbsss.txt" - "URL to use for retrieving station meta information.") +(defgroup metar () + "METAR weather reports." + :group 'net-utils) + +(defcustom metar-units '((length . m) + (pressure . hPa) + (speed . kph) + (temperature . degC)) + "Default measurement units to use when reporting weather information." + :group 'metar + :type '(list (cons :format "%v" + (const :tag "Length: " length) + (choice (const :tag "Meter" m) + (const :tag "Inch" in) + (const :tag "Foot" ft) + (const :tag "Yard" yd) + (const :tag "Mile" mi))) + (cons :format "%v" + (const :tag "Pressure:" pressure) + (choice (const :tag "Pascal" Pa) + (const :tag "Hecto pascal" hPa) + (const :tag "Bar" bar) + (const :tag "Inch of mercury" inHg) + (const :tag "Standard atmosphere" atm) + (const :tag "Meter of mercury" mHg) + (const :tag "Punds per square inch" psi))) + (cons :format "%v" + (const :tag "Speed:" speed) + (choice (const :tag "Kilometers per hour" kph) + (const :tag "Miles per hour" mph) + (const :tag "Knot" knot))) + (cons :format "%v" + (const :tag "Temperature:" temperature) + (choice (const :tag "Degree Celsius" degC) + (const :tag "Degree Kelvin" degK) + (const :tag "Degree Fahrenheit" degF))))) + +(defcustom metar-stations-info-url "http://weather.noaa.gov/data/nsd_bbsss.txt" + "URL to use for retrieving station meta information." + :group 'metar + :type 'string) (defvar metar-stations nil "Variable containing (cached) METAR station information. Use the function `metar-stations' to get the actual station list.") +(defun metar-station-convert-dms-to-deg (string) + "Convert degrees, minutes and optional seconds, to degrees." + (when (string-match (rx string-start + (group (1+ digit)) ?- (group (1+ digit)) + (optional ?- (group (1+ digit))) + (group (char ?N ?E ?S ?W)) + string-end) string) + (funcall (if (memq (aref (match-string 4 string) 0) '(?N ?E)) #'+ #'-) + (+ (string-to-number (match-string 1 string)) + (/ (string-to-number (match-string 2 string)) 60.0) + (if (match-string 3 string) + (/ (string-to-number (match-string 3 string)) 3600.0) + 0))))) + (defun metar-stations () "Retrieve a list of METAR stations. Results are cached in variable `metar-stations'. @@ -70,17 +128,9 @@ If this variable is nil, the information is retrieved from the Internet." (cons 'name (nth 3 item)) (cons 'country (nth 5 item)) (cons 'latitude - (when (string-match "^\\([0-9]+\\)-\\([0-9]+\\)\\(-[0-9]+\\)?\\([NS]\\)" (nth 7 item)) - (funcall (if (string= (match-string 4 (nth 7 item)) "N") #'+ #'-) - (+ (string-to-number (match-string 1 (nth 7 item))) - (/ (string-to-number (match-string 2 (nth 7 item))) - 60.0))))) + (metar-station-convert-dms-to-deg (nth 7 item))) (cons 'longitude - (when (string-match "^\\([0-9]+\\)-\\([0-9]+\\)\\(-[0-9]+\\)?\\([WE]\\)" (nth 8 item)) - (funcall (if (string= (match-string 4 (nth 8 item)) "E") #'+ #'-) - (+ (string-to-number (match-string 1 (nth 8 item))) - (/ (string-to-number (match-string 2 (nth 8 item))) - 60.0))))) + (metar-station-convert-dms-to-deg (nth 8 item))) (cons 'altitude (string-to-number (nth 12 item)))))) metar-stations))) (setq data (cdr data))) @@ -101,14 +151,15 @@ KEY can be one of the symbols `code', `name', `country', `latitude', (setq stations (cdr stations))) result)) -(defun metar-latitude-longitude-bearing (latitude1 longitude1 latitude2 longitude2) +(defun metar-latitude-longitude-bearing (latitude1 longitude1 + latitude2 longitude2) "Calculate bearing from start point LATITUDE1/LONGITUDE1 to end point LATITUDE2/LONGITUDE2." (% (+ 360 (truncate (radians-to-degrees (atan (* (sin (degrees-to-radians (- longitude2 longitude1))) - (cos (degrees-to-radians latitude2))) + (cos (degrees-to-radians latitude2))) (- (* (cos (degrees-to-radians latitude1)) (sin (degrees-to-radians latitude2))) (* (sin (degrees-to-radians latitude1)) @@ -117,13 +168,14 @@ LATITUDE2/LONGITUDE2." 360)) (defun metar-latitude-longitude-distance-haversine (latitude1 longitude1 - latitude2 longitude2) + latitude2 longitude2) "Caluclate the distance (in kilometers) between two points on the surface of the earth given as LATITUDE1, LONGITUDE1, LATITUDE2 and LONGITUDE2." (cl-macrolet ((distance (d1 d2) - `(expt (sin (/ (degrees-to-radians (- ,d2 ,d1)) 2)) 2))) + `(expt (sin (/ (degrees-to-radians (- ,d2 ,d1)) 2)) 2))) (let ((a (+ (distance latitude1 latitude2) - (* (cos (degrees-to-radians latitude1)) (cos (degrees-to-radians latitude2)) + (* (cos (degrees-to-radians latitude1)) + (cos (degrees-to-radians latitude2)) (distance longitude1 longitude2))))) (* 6371 (* 2 (atan (sqrt a) (sqrt (- 1 a)))))))) @@ -187,22 +239,60 @@ If no match if found, nil is returned." (when station-code (cons station-code (round best-distance)))))) -(defun metar-temp-to-number (string) - "Convert a METAR temperature to a number." - (if (= (aref string 0) ?M) - (- (string-to-number (substring string 1))) - (string-to-number string))) - -(defvar metar-url "http://weather.noaa.gov/pub/data/observations/metar/stations/%s.TXT" +(defun metar-convert-unit (value new-unit) + "Convert VALUE to NEW-UNIT. +VALUE is a string with the value followed by the unit, like \"5 knot\" +and NEW-UNIT should be a unit name like \"kph\" or similar." + (cl-check-type value string) + (cl-check-type new-unit (or string symbol)) + (cl-multiple-value-bind (value unit) + (split-string + (math-format-value + (math-convert-units (math-simplify (math-read-expr value)) + (math-read-expr + (cl-etypecase new-unit + (string new-unit) + (symbol (symbol-name new-unit)))))) + " ") + (cons (string-to-number value) (intern unit)))) + +(defun metar-convert-temperature (string &optional unit) + (let* ((value (concat (if (= (aref string 0) ?M) + (concat "-" (substring string 1)) + string) + "degC")) + (expr (math-read-expr value)) + (old-unit (math-single-units-in-expr-p expr)) + (new-unit (or unit (cdr (assq 'temperature metar-units))))) + (if old-unit + (cl-multiple-value-bind (value unit) + (split-string + (math-format-value + (math-simplify-units + (math-convert-temperature + expr + (list 'var + (car old-unit) + (intern (concat "var-" (symbol-name (car old-unit))))) + (math-read-expr (cl-etypecase new-unit + (string new-unit) + (symbol (symbol-name new-unit))))))) " ") + (cons (string-to-number value) (intern unit)))))) + +(defcustom metar-url + "http://weather.noaa.gov/pub/data/observations/metar/stations/%s.TXT" "URL used to fetch station specific information. -%s is replaced with the 4 letter station code.") +%s is replaced with the 4 letter station code." + :group 'metar + :type 'string) (defun metar-url (station) - (format metar-url (upcase (cl-etypecase station - (string station) - (symbol (symbol-name station)))))) + (format metar-url + (upcase (cl-etypecase station + (string station) + (symbol (symbol-name station)))))) -(defvar metar-record-regexp +(defconst metar-record-regexp (rx (group (1+ digit)) ?/ (group (1+ digit)) ?/ (group (1+ digit)) space (group (1+ digit)) ?: (group (1+ digit)) @@ -214,11 +304,9 @@ record.") (defun metar-get-record (station) "Retrieve a METAR/SPECI record for STATION from the Internet. -REturn a cons where `car' is the time of the measurement (as an emacs-lsip +Return a cons where `car' is the time of the measurement (as an emacs-lsip time value) and `cdr' is a string containing the actual METAR code. If no record was found for STATION, nil is returned." - (unless (string-match "^[A-Z][A-Z0-9][A-Z0-9][A-Z0-9]$" station) - (signal 'error "Invalid station code")) (with-temp-buffer (url-insert-file-contents (metar-url station)) (when (re-search-forward (format metar-record-regexp station) nil t) @@ -237,7 +325,8 @@ If no record was found for STATION, nil is returned." (group (or "FEW" "SCT" "BKN" "OVC")) (group (= 3 digit)) (optional (group (or "TCU" "CB"))) - symbol-end)) + symbol-end) + "Regular expression to match cloud information in METAR records.") (defun metar-clouds (info) (let ((clouds ()) @@ -245,7 +334,9 @@ If no record was found for STATION, nil is returned." (while (string-match metar-could-regexp info from) (setq from (match-end 0) clouds (push (append (list (match-string 1 info) - (string-to-number (match-string 2 info))) + (metar-convert-unit + (concat (match-string 2 info) " ft") + (cdr (assq 'length metar-units)))) (when (match-string 3 info) (list (match-string 3 info)))) clouds))) @@ -287,7 +378,8 @@ If no record was found for STATION, nil is returned." (eval `(rx symbol-start (group (optional (char ?+ ?-))) (group (1+ (or ,@(mapcar #'car metar-phenomena)))) - symbol-end))) + symbol-end)) + "Regular expression to match weather phenomena in METAR records.") (defun metar-phenomena (info) (when (string-match metar-phenomena-regexp info) @@ -314,9 +406,6 @@ If no record was found for STATION, nil is returned." symbol-end)) "Regular expression to match wind information in METAR records.") -(defsubst metar-knots (value) - (cons value 'knots)) - (defsubst metar-degrees (value) (cons value 'degrees)) @@ -327,16 +416,21 @@ If no record was found for STATION, nil is returned." (when (and (match-string 4 info) (match-string 5 info)) (list :from (string-to-number (match-string 4 info)) :to (string-to-number (match-string 5 info)))) - (append (list :direction (metar-degrees (string-to-number (match-string 1 info)))) - (when (and (match-string 4 info) (match-string 5 info)) - (list :from (metar-degrees (string-to-number (match-string 4 info))) - :to (metar-degrees (string-to-number (match-string 5 info))))))) - (list :speed (metar-knots (string-to-number (match-string 2 info)))) + (append + (list :direction (metar-degrees + (string-to-number (match-string 1 info)))) + (when (and (match-string 4 info) (match-string 5 info)) + (list :from (metar-degrees (string-to-number (match-string 4 info))) + :to (metar-degrees (string-to-number (match-string 5 info))))))) + (list :speed (metar-convert-unit (concat (match-string 2 info) "knot") + (cdr (assq 'speed metar-units)))) (when (match-string 3 info) - (list :gusts (metar-knots (string-to-number (match-string 3 info)))))))) + (list :gust (metar-convert-unit (concat (match-string 3 info) "knot") + (cdr (assq 'speed metar-units)))))))) (defconst metar-visibility-regexp - (rx symbol-start (group (1+ digit)) (optional (group "SM")) symbol-end)) + (rx symbol-start (group (1+ digit)) (optional (group "SM")) symbol-end) + "Regular expression to match information about visibility in METAR records.") (defconst metar-temperature-and-dewpoint-regexp (rx symbol-start @@ -344,22 +438,25 @@ If no record was found for STATION, nil is returned." (char ?/) (group (group (optional (char ?M))) (1+ digit)) symbol-end) - "Regular expression to match temperature and dewpoint information in METAR records.") + "Regular expression to match temperature and dewpoint information in METAR +records.") (defun metar-temperature (info) (when (string-match metar-temperature-and-dewpoint-regexp info) - (cons (metar-temp-to-number (match-string 1 info)) 'celsius))) + (metar-convert-temperature (match-string 1 info)))) (defun metar-dewpoint (info) (when (string-match metar-temperature-and-dewpoint-regexp info) - (cons (metar-temp-to-number (match-string 3 info)) 'celsius))) + (metar-convert-temperature (match-string 3 info)))) (defun metar-humidity (info) (when (string-match metar-temperature-and-dewpoint-regexp info) (cons (round (metar-magnus-formula-humidity-from-dewpoint - (metar-temp-to-number (match-string 1 info)) - (metar-temp-to-number (match-string 3 info)))) 'percent))) + (save-match-data (car (metar-convert-temperature + (match-string 1 info) 'degC))) + (car (metar-convert-temperature (match-string 3 info) 'degC)))) + 'percent))) (defconst metar-pressure-regexp (rx symbol-start (group (char ?Q ?A)) (group (1+ digit)) symbol-end) @@ -367,8 +464,12 @@ If no record was found for STATION, nil is returned." (defun metar-pressure (info) (when (string-match metar-pressure-regexp info) - (cons (string-to-number (match-string 2 info)) - (if (string= (match-string 1 info) "Q") 'hPa 'inHg)))) + (metar-convert-unit + (concat (match-string 2 info) + (cond + ((string= (match-string 1 info) "Q") "hPa") + ((string= (match-string 1 info) "A") "cinHg"))) + (cdr (assq 'pressure metar-units))))) (defun metar-decode (record) "Return a lisp structure describing the weather information in RECORD." @@ -406,7 +507,8 @@ degrees celsius)." ;;;###autoload (defun metar (&optional arg) "Display recent weather information. -If a prefix argument is given, prompt for the exact station code. +If a prefix argument is given, prompt for country and station name. +If two prefix arguments are given, prompt for exact station code. Otherwise, determine the best station via latitude/longitude." (interactive "p") (unless arg (setq arg 1)) @@ -443,16 +545,21 @@ Otherwise, determine the best station via latitude/longitude." nil t)))) (let ((info (metar-decode (metar-get-record station)))) (if info - (message "%d minutes ago at %s: %d°C, %d%% relative humidity%s" - (/ (truncate (float-time (time-since (cdr (assoc 'timestamp info))))) 60) + (message "%d minutes ago at %s: %d°%c, %s%d%% humidity, %.1f %S." + (/ (truncate (float-time (time-since + (cdr (assoc 'timestamp info))))) + 60) (or (metar-stations-get (cdr (assoc 'station info)) 'name) (cdr (assoc 'station info))) (cadr (assoc 'temperature info)) - (cadr (assoc 'humidity info)) + (cond + ((eq (cdr (assq 'temperature metar-units)) 'degC) ?C) + ((eq (cdr (assq 'temperature metar-units)) 'degF) ?F)) (if (assoc 'phenomena info) - (concat "\n" "Phenomena: " - (cdr (assoc 'phenomena info))) - "")) + (concat (cdr (assoc 'phenomena info)) ", ") + "") + (cadr (assoc 'humidity info)) + (cadr (assoc 'pressure info)) (cddr (assoc 'pressure info))) (message "No weather information found, sorry."))))) (defun metar-station-countries () @@ -497,12 +604,36 @@ Otherwise, determine the best station via latitude/longitude." (message "Average temperature in %s is %s" country (if (> count 0) - (format "%.1f°C (%d stations)" + (format "%.1f°C (%d stations)" (/ (float temp-sum) count) count) "unknown")) (when (> count 0) (/ (float temp-sum) count))))) +(defun metar-format (format report) + (format-spec + format + (list (cons ?d + (let ((dewpoint (cdr (assq 'dewpoint report)))) + (format "%.1f°%c" + (car dewpoint) + (cond ((eq (cdr dewpoint) 'degC) ?C) + ((eq (cdr dewpoint) 'degF) ?F) + ((eq (cdr dewpoint) 'degK) ?K))))) + (cons ?h + (let ((humidity (cdr (assq 'humidity report)))) + (format "%d%%" (car humidity)))) + (cons ?p + (let ((pressure (cdr (assq 'pressure report)))) + (format "%.1f %S" (car pressure) (cdr pressure)))) + (cons ?s (cdr (assq 'station report))) + (cons ?t + (let ((temperature (cdr (assq 'temperature report)))) + (format "%.1f°%c" + (car temperature) + (cond ((eq (cdr temperature) 'degC) ?C) + ((eq (cdr temperature) 'degF) ?F)))))))) + (provide 'metar) ;;; metar.el ends here