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