Commit | Line | Data |
---|---|---|
9f34a2a0 JB |
1 | ;;; solar.el --- calendar functions for solar events. |
2 | ||
6a6e6405 | 3 | ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. |
9f34a2a0 JB |
4 | |
5 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | |
68e60225 ER |
6 | ;; Keywords: calendar |
7 | ;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary, | |
8 | ;; holidays | |
9f34a2a0 JB |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
59243403 RS |
12 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation; either version 2, or (at your option) | |
15 | ;; any later version. | |
16 | ||
9f34a2a0 | 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
59243403 RS |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
23 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
24 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
9f34a2a0 JB |
25 | |
26 | ;;; Commentary: | |
27 | ||
6ff099c3 ER |
28 | ;; This collection of functions implements the features of calendar.el, |
29 | ;; diary.el, and holiday.el that deal with times of day, sunrise/sunset, and | |
a92ade89 | 30 | ;; eqinoxes/solstices. |
9f34a2a0 JB |
31 | |
32 | ;; Based on the ``Almanac for Computers 1984,'' prepared by the Nautical | |
33 | ;; Almanac Office, United States Naval Observatory, Washington, 1984 and | |
34 | ;; on ``Astronomical Formulae for Calculators,'' 3rd ed., by Jean Meeus, | |
35 | ;; Willmann-Bell, Inc., 1985. | |
36 | ;; | |
37 | ;; WARNINGS: | |
38 | ;; 1. SUNRISE/SUNSET calculations will be accurate only to +/- 2 minutes. | |
39 | ;; Locations should be between +/- 65 degrees of latitude. | |
40 | ;; Dates should be in the latter half of the 20th century. | |
41 | ;; | |
42 | ;; 2. Equinox/solstice times will be accurate only to +/- 15 minutes. | |
43 | ||
44 | ;; The author would be delighted to have an astronomically more sophisticated | |
45 | ;; person rewrite the code for the solar calculations in this file! | |
46 | ||
47 | ;; Comments, corrections, and improvements should be sent to | |
48 | ;; Edward M. Reingold Department of Computer Science | |
49 | ;; (217) 333-6733 University of Illinois at Urbana-Champaign | |
50 | ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue | |
51 | ;; Urbana, Illinois 61801 | |
52 | ||
53 | ;;; Code: | |
54 | ||
55 | (if (fboundp 'atan) | |
56 | (require 'lisp-float-type) | |
6ff099c3 | 57 | (error "Solar/lunar calculations impossible since floating point is unavailable.")) |
9f34a2a0 | 58 | |
a92ade89 JB |
59 | (require 'cal-dst) |
60 | ||
61 | ;;;###autoload | |
62 | (defvar calendar-time-display-form | |
63 | '(12-hours ":" minutes am-pm | |
64 | (if time-zone " (") time-zone (if time-zone ")")) | |
65 | "*The pseudo-pattern that governs the way a time of day is formatted. | |
66 | ||
67 | A pseudo-pattern is a list of expressions that can involve the keywords | |
68 | `12-hours', `24-hours', and `minutes', all numbers in string form, | |
69 | and `am-pm' and `time-zone', both alphabetic strings. | |
70 | ||
71 | For example, the form | |
72 | ||
73 | '(24-hours \":\" minutes | |
74 | (if time-zone \" (\") time-zone (if time-zone \")\")) | |
75 | ||
76 | would give military-style times like `21:07 (UTC)'.") | |
77 | ||
78 | ;;;###autoload | |
79 | (defvar calendar-latitude nil | |
6ff099c3 ER |
80 | "*Latitude of `calendar-location-name' in degrees. |
81 | ||
82 | The value can be either a decimal fraction (one place of accuracy is | |
83 | sufficient), + north, - south, such as 40.7 for New York City, or the value | |
84 | can be a vector [degrees minutes north/south] such as [40 50 north] for New | |
85 | York City. | |
86 | ||
87 | This variable should be set in site-local.el.") | |
a92ade89 JB |
88 | |
89 | ;;;###autoload | |
90 | (defvar calendar-longitude nil | |
6ff099c3 ER |
91 | "*Longitude of `calendar-location-name' in degrees. |
92 | ||
93 | The value can be either a decimal fraction (one place of accuracy is | |
94 | sufficient), + east, - west, such as -73.9 for New York City, or the value | |
95 | can be a vector [degrees minutes east/west] such as [73 55 west] for New | |
96 | York City. | |
97 | ||
98 | This variable should be set in site-local.el.") | |
99 | ||
100 | (defsubst calendar-latitude () | |
101 | "Convert calendar-latitude to a signed decimal fraction, if needed." | |
102 | (if (numberp calendar-latitude) | |
103 | calendar-latitude | |
104 | (let ((lat (+ (aref calendar-latitude 0) | |
105 | (/ (aref calendar-latitude 1) 60.0)))) | |
106 | (if (equal (aref calendar-latitude 2) 'north) | |
107 | lat | |
108 | (- lat))))) | |
109 | ||
110 | (defsubst calendar-longitude () | |
111 | "Convert calendar-longitude to a signed decimal fraction, if needed." | |
112 | (if (numberp calendar-longitude) | |
113 | calendar-longitude | |
114 | (let ((long (+ (aref calendar-longitude 0) | |
115 | (/ (aref calendar-longitude 1) 60.0)))) | |
116 | (if (equal (aref calendar-longitude 2) 'east) | |
117 | long | |
118 | (- long))))) | |
a92ade89 JB |
119 | |
120 | ;;;###autoload | |
121 | (defvar calendar-location-name | |
122 | '(let ((float-output-format "%.1f")) | |
123 | (format "%s%s, %s%s" | |
6ff099c3 ER |
124 | (if (numberp calendar-latitude) |
125 | (abs calendar-latitude) | |
126 | (+ (aref calendar-latitude 0) | |
127 | (/ (aref calendar-latitude 1) 60.0))) | |
128 | (if (numberp calendar-latitude) | |
129 | (if (> calendar-latitude 0) "N" "S") | |
130 | (if (equal (aref calendar-latitude 2) 'north) "N" "S")) | |
131 | (if (numberp calendar-longitude) | |
132 | (abs calendar-longitude) | |
133 | (+ (aref calendar-longitude 0) | |
134 | (/ (aref calendar-longitude 1) 60.0))) | |
135 | (if (numberp calendar-longitude) | |
136 | (if (> calendar-longitude 0) "E" "W") | |
137 | (if (equal (aref calendar-latitude 2) 'east) "E" "W")))) | |
a92ade89 | 138 | "*Expression evaluating to name of `calendar-longitude', calendar-latitude'. |
6ff099c3 ER |
139 | For example, \"New York City\". Default value is just the latitude, longitude |
140 | pair. | |
141 | ||
142 | This variable should be set in site-local.el.") | |
9f34a2a0 | 143 | |
3d9dece2 | 144 | (defvar solar-n-hemi-seasons |
fc68b552 BF |
145 | '("Vernal Equinox" "Summer Solstice" "Autumnal Equinox" "Winter Solstice") |
146 | "List of season changes for the northern hemisphere.") | |
147 | ||
3d9dece2 | 148 | (defvar solar-s-hemi-seasons |
fc68b552 BF |
149 | '("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice") |
150 | "List of season changes for the southern hemisphere.") | |
151 | ||
9f34a2a0 JB |
152 | (defun solar-setup () |
153 | "Prompt user for latitude, longitude, and time zone." | |
154 | (beep) | |
155 | (if (not calendar-longitude) | |
156 | (setq calendar-longitude | |
157 | (solar-get-number | |
158 | "Enter longitude (decimal fraction; + east, - west): "))) | |
159 | (if (not calendar-latitude) | |
160 | (setq calendar-latitude | |
161 | (solar-get-number | |
162 | "Enter latitude (decimal fraction; + north, - south): "))) | |
163 | (if (not calendar-time-zone) | |
164 | (setq calendar-time-zone | |
165 | (solar-get-number | |
e2fe2f52 | 166 | "Enter difference from Coordinated Universal Time (in minutes): ")))) |
9f34a2a0 JB |
167 | |
168 | (defun solar-get-number (prompt) | |
169 | "Return a number from the minibuffer, prompting with PROMPT. | |
170 | Returns nil if nothing was entered." | |
171 | (let ((x (read-string prompt ""))) | |
172 | (if (not (string-equal x "")) | |
173 | (string-to-int x)))) | |
174 | ||
6ff099c3 | 175 | (defsubst solar-sin-degrees (x) |
9f34a2a0 JB |
176 | (sin (degrees-to-radians x))) |
177 | ||
6ff099c3 | 178 | (defsubst solar-cosine-degrees (x) |
9f34a2a0 JB |
179 | (cos (degrees-to-radians x))) |
180 | ||
181 | (defun solar-tangent-degrees (x) | |
182 | (tan (degrees-to-radians x))) | |
183 | ||
184 | (defun solar-xy-to-quadrant (x y) | |
185 | "Determines the quadrant of the point X, Y." | |
186 | (if (> x 0) | |
187 | (if (> y 0) 1 4) | |
188 | (if (> y 0) 2 3))) | |
189 | ||
190 | (defun solar-degrees-to-quadrant (angle) | |
191 | "Determines the quadrant of ANGLE." | |
3a2e3ab5 | 192 | (1+ (floor (mod angle 360) 90))) |
9f34a2a0 JB |
193 | |
194 | (defun solar-arctan (x quad) | |
195 | "Arctangent of X in quadrant QUAD." | |
196 | (let ((deg (radians-to-degrees (atan x)))) | |
197 | (cond ((equal quad 2) (+ deg 180)) | |
198 | ((equal quad 3) (+ deg 180)) | |
199 | ((equal quad 4) (+ deg 360)) | |
200 | (t deg)))) | |
201 | ||
202 | (defun solar-arccos (x) | |
203 | (let ((y (sqrt (- 1 (* x x))))) | |
204 | (solar-arctan (/ y x) (solar-xy-to-quadrant x y)))) | |
205 | ||
206 | (defun solar-arcsin (y) | |
207 | (let ((x (sqrt (- 1 (* y y))))) | |
208 | (solar-arctan (/ y x) (solar-xy-to-quadrant x y)))) | |
209 | ||
9f34a2a0 JB |
210 | (defconst solar-earth-inclination 23.441884 |
211 | "Inclination of earth's equator to its solar orbit in degrees.") | |
212 | ||
213 | (defconst solar-cos-inclination (solar-cosine-degrees solar-earth-inclination) | |
214 | "Cosine of earth's inclination.") | |
215 | ||
216 | (defconst solar-sin-inclination (solar-sin-degrees solar-earth-inclination) | |
217 | "Sine of earth's inclination.") | |
218 | ||
219 | (defconst solar-earth-orbit-eccentricity 0.016718 | |
220 | "Eccentricity of orbit of the earth around the sun.") | |
221 | ||
6ff099c3 ER |
222 | (defsubst solar-degrees-to-hours (deg) |
223 | (/ deg 15.0)) | |
9f34a2a0 | 224 | |
6ff099c3 ER |
225 | (defsubst solar-hours-to-days (hour) |
226 | (/ hour 24.0)) | |
9f34a2a0 JB |
227 | |
228 | (defun solar-longitude-of-sun (day) | |
229 | "Longitude of the sun at DAY in the year." | |
230 | (let ((mean-anomaly (- (* 0.9856 day) 3.289))) | |
12e070d1 PE |
231 | (mod (+ mean-anomaly |
232 | (* 1.916 (solar-sin-degrees mean-anomaly)) | |
233 | (* 0.020 (solar-sin-degrees (* 2 mean-anomaly))) | |
234 | 282.634) | |
3a2e3ab5 | 235 | 360))) |
9f34a2a0 JB |
236 | |
237 | (defun solar-right-ascension (longitude) | |
238 | "Right ascension of the sun, given its LONGITUDE." | |
239 | (solar-degrees-to-hours | |
240 | (solar-arctan | |
241 | (* solar-cos-inclination (solar-tangent-degrees longitude)) | |
242 | (solar-degrees-to-quadrant longitude)))) | |
243 | ||
244 | (defun solar-declination (longitude) | |
245 | "Declination of the sun, given its LONGITUDE." | |
246 | (solar-arcsin | |
247 | (* solar-sin-inclination | |
248 | (solar-sin-degrees longitude)))) | |
249 | ||
250 | (defun solar-sunrise (date) | |
c68488d2 ER |
251 | "Calculates the *standard* time of sunrise for Gregorian DATE. |
252 | Calculation is for location given by `calendar-latitude' and | |
253 | `calendar-longitude'. | |
254 | ||
255 | Returns a decimal fraction of hours. Returns nil if the sun does not rise at | |
256 | that location on that day." | |
9f34a2a0 JB |
257 | (let* ((day-of-year (calendar-day-number date)) |
258 | (approx-sunrise | |
259 | (+ day-of-year | |
260 | (solar-hours-to-days | |
6ff099c3 | 261 | (- 6 (solar-degrees-to-hours (calendar-longitude)))))) |
9f34a2a0 JB |
262 | (solar-longitude-of-sun-at-sunrise |
263 | (solar-longitude-of-sun approx-sunrise)) | |
264 | (solar-right-ascension-at-sunrise | |
265 | (solar-right-ascension solar-longitude-of-sun-at-sunrise)) | |
266 | (solar-declination-at-sunrise | |
267 | (solar-declination solar-longitude-of-sun-at-sunrise)) | |
268 | (cos-local-sunrise | |
269 | (/ (- (solar-cosine-degrees (+ 90 (/ 50.0 60.0))) | |
270 | (* (solar-sin-degrees solar-declination-at-sunrise) | |
6ff099c3 | 271 | (solar-sin-degrees (calendar-latitude)))) |
9f34a2a0 | 272 | (* (solar-cosine-degrees solar-declination-at-sunrise) |
6ff099c3 | 273 | (solar-cosine-degrees (calendar-latitude)))))) |
9f34a2a0 JB |
274 | (if (<= (abs cos-local-sunrise) 1);; otherwise, no sunrise that day |
275 | (let* ((local-sunrise (solar-degrees-to-hours | |
276 | (- 360 (solar-arccos cos-local-sunrise)))) | |
277 | (local-mean-sunrise | |
12e070d1 PE |
278 | (mod (- (+ local-sunrise solar-right-ascension-at-sunrise) |
279 | (+ (* 0.065710 approx-sunrise) | |
280 | 6.622)) | |
3a2e3ab5 | 281 | 24))) |
6ff099c3 | 282 | (+ (- local-mean-sunrise (solar-degrees-to-hours (calendar-longitude))) |
9f34a2a0 JB |
283 | (/ calendar-time-zone 60.0)))))) |
284 | ||
285 | (defun solar-sunset (date) | |
c68488d2 ER |
286 | "Calculates the *standard* time of sunset for Gregorian DATE. |
287 | Calculation is for location given by `calendar-latitude' and | |
288 | `calendar-longitude'. | |
289 | ||
290 | Returns a decimal fractions of hours. Returns nil if the sun does not set at | |
291 | that location on that day." | |
9f34a2a0 JB |
292 | (let* ((day-of-year (calendar-day-number date)) |
293 | (approx-sunset | |
294 | (+ day-of-year | |
295 | (solar-hours-to-days | |
6ff099c3 | 296 | (- 18 (solar-degrees-to-hours (calendar-longitude)))))) |
9f34a2a0 JB |
297 | (solar-longitude-of-sun-at-sunset |
298 | (solar-longitude-of-sun approx-sunset)) | |
299 | (solar-right-ascension-at-sunset | |
300 | (solar-right-ascension solar-longitude-of-sun-at-sunset)) | |
301 | (solar-declination-at-sunset | |
302 | (solar-declination solar-longitude-of-sun-at-sunset)) | |
303 | (cos-local-sunset | |
304 | (/ (- (solar-cosine-degrees (+ 90 (/ 50.0 60.0))) | |
305 | (* (solar-sin-degrees solar-declination-at-sunset) | |
6ff099c3 | 306 | (solar-sin-degrees (calendar-latitude)))) |
9f34a2a0 | 307 | (* (solar-cosine-degrees solar-declination-at-sunset) |
6ff099c3 | 308 | (solar-cosine-degrees (calendar-latitude)))))) |
9f34a2a0 JB |
309 | (if (<= (abs cos-local-sunset) 1);; otherwise, no sunset that day |
310 | (let* ((local-sunset (solar-degrees-to-hours | |
311 | (solar-arccos cos-local-sunset))) | |
312 | (local-mean-sunset | |
12e070d1 PE |
313 | (mod (- (+ local-sunset solar-right-ascension-at-sunset) |
314 | (+ (* 0.065710 approx-sunset) 6.622)) | |
3a2e3ab5 | 315 | 24))) |
6ff099c3 | 316 | (+ (- local-mean-sunset (solar-degrees-to-hours (calendar-longitude))) |
9f34a2a0 JB |
317 | (/ calendar-time-zone 60.0)))))) |
318 | ||
c68488d2 ER |
319 | (defun solar-adj-time-for-dst (date time &optional style) |
320 | "Adjust decimal fraction standard TIME on DATE to account for dst. | |
321 | Returns a list (date adj-time zone) where `date' and `time' are the values | |
322 | adjusted for `zone'; here `date' is a list (month day year), `time' is a | |
323 | decimal fraction time, and `zone' is a string. | |
324 | ||
325 | Optional parameter STYLE forces the result time to be standard time when its | |
326 | value is 'standard and daylight savings time (if available) when its value is | |
e2fe2f52 JB |
327 | 'daylight. |
328 | ||
c68488d2 ER |
329 | Conversion to daylight savings time is done according to |
330 | `calendar-daylight-savings-starts', `calendar-daylight-savings-ends', | |
331 | `calendar-daylight-savings-starts-time', | |
332 | `calendar-daylight-savings-ends-time', and | |
333 | `calendar-daylight-savings-offset'." | |
334 | ||
9f34a2a0 | 335 | (let* ((year (extract-calendar-year date)) |
a92ade89 | 336 | (rounded-abs-date (+ (calendar-absolute-from-gregorian date) |
c68488d2 | 337 | (/ (round (* 60 time)) 60.0 24.0))) |
e2fe2f52 JB |
338 | (dst-starts (and calendar-daylight-savings-starts |
339 | (+ (calendar-absolute-from-gregorian | |
340 | (eval calendar-daylight-savings-starts)) | |
c27a1f51 | 341 | (/ calendar-daylight-savings-starts-time |
a92ade89 | 342 | 60.0 24.0)))) |
e2fe2f52 JB |
343 | (dst-ends (and calendar-daylight-savings-ends |
344 | (+ (calendar-absolute-from-gregorian | |
345 | (eval calendar-daylight-savings-ends)) | |
c27a1f51 | 346 | (/ (- calendar-daylight-savings-ends-time |
a92ade89 JB |
347 | calendar-daylight-time-offset) |
348 | 60.0 24.0)))) | |
e2fe2f52 JB |
349 | (dst (and (not (eq style 'standard)) |
350 | (or (eq style 'daylight) | |
351 | (and dst-starts dst-ends | |
352 | (or (and (< dst-starts dst-ends);; northern hemi. | |
353 | (<= dst-starts rounded-abs-date) | |
354 | (< rounded-abs-date dst-ends)) | |
355 | (and (< dst-ends dst-starts);; southern hemi. | |
356 | (or (< rounded-abs-date dst-ends) | |
357 | (<= dst-starts rounded-abs-date))))) | |
358 | (and dst-starts (not dst-ends) | |
359 | (<= dst-starts rounded-abs-date)) | |
360 | (and dst-ends (not dst-starts) | |
361 | (< rounded-abs-date dst-ends))))) | |
9f34a2a0 JB |
362 | (time-zone (if dst |
363 | calendar-daylight-time-zone-name | |
364 | calendar-standard-time-zone-name)) | |
c68488d2 ER |
365 | (time (+ rounded-abs-date |
366 | (if dst (/ calendar-daylight-time-offset 24.0 60.0) 0)))) | |
367 | (list (calendar-gregorian-from-absolute (truncate time)) | |
368 | (* 24.0 (- time (truncate time))) | |
369 | time-zone))) | |
370 | ||
371 | (defun solar-time-string (time time-zone) | |
372 | "Printable form for decimal fraction TIME on DATE. | |
373 | Format used is given by `calendar-time-display-form'." | |
374 | (let* ((time (round (* 60 time))) | |
a92ade89 JB |
375 | (24-hours (/ time 60)) |
376 | (minutes (format "%02d" (% time 60))) | |
377 | (12-hours (format "%d" (1+ (% (+ 24-hours 11) 12)))) | |
9f34a2a0 | 378 | (am-pm (if (>= 24-hours 12) "pm" "am")) |
9f34a2a0 JB |
379 | (24-hours (format "%02d" 24-hours))) |
380 | (mapconcat 'eval calendar-time-display-form ""))) | |
381 | ||
382 | (defun solar-sunrise-sunset (date) | |
383 | "String giving local times of sunrise and sunset on Gregorian DATE." | |
c68488d2 | 384 | (let* ((rise (solar-sunrise date)) |
89719ce9 | 385 | (adj-rise (if rise (solar-adj-time-for-dst date rise))) |
c68488d2 | 386 | (set (solar-sunset date)) |
89719ce9 | 387 | (adj-set (if set (solar-adj-time-for-dst date set)))) |
9f34a2a0 | 388 | (format "%s, %s at %s" |
c68488d2 ER |
389 | (if (and rise (calendar-date-equal date (car adj-rise))) |
390 | (concat "Sunrise " (apply 'solar-time-string (cdr adj-rise))) | |
9f34a2a0 | 391 | "No sunrise") |
c68488d2 ER |
392 | (if (and set (calendar-date-equal date (car adj-set))) |
393 | (concat "sunset " (apply 'solar-time-string (cdr adj-set))) | |
9f34a2a0 JB |
394 | "no sunset") |
395 | (eval calendar-location-name)))) | |
396 | ||
397 | (defun solar-apparent-longitude-of-sun (date) | |
398 | "Apparent longitude of the sun on Gregorian DATE." | |
399 | (let* ((time (/ (- (calendar-absolute-from-gregorian date) | |
400 | (calendar-absolute-from-gregorian '(1 0.5 1900))) | |
401 | 36525)) | |
402 | (l (+ 279.69668 | |
403 | (* 36000.76892 time) | |
404 | (* 0.0003025 time time))) | |
405 | (m (+ 358.47583 | |
406 | (* 35999.04975 time) | |
407 | (* -0.000150 time time) | |
408 | (* -0.0000033 time time time))) | |
409 | (c (+ (* (+ 1.919460 | |
410 | (* -0.004789 time) | |
411 | (* -0.000014 time time)) | |
412 | (solar-sin-degrees m)) | |
413 | (* (+ 0.020094 | |
414 | (* -0.000100 time)) | |
415 | (solar-sin-degrees (* 2 m))) | |
416 | (* 0.000293 | |
417 | (solar-sin-degrees (* 3 m))))) | |
418 | (L (+ l c)) | |
419 | (omega (+ 259.18 | |
420 | (* -1934.142 time))) | |
421 | (app (+ L | |
422 | -0.00569 | |
423 | (* -0.00479 | |
424 | (solar-sin-degrees omega))))) | |
425 | app)) | |
426 | ||
427 | (defun solar-ephemeris-correction (year) | |
e2fe2f52 | 428 | "Difference in minutes between Ephemeris time and UTC in YEAR. |
9f34a2a0 JB |
429 | Value is only an approximation." |
430 | (let ((T (/ (- year 1900) 100.0))) | |
431 | (+ 0.41 (* 1.2053 T) (* 0.4992 T T)))) | |
432 | ||
433 | (defun solar-equinoxes/solstices (k year) | |
434 | "Date of equinox/solstice K for YEAR. K=0, spring equinox; K=1, summer | |
435 | solstice; K=2, fall equinox; K=3, winter solstice. Accurate to within | |
436 | several minutes." | |
437 | (let ((date (list (+ 3 (* k 3)) 21 year)) | |
a92ade89 | 438 | app |
9f34a2a0 JB |
439 | (correction 1000)) |
440 | (while (> correction 0.00001) | |
3a2e3ab5 | 441 | (setq app (mod (solar-apparent-longitude-of-sun date) 360)) |
9f34a2a0 JB |
442 | (setq correction (* 58 (solar-sin-degrees (- (* k 90) app)))) |
443 | (setq date (list (extract-calendar-month date) | |
444 | (+ (extract-calendar-day date) correction) | |
445 | year))) | |
446 | (list (extract-calendar-month date) | |
447 | (+ (extract-calendar-day date) (/ calendar-time-zone 60.0 24.0) | |
448 | (- (/ (solar-ephemeris-correction year) 60.0 24.0))) | |
449 | year))) | |
450 | ||
451 | ;;;###autoload | |
452 | (defun sunrise-sunset (&optional arg) | |
453 | "Local time of sunrise and sunset for today. Accurate to +/- 2 minutes. | |
ec4dfb6b | 454 | If called with an optional prefix argument, prompt for date. |
9f34a2a0 | 455 | |
ec4dfb6b RS |
456 | If called with an optional double prefix argument, prompt for longitude, |
457 | latitude, time zone, and date, and always use standard time. | |
9f34a2a0 JB |
458 | |
459 | This function is suitable for execution in a .emacs file." | |
460 | (interactive "p") | |
6a6e6405 | 461 | (or arg (setq arg 1)) |
fbfed6f0 JB |
462 | (if (and (< arg 16) |
463 | (not (and calendar-latitude calendar-longitude calendar-time-zone))) | |
464 | (solar-setup)) | |
9f34a2a0 | 465 | (let* ((calendar-longitude |
fbfed6f0 | 466 | (if (< arg 16) calendar-longitude |
9f34a2a0 JB |
467 | (solar-get-number |
468 | "Enter longitude (decimal fraction; + east, - west): "))) | |
469 | (calendar-latitude | |
fbfed6f0 | 470 | (if (< arg 16) calendar-latitude |
9f34a2a0 JB |
471 | (solar-get-number |
472 | "Enter latitude (decimal fraction; + north, - south): "))) | |
473 | (calendar-time-zone | |
fbfed6f0 | 474 | (if (< arg 16) calendar-time-zone |
9f34a2a0 | 475 | (solar-get-number |
e2fe2f52 | 476 | "Enter difference from Coordinated Universal Time (in minutes): "))) |
9f34a2a0 | 477 | (calendar-location-name |
fbfed6f0 JB |
478 | (if (< arg 16) calendar-location-name |
479 | (let ((float-output-format "%.1f")) | |
480 | (format "%s%s, %s%s" | |
6ff099c3 ER |
481 | (if (numberp calendar-latitude) |
482 | (abs calendar-latitude) | |
483 | (+ (aref calendar-latitude 0) | |
484 | (/ (aref calendar-latitude 1) 60.0))) | |
485 | (if (numberp calendar-latitude) | |
486 | (if (> calendar-latitude 0) "N" "S") | |
487 | (if (equal (aref calendar-latitude 2) 'north) "N" "S")) | |
488 | (if (numberp calendar-longitude) | |
489 | (abs calendar-longitude) | |
490 | (+ (aref calendar-longitude 0) | |
491 | (/ (aref calendar-longitude 1) 60.0))) | |
492 | (if (numberp calendar-longitude) | |
493 | (if (> calendar-longitude 0) "E" "W") | |
494 | (if (equal (aref calendar-latitude 2) 'east) | |
495 | "E" "W")))))) | |
9f34a2a0 | 496 | (calendar-standard-time-zone-name |
fbfed6f0 | 497 | (if (< arg 16) calendar-standard-time-zone-name |
a92ade89 | 498 | (cond ((= calendar-time-zone 0) "UTC") |
fbfed6f0 | 499 | ((< calendar-time-zone 0) |
a92ade89 JB |
500 | (format "UTC%dmin" calendar-time-zone)) |
501 | (t (format "UTC+%dmin" calendar-time-zone))))) | |
ec4dfb6b RS |
502 | (calendar-daylight-savings-starts |
503 | (if (< arg 16) calendar-daylight-savings-starts)) | |
504 | (calendar-daylight-savings-ends | |
505 | (if (< arg 16) calendar-daylight-savings-ends)) | |
fbfed6f0 | 506 | (date (if (< arg 4) (calendar-current-date) (calendar-read-date))) |
9f34a2a0 JB |
507 | (date-string (calendar-date-string date t)) |
508 | (time-string (solar-sunrise-sunset date)) | |
509 | (msg (format "%s: %s" date-string time-string)) | |
510 | (one-window (one-window-p t))) | |
80897760 | 511 | (if (<= (length msg) (frame-width)) |
9f34a2a0 JB |
512 | (message msg) |
513 | (with-output-to-temp-buffer "*temp*" | |
514 | (princ (concat date-string "\n" time-string))) | |
515 | (message (substitute-command-keys | |
516 | (if one-window | |
517 | (if pop-up-windows | |
518 | "Type \\[delete-other-windows] to remove temp window." | |
519 | "Type \\[switch-to-buffer] RET to remove temp window.") | |
520 | "Type \\[switch-to-buffer-other-window] RET to restore old contents of temp window.")))))) | |
521 | ||
522 | (defun calendar-sunrise-sunset () | |
523 | "Local time of sunrise and sunset for date under cursor. | |
524 | Accurate to +/- 2 minutes." | |
525 | (interactive) | |
526 | (if (not (and calendar-latitude calendar-longitude calendar-time-zone)) | |
527 | (solar-setup)) | |
6a6e6405 | 528 | (let ((date (calendar-cursor-to-date t))) |
abd93e66 RS |
529 | (message "%s: %s" |
530 | (calendar-date-string date t t) | |
531 | (solar-sunrise-sunset date)))) | |
9f34a2a0 JB |
532 | |
533 | (defun diary-sunrise-sunset () | |
534 | "Local time of sunrise and sunset as a diary entry. | |
535 | Accurate to +/- 2 minutes." | |
536 | (if (not (and calendar-latitude calendar-longitude calendar-time-zone)) | |
537 | (solar-setup)) | |
538 | (solar-sunrise-sunset date)) | |
539 | ||
540 | (defun diary-sabbath-candles () | |
541 | "Local time of candle lighting diary entry--applies if date is a Friday. | |
542 | No diary entry if there is no sunset on that date." | |
543 | (if (not (and calendar-latitude calendar-longitude calendar-time-zone)) | |
544 | (solar-setup)) | |
545 | (if (= (% (calendar-absolute-from-gregorian date) 7) 5);; Friday | |
546 | (let* ((sunset (solar-sunset date)) | |
c68488d2 ER |
547 | (light (if sunset |
548 | (solar-adj-time-for-dst | |
549 | date | |
550 | (- sunset (/ 18.0 60.0)))))) | |
551 | (if (and light (calendar-date-equal date (car light))) | |
552 | (format "%s Sabbath candle lighting" | |
553 | (apply 'solar-time-string (cdr light))))))) | |
9f34a2a0 | 554 | |
ce4d3fff | 555 | ;;;###autoload |
a92ade89 | 556 | (defun solar-equinoxes-solstices () |
9f34a2a0 JB |
557 | "Date and time of equinoxes and solstices, if visible in the calendar window. |
558 | Requires floating point." | |
a92ade89 JB |
559 | (let ((m displayed-month) |
560 | (y displayed-year)) | |
9f34a2a0 JB |
561 | (increment-calendar-month m y (cond ((= 1 (% m 3)) -1) |
562 | ((= 2 (% m 3)) 1) | |
563 | (t 0))) | |
564 | (let* ((calendar-standard-time-zone-name | |
a92ade89 | 565 | (if calendar-time-zone calendar-standard-time-zone-name "UTC")) |
9f34a2a0 JB |
566 | (calendar-daylight-savings-starts |
567 | (if calendar-time-zone calendar-daylight-savings-starts)) | |
568 | (calendar-daylight-savings-ends | |
569 | (if calendar-time-zone calendar-daylight-savings-ends)) | |
570 | (calendar-time-zone (if calendar-time-zone calendar-time-zone 0)) | |
571 | (k (1- (/ m 3))) | |
572 | (date (solar-equinoxes/solstices k y)) | |
6ff099c3 | 573 | (s-hemi (and calendar-latitude (< (calendar-latitude) 0))) |
c68488d2 ER |
574 | (day (extract-calendar-day date)) |
575 | (adj (solar-adj-time-for-dst | |
576 | (list (extract-calendar-month date) | |
9f34a2a0 | 577 | (truncate day) |
c68488d2 ER |
578 | (extract-calendar-year date)) |
579 | (* 24 (- day (truncate day)))))) | |
580 | (list (list (car adj) | |
fc68b552 | 581 | (format "%s %s" |
3d9dece2 RS |
582 | (nth k (if s-hemi solar-s-hemi-seasons |
583 | solar-n-hemi-seasons)) | |
c68488d2 | 584 | (apply 'solar-time-string (cdr adj)))))))) |
9f34a2a0 JB |
585 | |
586 | (provide 'solar) | |
587 | ||
588 | ;;; solar.el ends here |