diff options
| author | Edward M. Reingold | 1994-10-26 15:34:14 +0000 |
|---|---|---|
| committer | Edward M. Reingold | 1994-10-26 15:34:14 +0000 |
| commit | 6ff099c3c687da42e3a3718c0cc6d152f20451f8 (patch) | |
| tree | 2595d5e2f10fc37308eaf74fc5c227016e2aa007 | |
| parent | cc4879d2715d891ab0f703c83cd543bffaab534e (diff) | |
| download | emacs-6ff099c3c687da42e3a3718c0cc6d152f20451f8.tar.gz emacs-6ff099c3c687da42e3a3718c0cc6d152f20451f8.zip | |
Allow vector form of latitude/longitude. Fix documentation.
| -rw-r--r-- | lisp/calendar/solar.el | 126 |
1 files changed, 87 insertions, 39 deletions
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 40ddaf5f40f..6eb412758b0 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el | |||
| @@ -25,8 +25,8 @@ | |||
| 25 | 25 | ||
| 26 | ;;; Commentary: | 26 | ;;; Commentary: |
| 27 | 27 | ||
| 28 | ;; This collection of functions implements the features of calendar.el and | 28 | ;; This collection of functions implements the features of calendar.el, |
| 29 | ;; diary.el that deal with times of day, sunrise/sunset, and | 29 | ;; diary.el, and holiday.el that deal with times of day, sunrise/sunset, and |
| 30 | ;; eqinoxes/solstices. | 30 | ;; eqinoxes/solstices. |
| 31 | 31 | ||
| 32 | ;; Based on the ``Almanac for Computers 1984,'' prepared by the Nautical | 32 | ;; Based on the ``Almanac for Computers 1984,'' prepared by the Nautical |
| @@ -54,7 +54,7 @@ | |||
| 54 | 54 | ||
| 55 | (if (fboundp 'atan) | 55 | (if (fboundp 'atan) |
| 56 | (require 'lisp-float-type) | 56 | (require 'lisp-float-type) |
| 57 | (error "Solar calculations impossible since floating point is unavailable.")) | 57 | (error "Solar/lunar calculations impossible since floating point is unavailable.")) |
| 58 | 58 | ||
| 59 | (require 'cal-dst) | 59 | (require 'cal-dst) |
| 60 | 60 | ||
| @@ -77,32 +77,69 @@ would give military-style times like `21:07 (UTC)'.") | |||
| 77 | 77 | ||
| 78 | ;;;###autoload | 78 | ;;;###autoload |
| 79 | (defvar calendar-latitude nil | 79 | (defvar calendar-latitude nil |
| 80 | "*Latitude of `calendar-location-name' in degrees, + north, - south. | 80 | "*Latitude of `calendar-location-name' in degrees. |
| 81 | For example, 40.7 for New York City. | 81 | |
| 82 | It may not be a good idea to set this in advance for your site; | 82 | The value can be either a decimal fraction (one place of accuracy is |
| 83 | if there may be users running Emacs at your site | 83 | sufficient), + north, - south, such as 40.7 for New York City, or the value |
| 84 | who are physically located elsewhere, they would get the wrong | 84 | can be a vector [degrees minutes north/south] such as [40 50 north] for New |
| 85 | value and might not know how to override it.") | 85 | York City. |
| 86 | |||
| 87 | This variable should be set in site-local.el.") | ||
| 86 | 88 | ||
| 87 | ;;;###autoload | 89 | ;;;###autoload |
| 88 | (defvar calendar-longitude nil | 90 | (defvar calendar-longitude nil |
| 89 | "*Longitude of `calendar-location-name' in degrees, + east, - west. | 91 | "*Longitude of `calendar-location-name' in degrees. |
| 90 | For example, -74.0 for New York City. | 92 | |
| 91 | It may not be a good idea to set this in advance for your site; | 93 | The value can be either a decimal fraction (one place of accuracy is |
| 92 | if there may be users running Emacs at your site | 94 | sufficient), + east, - west, such as -73.9 for New York City, or the value |
| 93 | who are physically located elsewhere, they would get the wrong | 95 | can be a vector [degrees minutes east/west] such as [73 55 west] for New |
| 94 | value and might not know how to override it.") | 96 | York City. |
| 97 | |||
| 98 | This variable should be set in site-local.el.") | ||
| 99 | |||
| 100 | (defsubst calendar-latitude () | ||
| 101 | "Convert calendar-latitude to a signed decimal fraction, if needed." | ||
| 102 | (if (numberp calendar-latitude) | ||
| 103 | calendar-latitude | ||
| 104 | (let ((lat (+ (aref calendar-latitude 0) | ||
| 105 | (/ (aref calendar-latitude 1) 60.0)))) | ||
| 106 | (if (equal (aref calendar-latitude 2) 'north) | ||
| 107 | lat | ||
| 108 | (- lat))))) | ||
| 109 | |||
| 110 | (defsubst calendar-longitude () | ||
| 111 | "Convert calendar-longitude to a signed decimal fraction, if needed." | ||
| 112 | (if (numberp calendar-longitude) | ||
| 113 | calendar-longitude | ||
| 114 | (let ((long (+ (aref calendar-longitude 0) | ||
| 115 | (/ (aref calendar-longitude 1) 60.0)))) | ||
| 116 | (if (equal (aref calendar-longitude 2) 'east) | ||
| 117 | long | ||
| 118 | (- long))))) | ||
| 95 | 119 | ||
| 96 | ;;;###autoload | 120 | ;;;###autoload |
| 97 | (defvar calendar-location-name | 121 | (defvar calendar-location-name |
| 98 | '(let ((float-output-format "%.1f")) | 122 | '(let ((float-output-format "%.1f")) |
| 99 | (format "%s%s, %s%s" | 123 | (format "%s%s, %s%s" |
| 100 | (abs calendar-latitude) | 124 | (if (numberp calendar-latitude) |
| 101 | (if (> calendar-latitude 0) "N" "S") | 125 | (abs calendar-latitude) |
| 102 | (abs calendar-longitude) | 126 | (+ (aref calendar-latitude 0) |
| 103 | (if (> calendar-longitude 0) "E" "W"))) | 127 | (/ (aref calendar-latitude 1) 60.0))) |
| 128 | (if (numberp calendar-latitude) | ||
| 129 | (if (> calendar-latitude 0) "N" "S") | ||
| 130 | (if (equal (aref calendar-latitude 2) 'north) "N" "S")) | ||
| 131 | (if (numberp calendar-longitude) | ||
| 132 | (abs calendar-longitude) | ||
| 133 | (+ (aref calendar-longitude 0) | ||
| 134 | (/ (aref calendar-longitude 1) 60.0))) | ||
| 135 | (if (numberp calendar-longitude) | ||
| 136 | (if (> calendar-longitude 0) "E" "W") | ||
| 137 | (if (equal (aref calendar-latitude 2) 'east) "E" "W")))) | ||
| 104 | "*Expression evaluating to name of `calendar-longitude', calendar-latitude'. | 138 | "*Expression evaluating to name of `calendar-longitude', calendar-latitude'. |
| 105 | Default value is just the latitude, longitude pair.") | 139 | For example, \"New York City\". Default value is just the latitude, longitude |
| 140 | pair. | ||
| 141 | |||
| 142 | This variable should be set in site-local.el.") | ||
| 106 | 143 | ||
| 107 | (defvar solar-n-hemi-seasons | 144 | (defvar solar-n-hemi-seasons |
| 108 | '("Vernal Equinox" "Summer Solstice" "Autumnal Equinox" "Winter Solstice") | 145 | '("Vernal Equinox" "Summer Solstice" "Autumnal Equinox" "Winter Solstice") |
| @@ -135,10 +172,10 @@ Returns nil if nothing was entered." | |||
| 135 | (if (not (string-equal x "")) | 172 | (if (not (string-equal x "")) |
| 136 | (string-to-int x)))) | 173 | (string-to-int x)))) |
| 137 | 174 | ||
| 138 | (defun solar-sin-degrees (x) | 175 | (defsubst solar-sin-degrees (x) |
| 139 | (sin (degrees-to-radians x))) | 176 | (sin (degrees-to-radians x))) |
| 140 | 177 | ||
| 141 | (defun solar-cosine-degrees (x) | 178 | (defsubst solar-cosine-degrees (x) |
| 142 | (cos (degrees-to-radians x))) | 179 | (cos (degrees-to-radians x))) |
| 143 | 180 | ||
| 144 | (defun solar-tangent-degrees (x) | 181 | (defun solar-tangent-degrees (x) |
| @@ -182,11 +219,11 @@ Returns nil if nothing was entered." | |||
| 182 | (defconst solar-earth-orbit-eccentricity 0.016718 | 219 | (defconst solar-earth-orbit-eccentricity 0.016718 |
| 183 | "Eccentricity of orbit of the earth around the sun.") | 220 | "Eccentricity of orbit of the earth around the sun.") |
| 184 | 221 | ||
| 185 | (defmacro solar-degrees-to-hours (deg) | 222 | (defsubst solar-degrees-to-hours (deg) |
| 186 | (list '/ deg 15.0)) | 223 | (/ deg 15.0)) |
| 187 | 224 | ||
| 188 | (defmacro solar-hours-to-days (hour) | 225 | (defsubst solar-hours-to-days (hour) |
| 189 | (list '/ hour 24.0)) | 226 | (/ hour 24.0)) |
| 190 | 227 | ||
| 191 | (defun solar-longitude-of-sun (day) | 228 | (defun solar-longitude-of-sun (day) |
| 192 | "Longitude of the sun at DAY in the year." | 229 | "Longitude of the sun at DAY in the year." |
| @@ -221,7 +258,7 @@ that location on that day." | |||
| 221 | (approx-sunrise | 258 | (approx-sunrise |
| 222 | (+ day-of-year | 259 | (+ day-of-year |
| 223 | (solar-hours-to-days | 260 | (solar-hours-to-days |
| 224 | (- 6 (solar-degrees-to-hours calendar-longitude))))) | 261 | (- 6 (solar-degrees-to-hours (calendar-longitude)))))) |
| 225 | (solar-longitude-of-sun-at-sunrise | 262 | (solar-longitude-of-sun-at-sunrise |
| 226 | (solar-longitude-of-sun approx-sunrise)) | 263 | (solar-longitude-of-sun approx-sunrise)) |
| 227 | (solar-right-ascension-at-sunrise | 264 | (solar-right-ascension-at-sunrise |
| @@ -231,9 +268,9 @@ that location on that day." | |||
| 231 | (cos-local-sunrise | 268 | (cos-local-sunrise |
| 232 | (/ (- (solar-cosine-degrees (+ 90 (/ 50.0 60.0))) | 269 | (/ (- (solar-cosine-degrees (+ 90 (/ 50.0 60.0))) |
| 233 | (* (solar-sin-degrees solar-declination-at-sunrise) | 270 | (* (solar-sin-degrees solar-declination-at-sunrise) |
| 234 | (solar-sin-degrees calendar-latitude))) | 271 | (solar-sin-degrees (calendar-latitude)))) |
| 235 | (* (solar-cosine-degrees solar-declination-at-sunrise) | 272 | (* (solar-cosine-degrees solar-declination-at-sunrise) |
| 236 | (solar-cosine-degrees calendar-latitude))))) | 273 | (solar-cosine-degrees (calendar-latitude)))))) |
| 237 | (if (<= (abs cos-local-sunrise) 1);; otherwise, no sunrise that day | 274 | (if (<= (abs cos-local-sunrise) 1);; otherwise, no sunrise that day |
| 238 | (let* ((local-sunrise (solar-degrees-to-hours | 275 | (let* ((local-sunrise (solar-degrees-to-hours |
| 239 | (- 360 (solar-arccos cos-local-sunrise)))) | 276 | (- 360 (solar-arccos cos-local-sunrise)))) |
| @@ -242,7 +279,7 @@ that location on that day." | |||
| 242 | (+ (* 0.065710 approx-sunrise) | 279 | (+ (* 0.065710 approx-sunrise) |
| 243 | 6.622)) | 280 | 6.622)) |
| 244 | 24))) | 281 | 24))) |
| 245 | (+ (- local-mean-sunrise (solar-degrees-to-hours calendar-longitude)) | 282 | (+ (- local-mean-sunrise (solar-degrees-to-hours (calendar-longitude))) |
| 246 | (/ calendar-time-zone 60.0)))))) | 283 | (/ calendar-time-zone 60.0)))))) |
| 247 | 284 | ||
| 248 | (defun solar-sunset (date) | 285 | (defun solar-sunset (date) |
| @@ -256,7 +293,7 @@ that location on that day." | |||
| 256 | (approx-sunset | 293 | (approx-sunset |
| 257 | (+ day-of-year | 294 | (+ day-of-year |
| 258 | (solar-hours-to-days | 295 | (solar-hours-to-days |
| 259 | (- 18 (solar-degrees-to-hours calendar-longitude))))) | 296 | (- 18 (solar-degrees-to-hours (calendar-longitude)))))) |
| 260 | (solar-longitude-of-sun-at-sunset | 297 | (solar-longitude-of-sun-at-sunset |
| 261 | (solar-longitude-of-sun approx-sunset)) | 298 | (solar-longitude-of-sun approx-sunset)) |
| 262 | (solar-right-ascension-at-sunset | 299 | (solar-right-ascension-at-sunset |
| @@ -266,9 +303,9 @@ that location on that day." | |||
| 266 | (cos-local-sunset | 303 | (cos-local-sunset |
| 267 | (/ (- (solar-cosine-degrees (+ 90 (/ 50.0 60.0))) | 304 | (/ (- (solar-cosine-degrees (+ 90 (/ 50.0 60.0))) |
| 268 | (* (solar-sin-degrees solar-declination-at-sunset) | 305 | (* (solar-sin-degrees solar-declination-at-sunset) |
| 269 | (solar-sin-degrees calendar-latitude))) | 306 | (solar-sin-degrees (calendar-latitude)))) |
| 270 | (* (solar-cosine-degrees solar-declination-at-sunset) | 307 | (* (solar-cosine-degrees solar-declination-at-sunset) |
| 271 | (solar-cosine-degrees calendar-latitude))))) | 308 | (solar-cosine-degrees (calendar-latitude)))))) |
| 272 | (if (<= (abs cos-local-sunset) 1);; otherwise, no sunset that day | 309 | (if (<= (abs cos-local-sunset) 1);; otherwise, no sunset that day |
| 273 | (let* ((local-sunset (solar-degrees-to-hours | 310 | (let* ((local-sunset (solar-degrees-to-hours |
| 274 | (solar-arccos cos-local-sunset))) | 311 | (solar-arccos cos-local-sunset))) |
| @@ -276,7 +313,7 @@ that location on that day." | |||
| 276 | (mod (- (+ local-sunset solar-right-ascension-at-sunset) | 313 | (mod (- (+ local-sunset solar-right-ascension-at-sunset) |
| 277 | (+ (* 0.065710 approx-sunset) 6.622)) | 314 | (+ (* 0.065710 approx-sunset) 6.622)) |
| 278 | 24))) | 315 | 24))) |
| 279 | (+ (- local-mean-sunset (solar-degrees-to-hours calendar-longitude)) | 316 | (+ (- local-mean-sunset (solar-degrees-to-hours (calendar-longitude))) |
| 280 | (/ calendar-time-zone 60.0)))))) | 317 | (/ calendar-time-zone 60.0)))))) |
| 281 | 318 | ||
| 282 | (defun solar-adj-time-for-dst (date time &optional style) | 319 | (defun solar-adj-time-for-dst (date time &optional style) |
| @@ -441,10 +478,21 @@ This function is suitable for execution in a .emacs file." | |||
| 441 | (if (< arg 16) calendar-location-name | 478 | (if (< arg 16) calendar-location-name |
| 442 | (let ((float-output-format "%.1f")) | 479 | (let ((float-output-format "%.1f")) |
| 443 | (format "%s%s, %s%s" | 480 | (format "%s%s, %s%s" |
| 444 | (abs calendar-latitude) | 481 | (if (numberp calendar-latitude) |
| 445 | (if (> calendar-latitude 0) "N" "S") | 482 | (abs calendar-latitude) |
| 446 | (abs calendar-longitude) | 483 | (+ (aref calendar-latitude 0) |
| 447 | (if (> calendar-longitude 0) "E" "W"))))) | 484 | (/ (aref calendar-latitude 1) 60.0))) |
| 485 | (if (numberp calendar-latitude) | ||
| 486 | (if (> calendar-latitude 0) "N" "S") | ||
| 487 | (if (equal (aref calendar-latitude 2) 'north) "N" "S")) | ||
| 488 | (if (numberp calendar-longitude) | ||
| 489 | (abs calendar-longitude) | ||
| 490 | (+ (aref calendar-longitude 0) | ||
| 491 | (/ (aref calendar-longitude 1) 60.0))) | ||
| 492 | (if (numberp calendar-longitude) | ||
| 493 | (if (> calendar-longitude 0) "E" "W") | ||
| 494 | (if (equal (aref calendar-latitude 2) 'east) | ||
| 495 | "E" "W")))))) | ||
| 448 | (calendar-standard-time-zone-name | 496 | (calendar-standard-time-zone-name |
| 449 | (if (< arg 16) calendar-standard-time-zone-name | 497 | (if (< arg 16) calendar-standard-time-zone-name |
| 450 | (cond ((= calendar-time-zone 0) "UTC") | 498 | (cond ((= calendar-time-zone 0) "UTC") |
| @@ -522,7 +570,7 @@ Requires floating point." | |||
| 522 | (calendar-time-zone (if calendar-time-zone calendar-time-zone 0)) | 570 | (calendar-time-zone (if calendar-time-zone calendar-time-zone 0)) |
| 523 | (k (1- (/ m 3))) | 571 | (k (1- (/ m 3))) |
| 524 | (date (solar-equinoxes/solstices k y)) | 572 | (date (solar-equinoxes/solstices k y)) |
| 525 | (s-hemi (and calendar-latitude (< calendar-latitude 0))) | 573 | (s-hemi (and calendar-latitude (< (calendar-latitude) 0))) |
| 526 | (day (extract-calendar-day date)) | 574 | (day (extract-calendar-day date)) |
| 527 | (adj (solar-adj-time-for-dst | 575 | (adj (solar-adj-time-for-dst |
| 528 | (list (extract-calendar-month date) | 576 | (list (extract-calendar-month date) |