X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/16cd607da77e5f8894b3cb65900b8c6035861fcf..ab5796a9f97180707734a81320e3eb81937281fe:/lisp/calendar/solar.el diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index d85c99c0b5..8a514fa641 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -1,6 +1,6 @@ ;;; solar.el --- calendar functions for solar events -;; Copyright (C) 1992, 1993, 1995, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1993, 1995, 1997, 2003 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Denis B. Roegel @@ -59,6 +59,9 @@ ;;; Code: +(defvar displayed-month) +(defvar displayed-year) + (if (fboundp 'atan) (require 'lisp-float-type) (error "Solar/lunar calculations impossible since floating point is unavailable")) @@ -73,8 +76,8 @@ "*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 -`12-hours', `24-hours', and `minutes', all numbers in string form, -and `am-pm' and `time-zone', both alphabetic strings. +`12-hours', `24-hours', and `minutes', all numbers in string form, +and `am-pm' and `time-zone', both alphabetic strings. For example, the form @@ -194,8 +197,8 @@ delta. At present, delta = 0.01 degrees, so the value of the variable '("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice") "List of season changes for the southern hemisphere.") -(defvar solar-sidereal-time-greenwich-midnight - nil +(defvar solar-sidereal-time-greenwich-midnight + nil "Sidereal time at Greenwich at midnight (universal time).") (defvar solar-northern-spring-or-summer-season nil @@ -239,7 +242,7 @@ Returns nil if nothing was entered." (condition-case nil (tan (degrees-to-radians (mod x 360.0))) (solar-tangent-degrees x))) - + (defun solar-xy-to-quadrant (x y) "Determines the quadrant of the point X, Y." (if (> x 0) @@ -262,7 +265,7 @@ Returns nil if nothing was entered." "Arctan of point X, Y." (if (= x 0) (if (> y 0) 90 270) - (solar-arctan (/ y x) x))) + (solar-arctan (/ y x) (solar-xy-to-quadrant x y)))) (defun solar-arccos (x) "Arcos of X." @@ -399,7 +402,7 @@ Format used is given by `calendar-time-display-form'." (floor (* 60 (- time (floor time)))))) (defun solar-exact-local-noon (date) - "Date and Universal Time of local noon at *local date* date. + "Date and Universal Time of local noon at *local date* date. The date may be different from the one asked for, but it will be the right local date. The second component of date should be an integer." @@ -408,12 +411,12 @@ local date. The second component of date should be an integer." (te (solar-time-equation date ut))) (setq ut (- ut te)) (if (>= ut 24) - (progn + (progn (setq nd (list (car date) (+ 1 (car (cdr date))) (car (cdr (cdr date))))) (setq ut (- ut 24)))) (if (< ut 0) - (progn + (progn (setq nd (list (car date) (- (car (cdr date)) 1) (car (cdr (cdr date))))) (setq ut (+ ut 24)))) @@ -477,10 +480,10 @@ Corresponding value is nil if there is no sunrise/sunset." (defun solar-julian-ut-centuries (date) "Number of Julian centuries elapsed since 1 Jan, 2000 at noon U.T. for Gregorian DATE." - (/ (- (calendar-absolute-from-gregorian date) + (/ (- (calendar-absolute-from-gregorian date) (calendar-absolute-from-gregorian '(1 1.5 2000))) 36525.0)) - + (defun solar-ephemeris-time(time) "Ephemeris Time at moment TIME. @@ -534,7 +537,7 @@ calendar-time-zone are used to interpret local time." (setq end-long long))) (/ (+ start end) 2.0))) -(defun solar-horizontal-coordinates +(defun solar-horizontal-coordinates (time latitude longitude for-sunrise-sunset) "Azimuth and height of the sun at TIME, LATITUDE, and LONGITUDE. @@ -557,7 +560,7 @@ The azimuth is given in degrees as well as the height (between -180 and 180)." (* (solar-tangent-degrees de) (solar-cosine-degrees latitude))) (solar-sin-degrees ah))) - (height (solar-arcsin + (height (solar-arcsin (+ (* (solar-sin-degrees latitude) (solar-sin-degrees de)) (* (solar-cosine-degrees latitude) (solar-cosine-degrees de) @@ -573,7 +576,7 @@ elapsed at 0 Universal Time, and the second component being the universal time. For instance, the pair corresponding to November 28, 1995 at 16 UT is \(-0.040945 16), -0.040945 being the number of julian centuries elapsed between Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT." - (let* ((tm (solar-ephemeris-time time)) + (let* ((tm (solar-ephemeris-time time)) (ec (solar-ecliptic-coordinates tm for-sunrise-sunset))) (list (solar-right-ascension (car ec) (car (cdr ec))) (solar-declination (car ec) (car (cdr ec)))))) @@ -585,16 +588,16 @@ at moment `time', expressed in julian centuries of Ephemeris Time since January 1st, 2000, at 12 ET." (let* ((l (+ 280.46645 (* 36000.76983 time) - (* 0.0003032 time time))) ; sun mean longitude + (* 0.0003032 time time))) ; sun mean longitude (ml (+ 218.3165 - (* 481267.8813 time))) ; moon mean longitude + (* 481267.8813 time))) ; moon mean longitude (m (+ 357.52910 (* 35999.05030 time) (* -0.0001559 time time) - (* -0.00000048 time time time))) ; sun mean anomaly + (* -0.00000048 time time time))) ; sun mean anomaly (i (+ 23.43929111 (* -0.013004167 time) (* -0.00000016389 time time) - (* 0.0000005036 time time time))); mean inclination + (* 0.0000005036 time time time))); mean inclination (c (+ (* (+ 1.914600 (* -0.004817 time) (* -0.000014 time time)) @@ -602,8 +605,8 @@ since January 1st, 2000, at 12 ET." (* (+ 0.019993 (* -0.000101 time)) (solar-sin-degrees (* 2 m))) (* 0.000290 - (solar-sin-degrees (* 3 m))))) ; center equation - (L (+ l c)) ; total longitude + (solar-sin-degrees (* 3 m))))) ; center equation + (L (+ l c)) ; total longitude (omega (+ 125.04 (* -1934.136 time))) ; longitude of moon's ascending node ; on the ecliptic @@ -624,13 +627,13 @@ since January 1st, 2000, at 12 ET." (* -0.00478 (solar-sin-degrees omega)))) ; apparent longitude of sun (y (if (not for-sunrise-sunset) - (* (solar-tangent-degrees (/ i 2)) + (* (solar-tangent-degrees (/ i 2)) (solar-tangent-degrees (/ i 2))) nil)) (time-eq (if (not for-sunrise-sunset) (/ (* 12 (+ (* y (solar-sin-degrees (* 2 l))) (* -2 ecc (solar-sin-degrees m)) - (* 4 ecc y (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))))) @@ -807,7 +810,7 @@ T0 must correspond to 0 hours UT." (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 + (mod (+ (mod (+ mean-sid-time (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0) 24.0) 24.0))) @@ -895,7 +898,7 @@ This function is suitable for execution in a .emacs file." "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 () "Local time of sunrise and sunset for date under cursor. Accurate to a few seconds." @@ -924,7 +927,7 @@ Accurate to a few seconds." "Local time of candle lighting diary entry--applies if date is a Friday. No diary entry if there is no sunset on that date. -An optional parameter MARK specifies a face or single-character string to +An optional parameter MARK specifies a face or single-character string to use when highlighting the day in the calendar." (if (not (and calendar-latitude calendar-longitude calendar-time-zone)) (solar-setup)) @@ -939,10 +942,37 @@ use when highlighting the day in the calendar." (format "%s Sabbath candle lighting" (apply 'solar-time-string light))))))) +; from Meeus, 1991, page 167 +(defconst solar-seasons-data + '((485 324.96 1934.136) + (203 337.23 32964.467) + (199 342.08 20.186) + (182 27.85 445267.112) + (156 73.14 45036.886) + (136 171.52 22518.443) + (77 222.54 65928.934) + (74 296.72 3034.906) + (70 243.58 9037.513) + (58 119.81 33718.147) + (52 297.17 150.678) + (50 21.02 2281.226) + (45 247.54 29929.562) + (44 325.15 31555.956) + (29 60.93 4443.417) + (18 155.12 67555.328) + (17 288.79 4562.452) + (16 198.04 62894.029) + (14 199.76 31436.921) + (12 95.39 14577.848) + (12 287.11 31931.756) + (12 320.81 34777.259) + (9 227.73 1222.114) + (8 15.45 16859.074))) + (defun solar-equinoxes/solstices (k year) "Date of equinox/solstice K for YEAR. K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; -K=3, winter solstice. +K=3, winter solstice. RESULT is a gregorian local date. Accurate to less than a minute between 1951 and 2050." @@ -951,13 +981,13 @@ Accurate to less than a minute between 1951 and 2050." (W (- (* 35999.373 T) 2.47)) (Delta-lambda (+ 1 (* 0.0334 (solar-cosine-degrees W)) (* 0.0007 (solar-cosine-degrees (* 2 W))))) - (S (apply '+ (mapcar '(lambda(x) - (* (car x) (solar-cosine-degrees + (S (apply '+ (mapcar '(lambda(x) + (* (car x) (solar-cosine-degrees (+ (* (car (cdr (cdr x))) T) - (car (cdr x)))))) + (car (cdr x)))))) solar-seasons-data))) (JDE (+ JDE0 (/ (* 0.00001 S) Delta-lambda))) - (correction (+ 102.3 (* 123.5 T) (* 32.5 T T))) + (correction (+ 102.3 (* 123.5 T) (* 32.5 T T))) ; ephemeris time correction (JD (- JDE (/ correction 86400))) (date (calendar-gregorian-from-absolute (floor (- JD 1721424.5)))) @@ -969,7 +999,7 @@ Accurate to less than a minute between 1951 and 2050." ; from Meeus, 1991, page 166 (defun solar-mean-equinoxes/solstices (k year) - "Julian day of mean equinox/solstice K for YEAR. + "Julian day of mean equinox/solstice K for YEAR. K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter solstice. These formulas are only to be used between 1000 BC and 3000 AD." (let ((y (/ year 1000.0)) @@ -1017,33 +1047,6 @@ solstice. These formulas are only to be used between 1000 BC and 3000 AD." (* -0.00823 z z z) (* 0.00032 z z z z))))))) -; from Meeus, 1991, page 167 -(defconst solar-seasons-data - '((485 324.96 1934.136) - (203 337.23 32964.467) - (199 342.08 20.186) - (182 27.85 445267.112) - (156 73.14 45036.886) - (136 171.52 22518.443) - (77 222.54 65928.934) - (74 296.72 3034.906) - (70 243.58 9037.513) - (58 119.81 33718.147) - (52 297.17 150.678) - (50 21.02 2281.226) - (45 247.54 29929.562) - (44 325.15 31555.956) - (29 60.93 4443.417) - (18 155.12 67555.328) - (17 288.79 4562.452) - (16 198.04 62894.029) - (14 199.76 31436.921) - (12 95.39 14577.848) - (12 287.11 31931.756) - (12 320.81 34777.259) - (9 227.73 1222.114) - (8 15.45 16859.074))) - ;;;###autoload (defun solar-equinoxes-solstices () "*local* date and time of equinoxes and solstices, if visible in the calendar window. @@ -1061,13 +1064,14 @@ Requires floating point." (if calendar-time-zone calendar-daylight-savings-ends)) (calendar-time-zone (if calendar-time-zone calendar-time-zone 0)) (k (1- (/ m 3))) - (d0 (solar-equinoxes/solstices k y)) + (d0 (solar-equinoxes/solstices k y)) (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 d1) (+ (car (cdr d1)) - (/ (car (cdr adj)) 24.0)) - (car (cdr (cdr d1))))) + (d (list (car (car adj)) + (+ (car (cdr (car adj)) ) + (/ (car (cdr adj)) 24.0)) + (car (cdr (cdr (car adj)))))) ; The following is nearly as accurate, but not quite: ;(d0 (solar-date-next-longitude ; (calendar-astro-from-absolute @@ -1092,4 +1096,5 @@ Requires floating point." (provide 'solar) +;;; arch-tag: bc0ff693-df58-4666-bde4-2a7837ccb8fe ;;; solar.el ends here