Mercurial > emacs
changeset 92822:3e5b1792e433
(solar-moment, solar-exact-local-noon)
(solar-sunrise-sunset, solar-sunrise-sunset-string)
(solar-ephemeris-time, solar-date-next-longitude, solar-sidereal-time):
(diary-sabbath-candles, solar-equinoxes/solstices)
(solar-equinoxes-solstices): Use cadr, cdar, nth, zerop.
(solar-time-equation, solar-date-to-et): Simplify.
| author | Glenn Morris <rgm@gnu.org> |
|---|---|
| date | Thu, 13 Mar 2008 04:04:14 +0000 |
| parents | d2480af27611 |
| children | 8fb3c7b3e53a |
| files | lisp/calendar/solar.el |
| diffstat | 1 files changed, 234 insertions(+), 248 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/calendar/solar.el Thu Mar 13 03:57:31 2008 +0000 +++ b/lisp/calendar/solar.el Thu Mar 13 04:04:14 2008 +0000 @@ -4,11 +4,10 @@ ;; 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> -;; Denis B. Roegel <Denis.Roegel@loria.fr> +;; Denis B. Roegel <Denis.Roegel@loria.fr> ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar -;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary, -;; holidays +;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary, holidays ;; This file is part of GNU Emacs. @@ -68,7 +67,7 @@ (defcustom calendar-time-display-form '(12-hours ":" minutes am-pm - (if time-zone " (") time-zone (if time-zone ")")) + (if time-zone " (") time-zone (if time-zone ")")) "The pseudo-pattern that governs the way a time of day is formatted. A pseudo-pattern is a list of expressions that can involve the keywords @@ -93,13 +92,13 @@ This variable should be set in `site-start'.el." :type '(choice (const nil) - (number :tag "Exact") - (vector :value [0 0 north] - (integer :tag "Degrees") - (integer :tag "Minutes") - (choice :tag "Position" - (const north) - (const south)))) + (number :tag "Exact") + (vector :value [0 0 north] + (integer :tag "Degrees") + (integer :tag "Minutes") + (choice :tag "Position" + (const north) + (const south)))) :group 'calendar) (defcustom calendar-longitude nil @@ -111,13 +110,13 @@ This variable should be set in `site-start'.el." :type '(choice (const nil) - (number :tag "Exact") - (vector :value [0 0 west] - (integer :tag "Degrees") - (integer :tag "Minutes") - (choice :tag "Position" - (const east) - (const west)))) + (number :tag "Exact") + (vector :value [0 0 west] + (integer :tag "Degrees") + (integer :tag "Minutes") + (choice :tag "Position" + (const east) + (const west)))) :group 'calendar) (defcustom calendar-location-name @@ -146,7 +145,7 @@ :group 'calendar) (defcustom solar-error 0.5 -"Tolerance (in minutes) for sunrise/sunset calculations. + "Tolerance (in minutes) for sunrise/sunset calculations. A larger value makes the calculations for sunrise/sunset faster, but less accurate. The default is half a minute (30 seconds), so that sunrise/sunset @@ -179,8 +178,8 @@ "List of season changes for the southern hemisphere.") (defvar solar-sidereal-time-greenwich-midnight - nil - "Sidereal time at Greenwich at midnight (universal time).") + nil + "Sidereal time at Greenwich at midnight (universal time).") (defvar solar-northern-spring-or-summer-season nil "Non-nil if northern spring or summer and nil otherwise. @@ -202,7 +201,7 @@ (if (numberp calendar-longitude) calendar-longitude (let ((long (+ (aref calendar-longitude 0) - (/ (aref calendar-longitude 1) 60.0)))) + (/ (aref calendar-longitude 1) 60.0)))) (if (equal (aref calendar-longitude 2) 'east) long (- long))))) @@ -221,8 +220,8 @@ (or calendar-time-zone (setq calendar-time-zone (solar-get-number - "Enter difference from Coordinated Universal Time (in \ -minutes): ")))) + "Enter difference from Coordinated Universal Time (in minutes): ") + ))) (defun solar-get-number (prompt) "Return a number from the minibuffer, prompting with PROMPT. @@ -247,7 +246,7 @@ "Determine the quadrant of the point X, Y." (if (> x 0) (if (> y 0) 1 4) - (if (> y 0) 2 3))) + (if (> y 0) 2 3))) (defun solar-degrees-to-quadrant (angle) "Determine the quadrant of ANGLE degrees." @@ -256,16 +255,16 @@ (defun solar-arctan (x quad) "Arctangent of X in quadrant QUAD." (let ((deg (radians-to-degrees (atan x)))) - (cond ((equal quad 2) (+ deg 180)) - ((equal quad 3) (+ deg 180)) - ((equal quad 4) (+ deg 360)) - (t deg)))) + (cond ((equal quad 2) (+ deg 180)) + ((equal quad 3) (+ deg 180)) + ((equal quad 4) (+ deg 360)) + (t deg)))) (defun solar-atn2 (x y) - "Arctangent of point X, Y." - (if (zerop x) - (if (> y 0) 90 270) - (solar-arctan (/ y x) (solar-xy-to-quadrant x y)))) + "Arctangent of point X, Y." + (if (zerop x) + (if (> y 0) 90 270) + (solar-arctan (/ y x) (solar-xy-to-quadrant x y)))) (defun solar-arccos (x) "Arccosine of X." @@ -325,7 +324,7 @@ (and (< latitude 0) (not solar-northern-spring-or-summer-season))) (setq day-length 24) - (setq day-length 0)) + (setq day-length 0)) (setq day-length (- set-time rise-time))) (list (if rise-time (+ rise-time (/ calendar-time-zone 60.0)) nil) (if set-time (+ set-time (/ calendar-time-zone 60.0)) nil) @@ -347,7 +346,7 @@ accounting for the edge of the sun being on the horizon. Uses binary search." - (let* ((ut (car (cdr time))) + (let* ((ut (cadr time)) (possible t) ; we assume that rise or set are possible (utmin (+ ut (* direction 12.0))) (utmax ut) ; the time searched is between utmin and utmax @@ -356,41 +355,37 @@ (utmoment 1.0) ; rise or set approximation (hut 0) ; sun height at utmoment (t0 (car time)) - (hmin (car (cdr - (solar-horizontal-coordinates (list t0 utmin) - latitude longitude t)))) - (hmax (car (cdr - (solar-horizontal-coordinates (list t0 utmax) - latitude longitude t))))) + (hmin (cadr (solar-horizontal-coordinates (list t0 utmin) + latitude longitude t))) + (hmax (cadr (solar-horizontal-coordinates (list t0 utmax) + latitude longitude t)))) ;; -0.61 degrees is the height of the middle of the sun, when it ;; rises or sets. - (if (< hmin height) - (if (> hmax height) - (while ;;; (< i 20) ; we perform a simple dichotomy - ;;; (> (abs (- hut height)) epsilon) - (>= (abs (- utmoment utmoment-old)) - (/ solar-error 60)) - (setq utmoment-old utmoment) - (setq utmoment (/ (+ utmin utmax) 2)) - (setq hut (car (cdr - (solar-horizontal-coordinates - (list t0 utmoment) latitude longitude t)))) - (if (< hut height) (setq utmin utmoment)) - (if (> hut height) (setq utmax utmoment)) - ) - (setq possible nil)) ; the sun never rises - (setq possible nil)) ; the sun never sets - (if (not possible) nil utmoment))) + (if (< hmin height) + (if (> hmax height) + (while ;;; (< i 20) ; we perform a simple dichotomy +;;; (> (abs (- hut height)) epsilon) + (>= (abs (- utmoment utmoment-old)) + (/ solar-error 60)) + (setq utmoment-old utmoment + utmoment (/ (+ utmin utmax) 2) + hut (cadr (solar-horizontal-coordinates + (list t0 utmoment) latitude longitude t))) + (if (< hut height) (setq utmin utmoment)) + (if (> hut height) (setq utmax utmoment))) + (setq possible nil)) ; the sun never rises + (setq possible nil)) ; the sun never sets + (if possible utmoment))) (defun solar-time-string (time time-zone) "Printable form for decimal fraction TIME in TIME-ZONE. Format used is given by `calendar-time-display-form'." (let* ((time (round (* 60 time))) - (24-hours (/ time 60)) - (minutes (format "%02d" (% time 60))) - (12-hours (format "%d" (1+ (% (+ 24-hours 11) 12)))) - (am-pm (if (>= 24-hours 12) "pm" "am")) - (24-hours (format "%02d" 24-hours))) + (24-hours (/ time 60)) + (minutes (format "%02d" (% time 60))) + (12-hours (format "%d" (1+ (% (+ 24-hours 11) 12)))) + (am-pm (if (>= 24-hours 12) "pm" "am")) + (24-hours (format "%02d" 24-hours))) (mapconcat 'eval calendar-time-display-form ""))) @@ -409,18 +404,15 @@ (te (solar-time-equation date ut))) (setq ut (- ut te)) (if (>= ut 24) - (progn - (setq nd (list (car date) (+ 1 (car (cdr date))) - (car (cdr (cdr date))))) - (setq ut (- ut 24)))) + (setq nd (list (car date) (1+ (cadr date)) + (nth 2 date)) + ut (- ut 24))) (if (< ut 0) - (progn - (setq nd (list (car date) (- (car (cdr date)) 1) - (car (cdr (cdr date))))) - (setq ut (+ ut 24)))) - (setq nd (calendar-gregorian-from-absolute - (calendar-absolute-from-gregorian nd))) - ; date standardization + (setq nd (list (car date) (1- (cadr date)) + (nth 2 date)) + ut (+ ut 24))) + (setq nd (calendar-gregorian-from-absolute ; date standardization + (calendar-absolute-from-gregorian nd))) (list nd ut))) (defun solar-sunrise-sunset (date) @@ -436,7 +428,7 @@ (progn (setq solar-sidereal-time-greenwich-midnight (solar-sidereal-time t0)) (solar-sunrise-and-sunset - (list t0 (car (cdr exact-local-noon))) + (list t0 (cadr exact-local-noon)) 1.0 (calendar-longitude) 0))) ;; Store the spring/summer information, compute sunrise and @@ -446,16 +438,16 @@ (rise-set (progn (setq solar-northern-spring-or-summer-season - (if (> (car (cdr (cdr equator-rise-set))) 12) t nil)) + (> (nth 2 equator-rise-set) 12)) (solar-sunrise-and-sunset - (list t0 (car (cdr exact-local-noon))) + (list t0 (cadr exact-local-noon)) (calendar-latitude) (calendar-longitude) -0.61))) (rise (car rise-set)) - (adj-rise (if rise (dst-adjust-time date rise) nil)) - (set (car (cdr rise-set))) - (adj-set (if set (dst-adjust-time date set) nil)) - (length (car (cdr (cdr rise-set)))) ) + (adj-rise (if rise (dst-adjust-time date rise))) + (set (cadr rise-set)) ; FIXME ? + (adj-set (if set (dst-adjust-time date set))) + (length (nth 2 rise-set))) (list (and rise (calendar-date-equal date (car adj-rise)) (cdr adj-rise)) (and set (calendar-date-equal date (car adj-set)) (cdr adj-set)) @@ -469,11 +461,11 @@ (if (car l) (concat "Sunrise " (apply 'solar-time-string (car l))) "No sunrise") - (if (car (cdr l)) - (concat "sunset " (apply 'solar-time-string (car (cdr l)))) + (if (cadr l) + (concat "sunset " (apply 'solar-time-string (cadr l))) "no sunset") (eval calendar-location-name) - (car (cdr (cdr l)))))) + (nth 2 l)))) (defun solar-julian-ut-centuries (date) "Number of Julian centuries since 1 Jan, 2000 at noon UT for Gregorian DATE." @@ -491,11 +483,11 @@ Result is in Julian centuries of ephemeris time." (let* ((t0 (car time)) - (ut (car (cdr time))) + (ut (cadr time)) (t1 (+ t0 (/ (/ ut 24.0) 36525))) (y (+ 2000 (* 100 t1))) (dt (* 86400 (solar-ephemeris-correction (floor y))))) - (+ t1 (/ (/ dt 86400) 36525)))) + (+ t1 (/ (/ dt 86400) 36525)))) (defun solar-date-next-longitude (d l) "First time after day D when solar longitude is a multiple of L degrees. @@ -518,15 +510,14 @@ ;; start-long <= next < end-long when next != 0 ;; when next = 0, we look for the discontinuity (start-long is near 360 ;; and end-long is small (less than l). - (setq d (/ (+ start end) 2.0)) - (setq long (solar-longitude d)) - (if (or (and (/= next 0) (< long next)) - (and (= next 0) (< l long))) - (progn - (setq start d) - (setq start-long long)) - (setq end d) - (setq end-long long))) + (setq d (/ (+ start end) 2.0) + long (solar-longitude d)) + (if (or (and (not (zerop next)) (< long next)) + (and (zerop next) (< l long))) + (setq start d + start-long long) + (setq end d + end-long long))) (/ (+ start end) 2.0))) (defun solar-horizontal-coordinates (time latitude longitude sunrise-flag) @@ -547,9 +538,9 @@ (ah (- (* st 15) (* 15 (car ec)) (* -1 (calendar-longitude)))) (de (cadr ec)) (azimuth (solar-atn2 (- (* (solar-cosine-degrees ah) - (solar-sin-degrees latitude)) - (* (solar-tangent-degrees de) - (solar-cosine-degrees latitude))) + (solar-sin-degrees latitude)) + (* (solar-tangent-degrees de) + (solar-cosine-degrees latitude))) (solar-sin-degrees ah))) (height (solar-arcsin (+ (* (solar-sin-degrees latitude) (solar-sin-degrees de)) @@ -568,10 +559,10 @@ -0.040945 being the number of Julian centuries elapsed between Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. SUNRISE-FLAG is passed to `solar-ecliptic-coordinates'." - (let* ((tm (solar-ephemeris-time time)) - (ec (solar-ecliptic-coordinates tm sunrise-flag))) - (list (solar-right-ascension (car ec) (car (cdr ec))) - (solar-declination (car ec) (car (cdr ec)))))) + (let* ((tm (solar-ephemeris-time time)) + (ec (solar-ecliptic-coordinates tm sunrise-flag))) + (list (solar-right-ascension (car ec) (car (cdr ec))) + (solar-declination (car ec) (car (cdr ec)))))) (defun solar-ecliptic-coordinates (time sunrise-flag) "Return solar longitude, ecliptic inclination, equation of time, nutation. @@ -623,12 +614,12 @@ ;; Equation of time, in hours. (time-eq (unless sunrise-flag (/ (* 12 (+ (* y (solar-sin-degrees (* 2 l))) - (* -2 ecc (solar-sin-degrees m)) - (* 4 ecc y (solar-sin-degrees m) - (solar-cosine-degrees (* 2 l))) - (* -0.5 y y (solar-sin-degrees (* 4 l))) - (* -1.25 ecc ecc (solar-sin-degrees (* 2 m))))) - 3.1415926535)))) + (* -2 ecc (solar-sin-degrees m)) + (* 4 ecc y (solar-sin-degrees m) + (solar-cosine-degrees (* 2 l))) + (* -0.5 y y (solar-sin-degrees (* 4 l))) + (* -1.25 ecc ecc (solar-sin-degrees (* 2 m))))) + 3.1415926535)))) (list app i time-eq nut))) (defconst solar-data-list @@ -712,11 +703,11 @@ (* 0.0000001 (apply '+ (mapcar (lambda (x) - (* (car x) - (sin (mod - (+ (car (cdr x)) - (* (car (cdr (cdr x))) U)) - (* 2 pi))))) + (* (car x) + (sin (mod + (+ (car (cdr x)) + (* (car (cdr (cdr x))) U)) + (* 2 pi))))) solar-data-list))))) (aberration (* 0.0000001 (- (* 17 (cos (+ 3.10 (* 62830.14 U)))) 973))) @@ -787,30 +778,27 @@ (defun solar-sidereal-time (t0) "Sidereal time (in hours) in Greenwich at T0 Julian centuries. T0 must correspond to 0 hours UT." - (let* ((mean-sid-time (+ 6.6973746 + (let* ((mean-sid-time (+ 6.6973746 (* 2400.051337 t0) (* 0.0000258622 t0 t0) (* -0.0000000017222 t0 t0 t0))) - (et (solar-ephemeris-time (list t0 0.0))) - (nut-i (solar-ecliptic-coordinates et nil)) - (nut (car (cdr (cdr (cdr nut-i))))) ; nutation - (i (car (cdr nut-i)))) ; inclination - (mod (+ (mod (+ mean-sid-time + (et (solar-ephemeris-time (list t0 0.0))) + (nut-i (solar-ecliptic-coordinates et nil)) + (nut (nth 3 nut-i)) ; nutation + (i (cadr nut-i))) ; inclination + (mod (+ (mod (+ mean-sid-time (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0) - 24.0) - 24.0))) + 24.0) + 24.0))) (defun solar-time-equation (date ut) "Equation of time expressed in hours at Gregorian DATE at Universal time UT." - (let* ((et (solar-date-to-et date ut)) - (ec (solar-ecliptic-coordinates et nil))) - (car (cdr (cdr ec))))) + (nth 2 (solar-ecliptic-coordinates (solar-date-to-et date ut) nil))) (defun solar-date-to-et (date ut) "Ephemeris Time at Gregorian DATE at Universal Time UT (in hours). Expressed in Julian centuries of Ephemeris Time." - (let ((t0 (solar-julian-ut-centuries date))) - (solar-ephemeris-time (list t0 ut)))) + (solar-ephemeris-time (list (solar-julian-ut-centuries date) ut))) ;;;###autoload (defun sunrise-sunset (&optional arg) @@ -820,68 +808,68 @@ longitude, latitude, time zone, and date, and always use standard time. This function is suitable for execution in a .emacs file." - (interactive "p") - (or arg (setq arg 1)) - (if (and (< arg 16) - (not (and calendar-latitude calendar-longitude calendar-time-zone))) - (solar-setup)) - (let* ((calendar-longitude - (if (< arg 16) calendar-longitude - (solar-get-number - "Enter longitude (decimal fraction; + east, - west): "))) - (calendar-latitude - (if (< arg 16) calendar-latitude - (solar-get-number - "Enter latitude (decimal fraction; + north, - south): "))) - (calendar-time-zone - (if (< arg 16) calendar-time-zone - (solar-get-number - "Enter difference from Coordinated Universal Time (in minutes): "))) - (calendar-location-name - (if (< arg 16) calendar-location-name - (let ((float-output-format "%.1f")) - (format "%s%s, %s%s" - (if (numberp calendar-latitude) - (abs calendar-latitude) - (+ (aref calendar-latitude 0) - (/ (aref calendar-latitude 1) 60.0))) - (if (numberp calendar-latitude) - (if (> calendar-latitude 0) "N" "S") - (if (equal (aref calendar-latitude 2) 'north) "N" "S")) - (if (numberp calendar-longitude) - (abs calendar-longitude) - (+ (aref calendar-longitude 0) - (/ (aref calendar-longitude 1) 60.0))) - (if (numberp calendar-longitude) - (if (> calendar-longitude 0) "E" "W") - (if (equal (aref calendar-longitude 2) 'east) - "E" "W")))))) - (calendar-standard-time-zone-name - (if (< arg 16) calendar-standard-time-zone-name - (cond ((= calendar-time-zone 0) "UTC") - ((< calendar-time-zone 0) - (format "UTC%dmin" calendar-time-zone)) - (t (format "UTC+%dmin" calendar-time-zone))))) - (calendar-daylight-savings-starts - (if (< arg 16) calendar-daylight-savings-starts)) - (calendar-daylight-savings-ends - (if (< arg 16) calendar-daylight-savings-ends)) - (date (if (< arg 4) (calendar-current-date) (calendar-read-date))) - (date-string (calendar-date-string date t)) - (time-string (solar-sunrise-sunset-string date)) - (msg (format "%s: %s" date-string time-string)) - (one-window (one-window-p t))) - (if (<= (length msg) (frame-width)) - (message "%s" msg) - (with-output-to-temp-buffer "*temp*" - (princ (concat date-string "\n" time-string))) - (message "%s" - (substitute-command-keys - (if one-window - (if pop-up-windows - "Type \\[delete-other-windows] to remove temp window." - "Type \\[switch-to-buffer] RET to remove temp window.") - "Type \\[switch-to-buffer-other-window] RET to restore old \ + (interactive "p") + (or arg (setq arg 1)) + (if (and (< arg 16) + (not (and calendar-latitude calendar-longitude calendar-time-zone))) + (solar-setup)) + (let* ((calendar-longitude + (if (< arg 16) calendar-longitude + (solar-get-number + "Enter longitude (decimal fraction; + east, - west): "))) + (calendar-latitude + (if (< arg 16) calendar-latitude + (solar-get-number + "Enter latitude (decimal fraction; + north, - south): "))) + (calendar-time-zone + (if (< arg 16) calendar-time-zone + (solar-get-number + "Enter difference from Coordinated Universal Time (in minutes): "))) + (calendar-location-name + (if (< arg 16) calendar-location-name + (let ((float-output-format "%.1f")) + (format "%s%s, %s%s" + (if (numberp calendar-latitude) + (abs calendar-latitude) + (+ (aref calendar-latitude 0) + (/ (aref calendar-latitude 1) 60.0))) + (if (numberp calendar-latitude) + (if (> calendar-latitude 0) "N" "S") + (if (equal (aref calendar-latitude 2) 'north) "N" "S")) + (if (numberp calendar-longitude) + (abs calendar-longitude) + (+ (aref calendar-longitude 0) + (/ (aref calendar-longitude 1) 60.0))) + (if (numberp calendar-longitude) + (if (> calendar-longitude 0) "E" "W") + (if (equal (aref calendar-longitude 2) 'east) + "E" "W")))))) + (calendar-standard-time-zone-name + (if (< arg 16) calendar-standard-time-zone-name + (cond ((= calendar-time-zone 0) "UTC") + ((< calendar-time-zone 0) + (format "UTC%dmin" calendar-time-zone)) + (t (format "UTC+%dmin" calendar-time-zone))))) + (calendar-daylight-savings-starts + (if (< arg 16) calendar-daylight-savings-starts)) + (calendar-daylight-savings-ends + (if (< arg 16) calendar-daylight-savings-ends)) + (date (if (< arg 4) (calendar-current-date) (calendar-read-date))) + (date-string (calendar-date-string date t)) + (time-string (solar-sunrise-sunset-string date)) + (msg (format "%s: %s" date-string time-string)) + (one-window (one-window-p t))) + (if (<= (length msg) (frame-width)) + (message "%s" msg) + (with-output-to-temp-buffer "*temp*" + (princ (concat date-string "\n" time-string))) + (message "%s" + (substitute-command-keys + (if one-window + (if pop-up-windows + "Type \\[delete-other-windows] to remove temp window." + "Type \\[switch-to-buffer] RET to remove temp window.") + "Type \\[switch-to-buffer-other-window] RET to restore old \ contents of temp window.")))))) (defun calendar-sunrise-sunset () @@ -914,16 +902,16 @@ use when highlighting the day in the calendar." (or (and calendar-latitude calendar-longitude calendar-time-zone) (solar-setup)) - (if (= (% (calendar-absolute-from-gregorian date) 7) 5) ; Friday - (let* ((sunset (car (cdr (solar-sunrise-sunset date)))) + (if (= (% (calendar-absolute-from-gregorian date) 7) 5) ; Friday + (let* ((sunset (cadr (solar-sunrise-sunset date))) (light (if sunset (cons (- (car sunset) (/ diary-sabbath-candles-minutes 60.0)) (cdr sunset))))) (if sunset (cons mark - (format "%s Sabbath candle lighting" - (apply 'solar-time-string light))))))) + (format "%s Sabbath candle lighting" + (apply 'solar-time-string light))))))) ;; From Meeus, 1991, page 167. (defconst solar-seasons-data @@ -962,22 +950,20 @@ (T (/ (- JDE0 2451545.0) 36525)) (W (- (* 35999.373 T) 2.47)) (Delta-lambda (+ 1 (* 0.0334 (solar-cosine-degrees W)) - (* 0.0007 (solar-cosine-degrees (* 2 W))))) + (* 0.0007 (solar-cosine-degrees (* 2 W))))) (S (apply '+ (mapcar (lambda(x) - (* (car x) (solar-cosine-degrees - (+ (* (car (cdr (cdr x))) T) - (car (cdr x)))))) + (* (car x) (solar-cosine-degrees + (+ (* (nth 2 x) T) (cadr x))))) solar-seasons-data))) (JDE (+ JDE0 (/ (* 0.00001 S) Delta-lambda))) ;; Ephemeris time correction. (correction (+ 102.3 (* 123.5 T) (* 32.5 T T))) (JD (- JDE (/ correction 86400))) (date (calendar-gregorian-from-absolute (floor (- JD 1721424.5)))) - (time (- (- JD 0.5) (floor (- JD 0.5)))) - ) - (list (car date) (+ (car (cdr date)) time - (/ (/ calendar-time-zone 60.0) 24.0)) - (car (cdr (cdr date)))))) + (time (- (- JD 0.5) (floor (- JD 0.5))))) + (list (car date) (+ (cadr date) time + (/ (/ calendar-time-zone 60.0) 24.0)) + (nth 2 date)))) ;; From Meeus, 1991, page 166. (defun solar-mean-equinoxes/solstices (k year) @@ -987,47 +973,47 @@ (let ((y (/ year 1000.0)) (z (/ (- year 2000) 1000.0))) (if (< year 1000) ; actually between -1000 and 1000 - (cond ((equal k 0) (+ 1721139.29189 - (* 365242.13740 y) - (* 0.06134 y y) - (* 0.00111 y y y) - (* -0.00071 y y y y))) - ((equal k 1) (+ 1721233.25401 - (* 365241.72562 y) - (* -0.05323 y y) - (* 0.00907 y y y) - (* 0.00025 y y y y))) - ((equal k 2) (+ 1721325.70455 - (* 365242.49558 y) - (* -0.11677 y y) - (* -0.00297 y y y) - (* 0.00074 y y y y))) - ((equal k 3) (+ 1721414.39987 - (* 365242.88257 y) - (* -0.00769 y y) - (* -0.00933 y y y) - (* -0.00006 y y y y)))) + (cond ((equal k 0) (+ 1721139.29189 + (* 365242.13740 y) + (* 0.06134 y y) + (* 0.00111 y y y) + (* -0.00071 y y y y))) + ((equal k 1) (+ 1721233.25401 + (* 365241.72562 y) + (* -0.05323 y y) + (* 0.00907 y y y) + (* 0.00025 y y y y))) + ((equal k 2) (+ 1721325.70455 + (* 365242.49558 y) + (* -0.11677 y y) + (* -0.00297 y y y) + (* 0.00074 y y y y))) + ((equal k 3) (+ 1721414.39987 + (* 365242.88257 y) + (* -0.00769 y y) + (* -0.00933 y y y) + (* -0.00006 y y y y)))) ; actually between 1000 and 3000 - (cond ((equal k 0) (+ 2451623.80984 - (* 365242.37404 z) - (* 0.05169 z z) - (* -0.00411 z z z) - (* -0.00057 z z z z))) - ((equal k 1) (+ 2451716.56767 - (* 365241.62603 z) - (* 0.00325 z z) - (* 0.00888 z z z) - (* -0.00030 z z z z))) - ((equal k 2) (+ 2451810.21715 - (* 365242.01767 z) - (* -0.11575 z z) - (* 0.00337 z z z) - (* 0.00078 z z z z))) - ((equal k 3) (+ 2451900.05952 - (* 365242.74049 z) - (* -0.06223 z z) - (* -0.00823 z z z) - (* 0.00032 z z z z))))))) + (cond ((equal k 0) (+ 2451623.80984 + (* 365242.37404 z) + (* 0.05169 z z) + (* -0.00411 z z z) + (* -0.00057 z z z z))) + ((equal k 1) (+ 2451716.56767 + (* 365241.62603 z) + (* 0.00325 z z) + (* 0.00888 z z z) + (* -0.00030 z z z z))) + ((equal k 2) (+ 2451810.21715 + (* 365242.01767 z) + (* -0.11575 z z) + (* 0.00337 z z z) + (* 0.00078 z z z z))) + ((equal k 3) (+ 2451900.05952 + (* 365242.74049 z) + (* -0.06223 z z) + (* -0.00823 z z z) + (* 0.00032 z z z z))))))) (defun solar-equinoxes-solstices () "Local date and time of equinoxes and solstices, if visible in the calendar. @@ -1035,8 +1021,8 @@ (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y (cond ((= 1 (% m 3)) -1) - ((= 2 (% m 3)) 1) - (t 0))) + ((= 2 (% m 3)) 1) + (t 0))) (let* ((calendar-standard-time-zone-name (if calendar-time-zone calendar-standard-time-zone-name "UTC")) (calendar-daylight-savings-starts @@ -1049,12 +1035,12 @@ (d1 (list (car d0) (floor (car (cdr d0))) (car (cdr (cdr d0))))) (h0 (* 24 (- (car (cdr d0)) (floor (car (cdr d0)))))) (adj (dst-adjust-time d1 h0)) - (d (list (car (car adj)) - (+ (car (cdr (car adj)) ) - (/ (car (cdr adj)) 24.0)) - (car (cdr (cdr (car adj)))))) + (d (list (caar adj) + (+ (car (cdar adj)) + (/ (cadr adj) 24.0)) + (cadr (cdar adj)))) ;; The following is nearly as accurate, but not quite: - ;; (d0 (solar-date-next-longitude + ;; (d0 (solar-date-next-longitude ;; (calendar-astro-from-absolute ;; (calendar-absolute-from-gregorian ;; (list (+ 3 (* k 3)) 15 y)))