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