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