code.delx.au - gnu-emacs-elpa/blob - packages/metar/metar.el

   1 ;;; metar.el --- Retrieve and decode METAR weather information
   2
   3 ;; Copyright (C) 2007, 2014-2016  Free Software Foundation, Inc.
   4
   5 ;; Author: Mario Lang <mlang@delysid.org>
   6 ;; Version: 0.2
   7 ;; Package-Requires: ((cl-lib "0.5"))
   8 ;; Keywords: comm
   9
  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.
  14
  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.
  19
  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/>.
  22
  23 ;;; Commentary:
  24
  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.
  29 ;;
  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).
  32 ;;
  33 ;; Customize `metar-units' to change length, speed, temperature or pressure
  34 ;; units to your liking.
  35 ;;
  36 ;; For programmatic access to decoded weather reports, use:
  37 ;;
  38 ;;   (metar-decode (metar-get-record "CODE"))
  39
  40 ;;; Code:
  41
  42 (require 'calc-units)
  43 (require 'cl-lib)
  44 (require 'format-spec)
  45 (require 'rx)
  46 (require 'solar)
  47 (require 'url)
  48
  49 (defgroup metar ()
  50   "METAR weather reports."
  51   :group 'net-utils)
  52
  53 (defcustom metar-units '((length . m)
  54                          (pressure . hPa)
  55                          (speed . kph)
  56                          (temperature . degC))
  57   "Default measurement units to use when reporting weather information."
  58   :group 'metar
  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)))
  66                (cons :format "%v"
  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)))
  75                (cons :format "%v"
  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)))
  80                (cons :format "%v"
  81                      (const :tag "Temperature:" temperature)
  82                      (choice (const :tag "Degree Celsius" degC)
  83                              (const :tag "Degree Kelvin" degK)
  84                              (const :tag "Degree Fahrenheit" degF)))))
  85
  86 (defcustom metar-stations-info-url "http://weather.noaa.gov/data/nsd_bbsss.txt"
  87   "URL to use for retrieving station meta information."
  88   :group 'metar
  89   :type 'string)
  90
  91 (defvar metar-stations nil
  92   "Variable containing (cached) METAR station information.
  93 Use the function `metar-stations' to get the actual station list.")
  94
  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))
 101                           string-end) string)
 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)
 107                   0)))))
 108
 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."
 113   (or metar-stations
 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)
 120         (while data
 121           (when (and (nth 7 (car data)) (nth 8 (car data))
 122                      (not (string= (nth 2 (car data)) "----")))
 123             (setq metar-stations
 124                   (append
 125                    (let ((item (car data)))
 126                      (list
 127                       (list (cons 'code (nth 2 item))
 128                             (cons 'name (nth 3 item))
 129                             (cons 'country (nth 5 item))
 130                             (cons 'latitude
 131                                   (metar-station-convert-dms-to-deg (nth 7 item)))
 132                             (cons 'longitude
 133                                   (metar-station-convert-dms-to-deg (nth 8 item)))
 134                             (cons 'altitude (string-to-number (nth 12 item))))))
 135                    metar-stations)))
 136           (setq data (cdr data)))
 137         ;; (unless metar-timer
 138         ;;   (setq metar-timer
 139         ;;      (run-with-timer 600 nil (lambda () (setq metar-stations nil)))))
 140         metar-stations)))
 141
 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)
 147     (while stations
 148       (when (string= (cdr (assoc 'code (car stations))) station-code)
 149         (setq result (cdr (assoc key (car stations)))
 150               stations nil))
 151       (setq stations (cdr stations)))
 152     result))
 153
 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."
 158   (% (+ 360
 159         (truncate
 160          (radians-to-degrees
 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)))))))))
 168      360))
 169
 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))))))))
 181
 182 (defun metar-find-station-by-latitude/longitude (latitude longitude &optional
 183                                                           radius)
 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
 186 kilometers.
 187 If RADIUS is non-nil, only stations within this range (in kilometers) are
 188 considered.
 189 If no match if found, nil is returned."
 190   (interactive
 191    (list
 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))
 196         (station-code nil))
 197     (while stations
 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
 202                            latitude longitude
 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)
 209         (if station-code
 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)
 213                      station-code
 214                      (let ((float-output-format "%.1f"))
 215                        (format "%s%s, %s%s"
 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")))
 220                      best-distance
 221                      (let ((float-output-format "%.1f"))
 222                        (format "%s%s, %s%s"
 223                                (if (numberp latitude)
 224                                    (abs latitude)
 225                                  (+ (aref latitude 0)
 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)
 231                                    (abs 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)
 237                                      "E" "W")))))
 238           (message "No appropriate station found."))
 239       (when station-code
 240         (cons station-code (round best-distance))))))
 241
 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))))
 257                nil
 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)
 261                          expr
 262                          (math-build-var-name new-unit)
 263                          t))))
 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)
 267                                                      res
 268                                                    (math-float res))))
 269             new-unit))))
 270
 271 (defun metar-convert-temperature (string &optional unit)
 272   (metar-convert-unit (concat (if (= (aref string 0) ?M)
 273                                   (concat "-" (substring string 1))
 274                                 string)
 275                               "degC")
 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)
 280                                                   new-unit-var
 281                                                   pure))))
 282
 283 (defcustom metar-url
 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."
 287   :group 'metar
 288   :type 'string)
 289
 290 (defun metar-url (station)
 291   (format metar-url
 292           (upcase (cl-etypecase station
 293                     (string station)
 294                     (symbol (symbol-name station))))))
 295
 296 (defconst metar-record-regexp
 297   (rx (group (1+ digit)) ?/ (group (1+ digit)) ?/ (group (1+ digit))
 298       space
 299       (group (1+ digit)) ?: (group (1+ digit))
 300       ?\n
 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
 304 record.")
 305
 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."
 311   (with-temp-buffer
 312     (url-insert-file-contents (metar-url station))
 313     (when (re-search-forward (format metar-record-regexp station) nil t)
 314       (cons (encode-time
 315              0
 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))
 321              0)
 322             (match-string 6)))))
 323
 324 (defconst metar-could-regexp
 325   (rx symbol-start
 326       (group (or "FEW" "SCT" "BKN" "OVC"))
 327       (group (= 3 digit))
 328       (optional (group (or "TCU" "CB")))
 329       symbol-end)
 330   "Regular expression to match cloud information in METAR records.")
 331
 332 (defun metar-clouds (info)
 333   (let ((clouds ())
 334         (from 0))
 335     (while (string-match metar-could-regexp info from)
 336       (setq from (match-end 0)
 337             clouds (push (append (list (match-string 1 info)
 338                                        (metar-convert-unit
 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))))
 343                          clouds)))
 344     clouds))
 345
 346 (defconst metar-phenomena '(("BC" . "patches")
 347                             ("BL" . "blowing")
 348                             ("BR" . "mist")
 349                             ("DR" . "drifting")
 350                             ("DS" . "dust storm")
 351                             ("DU" . "widespread dust")
 352                             ("DZ" . "drizzle")
 353                             ("FC" . "funnel cloud")
 354                             ("FG" . "fog")
 355                             ("FU" . "smoke")
 356                             ("FZ" . "freezing")
 357                             ("GR" . "hail")
 358                             ("GS" . "small hail/snow pellets")
 359                             ("HZ" . "haze")
 360                             ("IC" . "ice crystals")
 361                             ("MI" . "shallow")
 362                             ("PL" . "ice pellets")
 363                             ("PO" . "well developed dust/sand swirls")
 364                             ("PR" . "partials")
 365                             ("PY" . "spray")
 366                             ("RA" . "rain")
 367                             ("SA" . "sand")
 368                             ("SG" . "snow grains")
 369                             ("SH" . "showers")
 370                             ("SN" . "snow")
 371                             ("SQ" . "squall")
 372                             ("SS" . "sand storm")
 373                             ("TS" . "thunderstorm")
 374                             ("VA" . "volcanic ash")
 375                             ("VC" . "vicinity"))
 376   "Alist of codes and descriptions for METAR weather phenomenoa.")
 377
 378 (defconst metar-phenomena-regexp
 379   (eval `(rx symbol-start
 380              (group (optional (char ?+ ?-)))
 381              (group (1+ (or ,@(mapcar #'car metar-phenomena))))
 382              symbol-end))
 383   "Regular expression to match weather phenomena in METAR records.")
 384
 385 (defun metar-phenomena (info)
 386   (when (string-match metar-phenomena-regexp info)
 387     (let ((words ()))
 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)
 394                                                       metar-phenomena))))
 395                 obs (substring obs 2))))
 396       (mapconcat #'identity words " "))))
 397
 398 (defconst metar-wind-regexp
 399   (rx symbol-start
 400       (group (or "VRB" (= 3 digit)))
 401       (group (repeat 2 3 digit)) (optional (char ?G) (group (1+ digit)))
 402       "KT"
 403       symbol-end
 404       (optional (one-or-more not-newline)
 405                 symbol-start
 406                 (group (= 3 digit)) (char ?V) (group (= 3 digit))
 407                 symbol-end))
 408   "Regular expression to match wind information in METAR records.")
 409
 410 (defsubst metar-degrees (value)
 411   (cons value 'degrees))
 412
 413 (defun metar-wind (info)
 414   (when (string-match metar-wind-regexp info)
 415     (append
 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))))
 420        (append
 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))))))))
 431
 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.")
 435
 436 (defconst metar-temperature-and-dewpoint-regexp
 437   (rx symbol-start
 438       (group (group (optional (char ?M))) (1+ digit))
 439       (char ?/)
 440       (group (group (optional (char ?M))) (1+ digit))
 441       symbol-end)
 442   "Regular expression to match temperature and dewpoint information in METAR
 443 records.")
 444
 445 (defun metar-temperature (info)
 446   (when (string-match metar-temperature-and-dewpoint-regexp info)
 447     (metar-convert-temperature (match-string 1 info))))
 448
 449 (defun metar-dewpoint (info)
 450   (when (string-match metar-temperature-and-dewpoint-regexp info)
 451     (metar-convert-temperature (match-string 3 info))))
 452
 453 (defun metar-humidity (info)
 454   (when (string-match metar-temperature-and-dewpoint-regexp info)
 455     (cons (round
 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))))
 460           'percent)))
 461
 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.")
 465
 466 (defun metar-pressure (info)
 467   (when (string-match metar-pressure-regexp info)
 468     (metar-convert-unit
 469      (concat (match-string 2 info)
 470              (cond
 471               ((string= (match-string 1 info) "Q") "hPa")
 472               ((string= (match-string 1 info) "A") "cinHg")))
 473      (cdr (assq 'pressure metar-units)))))
 474
 475 (defun metar-decode (record)
 476   "Return a lisp structure describing the weather information in RECORD."
 477   (when 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)))
 484       (append
 485        (list (cons 'station (car (split-string codes " ")))
 486              (cons 'timestamp (car record))
 487              (cons 'wind wind)
 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))))))))
 494
 495 (defun metar-magnus-formula-humidity-from-dewpoint (temperature dewpoint)
 496   "Calculate relative humidity (in %) from TEMPERATURE and DEWPOINT (in
 497 degrees celsius)."
 498   (* 10000
 499      (expt 10
 500            (- (/ (- (* 0.4343
 501                        (+ 243.12 temperature)
 502                        (/ (* dewpoint 17.62)
 503                           (+ 243.12 dewpoint)))
 504                     (* 0.4343 17.62 temperature))
 505                  (+ 243.12 temperature))
 506               2))))
 507
 508 ;;;###autoload
 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."
 514   (interactive "p")
 515   (unless arg (setq arg 1))
 516   (let (station)
 517     (cond
 518      ((= arg 1)
 519       (unless calendar-longitude
 520         (setq calendar-longitude
 521               (solar-get-number
 522                "Enter longitude (decimal fraction; + east, - west): ")))
 523       (unless calendar-latitude
 524         (setq calendar-latitude
 525               (solar-get-number
 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))))
 532      ((= arg 4)
 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))
 536                                     nil t)))
 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)))))))
 541      ((= arg 16)
 542       (setq station (completing-read "Enter METAR station code: "
 543                                      (mapcar (lambda (station-info)
 544                                                (cdr (assq 'code station-info)))
 545                                              (metar-stations))
 546                                      nil t))))
 547     (let ((info (metar-decode (metar-get-record station))))
 548       (if info
 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)))))
 552                       60)
 553                    (or (metar-stations-get (cdr (assoc 'station info)) 'name)
 554                        (cdr (assoc 'station info)))
 555                    (cadr (assoc 'temperature info))
 556                    (cond
 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)) ", ")
 561                      "")
 562                    (cadr (assoc 'humidity info))
 563                    (cadr (assoc 'pressure info)) (cddr (assoc 'pressure info)))
 564         (message "No weather information found, sorry.")))))
 565
 566 (defun metar-station-countries ()
 567   (let (countries)
 568     (dolist (station (metar-stations))
 569       (let ((country (cdr (assq 'country station))))
 570         (cl-pushnew country countries :test #'equal)))
 571     countries))
 572
 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))
 577
 578 (defun metar-average-temperature (country)
 579   "Display average temperature from all stations in COUNTRY."
 580   (interactive
 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..."
 587                    0
 588                    (cl-count-if (lambda (station)
 589                                   (string= (cdr (assoc 'country station))
 590                                            country))
 591                                 (metar-stations)))))
 592     (while stations
 593       (when (string= (cdr (assoc 'country (car stations))) country)
 594         (let ((temp (cdr (assoc 'temperature
 595                                 (metar-decode
 596                                  (metar-get-record
 597                                   (cdr (assoc 'code (car stations)))))))))
 598           (when temp
 599             (setq temp-sum (+ temp-sum temp)
 600                   count (+ count 1))
 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"
 606                  country
 607                  (if (> count 0)
 608                      (format "%.1f°C (%d stations)"
 609                              (/ (float temp-sum) count)
 610                              count)
 611                    "unknown"))
 612       (when (> count 0)
 613         (/ (float temp-sum) count)))))
 614
 615 (defun metar-format (format report)
 616   (format-spec
 617    format
 618    (list (cons ?d
 619                (let ((dewpoint (cdr (assq 'dewpoint report))))
 620                  (format "%.1f°%c"
 621                          (car dewpoint)
 622                          (cond ((eq (cdr dewpoint) 'degC) ?C)
 623                                ((eq (cdr dewpoint) 'degF) ?F)
 624                                ((eq (cdr dewpoint) 'degK) ?K)))))
 625          (cons ?h
 626                (let ((humidity (cdr (assq 'humidity report))))
 627                  (format "%d%%" (car humidity))))
 628          (cons ?p
 629                (let ((pressure (cdr (assq 'pressure report))))
 630                  (format "%.1f %S" (car pressure) (cdr pressure))))
 631          (cons ?s (cdr (assq 'station report)))
 632          (cons ?t
 633                (let ((temperature (cdr (assq 'temperature report))))
 634                  (format "%.1f°%c"
 635                          (car temperature)
 636                          (cond ((eq (cdr temperature) 'degC) ?C)
 637                                ((eq (cdr temperature) 'degF) ?F))))))))
 638
 639 (provide 'metar)
 640 ;;; metar.el ends here