;; Copyright (C) 2007, 2014 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Version: 0
+;; Version: 0.1
;; Package-Requires: ((cl-lib "0.5"))
;; Keywords: comm
;; 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'.
(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)))
(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))
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."
- (macrolet ((distance (d1 d2)
- `(expt (sin (/ (degrees-to-radians (- ,d2 ,d1)) 2)) 2)))
+ (cl-macrolet ((distance (d1 d2)
+ `(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))))))))
(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))
(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)
(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 ())
(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)))
(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)
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))
(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
(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)
(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."
;;;###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))
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 ()
- (let (countries (stations (metar-stations)))
- (while stations
- (let ((country (cdr (assq 'country (car stations)))))
- (add-to-list 'countries country))
- (setq stations (cdr stations)))
+ (let (countries)
+ (dolist (station (metar-stations))
+ (let ((country (cdr (assq 'country station))))
+ (cl-pushnew country countries :test #'equal)))
countries))
(defun metar-stations-in-country (country)
(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