Commit | Line | Data |
---|---|---|
3afbc435 | 1 | ;;; solar.el --- calendar functions for solar events |
9f34a2a0 | 2 | |
ba318903 | 3 | ;; Copyright (C) 1992-1993, 1995, 1997, 2001-2014 Free Software |
ab422c4d | 4 | ;; Foundation, Inc. |
9f34a2a0 JB |
5 | |
6 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | |
f575f9ab | 7 | ;; Denis B. Roegel <Denis.Roegel@loria.fr> |
aff88519 | 8 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
68e60225 | 9 | ;; Keywords: calendar |
f575f9ab | 10 | ;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary, holidays |
bd78fa1d | 11 | ;; Package: calendar |
9f34a2a0 JB |
12 | |
13 | ;; This file is part of GNU Emacs. | |
14 | ||
2ed66575 | 15 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
59243403 | 16 | ;; it under the terms of the GNU General Public License as published by |
2ed66575 GM |
17 | ;; the Free Software Foundation, either version 3 of the License, or |
18 | ;; (at your option) any later version. | |
59243403 | 19 | |
9f34a2a0 | 20 | ;; GNU Emacs is distributed in the hope that it will be useful, |
59243403 RS |
21 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
22 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
23 | ;; GNU General Public License for more details. | |
24 | ||
25 | ;; You should have received a copy of the GNU General Public License | |
2ed66575 | 26 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
9f34a2a0 JB |
27 | |
28 | ;;; Commentary: | |
29 | ||
f1e3fbeb GM |
30 | ;; See calendar.el. This file implements features that deal with |
31 | ;; times of day, sunrise/sunset, and equinoxes/solstices. | |
9f34a2a0 JB |
32 | |
33 | ;; Based on the ``Almanac for Computers 1984,'' prepared by the Nautical | |
75af4a4a ER |
34 | ;; Almanac Office, United States Naval Observatory, Washington, 1984, on |
35 | ;; ``Astronomical Formulae for Calculators,'' 3rd ed., by Jean Meeus, | |
087c56fa ER |
36 | ;; Willmann-Bell, Inc., 1985, on ``Astronomical Algorithms'' by Jean Meeus, |
37 | ;; Willmann-Bell, Inc., 1991, and on ``Planetary Programs and Tables from | |
38 | ;; -4000 to +2800'' by Pierre Bretagnon and Jean-Louis Simon, Willmann-Bell, | |
39 | ;; Inc., 1986. | |
75af4a4a | 40 | |
9f34a2a0 | 41 | ;; |
087c56fa ER |
42 | ;; Accuracy: |
43 | ;; 1. Sunrise/sunset times will be accurate to the minute for years | |
44 | ;; 1951--2050. For other years the times will be within +/- 2 minutes. | |
9f34a2a0 | 45 | ;; |
087c56fa ER |
46 | ;; 2. Equinox/solstice times will be accurate to the minute for years |
47 | ;; 1951--2050. For other years the times will be within +/- 1 minute. | |
9f34a2a0 | 48 | |
9f34a2a0 JB |
49 | ;;; Code: |
50 | ||
37628fd0 | 51 | (require 'calendar) |
a92ade89 | 52 | (require 'cal-dst) |
5c645a20 | 53 | ;; calendar-astro-to-absolute and v versa are cal-autoloads. |
37628fd0 | 54 | ;;;(require 'cal-julian) |
a92ade89 | 55 | |
e85393d4 | 56 | |
5e11a170 | 57 | (defcustom calendar-time-display-form |
a92ade89 | 58 | '(12-hours ":" minutes am-pm |
f575f9ab | 59 | (if time-zone " (") time-zone (if time-zone ")")) |
e85393d4 | 60 | "The pseudo-pattern that governs the way a time of day is formatted. |
a92ade89 JB |
61 | |
62 | A pseudo-pattern is a list of expressions that can involve the keywords | |
4f7bf990 JB |
63 | `12-hours', `24-hours', and `minutes', all numbers in string form, |
64 | and `am-pm' and `time-zone', both alphabetic strings. | |
a92ade89 JB |
65 | |
66 | For example, the form | |
67 | ||
68 | '(24-hours \":\" minutes | |
69 | (if time-zone \" (\") time-zone (if time-zone \")\")) | |
70 | ||
5e11a170 RS |
71 | would give military-style times like `21:07 (UTC)'." |
72 | :type 'sexp | |
73 | :group 'calendar) | |
a92ade89 | 74 | |
5e11a170 | 75 | (defcustom calendar-latitude nil |
e85393d4 | 76 | "Latitude of `calendar-location-name' in degrees. |
6ff099c3 ER |
77 | The value can be either a decimal fraction (one place of accuracy is |
78 | sufficient), + north, - south, such as 40.7 for New York City, or the value | |
79 | can be a vector [degrees minutes north/south] such as [40 50 north] for New | |
80 | York City. | |
81 | ||
5e11a170 RS |
82 | This variable should be set in `site-start'.el." |
83 | :type '(choice (const nil) | |
f575f9ab GM |
84 | (number :tag "Exact") |
85 | (vector :value [0 0 north] | |
86 | (integer :tag "Degrees") | |
87 | (integer :tag "Minutes") | |
88 | (choice :tag "Position" | |
89 | (const north) | |
90 | (const south)))) | |
5e11a170 | 91 | :group 'calendar) |
a92ade89 | 92 | |
5e11a170 | 93 | (defcustom calendar-longitude nil |
e85393d4 | 94 | "Longitude of `calendar-location-name' in degrees. |
6ff099c3 ER |
95 | The value can be either a decimal fraction (one place of accuracy is |
96 | sufficient), + east, - west, such as -73.9 for New York City, or the value | |
97 | can be a vector [degrees minutes east/west] such as [73 55 west] for New | |
98 | York City. | |
99 | ||
5e11a170 RS |
100 | This variable should be set in `site-start'.el." |
101 | :type '(choice (const nil) | |
f575f9ab GM |
102 | (number :tag "Exact") |
103 | (vector :value [0 0 west] | |
104 | (integer :tag "Degrees") | |
105 | (integer :tag "Minutes") | |
106 | (choice :tag "Position" | |
107 | (const east) | |
108 | (const west)))) | |
5e11a170 | 109 | :group 'calendar) |
6ff099c3 | 110 | |
5e11a170 | 111 | (defcustom calendar-location-name |
a92ade89 JB |
112 | '(let ((float-output-format "%.1f")) |
113 | (format "%s%s, %s%s" | |
6ff099c3 ER |
114 | (if (numberp calendar-latitude) |
115 | (abs calendar-latitude) | |
116 | (+ (aref calendar-latitude 0) | |
117 | (/ (aref calendar-latitude 1) 60.0))) | |
118 | (if (numberp calendar-latitude) | |
119 | (if (> calendar-latitude 0) "N" "S") | |
7d17537f | 120 | (if (eq (aref calendar-latitude 2) 'north) "N" "S")) |
6ff099c3 ER |
121 | (if (numberp calendar-longitude) |
122 | (abs calendar-longitude) | |
123 | (+ (aref calendar-longitude 0) | |
124 | (/ (aref calendar-longitude 1) 60.0))) | |
125 | (if (numberp calendar-longitude) | |
126 | (if (> calendar-longitude 0) "E" "W") | |
7d17537f | 127 | (if (eq (aref calendar-longitude 2) 'east) "E" "W")))) |
a603b7db GM |
128 | "Expression evaluating to the name of the calendar location. |
129 | For example, \"New York City\". The default value is just the | |
130 | variable `calendar-latitude' paired with the variable `calendar-longitude'. | |
6ff099c3 | 131 | |
5e11a170 RS |
132 | This variable should be set in `site-start'.el." |
133 | :type 'sexp | |
134 | :group 'calendar) | |
087c56fa | 135 | |
5e11a170 | 136 | (defcustom solar-error 0.5 |
f575f9ab | 137 | "Tolerance (in minutes) for sunrise/sunset calculations. |
087c56fa ER |
138 | |
139 | A larger value makes the calculations for sunrise/sunset faster, but less | |
140 | accurate. The default is half a minute (30 seconds), so that sunrise/sunset | |
141 | times will be correct to the minute. | |
142 | ||
143 | It is useless to set the value smaller than 4*delta, where delta is the | |
144 | accuracy in the longitude of the sun (given by the function | |
145 | `solar-ecliptic-coordinates') in degrees since (delta/360) x (86400/60) = 4 x | |
146 | delta. At present, delta = 0.01 degrees, so the value of the variable | |
5e11a170 RS |
147 | `solar-error' should be at least 0.04 minutes (about 2.5 seconds)." |
148 | :type 'number | |
149 | :group 'calendar) | |
9f34a2a0 | 150 | |
8682defd | 151 | (defcustom solar-n-hemi-seasons |
fc68b552 | 152 | '("Vernal Equinox" "Summer Solstice" "Autumnal Equinox" "Winter Solstice") |
8682defd GM |
153 | "List of season changes for the northern hemisphere." |
154 | :type '(list | |
155 | (string :tag "Vernal Equinox") | |
156 | (string :tag "Summer Solstice") | |
157 | (string :tag "Autumnal Equinox") | |
158 | (string :tag "Winter Solstice")) | |
159 | :group 'calendar) | |
fc68b552 | 160 | |
8682defd | 161 | (defcustom solar-s-hemi-seasons |
fc68b552 | 162 | '("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice") |
8682defd GM |
163 | "List of season changes for the southern hemisphere." |
164 | :type '(list | |
165 | (string :tag "Autumnal Equinox") | |
166 | (string :tag "Winter Solstice") | |
167 | (string :tag "Vernal Equinox") | |
168 | (string :tag "Summer Solstice")) | |
169 | :group 'calendar) | |
170 | ||
171 | ;;; End of user options. | |
fc68b552 | 172 | |
de670487 | 173 | (defvar solar-sidereal-time-greenwich-midnight nil |
f575f9ab | 174 | "Sidereal time at Greenwich at midnight (universal time).") |
087c56fa | 175 | |
651f4408 | 176 | (defvar solar-northern-spring-or-summer-season nil |
85fd0d84 | 177 | "Non-nil if northern spring or summer and nil otherwise. |
087c56fa ER |
178 | Needed for polar areas, in order to know whether the day lasts 0 or 24 hours.") |
179 | ||
e85393d4 GM |
180 | |
181 | (defsubst calendar-latitude () | |
a603b7db | 182 | "Ensure the variable `calendar-latitude' is a signed decimal fraction." |
e85393d4 GM |
183 | (if (numberp calendar-latitude) |
184 | calendar-latitude | |
185 | (let ((lat (+ (aref calendar-latitude 0) | |
186 | (/ (aref calendar-latitude 1) 60.0)))) | |
7d17537f | 187 | (if (eq (aref calendar-latitude 2) 'north) |
e85393d4 GM |
188 | lat |
189 | (- lat))))) | |
190 | ||
191 | (defsubst calendar-longitude () | |
a603b7db | 192 | "Ensure the variable `calendar-longitude' is a signed decimal fraction." |
e85393d4 GM |
193 | (if (numberp calendar-longitude) |
194 | calendar-longitude | |
195 | (let ((long (+ (aref calendar-longitude 0) | |
f575f9ab | 196 | (/ (aref calendar-longitude 1) 60.0)))) |
7d17537f | 197 | (if (eq (aref calendar-longitude 2) 'east) |
e85393d4 GM |
198 | long |
199 | (- long))))) | |
200 | ||
e7148377 GM |
201 | (defun solar-get-number (prompt) |
202 | "Return a number from the minibuffer, prompting with PROMPT. | |
203 | Returns nil if nothing was entered." | |
204 | (let ((x (read-string prompt ""))) | |
205 | (unless (string-equal x "") | |
206 | (string-to-number x)))) | |
207 | ||
9f34a2a0 | 208 | (defun solar-setup () |
a603b7db | 209 | "Prompt for `calendar-longitude', `calendar-latitude', `calendar-time-zone'." |
9f34a2a0 | 210 | (beep) |
e85393d4 | 211 | (or calendar-longitude |
9f34a2a0 JB |
212 | (setq calendar-longitude |
213 | (solar-get-number | |
214 | "Enter longitude (decimal fraction; + east, - west): "))) | |
e85393d4 | 215 | (or calendar-latitude |
9f34a2a0 JB |
216 | (setq calendar-latitude |
217 | (solar-get-number | |
218 | "Enter latitude (decimal fraction; + north, - south): "))) | |
e85393d4 | 219 | (or calendar-time-zone |
9f34a2a0 JB |
220 | (setq calendar-time-zone |
221 | (solar-get-number | |
f575f9ab GM |
222 | "Enter difference from Coordinated Universal Time (in minutes): ") |
223 | ))) | |
9f34a2a0 | 224 | |
087c56fa | 225 | (defun solar-sin-degrees (x) |
a603b7db | 226 | "Return sin of X degrees." |
e85393d4 GM |
227 | (sin (degrees-to-radians (mod x 360.0)))) |
228 | ||
087c56fa | 229 | (defun solar-cosine-degrees (x) |
a603b7db | 230 | "Return cosine of X degrees." |
e85393d4 GM |
231 | (cos (degrees-to-radians (mod x 360.0)))) |
232 | ||
087c56fa | 233 | (defun solar-tangent-degrees (x) |
a603b7db | 234 | "Return tangent of X degrees." |
e85393d4 | 235 | (tan (degrees-to-radians (mod x 360.0)))) |
a1506d29 | 236 | |
9f34a2a0 | 237 | (defun solar-xy-to-quadrant (x y) |
a603b7db | 238 | "Determine the quadrant of the point X, Y." |
9f34a2a0 JB |
239 | (if (> x 0) |
240 | (if (> y 0) 1 4) | |
f575f9ab | 241 | (if (> y 0) 2 3))) |
9f34a2a0 JB |
242 | |
243 | (defun solar-degrees-to-quadrant (angle) | |
a603b7db | 244 | "Determine the quadrant of ANGLE degrees." |
3a2e3ab5 | 245 | (1+ (floor (mod angle 360) 90))) |
9f34a2a0 JB |
246 | |
247 | (defun solar-arctan (x quad) | |
248 | "Arctangent of X in quadrant QUAD." | |
249 | (let ((deg (radians-to-degrees (atan x)))) | |
7d17537f GM |
250 | (cond ((= quad 2) (+ deg 180)) |
251 | ((= quad 3) (+ deg 180)) | |
252 | ((= quad 4) (+ deg 360)) | |
253 | (t deg)))) | |
9f34a2a0 | 254 | |
087c56fa | 255 | (defun solar-atn2 (x y) |
f575f9ab GM |
256 | "Arctangent of point X, Y." |
257 | (if (zerop x) | |
258 | (if (> y 0) 90 270) | |
259 | (solar-arctan (/ y x) (solar-xy-to-quadrant x y)))) | |
087c56fa | 260 | |
9f34a2a0 | 261 | (defun solar-arccos (x) |
a603b7db | 262 | "Arccosine of X." |
e85393d4 GM |
263 | (let ((y (sqrt (- 1 (* x x))))) |
264 | (solar-atn2 x y))) | |
9f34a2a0 JB |
265 | |
266 | (defun solar-arcsin (y) | |
e85393d4 GM |
267 | "Arcsin of Y." |
268 | (let ((x (sqrt (- 1 (* y y))))) | |
269 | (solar-atn2 x y))) | |
9f34a2a0 | 270 | |
087c56fa ER |
271 | (defsubst solar-degrees-to-hours (degrees) |
272 | "Convert DEGREES to hours." | |
273 | (/ degrees 15.0)) | |
9f34a2a0 | 274 | |
6ff099c3 | 275 | (defsubst solar-hours-to-days (hour) |
087c56fa | 276 | "Convert HOUR to decimal fraction of a day." |
6ff099c3 | 277 | (/ hour 24.0)) |
9f34a2a0 | 278 | |
087c56fa ER |
279 | (defun solar-right-ascension (longitude obliquity) |
280 | "Right ascension of the sun, in hours, given LONGITUDE and OBLIQUITY. | |
281 | Both arguments are in degrees." | |
9f34a2a0 JB |
282 | (solar-degrees-to-hours |
283 | (solar-arctan | |
087c56fa | 284 | (* (solar-cosine-degrees obliquity) (solar-tangent-degrees longitude)) |
9f34a2a0 JB |
285 | (solar-degrees-to-quadrant longitude)))) |
286 | ||
087c56fa ER |
287 | (defun solar-declination (longitude obliquity) |
288 | "Declination of the sun, in degrees, given LONGITUDE and OBLIQUITY. | |
289 | Both arguments are in degrees." | |
9f34a2a0 | 290 | (solar-arcsin |
087c56fa | 291 | (* (solar-sin-degrees obliquity) |
9f34a2a0 JB |
292 | (solar-sin-degrees longitude)))) |
293 | ||
e7148377 GM |
294 | (defun solar-ecliptic-coordinates (time sunrise-flag) |
295 | "Return solar longitude, ecliptic inclination, equation of time, nutation. | |
296 | Values are for TIME in Julian centuries of Ephemeris Time since | |
297 | January 1st, 2000, at 12 ET. Longitude and inclination are in | |
298 | degrees, equation of time in hours, and nutation in seconds of longitude. | |
299 | If SUNRISE-FLAG is non-nil, only calculate longitude and inclination." | |
300 | (let* ((l (+ 280.46645 | |
301 | (* 36000.76983 time) | |
302 | (* 0.0003032 time time))) ; sun mean longitude | |
303 | (ml (+ 218.3165 | |
304 | (* 481267.8813 time))) ; moon mean longitude | |
305 | (m (+ 357.52910 | |
306 | (* 35999.05030 time) | |
307 | (* -0.0001559 time time) | |
308 | (* -0.00000048 time time time))) ; sun mean anomaly | |
309 | (i (+ 23.43929111 (* -0.013004167 time) | |
310 | (* -0.00000016389 time time) | |
311 | (* 0.0000005036 time time time))) ; mean inclination | |
312 | (c (+ (* (+ 1.914600 | |
313 | (* -0.004817 time) | |
314 | (* -0.000014 time time)) | |
315 | (solar-sin-degrees m)) | |
316 | (* (+ 0.019993 (* -0.000101 time)) | |
317 | (solar-sin-degrees (* 2 m))) | |
318 | (* 0.000290 | |
319 | (solar-sin-degrees (* 3 m))))) ; center equation | |
320 | (L (+ l c)) ; total longitude | |
321 | ;; Longitude of moon's ascending node on the ecliptic. | |
322 | (omega (+ 125.04 | |
323 | (* -1934.136 time))) | |
324 | ;; nut = nutation in longitude, measured in seconds of angle. | |
325 | (nut (unless sunrise-flag | |
326 | (+ (* -17.20 (solar-sin-degrees omega)) | |
327 | (* -1.32 (solar-sin-degrees (* 2 l))) | |
328 | (* -0.23 (solar-sin-degrees (* 2 ml))) | |
329 | (* 0.21 (solar-sin-degrees (* 2 omega)))))) | |
330 | (ecc (unless sunrise-flag ; eccentricity of earth's orbit | |
331 | (+ 0.016708617 | |
332 | (* -0.000042037 time) | |
333 | (* -0.0000001236 time time)))) | |
334 | (app (+ L ; apparent longitude of sun | |
335 | -0.00569 | |
336 | (* -0.00478 | |
337 | (solar-sin-degrees omega)))) | |
338 | (y (unless sunrise-flag | |
339 | (* (solar-tangent-degrees (/ i 2)) | |
340 | (solar-tangent-degrees (/ i 2))))) | |
341 | ;; Equation of time, in hours. | |
342 | (time-eq (unless sunrise-flag | |
343 | (/ (* 12 (+ (* y (solar-sin-degrees (* 2 l))) | |
344 | (* -2 ecc (solar-sin-degrees m)) | |
345 | (* 4 ecc y (solar-sin-degrees m) | |
346 | (solar-cosine-degrees (* 2 l))) | |
347 | (* -0.5 y y (solar-sin-degrees (* 4 l))) | |
348 | (* -1.25 ecc ecc (solar-sin-degrees (* 2 m))))) | |
349 | 3.1415926535)))) | |
350 | (list app i time-eq nut))) | |
351 | ||
352 | (defun solar-ephemeris-correction (year) | |
353 | "Ephemeris time minus Universal Time during Gregorian YEAR. | |
354 | Result is in days. For the years 1800-1987, the maximum error is | |
355 | 1.9 seconds. For the other years, the maximum error is about 30 seconds." | |
356 | (cond ((and (<= 1988 year) (< year 2020)) | |
357 | (/ (+ year -2000 67.0) 60.0 60.0 24.0)) | |
358 | ((and (<= 1900 year) (< year 1988)) | |
359 | (let* ((theta (/ (- (calendar-astro-from-absolute | |
360 | (calendar-absolute-from-gregorian | |
361 | (list 7 1 year))) | |
362 | (calendar-astro-from-absolute | |
363 | (calendar-absolute-from-gregorian | |
364 | '(1 1 1900)))) | |
365 | 36525.0)) | |
366 | (theta2 (* theta theta)) | |
367 | (theta3 (* theta2 theta)) | |
368 | (theta4 (* theta2 theta2)) | |
369 | (theta5 (* theta3 theta2))) | |
370 | (+ -0.00002 | |
371 | (* 0.000297 theta) | |
372 | (* 0.025184 theta2) | |
373 | (* -0.181133 theta3) | |
374 | (* 0.553040 theta4) | |
375 | (* -0.861938 theta5) | |
376 | (* 0.677066 theta3 theta3) | |
377 | (* -0.212591 theta4 theta3)))) | |
378 | ((and (<= 1800 year) (< year 1900)) | |
379 | (let* ((theta (/ (- (calendar-astro-from-absolute | |
380 | (calendar-absolute-from-gregorian | |
381 | (list 7 1 year))) | |
382 | (calendar-astro-from-absolute | |
383 | (calendar-absolute-from-gregorian | |
384 | '(1 1 1900)))) | |
385 | 36525.0)) | |
386 | (theta2 (* theta theta)) | |
387 | (theta3 (* theta2 theta)) | |
388 | (theta4 (* theta2 theta2)) | |
389 | (theta5 (* theta3 theta2))) | |
390 | (+ -0.000009 | |
391 | (* 0.003844 theta) | |
392 | (* 0.083563 theta2) | |
393 | (* 0.865736 theta3) | |
394 | (* 4.867575 theta4) | |
395 | (* 15.845535 theta5) | |
396 | (* 31.332267 theta3 theta3) | |
397 | (* 38.291999 theta4 theta3) | |
398 | (* 28.316289 theta4 theta4) | |
399 | (* 11.636204 theta4 theta5) | |
400 | (* 2.043794 theta5 theta5)))) | |
401 | ((and (<= 1620 year) (< year 1800)) | |
402 | (let ((x (/ (- year 1600) 10.0))) | |
403 | (/ (+ (* 2.19167 x x) (* -40.675 x) 196.58333) 60.0 60.0 24.0))) | |
404 | (t (let* ((tmp (- (calendar-astro-from-absolute | |
405 | (calendar-absolute-from-gregorian | |
406 | (list 1 1 year))) | |
407 | 2382148)) | |
408 | (second (- (/ (* tmp tmp) 41048480.0) 15))) | |
409 | (/ second 60.0 60.0 24.0))))) | |
087c56fa | 410 | |
e7148377 GM |
411 | (defun solar-ephemeris-time (time) |
412 | "Ephemeris Time at moment TIME. | |
087c56fa ER |
413 | TIME is a pair with the first component being the number of Julian centuries |
414 | elapsed at 0 Universal Time, and the second component being the universal | |
415 | time. For instance, the pair corresponding to November 28, 1995 at 16 UT is | |
a603b7db | 416 | \(-0.040945 16), -0.040945 being the number of Julian centuries elapsed between |
087c56fa ER |
417 | Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. |
418 | ||
e7148377 GM |
419 | Result is in Julian centuries of ephemeris time." |
420 | (let* ((t0 (car time)) | |
421 | (ut (cadr time)) | |
422 | (t1 (+ t0 (/ (/ ut 24.0) 36525))) | |
423 | (y (+ 2000 (* 100 t1))) | |
424 | (dt (* 86400 (solar-ephemeris-correction (floor y))))) | |
425 | (+ t1 (/ (/ dt 86400) 36525)))) | |
651f4408 | 426 | |
e7148377 GM |
427 | (defun solar-equatorial-coordinates (time sunrise-flag) |
428 | "Right ascension (in hours) and declination (in degrees) of the sun at TIME. | |
429 | TIME is a pair with the first component being the number of | |
430 | Julian centuries elapsed at 0 Universal Time, and the second | |
431 | component being the universal time. For instance, the pair | |
432 | corresponding to November 28, 1995 at 16 UT is (-0.040945 16), | |
433 | -0.040945 being the number of Julian centuries elapsed between | |
434 | Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. SUNRISE-FLAG is passed | |
435 | to `solar-ecliptic-coordinates'." | |
436 | (let ((ec (solar-ecliptic-coordinates (solar-ephemeris-time time) | |
437 | sunrise-flag))) | |
438 | (list (solar-right-ascension (car ec) (cadr ec)) | |
439 | (solar-declination (car ec) (cadr ec))))) | |
440 | ||
441 | (defun solar-horizontal-coordinates (time latitude longitude sunrise-flag) | |
442 | "Azimuth and height of the sun at TIME, LATITUDE, and LONGITUDE. | |
443 | TIME is a pair with the first component being the number of | |
444 | Julian centuries elapsed at 0 Universal Time, and the second | |
445 | component being the universal time. For instance, the pair | |
446 | corresponding to November 28, 1995 at 16 UT is (-0.040945 16), | |
447 | -0.040945 being the number of Julian centuries elapsed between | |
448 | Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. SUNRISE-FLAG | |
449 | is passed to `solar-ecliptic-coordinates'. Azimuth and | |
450 | height (between -180 and 180) are both in degrees." | |
451 | (let* ((ut (cadr time)) | |
452 | (ec (solar-equatorial-coordinates time sunrise-flag)) | |
453 | (st (+ solar-sidereal-time-greenwich-midnight | |
454 | (* ut 1.00273790935))) | |
455 | ;; Hour angle (in degrees). | |
f195c582 | 456 | (ah (- (* st 15) (* 15 (car ec)) (* -1 longitude))) |
e7148377 GM |
457 | (de (cadr ec)) |
458 | (azimuth (solar-atn2 (- (* (solar-cosine-degrees ah) | |
459 | (solar-sin-degrees latitude)) | |
460 | (* (solar-tangent-degrees de) | |
461 | (solar-cosine-degrees latitude))) | |
462 | (solar-sin-degrees ah))) | |
463 | (height (solar-arcsin | |
464 | (+ (* (solar-sin-degrees latitude) (solar-sin-degrees de)) | |
465 | (* (solar-cosine-degrees latitude) | |
466 | (solar-cosine-degrees de) | |
467 | (solar-cosine-degrees ah)))))) | |
468 | (if (> height 180) (setq height (- height 360))) | |
469 | (list azimuth height))) | |
087c56fa | 470 | |
651f4408 | 471 | (defun solar-moment (direction latitude longitude time height) |
087c56fa ER |
472 | "Sunrise/sunset at location. |
473 | Sunrise if DIRECTION =-1 or sunset if =1 at LATITUDE, LONGITUDE, with midday | |
474 | being TIME. | |
475 | ||
476 | TIME is a pair with the first component being the number of Julian centuries | |
477 | elapsed at 0 Universal Time, and the second component being the universal | |
478 | time. For instance, the pair corresponding to November 28, 1995 at 16 UT is | |
a603b7db | 479 | \(-0.040945 16), -0.040945 being the number of Julian centuries elapsed between |
087c56fa ER |
480 | Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. |
481 | ||
651f4408 | 482 | HEIGHT is the angle the center of the sun has over the horizon for the contact |
a603b7db | 483 | we are trying to find. For sunrise and sunset, it is usually -0.61 degrees, |
651f4408 RS |
484 | accounting for the edge of the sun being on the horizon. |
485 | ||
087c56fa | 486 | Uses binary search." |
f575f9ab | 487 | (let* ((ut (cadr time)) |
53bee0c9 | 488 | (possible t) ; we assume that rise or set are possible |
651f4408 | 489 | (utmin (+ ut (* direction 12.0))) |
53bee0c9 GM |
490 | (utmax ut) ; the time searched is between utmin and utmax |
491 | ;; utmin and utmax are in hours. | |
492 | (utmoment-old 0.0) ; rise or set approximation | |
493 | (utmoment 1.0) ; rise or set approximation | |
494 | (hut 0) ; sun height at utmoment | |
087c56fa | 495 | (t0 (car time)) |
f575f9ab GM |
496 | (hmin (cadr (solar-horizontal-coordinates (list t0 utmin) |
497 | latitude longitude t))) | |
498 | (hmax (cadr (solar-horizontal-coordinates (list t0 utmax) | |
499 | latitude longitude t)))) | |
53bee0c9 GM |
500 | ;; -0.61 degrees is the height of the middle of the sun, when it |
501 | ;; rises or sets. | |
f575f9ab GM |
502 | (if (< hmin height) |
503 | (if (> hmax height) | |
504 | (while ;;; (< i 20) ; we perform a simple dichotomy | |
505 | ;;; (> (abs (- hut height)) epsilon) | |
506 | (>= (abs (- utmoment utmoment-old)) | |
507 | (/ solar-error 60)) | |
508 | (setq utmoment-old utmoment | |
509 | utmoment (/ (+ utmin utmax) 2) | |
510 | hut (cadr (solar-horizontal-coordinates | |
511 | (list t0 utmoment) latitude longitude t))) | |
512 | (if (< hut height) (setq utmin utmoment)) | |
513 | (if (> hut height) (setq utmax utmoment))) | |
514 | (setq possible nil)) ; the sun never rises | |
515 | (setq possible nil)) ; the sun never sets | |
516 | (if possible utmoment))) | |
9f34a2a0 | 517 | |
e7148377 GM |
518 | (defun solar-sunrise-and-sunset (time latitude longitude height) |
519 | "Sunrise, sunset and length of day. | |
520 | Parameters are the midday TIME and the LATITUDE, LONGITUDE of the location. | |
521 | ||
522 | TIME is a pair with the first component being the number of Julian centuries | |
523 | elapsed at 0 Universal Time, and the second component being the universal | |
524 | time. For instance, the pair corresponding to November 28, 1995 at 16 UT is | |
525 | \(-0.040945 16), -0.040945 being the number of Julian centuries elapsed between | |
526 | Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. | |
527 | ||
528 | HEIGHT is the angle the center of the sun has over the horizon for the contact | |
529 | we are trying to find. For sunrise and sunset, it is usually -0.61 degrees, | |
530 | accounting for the edge of the sun being on the horizon. | |
531 | ||
532 | Coordinates are included because this function is called with latitude=1 | |
533 | degrees to find out if polar regions have 24 hours of sun or only night." | |
534 | (let ((rise-time (solar-moment -1 latitude longitude time height)) | |
535 | (set-time (solar-moment 1 latitude longitude time height)) | |
536 | day-length) | |
537 | (if (not (and rise-time set-time)) | |
538 | (if (or (and (> latitude 0) | |
539 | solar-northern-spring-or-summer-season) | |
540 | (and (< latitude 0) | |
541 | (not solar-northern-spring-or-summer-season))) | |
542 | (setq day-length 24) | |
543 | (setq day-length 0)) | |
544 | (setq day-length (- set-time rise-time))) | |
545 | (list (if rise-time (+ rise-time (/ calendar-time-zone 60.0)) nil) | |
546 | (if set-time (+ set-time (/ calendar-time-zone 60.0)) nil) | |
547 | day-length))) | |
548 | ||
c68488d2 | 549 | (defun solar-time-string (time time-zone) |
75af4a4a | 550 | "Printable form for decimal fraction TIME in TIME-ZONE. |
c68488d2 ER |
551 | Format used is given by `calendar-time-display-form'." |
552 | (let* ((time (round (* 60 time))) | |
f575f9ab GM |
553 | (24-hours (/ time 60)) |
554 | (minutes (format "%02d" (% time 60))) | |
555 | (12-hours (format "%d" (1+ (% (+ 24-hours 11) 12)))) | |
556 | (am-pm (if (>= 24-hours 12) "pm" "am")) | |
557 | (24-hours (format "%02d" 24-hours))) | |
9f34a2a0 JB |
558 | (mapconcat 'eval calendar-time-display-form ""))) |
559 | ||
087c56fa | 560 | (defun solar-daylight (time) |
a603b7db | 561 | "Printable form for TIME expressed in hours." |
087c56fa ER |
562 | (format "%d:%02d" |
563 | (floor time) | |
564 | (floor (* 60 (- time (floor time)))))) | |
565 | ||
e7148377 GM |
566 | (defun solar-julian-ut-centuries (date) |
567 | "Number of Julian centuries since 1 Jan, 2000 at noon UT for Gregorian DATE." | |
568 | (/ (- (calendar-absolute-from-gregorian date) | |
569 | (calendar-absolute-from-gregorian '(1 1.5 2000))) | |
570 | 36525.0)) | |
571 | ||
572 | (defun solar-date-to-et (date ut) | |
573 | "Ephemeris Time at Gregorian DATE at Universal Time UT (in hours). | |
574 | Expressed in Julian centuries of Ephemeris Time." | |
575 | (solar-ephemeris-time (list (solar-julian-ut-centuries date) ut))) | |
576 | ||
577 | (defun solar-time-equation (date ut) | |
578 | "Equation of time expressed in hours at Gregorian DATE at Universal time UT." | |
579 | (nth 2 (solar-ecliptic-coordinates (solar-date-to-et date ut) nil))) | |
580 | ||
087c56fa | 581 | (defun solar-exact-local-noon (date) |
a603b7db | 582 | "Date and Universal Time of local noon at *local date* DATE. |
087c56fa ER |
583 | The date may be different from the one asked for, but it will be the right |
584 | local date. The second component of date should be an integer." | |
585 | (let* ((nd date) | |
556b41d2 | 586 | (ut (- 12.0 (/ (calendar-longitude) 15))) |
087c56fa ER |
587 | (te (solar-time-equation date ut))) |
588 | (setq ut (- ut te)) | |
589 | (if (>= ut 24) | |
f575f9ab GM |
590 | (setq nd (list (car date) (1+ (cadr date)) |
591 | (nth 2 date)) | |
592 | ut (- ut 24))) | |
087c56fa | 593 | (if (< ut 0) |
f575f9ab GM |
594 | (setq nd (list (car date) (1- (cadr date)) |
595 | (nth 2 date)) | |
596 | ut (+ ut 24))) | |
597 | (setq nd (calendar-gregorian-from-absolute ; date standardization | |
598 | (calendar-absolute-from-gregorian nd))) | |
087c56fa ER |
599 | (list nd ut))) |
600 | ||
e7148377 GM |
601 | (defun solar-sidereal-time (t0) |
602 | "Sidereal time (in hours) in Greenwich at T0 Julian centuries. | |
603 | T0 must correspond to 0 hours UT." | |
604 | (let* ((mean-sid-time (+ 6.6973746 | |
605 | (* 2400.051337 t0) | |
606 | (* 0.0000258622 t0 t0) | |
607 | (* -0.0000000017222 t0 t0 t0))) | |
608 | (et (solar-ephemeris-time (list t0 0.0))) | |
609 | (nut-i (solar-ecliptic-coordinates et nil)) | |
610 | (nut (nth 3 nut-i)) ; nutation | |
611 | (i (cadr nut-i))) ; inclination | |
612 | (mod (+ (mod (+ mean-sid-time | |
613 | (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0) | |
614 | 24.0) | |
615 | 24.0))) | |
616 | ||
9f34a2a0 | 617 | (defun solar-sunrise-sunset (date) |
087c56fa | 618 | "List of *local* times of sunrise, sunset, and daylight on Gregorian DATE. |
087c56fa | 619 | Corresponding value is nil if there is no sunrise/sunset." |
53bee0c9 GM |
620 | ;; First, get the exact moment of local noon. |
621 | (let* ((exact-local-noon (solar-exact-local-noon date)) | |
622 | ;; Get the time from the 2000 epoch. | |
087c56fa | 623 | (t0 (solar-julian-ut-centuries (car exact-local-noon))) |
53bee0c9 GM |
624 | ;; Store the sidereal time at Greenwich at midnight of UT time. |
625 | ;; Find if summer or winter slightly above the equator. | |
087c56fa | 626 | (equator-rise-set |
651f4408 | 627 | (progn (setq solar-sidereal-time-greenwich-midnight |
087c56fa | 628 | (solar-sidereal-time t0)) |
651f4408 | 629 | (solar-sunrise-and-sunset |
f575f9ab | 630 | (list t0 (cadr exact-local-noon)) |
651f4408 RS |
631 | 1.0 |
632 | (calendar-longitude) 0))) | |
53bee0c9 GM |
633 | ;; Store the spring/summer information, compute sunrise and |
634 | ;; sunset (two first components of rise-set). Length of day | |
635 | ;; is the third component (it is only the difference between | |
636 | ;; sunset and sunrise when there is a sunset and a sunrise) | |
087c56fa ER |
637 | (rise-set |
638 | (progn | |
651f4408 | 639 | (setq solar-northern-spring-or-summer-season |
f575f9ab | 640 | (> (nth 2 equator-rise-set) 12)) |
651f4408 | 641 | (solar-sunrise-and-sunset |
f575f9ab | 642 | (list t0 (cadr exact-local-noon)) |
556b41d2 | 643 | (calendar-latitude) |
651f4408 | 644 | (calendar-longitude) -0.61))) |
48dc6f9f GM |
645 | (rise-time (car rise-set)) |
646 | (adj-rise (if rise-time (dst-adjust-time date rise-time))) | |
647 | (set-time (cadr rise-set)) | |
648 | (adj-set (if set-time (dst-adjust-time date set-time))) | |
f575f9ab | 649 | (length (nth 2 rise-set))) |
087c56fa | 650 | (list |
48dc6f9f GM |
651 | (and rise-time (calendar-date-equal date (car adj-rise)) (cdr adj-rise)) |
652 | (and set-time (calendar-date-equal date (car adj-set)) (cdr adj-set)) | |
087c56fa ER |
653 | (solar-daylight length)))) |
654 | ||
5c4e1641 GM |
655 | (defun solar-sunrise-sunset-string (date &optional nolocation) |
656 | "String of *local* times of sunrise, sunset, and daylight on Gregorian DATE. | |
657 | Optional NOLOCATION non-nil means do not print the location." | |
087c56fa ER |
658 | (let ((l (solar-sunrise-sunset date))) |
659 | (format | |
5c4e1641 | 660 | "%s, %s%s (%s hours daylight)" |
087c56fa ER |
661 | (if (car l) |
662 | (concat "Sunrise " (apply 'solar-time-string (car l))) | |
663 | "No sunrise") | |
f575f9ab GM |
664 | (if (cadr l) |
665 | (concat "sunset " (apply 'solar-time-string (cadr l))) | |
087c56fa | 666 | "no sunset") |
5c4e1641 GM |
667 | (if nolocation "" |
668 | (format " at %s" (eval calendar-location-name))) | |
f575f9ab | 669 | (nth 2 l)))) |
087c56fa | 670 | |
087c56fa ER |
671 | (defconst solar-data-list |
672 | '((403406 4.721964 1.621043) | |
673 | (195207 5.937458 62830.348067) | |
674 | (119433 1.115589 62830.821524) | |
675 | (112392 5.781616 62829.634302) | |
676 | (3891 5.5474 125660.5691) | |
677 | (2819 1.5120 125660.984) | |
678 | (1721 4.1897 62832.4766) | |
679 | (0 1.163 0.813) | |
680 | (660 5.415 125659.31) | |
681 | (350 4.315 57533.85) | |
682 | (334 4.553 -33.931) | |
683 | (314 5.198 777137.715) | |
684 | (268 5.989 78604.191) | |
685 | (242 2.911 5.412) | |
686 | (234 1.423 39302.098) | |
687 | (158 0.061 -34.861) | |
688 | (132 2.317 115067.698) | |
689 | (129 3.193 15774.337) | |
690 | (114 2.828 5296.670) | |
691 | (99 0.52 58849.27) | |
692 | (93 4.65 5296.11) | |
693 | (86 4.35 -3980.70) | |
694 | (78 2.75 52237.69) | |
695 | (72 4.50 55076.47) | |
696 | (68 3.23 261.08) | |
697 | (64 1.22 15773.85) | |
698 | (46 0.14 188491.03) | |
699 | (38 3.44 -7756.55) | |
700 | (37 4.37 264.89) | |
701 | (32 1.14 117906.27) | |
702 | (29 2.84 55075.75) | |
703 | (28 5.96 -7961.39) | |
704 | (27 5.09 188489.81) | |
705 | (27 1.72 2132.19) | |
706 | (25 2.56 109771.03) | |
707 | (24 1.92 54868.56) | |
708 | (21 0.09 25443.93) | |
709 | (21 5.98 -55731.43) | |
710 | (20 4.03 60697.74) | |
711 | (18 4.47 2132.79) | |
712 | (17 0.79 109771.63) | |
713 | (14 4.24 -7752.82) | |
714 | (13 2.01 188491.91) | |
715 | (13 2.65 207.81) | |
716 | (13 4.98 29424.63) | |
717 | (12 0.93 -7.99) | |
718 | (10 2.21 46941.14) | |
719 | (10 3.59 -68.29) | |
720 | (10 1.50 21463.25) | |
a603b7db GM |
721 | (10 2.55 157208.40)) |
722 | "Data used for calculation of solar longitude.") | |
9f34a2a0 | 723 | |
7fde7268 RS |
724 | (defun solar-longitude (d) |
725 | "Longitude of sun on astronomical (Julian) day number D. | |
a603b7db GM |
726 | Accuracy is about 0.0006 degree (about 365.25*24*60*0.0006/360 = 1 minutes). |
727 | The values of `calendar-daylight-savings-starts', | |
728 | `calendar-daylight-savings-starts-time', `calendar-daylight-savings-ends', | |
729 | `calendar-daylight-savings-ends-time', `calendar-daylight-time-offset', and | |
730 | `calendar-time-zone' are used to interpret local time." | |
5c645a20 | 731 | (let* ((a-d (calendar-astro-to-absolute d)) |
53bee0c9 | 732 | ;; Get Universal Time. |
7fde7268 RS |
733 | (date (calendar-astro-from-absolute |
734 | (- a-d | |
735 | (if (dst-in-effect a-d) | |
736 | (/ calendar-daylight-time-offset 24.0 60.0) 0) | |
737 | (/ calendar-time-zone 60.0 24.0)))) | |
53bee0c9 | 738 | ;; Get Ephemeris Time. |
7fde7268 | 739 | (date (+ date (solar-ephemeris-correction |
e803eab7 | 740 | (calendar-extract-year |
7fde7268 RS |
741 | (calendar-gregorian-from-absolute |
742 | (floor | |
5c645a20 | 743 | (calendar-astro-to-absolute |
7fde7268 RS |
744 | date))))))) |
745 | (U (/ (- date 2451545) 3652500)) | |
746 | (longitude | |
747 | (+ 4.9353929 | |
748 | (* 62833.1961680 U) | |
749 | (* 0.0000001 | |
750 | (apply '+ | |
b3a6c0ca | 751 | (mapcar (lambda (x) |
f575f9ab GM |
752 | (* (car x) |
753 | (sin (mod | |
e7148377 GM |
754 | (+ (cadr x) |
755 | (* (nth 2 x) U)) | |
9e0d4f9e | 756 | (* 2 float-pi))))) |
7fde7268 RS |
757 | solar-data-list))))) |
758 | (aberration | |
759 | (* 0.0000001 (- (* 17 (cos (+ 3.10 (* 62830.14 U)))) 973))) | |
9e0d4f9e SM |
760 | (A1 (mod (+ 2.18 (* U (+ -3375.70 (* 0.36 U)))) (* 2 float-pi))) |
761 | (A2 (mod (+ 3.51 (* U (+ 125666.39 (* 0.10 U)))) (* 2 float-pi))) | |
7fde7268 RS |
762 | (nutation (* -0.0000001 (+ (* 834 (sin A1)) (* 64 (sin A2)))))) |
763 | (mod (radians-to-degrees (+ longitude aberration nutation)) 360.0))) | |
764 | ||
e7148377 GM |
765 | (defun solar-date-next-longitude (d l) |
766 | "First time after day D when solar longitude is a multiple of L degrees. | |
767 | D is a Julian day number. L must be an integer divisor of 360. | |
768 | The result is for `calendar-location-name', and is in local time | |
769 | \(including any daylight saving rules) expressed in astronomical (Julian) | |
770 | day numbers. The values of `calendar-daylight-savings-starts', | |
771 | `calendar-daylight-savings-starts-time', `calendar-daylight-savings-ends', | |
772 | `calendar-daylight-savings-ends-time', `calendar-daylight-time-offset', | |
773 | and `calendar-time-zone' are used to interpret local time." | |
f195c582 GM |
774 | (let ((start d) |
775 | (next (mod (* l (1+ (floor (/ (solar-longitude d) l)))) 360)) | |
776 | (end (+ d (* (/ l 360.0) 400))) | |
777 | long) | |
778 | ;; Bisection search for nearest minute. | |
779 | (while (< 0.00001 (- end start)) | |
780 | ;; start <= d < end | |
e7148377 | 781 | ;; start-long <= next < end-long when next != 0 |
f195c582 GM |
782 | ;; when next = 0, look for the discontinuity (start-long is near 360 |
783 | ;; and end-long is small (less than l)). | |
e7148377 GM |
784 | (setq d (/ (+ start end) 2.0) |
785 | long (solar-longitude d)) | |
786 | (if (or (and (not (zerop next)) (< long next)) | |
787 | (and (zerop next) (< l long))) | |
f195c582 GM |
788 | (setq start d) |
789 | (setq end d))) | |
e7148377 | 790 | (/ (+ start end) 2.0))) |
087c56fa | 791 | |
8c34d83e | 792 | ;; FIXME but there already is solar-sunrise-sunset. |
9f34a2a0 JB |
793 | ;;;###autoload |
794 | (defun sunrise-sunset (&optional arg) | |
087c56fa | 795 | "Local time of sunrise and sunset for today. Accurate to a few seconds. |
a603b7db GM |
796 | If called with an optional prefix argument ARG, prompt for date. |
797 | If called with an optional double prefix argument, prompt for | |
798 | longitude, latitude, time zone, and date, and always use standard time. | |
9f34a2a0 | 799 | |
865fe16f | 800 | This function is suitable for execution in an init file." |
f575f9ab GM |
801 | (interactive "p") |
802 | (or arg (setq arg 1)) | |
803 | (if (and (< arg 16) | |
804 | (not (and calendar-latitude calendar-longitude calendar-time-zone))) | |
805 | (solar-setup)) | |
806 | (let* ((calendar-longitude | |
807 | (if (< arg 16) calendar-longitude | |
808 | (solar-get-number | |
809 | "Enter longitude (decimal fraction; + east, - west): "))) | |
810 | (calendar-latitude | |
811 | (if (< arg 16) calendar-latitude | |
812 | (solar-get-number | |
813 | "Enter latitude (decimal fraction; + north, - south): "))) | |
814 | (calendar-time-zone | |
815 | (if (< arg 16) calendar-time-zone | |
816 | (solar-get-number | |
817 | "Enter difference from Coordinated Universal Time (in minutes): "))) | |
818 | (calendar-location-name | |
819 | (if (< arg 16) calendar-location-name | |
820 | (let ((float-output-format "%.1f")) | |
821 | (format "%s%s, %s%s" | |
822 | (if (numberp calendar-latitude) | |
823 | (abs calendar-latitude) | |
824 | (+ (aref calendar-latitude 0) | |
825 | (/ (aref calendar-latitude 1) 60.0))) | |
826 | (if (numberp calendar-latitude) | |
827 | (if (> calendar-latitude 0) "N" "S") | |
7d17537f | 828 | (if (eq (aref calendar-latitude 2) 'north) "N" "S")) |
f575f9ab GM |
829 | (if (numberp calendar-longitude) |
830 | (abs calendar-longitude) | |
831 | (+ (aref calendar-longitude 0) | |
832 | (/ (aref calendar-longitude 1) 60.0))) | |
833 | (if (numberp calendar-longitude) | |
834 | (if (> calendar-longitude 0) "E" "W") | |
7d17537f | 835 | (if (eq (aref calendar-longitude 2) 'east) |
f575f9ab GM |
836 | "E" "W")))))) |
837 | (calendar-standard-time-zone-name | |
838 | (if (< arg 16) calendar-standard-time-zone-name | |
48dc6f9f | 839 | (cond ((zerop calendar-time-zone) "UTC") |
f575f9ab GM |
840 | ((< calendar-time-zone 0) |
841 | (format "UTC%dmin" calendar-time-zone)) | |
842 | (t (format "UTC+%dmin" calendar-time-zone))))) | |
843 | (calendar-daylight-savings-starts | |
844 | (if (< arg 16) calendar-daylight-savings-starts)) | |
845 | (calendar-daylight-savings-ends | |
846 | (if (< arg 16) calendar-daylight-savings-ends)) | |
847 | (date (if (< arg 4) (calendar-current-date) (calendar-read-date))) | |
848 | (date-string (calendar-date-string date t)) | |
849 | (time-string (solar-sunrise-sunset-string date)) | |
850 | (msg (format "%s: %s" date-string time-string)) | |
851 | (one-window (one-window-p t))) | |
852 | (if (<= (length msg) (frame-width)) | |
853 | (message "%s" msg) | |
854 | (with-output-to-temp-buffer "*temp*" | |
855 | (princ (concat date-string "\n" time-string))) | |
856 | (message "%s" | |
857 | (substitute-command-keys | |
858 | (if one-window | |
859 | (if pop-up-windows | |
860 | "Type \\[delete-other-windows] to remove temp window." | |
861 | "Type \\[switch-to-buffer] RET to remove temp window.") | |
862 | "Type \\[switch-to-buffer-other-window] RET to restore old \ | |
a603b7db | 863 | contents of temp window.")))))) |
a1506d29 | 864 | |
fb97eeac | 865 | ;;;###cal-autoload |
10979c74 | 866 | (defun calendar-sunrise-sunset (&optional event) |
9f34a2a0 | 867 | "Local time of sunrise and sunset for date under cursor. |
087c56fa | 868 | Accurate to a few seconds." |
10979c74 | 869 | (interactive (list last-nonmenu-event)) |
a603b7db | 870 | (or (and calendar-latitude calendar-longitude calendar-time-zone) |
9f34a2a0 | 871 | (solar-setup)) |
10979c74 | 872 | (let ((date (calendar-cursor-to-date t event))) |
abd93e66 RS |
873 | (message "%s: %s" |
874 | (calendar-date-string date t t) | |
087c56fa | 875 | (solar-sunrise-sunset-string date)))) |
9f34a2a0 | 876 | |
5c4e1641 GM |
877 | ;;;###cal-autoload |
878 | (defun calendar-sunrise-sunset-month (&optional event) | |
879 | "Local time of sunrise and sunset for month under cursor or at EVENT." | |
880 | (interactive (list last-nonmenu-event)) | |
881 | (or (and calendar-latitude calendar-longitude calendar-time-zone) | |
882 | (solar-setup)) | |
883 | (let* ((date (calendar-cursor-to-date t event)) | |
884 | (month (car date)) | |
885 | (year (nth 2 date)) | |
886 | (last (calendar-last-day-of-month month year)) | |
887 | (title (format "Sunrise/sunset times for %s %d at %s" | |
888 | (calendar-month-name month) year | |
889 | (eval calendar-location-name)))) | |
890 | (calendar-in-read-only-buffer solar-sunrises-buffer | |
891 | (calendar-set-mode-line title) | |
892 | (insert title ":\n\n") | |
893 | (dotimes (i last) | |
894 | (setq date (list month (1+ i) year)) | |
895 | (insert (format "%s %2d: " (calendar-month-name month t) (1+ i)) | |
896 | (solar-sunrise-sunset-string date t) "\n"))))) | |
897 | ||
a603b7db GM |
898 | (defvar date) |
899 | ||
8c34d83e | 900 | ;; To be called from diary-list-sexp-entries, where DATE is bound. |
fb97eeac | 901 | ;;;###diary-autoload |
9f34a2a0 JB |
902 | (defun diary-sunrise-sunset () |
903 | "Local time of sunrise and sunset as a diary entry. | |
087c56fa | 904 | Accurate to a few seconds." |
a603b7db | 905 | (or (and calendar-latitude calendar-longitude calendar-time-zone) |
9f34a2a0 | 906 | (solar-setup)) |
087c56fa | 907 | (solar-sunrise-sunset-string date)) |
9f34a2a0 | 908 | |
53bee0c9 | 909 | ;; From Meeus, 1991, page 167. |
3f762917 GM |
910 | (defconst solar-seasons-data |
911 | '((485 324.96 1934.136) | |
912 | (203 337.23 32964.467) | |
913 | (199 342.08 20.186) | |
914 | (182 27.85 445267.112) | |
915 | (156 73.14 45036.886) | |
916 | (136 171.52 22518.443) | |
917 | (77 222.54 65928.934) | |
918 | (74 296.72 3034.906) | |
919 | (70 243.58 9037.513) | |
920 | (58 119.81 33718.147) | |
921 | (52 297.17 150.678) | |
922 | (50 21.02 2281.226) | |
923 | (45 247.54 29929.562) | |
924 | (44 325.15 31555.956) | |
925 | (29 60.93 4443.417) | |
926 | (18 155.12 67555.328) | |
927 | (17 288.79 4562.452) | |
928 | (16 198.04 62894.029) | |
929 | (14 199.76 31436.921) | |
930 | (12 95.39 14577.848) | |
931 | (12 287.11 31931.756) | |
932 | (12 320.81 34777.259) | |
933 | (9 227.73 1222.114) | |
a603b7db GM |
934 | (8 15.45 16859.074)) |
935 | "Data for solar equinox/solstice calculations.") | |
3f762917 | 936 | |
087c56fa ER |
937 | (defun solar-equinoxes/solstices (k year) |
938 | "Date of equinox/solstice K for YEAR. | |
939 | K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; | |
a603b7db GM |
940 | K=3, winter solstice. RESULT is a Gregorian local date. |
941 | Accurate to within a minute between 1951 and 2050." | |
087c56fa ER |
942 | (let* ((JDE0 (solar-mean-equinoxes/solstices k year)) |
943 | (T (/ (- JDE0 2451545.0) 36525)) | |
944 | (W (- (* 35999.373 T) 2.47)) | |
945 | (Delta-lambda (+ 1 (* 0.0334 (solar-cosine-degrees W)) | |
f575f9ab | 946 | (* 0.0007 (solar-cosine-degrees (* 2 W))))) |
b3a6c0ca | 947 | (S (apply '+ (mapcar (lambda(x) |
f575f9ab GM |
948 | (* (car x) (solar-cosine-degrees |
949 | (+ (* (nth 2 x) T) (cadr x))))) | |
087c56fa ER |
950 | solar-seasons-data))) |
951 | (JDE (+ JDE0 (/ (* 0.00001 S) Delta-lambda))) | |
53bee0c9 | 952 | ;; Ephemeris time correction. |
a1506d29 | 953 | (correction (+ 102.3 (* 123.5 T) (* 32.5 T T))) |
087c56fa ER |
954 | (JD (- JDE (/ correction 86400))) |
955 | (date (calendar-gregorian-from-absolute (floor (- JD 1721424.5)))) | |
f575f9ab GM |
956 | (time (- (- JD 0.5) (floor (- JD 0.5))))) |
957 | (list (car date) (+ (cadr date) time | |
958 | (/ (/ calendar-time-zone 60.0) 24.0)) | |
959 | (nth 2 date)))) | |
087c56fa | 960 | |
53bee0c9 | 961 | ;; From Meeus, 1991, page 166. |
087c56fa | 962 | (defun solar-mean-equinoxes/solstices (k year) |
a1506d29 | 963 | "Julian day of mean equinox/solstice K for YEAR. |
087c56fa | 964 | K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter |
fa463103 | 965 | solstice. These formulas are only to be used between 1000 BC and 3000 AD." |
087c56fa ER |
966 | (let ((y (/ year 1000.0)) |
967 | (z (/ (- year 2000) 1000.0))) | |
53bee0c9 | 968 | (if (< year 1000) ; actually between -1000 and 1000 |
7d17537f GM |
969 | (cond ((= k 0) (+ 1721139.29189 |
970 | (* 365242.13740 y) | |
971 | (* 0.06134 y y) | |
972 | (* 0.00111 y y y) | |
973 | (* -0.00071 y y y y))) | |
974 | ((= k 1) (+ 1721233.25401 | |
975 | (* 365241.72562 y) | |
976 | (* -0.05323 y y) | |
977 | (* 0.00907 y y y) | |
978 | (* 0.00025 y y y y))) | |
979 | ((= k 2) (+ 1721325.70455 | |
980 | (* 365242.49558 y) | |
981 | (* -0.11677 y y) | |
982 | (* -0.00297 y y y) | |
983 | (* 0.00074 y y y y))) | |
984 | ((= k 3) (+ 1721414.39987 | |
985 | (* 365242.88257 y) | |
986 | (* -0.00769 y y) | |
987 | (* -0.00933 y y y) | |
988 | (* -0.00006 y y y y)))) | |
53bee0c9 | 989 | ; actually between 1000 and 3000 |
7d17537f GM |
990 | (cond ((= k 0) (+ 2451623.80984 |
991 | (* 365242.37404 z) | |
992 | (* 0.05169 z z) | |
993 | (* -0.00411 z z z) | |
994 | (* -0.00057 z z z z))) | |
995 | ((= k 1) (+ 2451716.56767 | |
996 | (* 365241.62603 z) | |
997 | (* 0.00325 z z) | |
998 | (* 0.00888 z z z) | |
999 | (* -0.00030 z z z z))) | |
1000 | ((= k 2) (+ 2451810.21715 | |
1001 | (* 365242.01767 z) | |
1002 | (* -0.11575 z z) | |
1003 | (* 0.00337 z z z) | |
1004 | (* 0.00078 z z z z))) | |
1005 | ((= k 3) (+ 2451900.05952 | |
1006 | (* 365242.74049 z) | |
1007 | (* -0.06223 z z) | |
1008 | (* -0.00823 z z z) | |
1009 | (* 0.00032 z z z z))))))) | |
087c56fa | 1010 | |
e803eab7 | 1011 | (defvar displayed-month) ; from calendar-generate |
e7148377 GM |
1012 | (defvar displayed-year) |
1013 | ||
fb97eeac | 1014 | ;;;###holiday-autoload |
a92ade89 | 1015 | (defun solar-equinoxes-solstices () |
e85393d4 | 1016 | "Local date and time of equinoxes and solstices, if visible in the calendar. |
9f34a2a0 | 1017 | Requires floating point." |
f1e3fbeb GM |
1018 | (let* ((m displayed-month) |
1019 | (y displayed-year) | |
1020 | (calendar-standard-time-zone-name | |
1021 | (if calendar-time-zone calendar-standard-time-zone-name "UTC")) | |
1022 | (calendar-daylight-savings-starts | |
1023 | (if calendar-time-zone calendar-daylight-savings-starts)) | |
1024 | (calendar-daylight-savings-ends | |
1025 | (if calendar-time-zone calendar-daylight-savings-ends)) | |
1026 | (calendar-time-zone (if calendar-time-zone calendar-time-zone 0)) | |
1027 | (k (progn | |
e803eab7 | 1028 | (calendar-increment-month m y (cond ((= 1 (% m 3)) -1) |
f1e3fbeb GM |
1029 | ((= 2 (% m 3)) 1) |
1030 | (t 0))) | |
1031 | (1- (/ m 3)))) | |
1032 | (d0 (solar-equinoxes/solstices k y)) | |
1033 | (d1 (list (car d0) (floor (cadr d0)) (nth 2 d0))) | |
1034 | (h0 (* 24 (- (cadr d0) (floor (cadr d0))))) | |
1035 | (adj (dst-adjust-time d1 h0)) | |
1036 | (d (list (caar adj) | |
1037 | (+ (car (cdar adj)) | |
1038 | (/ (cadr adj) 24.0)) | |
1039 | (cadr (cdar adj)))) | |
1040 | ;; The following is nearly as accurate, but not quite: | |
1041 | ;; (d0 (solar-date-next-longitude | |
1042 | ;; (calendar-astro-from-absolute | |
1043 | ;; (calendar-absolute-from-gregorian | |
1044 | ;; (list (+ 3 (* k 3)) 15 y))) | |
1045 | ;; 90)) | |
5c645a20 | 1046 | ;; (abs-day (calendar-astro-to-absolute d))) |
f1e3fbeb GM |
1047 | (abs-day (calendar-absolute-from-gregorian d))) |
1048 | (list | |
1049 | (list (calendar-gregorian-from-absolute (floor abs-day)) | |
1050 | (format "%s %s" | |
1051 | (nth k (if (and calendar-latitude | |
1052 | (< (calendar-latitude) 0)) | |
1053 | solar-s-hemi-seasons | |
1054 | solar-n-hemi-seasons)) | |
1055 | (solar-time-string | |
1056 | (* 24 (- abs-day (floor abs-day))) | |
1057 | (if (dst-in-effect abs-day) | |
1058 | calendar-daylight-time-zone-name | |
1059 | calendar-standard-time-zone-name))))))) | |
75af4a4a | 1060 | |
9f34a2a0 JB |
1061 | |
1062 | (provide 'solar) | |
1063 | ||
1064 | ;;; solar.el ends here |