1 ;;; metar.el --- Retrieve and decode METAR weather information
3 ;; Copyright (C) 2007, 2014 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)
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 (cl-check-type value string)
247 (cl-check-type new-unit (or string symbol))
248 (cl-multiple-value-bind (value unit)
251 (math-convert-units (math-simplify (math-read-expr value))
253 (cl-etypecase new-unit
255 (symbol (symbol-name new-unit))))))
257 (cons (string-to-number value) (intern unit))))
259 (defun metar-convert-temperature (string &optional unit)
260 (let* ((value (concat (if (= (aref string 0) ?M)
261 (concat "-" (substring string 1))
264 (expr (math-read-expr value))
265 (old-unit (math-single-units-in-expr-p expr))
266 (new-unit (or unit (cdr (assq 'temperature metar-units)))))
268 (cl-multiple-value-bind (value unit)
272 (math-convert-temperature
276 (intern (concat "var-" (symbol-name (car old-unit)))))
277 (math-read-expr (cl-etypecase new-unit
279 (symbol (symbol-name new-unit))))))) " ")
280 (cons (string-to-number value) (intern unit))))))
283 "http://weather.noaa.gov/pub/data/observations/metar/stations/%s.TXT"
284 "URL used to fetch station specific information.
285 %s is replaced with the 4 letter station code."
289 (defun metar-url (station)
291 (upcase (cl-etypecase station
293 (symbol (symbol-name station))))))
295 (defconst metar-record-regexp
296 (rx (group (1+ digit)) ?/ (group (1+ digit)) ?/ (group (1+ digit))
298 (group (1+ digit)) ?: (group (1+ digit))
300 (group "%s" (* not-newline)))
301 "Regular expression used to extract METAR information from `metar-url'.
302 %s is replaced with the station code which always has to be present in a METAR
305 (defun metar-get-record (station)
306 "Retrieve a METAR/SPECI record for STATION from the Internet.
307 Return a cons where `car' is the time of the measurement (as an emacs-lsip
308 time value) and `cdr' is a string containing the actual METAR code.
309 If no record was found for STATION, nil is returned."
311 (url-insert-file-contents (metar-url station))
312 (when (re-search-forward (format metar-record-regexp station) nil t)
315 (string-to-number (match-string 5))
316 (string-to-number (match-string 4))
317 (string-to-number (match-string 3))
318 (string-to-number (match-string 2))
319 (string-to-number (match-string 1))
323 (defconst metar-could-regexp
325 (group (or "FEW" "SCT" "BKN" "OVC"))
327 (optional (group (or "TCU" "CB")))
329 "Regular expression to match cloud information in METAR records.")
331 (defun metar-clouds (info)
334 (while (string-match metar-could-regexp info from)
335 (setq from (match-end 0)
336 clouds (push (append (list (match-string 1 info)
338 (concat (match-string 2 info) " ft")
339 (cdr (assq 'length metar-units))))
340 (when (match-string 3 info)
341 (list (match-string 3 info))))
345 (defconst metar-phenomena '(("BC" . "patches")
349 ("DS" . "dust storm")
350 ("DU" . "widespread dust")
352 ("FC" . "funnel cloud")
357 ("GS" . "small hail/snow pellets")
359 ("IC" . "ice crystals")
361 ("PL" . "ice pellets")
362 ("PO" . "well developed dust/sand swirls")
367 ("SG" . "snow grains")
371 ("SS" . "sand storm")
372 ("TS" . "thunderstorm")
373 ("VA" . "volcanic ash")
375 "Alist of codes and descriptions for METAR weather phenomenoa.")
377 (defconst metar-phenomena-regexp
378 (eval `(rx symbol-start
379 (group (optional (char ?+ ?-)))
380 (group (1+ (or ,@(mapcar #'car metar-phenomena))))
382 "Regular expression to match weather phenomena in METAR records.")
384 (defun metar-phenomena (info)
385 (when (string-match metar-phenomena-regexp info)
387 (when (string= (match-string 1 info) "-")
388 (push "light" words))
389 (let ((obs (match-string 2 info)))
390 (while (> (length obs) 0)
391 (setq words (nconc words
392 (list (cdr (assoc-string (substring obs 0 2)
394 obs (substring obs 2))))
395 (mapconcat #'identity words " "))))
397 (defconst metar-wind-regexp
399 (group (or "VRB" (= 3 digit)))
400 (group (repeat 2 3 digit)) (optional (char ?G) (group (1+ digit)))
403 (optional (one-or-more not-newline)
405 (group (= 3 digit)) (char ?V) (group (= 3 digit))
407 "Regular expression to match wind information in METAR records.")
409 (defsubst metar-degrees (value)
410 (cons value 'degrees))
412 (defun metar-wind (info)
413 (when (string-match metar-wind-regexp info)
415 (if (string= (match-string 1 info) "VRB")
416 (when (and (match-string 4 info) (match-string 5 info))
417 (list :from (string-to-number (match-string 4 info))
418 :to (string-to-number (match-string 5 info))))
420 (list :direction (metar-degrees
421 (string-to-number (match-string 1 info))))
422 (when (and (match-string 4 info) (match-string 5 info))
423 (list :from (metar-degrees (string-to-number (match-string 4 info)))
424 :to (metar-degrees (string-to-number (match-string 5 info)))))))
425 (list :speed (metar-convert-unit (concat (match-string 2 info) "knot")
426 (cdr (assq 'speed metar-units))))
427 (when (match-string 3 info)
428 (list :gust (metar-convert-unit (concat (match-string 3 info) "knot")
429 (cdr (assq 'speed metar-units))))))))
431 (defconst metar-visibility-regexp
432 (rx symbol-start (group (1+ digit)) (optional (group "SM")) symbol-end)
433 "Regular expression to match information about visibility in METAR records.")
435 (defconst metar-temperature-and-dewpoint-regexp
437 (group (group (optional (char ?M))) (1+ digit))
439 (group (group (optional (char ?M))) (1+ digit))
441 "Regular expression to match temperature and dewpoint information in METAR
444 (defun metar-temperature (info)
445 (when (string-match metar-temperature-and-dewpoint-regexp info)
446 (metar-convert-temperature (match-string 1 info))))
448 (defun metar-dewpoint (info)
449 (when (string-match metar-temperature-and-dewpoint-regexp info)
450 (metar-convert-temperature (match-string 3 info))))
452 (defun metar-humidity (info)
453 (when (string-match metar-temperature-and-dewpoint-regexp info)
455 (metar-magnus-formula-humidity-from-dewpoint
456 (save-match-data (car (metar-convert-temperature
457 (match-string 1 info) 'degC)))
458 (car (metar-convert-temperature (match-string 3 info) 'degC))))
461 (defconst metar-pressure-regexp
462 (rx symbol-start (group (char ?Q ?A)) (group (1+ digit)) symbol-end)
463 "Regular expression to match air pressure information in METAR records.")
465 (defun metar-pressure (info)
466 (when (string-match metar-pressure-regexp info)
468 (concat (match-string 2 info)
470 ((string= (match-string 1 info) "Q") "hPa")
471 ((string= (match-string 1 info) "A") "cinHg")))
472 (cdr (assq 'pressure metar-units)))))
474 (defun metar-decode (record)
475 "Return a lisp structure describing the weather information in RECORD."
477 (let* ((codes (cdr record))
478 (temperature (metar-temperature codes))
479 (dewpoint (metar-dewpoint codes))
480 (humidity (metar-humidity codes))
481 (pressure (metar-pressure codes))
482 (wind (metar-wind codes)))
484 (list (cons 'station (car (split-string codes " ")))
485 (cons 'timestamp (car record))
487 (cons 'temperature temperature)
488 (cons 'dewpoint dewpoint)
489 (cons 'humidity humidity)
490 (cons 'pressure pressure))
491 (when (metar-phenomena codes)
492 (list (cons 'phenomena (metar-phenomena codes))))))))
494 (defun metar-magnus-formula-humidity-from-dewpoint (temperature dewpoint)
495 "Calculate relative humidity (in %) from TEMPERATURE and DEWPOINT (in
500 (+ 243.12 temperature)
501 (/ (* dewpoint 17.62)
502 (+ 243.12 dewpoint)))
503 (* 0.4343 17.62 temperature))
504 (+ 243.12 temperature))
508 (defun metar (&optional arg)
509 "Display recent weather information.
510 If a prefix argument is given, prompt for country and station name.
511 If two prefix arguments are given, prompt for exact station code.
512 Otherwise, determine the best station via latitude/longitude."
514 (unless arg (setq arg 1))
518 (unless calendar-longitude
519 (setq calendar-longitude
521 "Enter longitude (decimal fraction; + east, - west): ")))
522 (unless calendar-latitude
523 (setq calendar-latitude
525 "Enter latitude (decimal fraction; + north, - south): ")))
526 (when (and calendar-latitude calendar-longitude
527 (setq station (metar-find-station-by-latitude/longitude
528 (calendar-latitude) (calendar-longitude))))
529 (message "Found %s %d kilometers away." (car station) (cdr station))
530 (setq station (car station))))
532 (let* ((country (completing-read "Country: " (metar-station-countries) nil t))
533 (name (completing-read "Station name: " (mapcar (lambda (s) (cdr (assq 'name s)))
534 (metar-stations-in-country country))
536 (setq station (cdr (assq 'code (cl-find-if (lambda (s)
537 (and (string= name (cdr (assq 'name s)))
538 (string= country (cdr (assq 'country s)))))
539 (metar-stations)))))))
541 (setq station (completing-read "Enter METAR station code: "
542 (mapcar (lambda (station-info)
543 (cdr (assq 'code station-info)))
546 (let ((info (metar-decode (metar-get-record station))))
548 (message "%d minutes ago at %s: %d°%c, %s%d%% humidity, %.1f %S."
549 (/ (truncate (float-time (time-since
550 (cdr (assoc 'timestamp info)))))
552 (or (metar-stations-get (cdr (assoc 'station info)) 'name)
553 (cdr (assoc 'station info)))
554 (cadr (assoc 'temperature info))
556 ((eq (cdr (assq 'temperature metar-units)) 'degC) ?C)
557 ((eq (cdr (assq 'temperature metar-units)) 'degF) ?F))
558 (if (assoc 'phenomena info)
559 (concat (cdr (assoc 'phenomena info)) ", ")
561 (cadr (assoc 'humidity info))
562 (cadr (assoc 'pressure info)) (cddr (assoc 'pressure info)))
563 (message "No weather information found, sorry.")))))
565 (defun metar-station-countries ()
567 (dolist (station (metar-stations))
568 (let ((country (cdr (assq 'country station))))
569 (cl-pushnew country countries :test #'equal)))
572 (defun metar-stations-in-country (country)
573 (cl-loop for station-info in (metar-stations)
574 when (string= country (cdr (assq 'country station-info)))
575 collect station-info))
577 (defun metar-average-temperature (country)
578 "Display average temperature from all stations in COUNTRY."
580 (list (completing-read "Country: " (metar-station-countries) nil t)))
581 (let ((count 0) (temp-sum 0)
582 (stations (metar-stations))
583 (url-show-status nil)
584 (progress (make-progress-reporter
585 "Downloading METAR records..."
587 (cl-count-if (lambda (station)
588 (string= (cdr (assoc 'country station))
592 (when (string= (cdr (assoc 'country (car stations))) country)
593 (let ((temp (cdr (assoc 'temperature
596 (cdr (assoc 'code (car stations)))))))))
598 (setq temp-sum (+ temp-sum temp)
600 (progress-reporter-update progress count))))
601 (setq stations (cdr stations)))
602 (progress-reporter-done progress)
603 (if (called-interactively-p 'interactive)
604 (message "Average temperature in %s is %s"
607 (format "%.1f°C (%d stations)"
608 (/ (float temp-sum) count)
612 (/ (float temp-sum) count)))))
614 (defun metar-format (format report)
618 (let ((dewpoint (cdr (assq 'dewpoint report))))
621 (cond ((eq (cdr dewpoint) 'degC) ?C)
622 ((eq (cdr dewpoint) 'degF) ?F)
623 ((eq (cdr dewpoint) 'degK) ?K)))))
625 (let ((humidity (cdr (assq 'humidity report))))
626 (format "%d%%" (car humidity))))
628 (let ((pressure (cdr (assq 'pressure report))))
629 (format "%.1f %S" (car pressure) (cdr pressure))))
630 (cons ?s (cdr (assq 'station report)))
632 (let ((temperature (cdr (assq 'temperature report))))
635 (cond ((eq (cdr temperature) 'degC) ?C)
636 ((eq (cdr temperature) 'degF) ?F))))))))
639 ;;; metar.el ends here