1 ;;; metar.el --- Retrieve and decode METAR weather information
3 ;; Copyright (C) 2007, 2014-2016 Free Software Foundation, Inc.
5 ;; Author: Mario Lang <mlang@delysid.org>
7 ;; Package-Requires: ((cl-lib "0.5"))
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
25 ;; Run `M-x metar RET' to get a simple weather report from weather.noaa.gov.
26 ;; The value of `calendar-latitude' and `calendar-longitude' will be used to
27 ;; automatically determine a nearby station. If these variables are not set,
28 ;; you will be prompted to enter the location manually.
30 ;; With `C-u M-x metar RET', country and station name need to be entered.
31 ;; `C-u C-u M-x metar RET' will prompt for the METAR station code (4 letters).
33 ;; Customize `metar-units' to change length, speed, temperature or pressure
34 ;; units to your liking.
36 ;; For programmatic access to decoded weather reports, use:
38 ;; (metar-decode (metar-get-record "CODE"))
44 (require 'format-spec)
50 "METAR weather reports."
53 (defcustom metar-units '((length . m)
57 "Default measurement units to use when reporting weather information."
59 :type '(list (cons :format "%v"
60 (const :tag "Length: " length)
61 (choice (const :tag "Meter" m)
62 (const :tag "Inch" in)
63 (const :tag "Foot" ft)
64 (const :tag "Yard" yd)
65 (const :tag "Mile" mi)))
67 (const :tag "Pressure:" pressure)
68 (choice (const :tag "Pascal" Pa)
69 (const :tag "Hecto pascal" hPa)
70 (const :tag "Bar" bar)
71 (const :tag "Inch of mercury" inHg)
72 (const :tag "Standard atmosphere" atm)
73 (const :tag "Meter of mercury" mHg)
74 (const :tag "Punds per square inch" psi)))
76 (const :tag "Speed:" speed)
77 (choice (const :tag "Kilometers per hour" kph)
78 (const :tag "Miles per hour" mph)
79 (const :tag "Knot" knot)))
81 (const :tag "Temperature:" temperature)
82 (choice (const :tag "Degree Celsius" degC)
83 (const :tag "Degree Kelvin" degK)
84 (const :tag "Degree Fahrenheit" degF)))))
86 (defcustom metar-stations-info-url "http://weather.noaa.gov/data/nsd_bbsss.txt"
87 "URL to use for retrieving station meta information."
91 (defvar metar-stations nil
92 "Variable containing (cached) METAR station information.
93 Use the function `metar-stations' to get the actual station list.")
95 (defun metar-station-convert-dms-to-deg (string)
96 "Convert degrees, minutes and optional seconds, to degrees."
97 (when (string-match (rx string-start
98 (group (1+ digit)) ?- (group (1+ digit))
99 (optional ?- (group (1+ digit)))
100 (group (char ?N ?E ?S ?W))
102 (funcall (if (memq (aref (match-string 4 string) 0) '(?N ?E)) #'+ #'-)
103 (+ (string-to-number (match-string 1 string))
104 (/ (string-to-number (match-string 2 string)) 60.0)
105 (if (match-string 3 string)
106 (/ (string-to-number (match-string 3 string)) 3600.0)
109 (defun metar-stations ()
110 "Retrieve a list of METAR stations.
111 Results are cached in variable `metar-stations'.
112 If this variable is nil, the information is retrieved from the Internet."
114 (let ((data (with-temp-buffer
115 (url-insert-file-contents metar-stations-info-url)
116 (mapcar (lambda (entry)
117 (split-string entry ";"))
118 (split-string (buffer-string) "\n")))))
119 (setq metar-stations nil)
121 (when (and (nth 7 (car data)) (nth 8 (car data))
122 (not (string= (nth 2 (car data)) "----")))
125 (let ((item (car data)))
127 (list (cons 'code (nth 2 item))
128 (cons 'name (nth 3 item))
129 (cons 'country (nth 5 item))
131 (metar-station-convert-dms-to-deg (nth 7 item)))
133 (metar-station-convert-dms-to-deg (nth 8 item)))
134 (cons 'altitude (string-to-number (nth 12 item))))))
136 (setq data (cdr data)))
137 ;; (unless metar-timer
139 ;; (run-with-timer 600 nil (lambda () (setq metar-stations nil)))))
142 (defun metar-stations-get (station-code key)
143 "Get meta information for station with STATION-CODE and KEY.
144 KEY can be one of the symbols `code', `name', `country', `latitude',
145 `longitude' or `altitude'."
146 (let ((stations (metar-stations)) result)
148 (when (string= (cdr (assoc 'code (car stations))) station-code)
149 (setq result (cdr (assoc key (car stations)))
151 (setq stations (cdr stations)))
154 (defun metar-latitude-longitude-bearing (latitude1 longitude1
155 latitude2 longitude2)
156 "Calculate bearing from start point LATITUDE1/LONGITUDE1 to end point
157 LATITUDE2/LONGITUDE2."
161 (atan (* (sin (degrees-to-radians (- longitude2 longitude1)))
162 (cos (degrees-to-radians latitude2)))
163 (- (* (cos (degrees-to-radians latitude1))
164 (sin (degrees-to-radians latitude2)))
165 (* (sin (degrees-to-radians latitude1))
166 (cos (degrees-to-radians latitude2))
167 (cos (degrees-to-radians (- longitude2 longitude1)))))))))
170 (defun metar-latitude-longitude-distance-haversine (latitude1 longitude1
171 latitude2 longitude2)
172 "Caluclate the distance (in kilometers) between two points on the
173 surface of the earth given as LATITUDE1, LONGITUDE1, LATITUDE2 and LONGITUDE2."
174 (cl-macrolet ((distance (d1 d2)
175 `(expt (sin (/ (degrees-to-radians (- ,d2 ,d1)) 2)) 2)))
176 (let ((a (+ (distance latitude1 latitude2)
177 (* (cos (degrees-to-radians latitude1))
178 (cos (degrees-to-radians latitude2))
179 (distance longitude1 longitude2)))))
180 (* 6371 (* 2 (atan (sqrt a) (sqrt (- 1 a))))))))
182 (defun metar-find-station-by-latitude/longitude (latitude longitude &optional
184 "Find a station near the coordinates given by LATITUDE and LONGITUDE.
185 Returns a cons where car is the station code and cdr is the distance in
187 If RADIUS is non-nil, only stations within this range (in kilometers) are
189 If no match if found, nil is returned."
192 (solar-get-number "Enter latitude (decimal fraction; + north, - south): ")
193 (solar-get-number "Enter longitude (decimal fraction; + east, - west): ")))
194 (let ((stations (metar-stations))
195 (best-distance (or radius 10000))
198 (let ((station-latitude (cdr (assoc 'latitude (car stations))))
199 (station-longitude (cdr (assoc 'longitude (car stations)))))
200 (when (and station-latitude station-longitude)
201 (let ((distance (metar-latitude-longitude-distance-haversine
203 station-latitude station-longitude)))
204 (when (< distance best-distance)
205 (setq best-distance distance
206 station-code (cdr (assoc 'code (car stations))))))))
207 (setq stations (cdr stations)))
208 (if (called-interactively-p 'interactive)
210 (message "%s, %s (%s) at %s is %d km away from %s."
211 (metar-stations-get station-code 'name)
212 (metar-stations-get station-code 'country)
214 (let ((float-output-format "%.1f"))
216 (abs (metar-stations-get station-code 'latitude))
217 (if (> (metar-stations-get station-code 'latitude) 0) "N" "S")
218 (abs (metar-stations-get station-code 'longitude))
219 (if (> (metar-stations-get station-code 'longitude) 0) "E" "W")))
221 (let ((float-output-format "%.1f"))
223 (if (numberp latitude)
226 (/ (aref latitude 1) 60.0)))
227 (if (numberp latitude)
228 (if (> latitude 0) "N" "S")
229 (if (equal (aref latitude 2) 'north) "N" "S"))
230 (if (numberp longitude)
232 (+ (aref longitude 0)
233 (/ (aref longitude 1) 60.0)))
234 (if (numberp longitude)
235 (if (> longitude 0) "E" "W")
236 (if (equal (aref longitude 2) 'east)
238 (message "No appropriate station found."))
240 (cons station-code (round best-distance))))))
242 (defun metar-convert-unit (value new-unit &optional convert-units-function)
243 "Convert VALUE to NEW-UNIT.
244 VALUE is a string with the value followed by the unit, like \"5 knot\"
245 and NEW-UNIT should be a unit name like \"kph\" or similar.
246 CONVERT-UNITS-FUNCTION designates the function actually doing the conversion.
247 It must have the signature of `math-convert-units', which is the default."
248 (cl-check-type value string)
249 (unless (symbolp new-unit)
250 (setq new-unit (intern new-unit)))
251 (let ((expr (math-simplify (math-read-expr value))))
252 ;; Sneakily work around bug#19582.
253 (when (eq (car-safe expr) 'neg)
254 (setq expr `(* -1 ,(cadr expr))))
255 (cl-assert (or (math-zerop expr)
256 (not (memq (math-single-units-in-expr-p expr) '(nil wrong))))
258 "Metar: Not exactly one unit in expression: %S" expr)
259 (let ((res (math-simplify-units
260 (funcall (or convert-units-function 'math-convert-units)
262 (math-build-var-name new-unit)
264 (cl-assert (math-realp res) nil
265 "Metar: Not a Calc real number: %S" res)
266 (cons (string-to-number (math-format-value (if (integerp res)
271 (defun metar-convert-temperature (string &optional unit)
272 (metar-convert-unit (concat (if (= (aref string 0) ?M)
273 (concat "-" (substring string 1))
276 (or unit (cdr (assq 'temperature metar-units)))
277 (lambda (expr new-unit-var pure)
278 (math-convert-temperature expr
279 (math-build-var-name 'degC)
284 "http://weather.noaa.gov/pub/data/observations/metar/stations/%s.TXT"
285 "URL used to fetch station specific information.
286 %s is replaced with the 4 letter station code."
290 (defun metar-url (station)
292 (upcase (cl-etypecase station
294 (symbol (symbol-name station))))))
296 (defconst metar-record-regexp
297 (rx (group (1+ digit)) ?/ (group (1+ digit)) ?/ (group (1+ digit))
299 (group (1+ digit)) ?: (group (1+ digit))
301 (group "%s" (* not-newline)))
302 "Regular expression used to extract METAR information from `metar-url'.
303 %s is replaced with the station code which always has to be present in a METAR
306 (defun metar-get-record (station)
307 "Retrieve a METAR/SPECI record for STATION from the Internet.
308 Return a cons where `car' is the time of the measurement (as an emacs-lsip
309 time value) and `cdr' is a string containing the actual METAR code.
310 If no record was found for STATION, nil is returned."
312 (url-insert-file-contents (metar-url station))
313 (when (re-search-forward (format metar-record-regexp station) nil t)
316 (string-to-number (match-string 5))
317 (string-to-number (match-string 4))
318 (string-to-number (match-string 3))
319 (string-to-number (match-string 2))
320 (string-to-number (match-string 1))
324 (defconst metar-could-regexp
326 (group (or "FEW" "SCT" "BKN" "OVC"))
328 (optional (group (or "TCU" "CB")))
330 "Regular expression to match cloud information in METAR records.")
332 (defun metar-clouds (info)
335 (while (string-match metar-could-regexp info from)
336 (setq from (match-end 0)
337 clouds (push (append (list (match-string 1 info)
339 (concat (match-string 2 info) " ft")
340 (cdr (assq 'length metar-units))))
341 (when (match-string 3 info)
342 (list (match-string 3 info))))
346 (defconst metar-phenomena '(("BC" . "patches")
350 ("DS" . "dust storm")
351 ("DU" . "widespread dust")
353 ("FC" . "funnel cloud")
358 ("GS" . "small hail/snow pellets")
360 ("IC" . "ice crystals")
362 ("PL" . "ice pellets")
363 ("PO" . "well developed dust/sand swirls")
368 ("SG" . "snow grains")
372 ("SS" . "sand storm")
373 ("TS" . "thunderstorm")
374 ("VA" . "volcanic ash")
376 "Alist of codes and descriptions for METAR weather phenomenoa.")
378 (defconst metar-phenomena-regexp
379 (eval `(rx symbol-start
380 (group (optional (char ?+ ?-)))
381 (group (1+ (or ,@(mapcar #'car metar-phenomena))))
383 "Regular expression to match weather phenomena in METAR records.")
385 (defun metar-phenomena (info)
386 (when (string-match metar-phenomena-regexp info)
388 (when (string= (match-string 1 info) "-")
389 (push "light" words))
390 (let ((obs (match-string 2 info)))
391 (while (> (length obs) 0)
392 (setq words (nconc words
393 (list (cdr (assoc-string (substring obs 0 2)
395 obs (substring obs 2))))
396 (mapconcat #'identity words " "))))
398 (defconst metar-wind-regexp
400 (group (or "VRB" (= 3 digit)))
401 (group (repeat 2 3 digit)) (optional (char ?G) (group (1+ digit)))
404 (optional (one-or-more not-newline)
406 (group (= 3 digit)) (char ?V) (group (= 3 digit))
408 "Regular expression to match wind information in METAR records.")
410 (defsubst metar-degrees (value)
411 (cons value 'degrees))
413 (defun metar-wind (info)
414 (when (string-match metar-wind-regexp info)
416 (if (string= (match-string 1 info) "VRB")
417 (when (and (match-string 4 info) (match-string 5 info))
418 (list :from (string-to-number (match-string 4 info))
419 :to (string-to-number (match-string 5 info))))
421 (list :direction (metar-degrees
422 (string-to-number (match-string 1 info))))
423 (when (and (match-string 4 info) (match-string 5 info))
424 (list :from (metar-degrees (string-to-number (match-string 4 info)))
425 :to (metar-degrees (string-to-number (match-string 5 info)))))))
426 (list :speed (metar-convert-unit (concat (match-string 2 info) "knot")
427 (cdr (assq 'speed metar-units))))
428 (when (match-string 3 info)
429 (list :gust (metar-convert-unit (concat (match-string 3 info) "knot")
430 (cdr (assq 'speed metar-units))))))))
432 (defconst metar-visibility-regexp
433 (rx symbol-start (group (1+ digit)) (optional (group "SM")) symbol-end)
434 "Regular expression to match information about visibility in METAR records.")
436 (defconst metar-temperature-and-dewpoint-regexp
438 (group (group (optional (char ?M))) (1+ digit))
440 (group (group (optional (char ?M))) (1+ digit))
442 "Regular expression to match temperature and dewpoint information in METAR
445 (defun metar-temperature (info)
446 (when (string-match metar-temperature-and-dewpoint-regexp info)
447 (metar-convert-temperature (match-string 1 info))))
449 (defun metar-dewpoint (info)
450 (when (string-match metar-temperature-and-dewpoint-regexp info)
451 (metar-convert-temperature (match-string 3 info))))
453 (defun metar-humidity (info)
454 (when (string-match metar-temperature-and-dewpoint-regexp info)
456 (metar-magnus-formula-humidity-from-dewpoint
457 (save-match-data (car (metar-convert-temperature
458 (match-string 1 info) 'degC)))
459 (car (metar-convert-temperature (match-string 3 info) 'degC))))
462 (defconst metar-pressure-regexp
463 (rx symbol-start (group (char ?Q ?A)) (group (1+ digit)) symbol-end)
464 "Regular expression to match air pressure information in METAR records.")
466 (defun metar-pressure (info)
467 (when (string-match metar-pressure-regexp info)
469 (concat (match-string 2 info)
471 ((string= (match-string 1 info) "Q") "hPa")
472 ((string= (match-string 1 info) "A") "cinHg")))
473 (cdr (assq 'pressure metar-units)))))
475 (defun metar-decode (record)
476 "Return a lisp structure describing the weather information in RECORD."
478 (let* ((codes (cdr record))
479 (temperature (metar-temperature codes))
480 (dewpoint (metar-dewpoint codes))
481 (humidity (metar-humidity codes))
482 (pressure (metar-pressure codes))
483 (wind (metar-wind codes)))
485 (list (cons 'station (car (split-string codes " ")))
486 (cons 'timestamp (car record))
488 (cons 'temperature temperature)
489 (cons 'dewpoint dewpoint)
490 (cons 'humidity humidity)
491 (cons 'pressure pressure))
492 (when (metar-phenomena codes)
493 (list (cons 'phenomena (metar-phenomena codes))))))))
495 (defun metar-magnus-formula-humidity-from-dewpoint (temperature dewpoint)
496 "Calculate relative humidity (in %) from TEMPERATURE and DEWPOINT (in
501 (+ 243.12 temperature)
502 (/ (* dewpoint 17.62)
503 (+ 243.12 dewpoint)))
504 (* 0.4343 17.62 temperature))
505 (+ 243.12 temperature))
509 (defun metar (&optional arg)
510 "Display recent weather information.
511 If a prefix argument is given, prompt for country and station name.
512 If two prefix arguments are given, prompt for exact station code.
513 Otherwise, determine the best station via latitude/longitude."
515 (unless arg (setq arg 1))
519 (unless calendar-longitude
520 (setq calendar-longitude
522 "Enter longitude (decimal fraction; + east, - west): ")))
523 (unless calendar-latitude
524 (setq calendar-latitude
526 "Enter latitude (decimal fraction; + north, - south): ")))
527 (when (and calendar-latitude calendar-longitude
528 (setq station (metar-find-station-by-latitude/longitude
529 (calendar-latitude) (calendar-longitude))))
530 (message "Found %s %d kilometers away." (car station) (cdr station))
531 (setq station (car station))))
533 (let* ((country (completing-read "Country: " (metar-station-countries) nil t))
534 (name (completing-read "Station name: " (mapcar (lambda (s) (cdr (assq 'name s)))
535 (metar-stations-in-country country))
537 (setq station (cdr (assq 'code (cl-find-if (lambda (s)
538 (and (string= name (cdr (assq 'name s)))
539 (string= country (cdr (assq 'country s)))))
540 (metar-stations)))))))
542 (setq station (completing-read "Enter METAR station code: "
543 (mapcar (lambda (station-info)
544 (cdr (assq 'code station-info)))
547 (let ((info (metar-decode (metar-get-record station))))
549 (message "%d minutes ago at %s: %d°%c, %s%d%% humidity, %.1f %S."
550 (/ (truncate (float-time (time-since
551 (cdr (assoc 'timestamp info)))))
553 (or (metar-stations-get (cdr (assoc 'station info)) 'name)
554 (cdr (assoc 'station info)))
555 (cadr (assoc 'temperature info))
557 ((eq (cdr (assq 'temperature metar-units)) 'degC) ?C)
558 ((eq (cdr (assq 'temperature metar-units)) 'degF) ?F))
559 (if (assoc 'phenomena info)
560 (concat (cdr (assoc 'phenomena info)) ", ")
562 (cadr (assoc 'humidity info))
563 (cadr (assoc 'pressure info)) (cddr (assoc 'pressure info)))
564 (message "No weather information found, sorry.")))))
566 (defun metar-station-countries ()
568 (dolist (station (metar-stations))
569 (let ((country (cdr (assq 'country station))))
570 (cl-pushnew country countries :test #'equal)))
573 (defun metar-stations-in-country (country)
574 (cl-loop for station-info in (metar-stations)
575 when (string= country (cdr (assq 'country station-info)))
576 collect station-info))
578 (defun metar-average-temperature (country)
579 "Display average temperature from all stations in COUNTRY."
581 (list (completing-read "Country: " (metar-station-countries) nil t)))
582 (let ((count 0) (temp-sum 0)
583 (stations (metar-stations))
584 (url-show-status nil)
585 (progress (make-progress-reporter
586 "Downloading METAR records..."
588 (cl-count-if (lambda (station)
589 (string= (cdr (assoc 'country station))
593 (when (string= (cdr (assoc 'country (car stations))) country)
594 (let ((temp (cdr (assoc 'temperature
597 (cdr (assoc 'code (car stations)))))))))
599 (setq temp-sum (+ temp-sum temp)
601 (progress-reporter-update progress count))))
602 (setq stations (cdr stations)))
603 (progress-reporter-done progress)
604 (if (called-interactively-p 'interactive)
605 (message "Average temperature in %s is %s"
608 (format "%.1f°C (%d stations)"
609 (/ (float temp-sum) count)
613 (/ (float temp-sum) count)))))
615 (defun metar-format (format report)
619 (let ((dewpoint (cdr (assq 'dewpoint report))))
622 (cond ((eq (cdr dewpoint) 'degC) ?C)
623 ((eq (cdr dewpoint) 'degF) ?F)
624 ((eq (cdr dewpoint) 'degK) ?K)))))
626 (let ((humidity (cdr (assq 'humidity report))))
627 (format "%d%%" (car humidity))))
629 (let ((pressure (cdr (assq 'pressure report))))
630 (format "%.1f %S" (car pressure) (cdr pressure))))
631 (cons ?s (cdr (assq 'station report)))
633 (let ((temperature (cdr (assq 'temperature report))))
636 (cond ((eq (cdr temperature) 'degC) ?C)
637 ((eq (cdr temperature) 'degF) ?F))))))))
640 ;;; metar.el ends here