Mercurial > emacs
annotate lisp/calendar/solar.el @ 4863:adfd03a381ca
(solar-n-hemi-seasons, solar-s-hemi-seasons): New vars.
(solar-equinoxes-solstices): Use them to fix names for southern hemisphere.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 20 Oct 1993 05:51:19 +0000 |
parents | ec8c8721b7e3 |
children | 9595049f63a9 |
rev | line source |
---|---|
956 | 1 ;;; solar.el --- calendar functions for solar events. |
2 | |
3 ;; Copyright (C) 1992 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | |
2249
94fc2ce49c55
Corrected Keywords header
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2248
diff
changeset
|
6 ;; Keywords: calendar |
94fc2ce49c55
Corrected Keywords header
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2248
diff
changeset
|
7 ;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary, |
94fc2ce49c55
Corrected Keywords header
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2248
diff
changeset
|
8 ;; holidays |
956 | 9 |
10 ;; This file is part of GNU Emacs. | |
11 | |
12 ;; GNU Emacs is distributed in the hope that it will be useful, | |
13 ;; but WITHOUT ANY WARRANTY. No author or distributor | |
14 ;; accepts responsibility to anyone for the consequences of using it | |
15 ;; or for whether it serves any particular purpose or works at all, | |
16 ;; unless he says so in writing. Refer to the GNU Emacs General Public | |
17 ;; License for full details. | |
18 | |
19 ;; Everyone is granted permission to copy, modify and redistribute | |
20 ;; GNU Emacs, but only under the conditions described in the | |
21 ;; GNU Emacs General Public License. A copy of this license is | |
22 ;; supposed to have been given to you along with GNU Emacs so you | |
23 ;; can know your rights and responsibilities. It should be in a | |
24 ;; file named COPYING. Among other things, the copyright notice | |
25 ;; and this notice must be preserved on all copies. | |
26 | |
27 ;;; Commentary: | |
28 | |
29 ;; This collection of functions implements the features of calendar.el and | |
3866
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
30 ;; diary.el that deal with times of day, sunrise/sunset, and |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
31 ;; eqinoxes/solstices. |
956 | 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 calculations impossible since floating point is unavailable.")) | |
59 | |
3866
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
60 (require 'cal-dst) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
61 |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
62 ;;;###autoload |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
63 (defvar calendar-time-display-form |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
64 '(12-hours ":" minutes am-pm |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
65 (if time-zone " (") time-zone (if time-zone ")")) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
66 "*The pseudo-pattern that governs the way a time of day is formatted. |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
67 |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
68 A pseudo-pattern is a list of expressions that can involve the keywords |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
69 `12-hours', `24-hours', and `minutes', all numbers in string form, |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
70 and `am-pm' and `time-zone', both alphabetic strings. |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
71 |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
72 For example, the form |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
73 |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
74 '(24-hours \":\" minutes |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
75 (if time-zone \" (\") time-zone (if time-zone \")\")) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
76 |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
77 would give military-style times like `21:07 (UTC)'.") |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
78 |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
79 ;;;###autoload |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
80 (defvar calendar-latitude nil |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
81 "*Latitude of `calendar-location-name' in degrees, + north, - south. |
3907 | 82 For example, 40.7 for New York City. |
83 It may not be a good idea to set this in advance for your site; | |
84 if there may be users running Emacs at your site | |
85 who are physically located elsewhere, they would get the wrong | |
86 value and might not know how to override it.") | |
3866
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
87 |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
88 ;;;###autoload |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
89 (defvar calendar-longitude nil |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
90 "*Longitude of `calendar-location-name' in degrees, + east, - west. |
3907 | 91 For example, -74.0 for New York City. |
92 It may not be a good idea to set this in advance for your site; | |
93 if there may be users running Emacs at your site | |
94 who are physically located elsewhere, they would get the wrong | |
95 value and might not know how to override it.") | |
3866
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
96 |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
97 ;;;###autoload |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
98 (defvar calendar-location-name |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
99 '(let ((float-output-format "%.1f")) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
100 (format "%s%s, %s%s" |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
101 (abs calendar-latitude) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
102 (if (> calendar-latitude 0) "N" "S") |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
103 (abs calendar-longitude) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
104 (if (> calendar-longitude 0) "E" "W"))) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
105 "*Expression evaluating to name of `calendar-longitude', calendar-latitude'. |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
106 Default value is just the latitude, longitude pair.") |
956 | 107 |
4863
adfd03a381ca
(solar-n-hemi-seasons, solar-s-hemi-seasons): New vars.
Richard M. Stallman <rms@gnu.org>
parents:
4766
diff
changeset
|
108 (defvar solar-n-hemi-seasons |
4766
ec8c8721b7e3
(s-hemi-seasons n-hemi-seasons): New constants are hemisphere
Brian Fox <bfox@gnu.org>
parents:
4660
diff
changeset
|
109 '("Vernal Equinox" "Summer Solstice" "Autumnal Equinox" "Winter Solstice") |
ec8c8721b7e3
(s-hemi-seasons n-hemi-seasons): New constants are hemisphere
Brian Fox <bfox@gnu.org>
parents:
4660
diff
changeset
|
110 "List of season changes for the northern hemisphere.") |
ec8c8721b7e3
(s-hemi-seasons n-hemi-seasons): New constants are hemisphere
Brian Fox <bfox@gnu.org>
parents:
4660
diff
changeset
|
111 |
4863
adfd03a381ca
(solar-n-hemi-seasons, solar-s-hemi-seasons): New vars.
Richard M. Stallman <rms@gnu.org>
parents:
4766
diff
changeset
|
112 (defvar solar-s-hemi-seasons |
4766
ec8c8721b7e3
(s-hemi-seasons n-hemi-seasons): New constants are hemisphere
Brian Fox <bfox@gnu.org>
parents:
4660
diff
changeset
|
113 '("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice") |
ec8c8721b7e3
(s-hemi-seasons n-hemi-seasons): New constants are hemisphere
Brian Fox <bfox@gnu.org>
parents:
4660
diff
changeset
|
114 "List of season changes for the southern hemisphere.") |
ec8c8721b7e3
(s-hemi-seasons n-hemi-seasons): New constants are hemisphere
Brian Fox <bfox@gnu.org>
parents:
4660
diff
changeset
|
115 |
956 | 116 (defun solar-setup () |
117 "Prompt user for latitude, longitude, and time zone." | |
118 (beep) | |
119 (if (not calendar-longitude) | |
120 (setq calendar-longitude | |
121 (solar-get-number | |
122 "Enter longitude (decimal fraction; + east, - west): "))) | |
123 (if (not calendar-latitude) | |
124 (setq calendar-latitude | |
125 (solar-get-number | |
126 "Enter latitude (decimal fraction; + north, - south): "))) | |
127 (if (not calendar-time-zone) | |
128 (setq calendar-time-zone | |
129 (solar-get-number | |
3779
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
130 "Enter difference from Coordinated Universal Time (in minutes): ")))) |
956 | 131 |
132 (defun solar-get-number (prompt) | |
133 "Return a number from the minibuffer, prompting with PROMPT. | |
134 Returns nil if nothing was entered." | |
135 (let ((x (read-string prompt ""))) | |
136 (if (not (string-equal x "")) | |
137 (string-to-int x)))) | |
138 | |
139 (defun solar-sin-degrees (x) | |
140 (sin (degrees-to-radians x))) | |
141 | |
142 (defun solar-cosine-degrees (x) | |
143 (cos (degrees-to-radians x))) | |
144 | |
145 (defun solar-tangent-degrees (x) | |
146 (tan (degrees-to-radians x))) | |
147 | |
148 (defun solar-xy-to-quadrant (x y) | |
149 "Determines the quadrant of the point X, Y." | |
150 (if (> x 0) | |
151 (if (> y 0) 1 4) | |
152 (if (> y 0) 2 3))) | |
153 | |
154 (defun solar-degrees-to-quadrant (angle) | |
155 "Determines the quadrant of ANGLE." | |
4660
2516bc453477
Use integers instead of floating point where they will do.
Paul Eggert <eggert@twinsun.com>
parents:
4657
diff
changeset
|
156 (1+ (floor (mod angle 360) 90))) |
956 | 157 |
158 (defun solar-arctan (x quad) | |
159 "Arctangent of X in quadrant QUAD." | |
160 (let ((deg (radians-to-degrees (atan x)))) | |
161 (cond ((equal quad 2) (+ deg 180)) | |
162 ((equal quad 3) (+ deg 180)) | |
163 ((equal quad 4) (+ deg 360)) | |
164 (t deg)))) | |
165 | |
166 (defun solar-arccos (x) | |
167 (let ((y (sqrt (- 1 (* x x))))) | |
168 (solar-arctan (/ y x) (solar-xy-to-quadrant x y)))) | |
169 | |
170 (defun solar-arcsin (y) | |
171 (let ((x (sqrt (- 1 (* y y))))) | |
172 (solar-arctan (/ y x) (solar-xy-to-quadrant x y)))) | |
173 | |
174 (defconst solar-earth-inclination 23.441884 | |
175 "Inclination of earth's equator to its solar orbit in degrees.") | |
176 | |
177 (defconst solar-cos-inclination (solar-cosine-degrees solar-earth-inclination) | |
178 "Cosine of earth's inclination.") | |
179 | |
180 (defconst solar-sin-inclination (solar-sin-degrees solar-earth-inclination) | |
181 "Sine of earth's inclination.") | |
182 | |
183 (defconst solar-earth-orbit-eccentricity 0.016718 | |
184 "Eccentricity of orbit of the earth around the sun.") | |
185 | |
186 (defmacro solar-degrees-to-hours (deg) | |
187 (list '/ deg 15)) | |
188 | |
189 (defmacro solar-hours-to-days (hour) | |
190 (list '/ hour 24)) | |
191 | |
192 (defun solar-longitude-of-sun (day) | |
193 "Longitude of the sun at DAY in the year." | |
194 (let ((mean-anomaly (- (* 0.9856 day) 3.289))) | |
4519
c8f5e05c332e
(siolar-mode): Remove, since mod now subsumes it. ALl callers changed.
Paul Eggert <eggert@twinsun.com>
parents:
3907
diff
changeset
|
195 (mod (+ mean-anomaly |
c8f5e05c332e
(siolar-mode): Remove, since mod now subsumes it. ALl callers changed.
Paul Eggert <eggert@twinsun.com>
parents:
3907
diff
changeset
|
196 (* 1.916 (solar-sin-degrees mean-anomaly)) |
c8f5e05c332e
(siolar-mode): Remove, since mod now subsumes it. ALl callers changed.
Paul Eggert <eggert@twinsun.com>
parents:
3907
diff
changeset
|
197 (* 0.020 (solar-sin-degrees (* 2 mean-anomaly))) |
c8f5e05c332e
(siolar-mode): Remove, since mod now subsumes it. ALl callers changed.
Paul Eggert <eggert@twinsun.com>
parents:
3907
diff
changeset
|
198 282.634) |
4660
2516bc453477
Use integers instead of floating point where they will do.
Paul Eggert <eggert@twinsun.com>
parents:
4657
diff
changeset
|
199 360))) |
956 | 200 |
201 (defun solar-right-ascension (longitude) | |
202 "Right ascension of the sun, given its LONGITUDE." | |
203 (solar-degrees-to-hours | |
204 (solar-arctan | |
205 (* solar-cos-inclination (solar-tangent-degrees longitude)) | |
206 (solar-degrees-to-quadrant longitude)))) | |
207 | |
208 (defun solar-declination (longitude) | |
209 "Declination of the sun, given its LONGITUDE." | |
210 (solar-arcsin | |
211 (* solar-sin-inclination | |
212 (solar-sin-degrees longitude)))) | |
213 | |
214 (defun solar-sunrise (date) | |
215 "Calculates the *standard* time of sunrise for Gregorian DATE for location | |
216 given by `calendar-latitude' and `calendar-longitude'. Returns a decimal fraction | |
217 of hours. Returns nil if the sun does not rise at that location on that day." | |
218 (let* ((day-of-year (calendar-day-number date)) | |
219 (approx-sunrise | |
220 (+ day-of-year | |
221 (solar-hours-to-days | |
222 (- 6 (solar-degrees-to-hours calendar-longitude))))) | |
223 (solar-longitude-of-sun-at-sunrise | |
224 (solar-longitude-of-sun approx-sunrise)) | |
225 (solar-right-ascension-at-sunrise | |
226 (solar-right-ascension solar-longitude-of-sun-at-sunrise)) | |
227 (solar-declination-at-sunrise | |
228 (solar-declination solar-longitude-of-sun-at-sunrise)) | |
229 (cos-local-sunrise | |
230 (/ (- (solar-cosine-degrees (+ 90 (/ 50.0 60.0))) | |
231 (* (solar-sin-degrees solar-declination-at-sunrise) | |
232 (solar-sin-degrees calendar-latitude))) | |
233 (* (solar-cosine-degrees solar-declination-at-sunrise) | |
234 (solar-cosine-degrees calendar-latitude))))) | |
235 (if (<= (abs cos-local-sunrise) 1);; otherwise, no sunrise that day | |
236 (let* ((local-sunrise (solar-degrees-to-hours | |
237 (- 360 (solar-arccos cos-local-sunrise)))) | |
238 (local-mean-sunrise | |
4519
c8f5e05c332e
(siolar-mode): Remove, since mod now subsumes it. ALl callers changed.
Paul Eggert <eggert@twinsun.com>
parents:
3907
diff
changeset
|
239 (mod (- (+ local-sunrise solar-right-ascension-at-sunrise) |
c8f5e05c332e
(siolar-mode): Remove, since mod now subsumes it. ALl callers changed.
Paul Eggert <eggert@twinsun.com>
parents:
3907
diff
changeset
|
240 (+ (* 0.065710 approx-sunrise) |
c8f5e05c332e
(siolar-mode): Remove, since mod now subsumes it. ALl callers changed.
Paul Eggert <eggert@twinsun.com>
parents:
3907
diff
changeset
|
241 6.622)) |
4660
2516bc453477
Use integers instead of floating point where they will do.
Paul Eggert <eggert@twinsun.com>
parents:
4657
diff
changeset
|
242 24))) |
956 | 243 (+ (- local-mean-sunrise (solar-degrees-to-hours calendar-longitude)) |
244 (/ calendar-time-zone 60.0)))))) | |
245 | |
246 (defun solar-sunset (date) | |
247 "Calculates the *standard* time of sunset for Gregorian DATE for location | |
248 given by `calendar-latitude' and `calendar-longitude'. Returns a decimal fractions | |
249 of hours. Returns nil if the sun does not set at that location on that day." | |
250 (let* ((day-of-year (calendar-day-number date)) | |
251 (approx-sunset | |
252 (+ day-of-year | |
253 (solar-hours-to-days | |
254 (- 18 (solar-degrees-to-hours calendar-longitude))))) | |
255 (solar-longitude-of-sun-at-sunset | |
256 (solar-longitude-of-sun approx-sunset)) | |
257 (solar-right-ascension-at-sunset | |
258 (solar-right-ascension solar-longitude-of-sun-at-sunset)) | |
259 (solar-declination-at-sunset | |
260 (solar-declination solar-longitude-of-sun-at-sunset)) | |
261 (cos-local-sunset | |
262 (/ (- (solar-cosine-degrees (+ 90 (/ 50.0 60.0))) | |
263 (* (solar-sin-degrees solar-declination-at-sunset) | |
264 (solar-sin-degrees calendar-latitude))) | |
265 (* (solar-cosine-degrees solar-declination-at-sunset) | |
266 (solar-cosine-degrees calendar-latitude))))) | |
267 (if (<= (abs cos-local-sunset) 1);; otherwise, no sunset that day | |
268 (let* ((local-sunset (solar-degrees-to-hours | |
269 (solar-arccos cos-local-sunset))) | |
270 (local-mean-sunset | |
4519
c8f5e05c332e
(siolar-mode): Remove, since mod now subsumes it. ALl callers changed.
Paul Eggert <eggert@twinsun.com>
parents:
3907
diff
changeset
|
271 (mod (- (+ local-sunset solar-right-ascension-at-sunset) |
c8f5e05c332e
(siolar-mode): Remove, since mod now subsumes it. ALl callers changed.
Paul Eggert <eggert@twinsun.com>
parents:
3907
diff
changeset
|
272 (+ (* 0.065710 approx-sunset) 6.622)) |
4660
2516bc453477
Use integers instead of floating point where they will do.
Paul Eggert <eggert@twinsun.com>
parents:
4657
diff
changeset
|
273 24))) |
956 | 274 (+ (- local-mean-sunset (solar-degrees-to-hours calendar-longitude)) |
275 (/ calendar-time-zone 60.0)))))) | |
276 | |
3779
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
277 (defun solar-time-string (time date &optional style) |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
278 "Printable form for decimal fraction *standard* TIME on DATE. |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
279 Optional parameter STYLE forces the time to be standard time when its value |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
280 is 'standard and daylight savings time (if available) when its value is |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
281 'daylight. |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
282 |
956 | 283 Format used is given by `calendar-time-display-form'. Converted to daylight |
3779
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
284 savings time according to `calendar-daylight-savings-starts', |
4657 | 285 `calendar-daylight-savings-ends', `calendar-daylight-savings-starts-time', |
286 `calendar-daylight-savings-ends-time', and `calendar-daylight-savings-offset'." | |
956 | 287 (let* ((year (extract-calendar-year date)) |
3866
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
288 (time (round (* 60 time))) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
289 (rounded-abs-date (+ (calendar-absolute-from-gregorian date) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
290 (/ time 60.0 24.0))) |
3779
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
291 (dst-starts (and calendar-daylight-savings-starts |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
292 (+ (calendar-absolute-from-gregorian |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
293 (eval calendar-daylight-savings-starts)) |
4657 | 294 (/ calendar-daylight-savings-starts-time |
3866
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
295 60.0 24.0)))) |
3779
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
296 (dst-ends (and calendar-daylight-savings-ends |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
297 (+ (calendar-absolute-from-gregorian |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
298 (eval calendar-daylight-savings-ends)) |
4657 | 299 (/ (- calendar-daylight-savings-ends-time |
3866
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
300 calendar-daylight-time-offset) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
301 60.0 24.0)))) |
3779
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
302 (dst (and (not (eq style 'standard)) |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
303 (or (eq style 'daylight) |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
304 (and dst-starts dst-ends |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
305 (or (and (< dst-starts dst-ends);; northern hemi. |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
306 (<= dst-starts rounded-abs-date) |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
307 (< rounded-abs-date dst-ends)) |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
308 (and (< dst-ends dst-starts);; southern hemi. |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
309 (or (< rounded-abs-date dst-ends) |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
310 (<= dst-starts rounded-abs-date))))) |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
311 (and dst-starts (not dst-ends) |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
312 (<= dst-starts rounded-abs-date)) |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
313 (and dst-ends (not dst-starts) |
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
314 (< rounded-abs-date dst-ends))))) |
956 | 315 (time-zone (if dst |
316 calendar-daylight-time-zone-name | |
317 calendar-standard-time-zone-name)) | |
3866
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
318 (time (+ time (if dst calendar-daylight-time-offset 0))) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
319 (24-hours (/ time 60)) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
320 (minutes (format "%02d" (% time 60))) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
321 (12-hours (format "%d" (1+ (% (+ 24-hours 11) 12)))) |
956 | 322 (am-pm (if (>= 24-hours 12) "pm" "am")) |
323 (24-hours (format "%02d" 24-hours))) | |
324 (mapconcat 'eval calendar-time-display-form ""))) | |
325 | |
326 (defun solar-sunrise-sunset (date) | |
327 "String giving local times of sunrise and sunset on Gregorian DATE." | |
328 (let ((rise (solar-sunrise date)) | |
329 (set (solar-sunset date))) | |
330 (format "%s, %s at %s" | |
331 (if rise | |
332 (concat "Sunrise " (solar-time-string rise date)) | |
333 "No sunrise") | |
334 (if set | |
335 (concat "sunset " (solar-time-string set date)) | |
336 "no sunset") | |
337 (eval calendar-location-name)))) | |
338 | |
339 (defun solar-apparent-longitude-of-sun (date) | |
340 "Apparent longitude of the sun on Gregorian DATE." | |
341 (let* ((time (/ (- (calendar-absolute-from-gregorian date) | |
342 (calendar-absolute-from-gregorian '(1 0.5 1900))) | |
343 36525)) | |
344 (l (+ 279.69668 | |
345 (* 36000.76892 time) | |
346 (* 0.0003025 time time))) | |
347 (m (+ 358.47583 | |
348 (* 35999.04975 time) | |
349 (* -0.000150 time time) | |
350 (* -0.0000033 time time time))) | |
351 (c (+ (* (+ 1.919460 | |
352 (* -0.004789 time) | |
353 (* -0.000014 time time)) | |
354 (solar-sin-degrees m)) | |
355 (* (+ 0.020094 | |
356 (* -0.000100 time)) | |
357 (solar-sin-degrees (* 2 m))) | |
358 (* 0.000293 | |
359 (solar-sin-degrees (* 3 m))))) | |
360 (L (+ l c)) | |
361 (omega (+ 259.18 | |
362 (* -1934.142 time))) | |
363 (app (+ L | |
364 -0.00569 | |
365 (* -0.00479 | |
366 (solar-sin-degrees omega))))) | |
367 app)) | |
368 | |
369 (defun solar-ephemeris-correction (year) | |
3779
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
370 "Difference in minutes between Ephemeris time and UTC in YEAR. |
956 | 371 Value is only an approximation." |
372 (let ((T (/ (- year 1900) 100.0))) | |
373 (+ 0.41 (* 1.2053 T) (* 0.4992 T T)))) | |
374 | |
375 (defun solar-equinoxes/solstices (k year) | |
376 "Date of equinox/solstice K for YEAR. K=0, spring equinox; K=1, summer | |
377 solstice; K=2, fall equinox; K=3, winter solstice. Accurate to within | |
378 several minutes." | |
379 (let ((date (list (+ 3 (* k 3)) 21 year)) | |
3866
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
380 app |
956 | 381 (correction 1000)) |
382 (while (> correction 0.00001) | |
4660
2516bc453477
Use integers instead of floating point where they will do.
Paul Eggert <eggert@twinsun.com>
parents:
4657
diff
changeset
|
383 (setq app (mod (solar-apparent-longitude-of-sun date) 360)) |
956 | 384 (setq correction (* 58 (solar-sin-degrees (- (* k 90) app)))) |
385 (setq date (list (extract-calendar-month date) | |
386 (+ (extract-calendar-day date) correction) | |
387 year))) | |
388 (list (extract-calendar-month date) | |
389 (+ (extract-calendar-day date) (/ calendar-time-zone 60.0 24.0) | |
390 (- (/ (solar-ephemeris-correction year) 60.0 24.0))) | |
391 year))) | |
392 | |
393 ;;;###autoload | |
394 (defun sunrise-sunset (&optional arg) | |
395 "Local time of sunrise and sunset for today. Accurate to +/- 2 minutes. | |
396 If called with an optional prefix argument, prompts for date. | |
397 | |
398 If called with an optional double prefix argument, prompts for longitude, | |
399 latitude, time zone, and date. | |
400 | |
401 This function is suitable for execution in a .emacs file." | |
402 (interactive "p") | |
998 | 403 (if (and (< arg 16) |
404 (not (and calendar-latitude calendar-longitude calendar-time-zone))) | |
405 (solar-setup)) | |
956 | 406 (let* ((calendar-longitude |
998 | 407 (if (< arg 16) calendar-longitude |
956 | 408 (solar-get-number |
409 "Enter longitude (decimal fraction; + east, - west): "))) | |
410 (calendar-latitude | |
998 | 411 (if (< arg 16) calendar-latitude |
956 | 412 (solar-get-number |
413 "Enter latitude (decimal fraction; + north, - south): "))) | |
414 (calendar-time-zone | |
998 | 415 (if (< arg 16) calendar-time-zone |
956 | 416 (solar-get-number |
3779
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
417 "Enter difference from Coordinated Universal Time (in minutes): "))) |
956 | 418 (calendar-location-name |
998 | 419 (if (< arg 16) calendar-location-name |
420 (let ((float-output-format "%.1f")) | |
421 (format "%s%s, %s%s" | |
422 (abs calendar-latitude) | |
423 (if (> calendar-latitude 0) "N" "S") | |
424 (abs calendar-longitude) | |
425 (if (> calendar-longitude 0) "E" "W"))))) | |
956 | 426 (calendar-standard-time-zone-name |
998 | 427 (if (< arg 16) calendar-standard-time-zone-name |
3866
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
428 (cond ((= calendar-time-zone 0) "UTC") |
998 | 429 ((< calendar-time-zone 0) |
3866
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
430 (format "UTC%dmin" calendar-time-zone)) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
431 (t (format "UTC+%dmin" calendar-time-zone))))) |
998 | 432 (calendar-daylight-savings-starts |
433 (if (< arg 16) calendar-daylight-savings-starts)) | |
434 (calendar-daylight-savings-ends | |
435 (if (< arg 16) calendar-daylight-savings-ends)) | |
436 (date (if (< arg 4) (calendar-current-date) (calendar-read-date))) | |
956 | 437 (date-string (calendar-date-string date t)) |
438 (time-string (solar-sunrise-sunset date)) | |
439 (msg (format "%s: %s" date-string time-string)) | |
440 (one-window (one-window-p t))) | |
4651
7ca17b5fd85e
* solar.el (solar-sunrise, solar-sunset, solar-longitude-of-sun):
Jim Blandy <jimb@redhat.com>
parents:
4519
diff
changeset
|
441 (if (<= (length msg) (frame-width)) |
956 | 442 (message msg) |
443 (with-output-to-temp-buffer "*temp*" | |
444 (princ (concat date-string "\n" time-string))) | |
445 (message (substitute-command-keys | |
446 (if one-window | |
447 (if pop-up-windows | |
448 "Type \\[delete-other-windows] to remove temp window." | |
449 "Type \\[switch-to-buffer] RET to remove temp window.") | |
450 "Type \\[switch-to-buffer-other-window] RET to restore old contents of temp window.")))))) | |
451 | |
452 (defun calendar-sunrise-sunset () | |
453 "Local time of sunrise and sunset for date under cursor. | |
454 Accurate to +/- 2 minutes." | |
455 (interactive) | |
456 (if (not (and calendar-latitude calendar-longitude calendar-time-zone)) | |
457 (solar-setup)) | |
458 (message | |
459 (solar-sunrise-sunset | |
460 (or (calendar-cursor-to-date) | |
461 (error "Cursor is not on a date!"))))) | |
462 | |
463 (defun diary-sunrise-sunset () | |
464 "Local time of sunrise and sunset as a diary entry. | |
465 Accurate to +/- 2 minutes." | |
466 (if (not (and calendar-latitude calendar-longitude calendar-time-zone)) | |
467 (solar-setup)) | |
468 (solar-sunrise-sunset date)) | |
469 | |
470 (defun diary-sabbath-candles () | |
471 "Local time of candle lighting diary entry--applies if date is a Friday. | |
472 No diary entry if there is no sunset on that date." | |
473 (if (not (and calendar-latitude calendar-longitude calendar-time-zone)) | |
474 (solar-setup)) | |
475 (if (= (% (calendar-absolute-from-gregorian date) 7) 5);; Friday | |
476 (let* ((sunset (solar-sunset date)) | |
477 (light (if sunset (- sunset (/ 18.0 60.0))))) | |
478 (if light (format "%s Sabbath candle lighting" | |
479 (solar-time-string light date)))))) | |
480 | |
3866
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
481 (defun solar-equinoxes-solstices () |
956 | 482 "Date and time of equinoxes and solstices, if visible in the calendar window. |
483 Requires floating point." | |
3866
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
484 (let ((m displayed-month) |
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
485 (y displayed-year)) |
956 | 486 (increment-calendar-month m y (cond ((= 1 (% m 3)) -1) |
487 ((= 2 (% m 3)) 1) | |
488 (t 0))) | |
489 (let* ((calendar-standard-time-zone-name | |
3866
c97c63c1a920
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
Jim Blandy <jimb@redhat.com>
parents:
3779
diff
changeset
|
490 (if calendar-time-zone calendar-standard-time-zone-name "UTC")) |
956 | 491 (calendar-daylight-savings-starts |
492 (if calendar-time-zone calendar-daylight-savings-starts)) | |
493 (calendar-daylight-savings-ends | |
494 (if calendar-time-zone calendar-daylight-savings-ends)) | |
495 (calendar-time-zone (if calendar-time-zone calendar-time-zone 0)) | |
496 (k (1- (/ m 3))) | |
497 (date (solar-equinoxes/solstices k y)) | |
498 (day (extract-calendar-day date)) | |
499 (time (* 24 (- day (truncate day)))) | |
4660
2516bc453477
Use integers instead of floating point where they will do.
Paul Eggert <eggert@twinsun.com>
parents:
4657
diff
changeset
|
500 (s-hemi (and calendar-latitude (< calendar-latitude 0))) |
956 | 501 ;; Time zone/DST can't move the date out of range, |
502 ;; so let solar-time-string do the conversion. | |
503 (date (list (extract-calendar-month date) | |
504 (truncate day) | |
505 (extract-calendar-year date)))) | |
4766
ec8c8721b7e3
(s-hemi-seasons n-hemi-seasons): New constants are hemisphere
Brian Fox <bfox@gnu.org>
parents:
4660
diff
changeset
|
506 (list (list date |
ec8c8721b7e3
(s-hemi-seasons n-hemi-seasons): New constants are hemisphere
Brian Fox <bfox@gnu.org>
parents:
4660
diff
changeset
|
507 (format "%s %s" |
4863
adfd03a381ca
(solar-n-hemi-seasons, solar-s-hemi-seasons): New vars.
Richard M. Stallman <rms@gnu.org>
parents:
4766
diff
changeset
|
508 (nth k (if s-hemi solar-s-hemi-seasons |
adfd03a381ca
(solar-n-hemi-seasons, solar-s-hemi-seasons): New vars.
Richard M. Stallman <rms@gnu.org>
parents:
4766
diff
changeset
|
509 solar-n-hemi-seasons)) |
4766
ec8c8721b7e3
(s-hemi-seasons n-hemi-seasons): New constants are hemisphere
Brian Fox <bfox@gnu.org>
parents:
4660
diff
changeset
|
510 (solar-time-string time date))))))) |
956 | 511 |
512 (provide 'solar) | |
513 | |
514 ;;; solar.el ends here |