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