diff options
| author | Glenn Morris | 2008-03-08 21:27:23 +0000 |
|---|---|---|
| committer | Glenn Morris | 2008-03-08 21:27:23 +0000 |
| commit | 53bee0c9ea662e4e7a14f04680a0674947586f13 (patch) | |
| tree | 72ed4578edc4b8052ce255d01ff2698012f97f42 | |
| parent | 754c5007639b4dd81ca1781f03f243fa456ef63e (diff) | |
| download | emacs-53bee0c9ea662e4e7a14f04680a0674947586f13.tar.gz emacs-53bee0c9ea662e4e7a14f04680a0674947586f13.zip | |
Formatting changes only.
| -rw-r--r-- | lisp/calendar/solar.el | 92 |
1 files changed, 46 insertions, 46 deletions
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 71c22995593..ecb5321c5a7 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el | |||
| @@ -348,13 +348,13 @@ accounting for the edge of the sun being on the horizon. | |||
| 348 | 348 | ||
| 349 | Uses binary search." | 349 | Uses binary search." |
| 350 | (let* ((ut (car (cdr time))) | 350 | (let* ((ut (car (cdr time))) |
| 351 | (possible t) ; we assume that rise or set are possible | 351 | (possible t) ; we assume that rise or set are possible |
| 352 | (utmin (+ ut (* direction 12.0))) | 352 | (utmin (+ ut (* direction 12.0))) |
| 353 | (utmax ut) ; the time searched is between utmin and utmax | 353 | (utmax ut) ; the time searched is between utmin and utmax |
| 354 | ; utmin and utmax are in hours | 354 | ;; utmin and utmax are in hours. |
| 355 | (utmoment-old 0.0) ; rise or set approximation | 355 | (utmoment-old 0.0) ; rise or set approximation |
| 356 | (utmoment 1.0) ; rise or set approximation | 356 | (utmoment 1.0) ; rise or set approximation |
| 357 | (hut 0) ; sun height at utmoment | 357 | (hut 0) ; sun height at utmoment |
| 358 | (t0 (car time)) | 358 | (t0 (car time)) |
| 359 | (hmin (car (cdr | 359 | (hmin (car (cdr |
| 360 | (solar-horizontal-coordinates (list t0 utmin) | 360 | (solar-horizontal-coordinates (list t0 utmin) |
| @@ -362,12 +362,12 @@ Uses binary search." | |||
| 362 | (hmax (car (cdr | 362 | (hmax (car (cdr |
| 363 | (solar-horizontal-coordinates (list t0 utmax) | 363 | (solar-horizontal-coordinates (list t0 utmax) |
| 364 | latitude longitude t))))) | 364 | latitude longitude t))))) |
| 365 | ; -0.61 degrees is the height of the middle of the sun, when it rises | 365 | ;; -0.61 degrees is the height of the middle of the sun, when it |
| 366 | ; or sets. | 366 | ;; rises or sets. |
| 367 | (if (< hmin height) | 367 | (if (< hmin height) |
| 368 | (if (> hmax height) | 368 | (if (> hmax height) |
| 369 | (while ;(< i 20) ; we perform a simple dichotomy | 369 | (while ;;; (< i 20) ; we perform a simple dichotomy |
| 370 | ; (> (abs (- hut height)) epsilon) | 370 | ;;; (> (abs (- hut height)) epsilon) |
| 371 | (>= (abs (- utmoment utmoment-old)) | 371 | (>= (abs (- utmoment utmoment-old)) |
| 372 | (/ solar-error 60)) | 372 | (/ solar-error 60)) |
| 373 | (setq utmoment-old utmoment) | 373 | (setq utmoment-old utmoment) |
| @@ -378,8 +378,8 @@ Uses binary search." | |||
| 378 | (if (< hut height) (setq utmin utmoment)) | 378 | (if (< hut height) (setq utmin utmoment)) |
| 379 | (if (> hut height) (setq utmax utmoment)) | 379 | (if (> hut height) (setq utmax utmoment)) |
| 380 | ) | 380 | ) |
| 381 | (setq possible nil)) ; the sun never rises | 381 | (setq possible nil)) ; the sun never rises |
| 382 | (setq possible nil)) ; the sun never sets | 382 | (setq possible nil)) ; the sun never sets |
| 383 | (if (not possible) nil utmoment))) | 383 | (if (not possible) nil utmoment))) |
| 384 | 384 | ||
| 385 | (defun solar-time-string (time time-zone) | 385 | (defun solar-time-string (time time-zone) |
| @@ -428,12 +428,12 @@ local date. The second component of date should be an integer." | |||
| 428 | "List of *local* times of sunrise, sunset, and daylight on Gregorian DATE. | 428 | "List of *local* times of sunrise, sunset, and daylight on Gregorian DATE. |
| 429 | 429 | ||
| 430 | Corresponding value is nil if there is no sunrise/sunset." | 430 | Corresponding value is nil if there is no sunrise/sunset." |
| 431 | (let* (; first, get the exact moment of local noon. | 431 | ;; First, get the exact moment of local noon. |
| 432 | (exact-local-noon (solar-exact-local-noon date)) | 432 | (let* ((exact-local-noon (solar-exact-local-noon date)) |
| 433 | ; get the time from the 2000 epoch. | 433 | ;; Get the time from the 2000 epoch. |
| 434 | (t0 (solar-julian-ut-centuries (car exact-local-noon))) | 434 | (t0 (solar-julian-ut-centuries (car exact-local-noon))) |
| 435 | ; store the sidereal time at Greenwich at midnight of UT time. | 435 | ;; Store the sidereal time at Greenwich at midnight of UT time. |
| 436 | ; find if summer or winter slightly above the equator | 436 | ;; Find if summer or winter slightly above the equator. |
| 437 | (equator-rise-set | 437 | (equator-rise-set |
| 438 | (progn (setq solar-sidereal-time-greenwich-midnight | 438 | (progn (setq solar-sidereal-time-greenwich-midnight |
| 439 | (solar-sidereal-time t0)) | 439 | (solar-sidereal-time t0)) |
| @@ -441,10 +441,10 @@ Corresponding value is nil if there is no sunrise/sunset." | |||
| 441 | (list t0 (car (cdr exact-local-noon))) | 441 | (list t0 (car (cdr exact-local-noon))) |
| 442 | 1.0 | 442 | 1.0 |
| 443 | (calendar-longitude) 0))) | 443 | (calendar-longitude) 0))) |
| 444 | ; store the spring/summer information, | 444 | ;; Store the spring/summer information, compute sunrise and |
| 445 | ; compute sunrise and sunset (two first components of rise-set). | 445 | ;; sunset (two first components of rise-set). Length of day |
| 446 | ; length of day is the third component (it is only the difference | 446 | ;; is the third component (it is only the difference between |
| 447 | ; between sunset and sunrise when there is a sunset and a sunrise) | 447 | ;; sunset and sunrise when there is a sunset and a sunrise) |
| 448 | (rise-set | 448 | (rise-set |
| 449 | (progn | 449 | (progn |
| 450 | (setq solar-northern-spring-or-summer-season | 450 | (setq solar-northern-spring-or-summer-season |
| @@ -519,7 +519,7 @@ calendar-time-zone are used to interpret local time." | |||
| 519 | (next (mod (* l (1+ (floor (/ start-long l)))) 360)) | 519 | (next (mod (* l (1+ (floor (/ start-long l)))) 360)) |
| 520 | (end (+ d (* (/ l 360.0) 400))) | 520 | (end (+ d (* (/ l 360.0) 400))) |
| 521 | (end-long (solar-longitude end))) | 521 | (end-long (solar-longitude end))) |
| 522 | (while ;; bisection search for nearest minute | 522 | (while ; bisection search for nearest minute |
| 523 | (< 0.00001 (- end start)) | 523 | (< 0.00001 (- end start)) |
| 524 | ;; start <= d < end | 524 | ;; start <= d < end |
| 525 | ;; start-long <= next < end-long when next != 0 | 525 | ;; start-long <= next < end-long when next != 0 |
| @@ -551,8 +551,8 @@ The azimuth is given in degrees as well as the height (between -180 and 180)." | |||
| 551 | (ec (solar-equatorial-coordinates time for-sunrise-sunset)) | 551 | (ec (solar-equatorial-coordinates time for-sunrise-sunset)) |
| 552 | (st (+ solar-sidereal-time-greenwich-midnight | 552 | (st (+ solar-sidereal-time-greenwich-midnight |
| 553 | (* ut 1.00273790935))) | 553 | (* ut 1.00273790935))) |
| 554 | ;; Hour angle (in degrees). | ||
| 554 | (ah (- (* st 15) (* 15 (car ec)) (* -1 (calendar-longitude)))) | 555 | (ah (- (* st 15) (* 15 (car ec)) (* -1 (calendar-longitude)))) |
| 555 | ; hour angle (in degrees) | ||
| 556 | (de (car (cdr ec))) | 556 | (de (car (cdr ec))) |
| 557 | (azimuth (solar-atn2 (- (* (solar-cosine-degrees ah) | 557 | (azimuth (solar-atn2 (- (* (solar-cosine-degrees ah) |
| 558 | (solar-sin-degrees latitude)) | 558 | (solar-sin-degrees latitude)) |
| @@ -589,14 +589,14 @@ since January 1st, 2000, at 12 ET." | |||
| 589 | (* 36000.76983 time) | 589 | (* 36000.76983 time) |
| 590 | (* 0.0003032 time time))) ; sun mean longitude | 590 | (* 0.0003032 time time))) ; sun mean longitude |
| 591 | (ml (+ 218.3165 | 591 | (ml (+ 218.3165 |
| 592 | (* 481267.8813 time))) ; moon mean longitude | 592 | (* 481267.8813 time))) ; moon mean longitude |
| 593 | (m (+ 357.52910 | 593 | (m (+ 357.52910 |
| 594 | (* 35999.05030 time) | 594 | (* 35999.05030 time) |
| 595 | (* -0.0001559 time time) | 595 | (* -0.0001559 time time) |
| 596 | (* -0.00000048 time time time))) ; sun mean anomaly | 596 | (* -0.00000048 time time time))) ; sun mean anomaly |
| 597 | (i (+ 23.43929111 (* -0.013004167 time) | 597 | (i (+ 23.43929111 (* -0.013004167 time) |
| 598 | (* -0.00000016389 time time) | 598 | (* -0.00000016389 time time) |
| 599 | (* 0.0000005036 time time time))); mean inclination | 599 | (* 0.0000005036 time time time))) ; mean inclination |
| 600 | (c (+ (* (+ 1.914600 | 600 | (c (+ (* (+ 1.914600 |
| 601 | (* -0.004817 time) | 601 | (* -0.004817 time) |
| 602 | (* -0.000014 time time)) | 602 | (* -0.000014 time time)) |
| @@ -605,17 +605,17 @@ since January 1st, 2000, at 12 ET." | |||
| 605 | (solar-sin-degrees (* 2 m))) | 605 | (solar-sin-degrees (* 2 m))) |
| 606 | (* 0.000290 | 606 | (* 0.000290 |
| 607 | (solar-sin-degrees (* 3 m))))) ; center equation | 607 | (solar-sin-degrees (* 3 m))))) ; center equation |
| 608 | (L (+ l c)) ; total longitude | 608 | (L (+ l c)) ; total longitude |
| 609 | ;; Longitude of moon's ascending node on the ecliptic. | ||
| 609 | (omega (+ 125.04 | 610 | (omega (+ 125.04 |
| 610 | (* -1934.136 time))) ; longitude of moon's ascending node | 611 | (* -1934.136 time))) |
| 611 | ; on the ecliptic | 612 | ;; nut = nutation in longitude, measured in seconds of angle. |
| 612 | (nut (if (not for-sunrise-sunset) | 613 | (nut (if (not for-sunrise-sunset) |
| 613 | (+ (* -17.20 (solar-sin-degrees omega)) | 614 | (+ (* -17.20 (solar-sin-degrees omega)) |
| 614 | (* -1.32 (solar-sin-degrees (* 2 l))) | 615 | (* -1.32 (solar-sin-degrees (* 2 l))) |
| 615 | (* -0.23 (solar-sin-degrees (* 2 ml))) | 616 | (* -0.23 (solar-sin-degrees (* 2 ml))) |
| 616 | (* 0.21 (solar-sin-degrees (* 2 omega)))) | 617 | (* 0.21 (solar-sin-degrees (* 2 omega)))) |
| 617 | nil)) | 618 | nil)) |
| 618 | ; nut = nutation in longitude, measured in seconds of angle. | ||
| 619 | (ecc (if (not for-sunrise-sunset) | 619 | (ecc (if (not for-sunrise-sunset) |
| 620 | (+ 0.016708617 | 620 | (+ 0.016708617 |
| 621 | (* -0.000042037 time) | 621 | (* -0.000042037 time) |
| @@ -629,6 +629,7 @@ since January 1st, 2000, at 12 ET." | |||
| 629 | (* (solar-tangent-degrees (/ i 2)) | 629 | (* (solar-tangent-degrees (/ i 2)) |
| 630 | (solar-tangent-degrees (/ i 2))) | 630 | (solar-tangent-degrees (/ i 2))) |
| 631 | nil)) | 631 | nil)) |
| 632 | ;; Equation of time, in hours. | ||
| 632 | (time-eq (if (not for-sunrise-sunset) | 633 | (time-eq (if (not for-sunrise-sunset) |
| 633 | (/ (* 12 (+ (* y (solar-sin-degrees (* 2 l))) | 634 | (/ (* 12 (+ (* y (solar-sin-degrees (* 2 l))) |
| 634 | (* -2 ecc (solar-sin-degrees m)) | 635 | (* -2 ecc (solar-sin-degrees m)) |
| @@ -638,7 +639,6 @@ since January 1st, 2000, at 12 ET." | |||
| 638 | (* -1.25 ecc ecc (solar-sin-degrees (* 2 m))))) | 639 | (* -1.25 ecc ecc (solar-sin-degrees (* 2 m))))) |
| 639 | 3.1415926535) | 640 | 3.1415926535) |
| 640 | nil))) | 641 | nil))) |
| 641 | ; equation of time, in hours | ||
| 642 | (list app i time-eq nut))) | 642 | (list app i time-eq nut))) |
| 643 | 643 | ||
| 644 | (defconst solar-data-list | 644 | (defconst solar-data-list |
| @@ -702,13 +702,13 @@ calendar-daylight-savings-starts-time, calendar-daylight-savings-ends, | |||
| 702 | calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and | 702 | calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and |
| 703 | calendar-time-zone are used to interpret local time." | 703 | calendar-time-zone are used to interpret local time." |
| 704 | (let* ((a-d (calendar-absolute-from-astro d)) | 704 | (let* ((a-d (calendar-absolute-from-astro d)) |
| 705 | ;; get Universal Time | 705 | ;; Get Universal Time. |
| 706 | (date (calendar-astro-from-absolute | 706 | (date (calendar-astro-from-absolute |
| 707 | (- a-d | 707 | (- a-d |
| 708 | (if (dst-in-effect a-d) | 708 | (if (dst-in-effect a-d) |
| 709 | (/ calendar-daylight-time-offset 24.0 60.0) 0) | 709 | (/ calendar-daylight-time-offset 24.0 60.0) 0) |
| 710 | (/ calendar-time-zone 60.0 24.0)))) | 710 | (/ calendar-time-zone 60.0 24.0)))) |
| 711 | ;; get Ephemeris Time | 711 | ;; Get Ephemeris Time. |
| 712 | (date (+ date (solar-ephemeris-correction | 712 | (date (+ date (solar-ephemeris-correction |
| 713 | (extract-calendar-year | 713 | (extract-calendar-year |
| 714 | (calendar-gregorian-from-absolute | 714 | (calendar-gregorian-from-absolute |
| @@ -808,7 +808,7 @@ T0 must correspond to 0 hours UT." | |||
| 808 | (et (solar-ephemeris-time (list t0 0.0))) | 808 | (et (solar-ephemeris-time (list t0 0.0))) |
| 809 | (nut-i (solar-ecliptic-coordinates et nil)) | 809 | (nut-i (solar-ecliptic-coordinates et nil)) |
| 810 | (nut (car (cdr (cdr (cdr nut-i))))) ; nutation | 810 | (nut (car (cdr (cdr (cdr nut-i))))) ; nutation |
| 811 | (i (car (cdr nut-i)))) ; inclination | 811 | (i (car (cdr nut-i)))) ; inclination |
| 812 | (mod (+ (mod (+ mean-sid-time | 812 | (mod (+ (mod (+ mean-sid-time |
| 813 | (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0) | 813 | (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0) |
| 814 | 24.0) | 814 | 24.0) |
| @@ -924,7 +924,7 @@ An optional parameter MARK specifies a face or single-character string to | |||
| 924 | use when highlighting the day in the calendar." | 924 | use when highlighting the day in the calendar." |
| 925 | (if (not (and calendar-latitude calendar-longitude calendar-time-zone)) | 925 | (if (not (and calendar-latitude calendar-longitude calendar-time-zone)) |
| 926 | (solar-setup)) | 926 | (solar-setup)) |
| 927 | (if (= (% (calendar-absolute-from-gregorian date) 7) 5);; Friday | 927 | (if (= (% (calendar-absolute-from-gregorian date) 7) 5) ; Friday |
| 928 | (let* ((sunset (car (cdr (solar-sunrise-sunset date)))) | 928 | (let* ((sunset (car (cdr (solar-sunrise-sunset date)))) |
| 929 | (light (if sunset | 929 | (light (if sunset |
| 930 | (cons (- (car sunset) | 930 | (cons (- (car sunset) |
| @@ -935,7 +935,7 @@ use when highlighting the day in the calendar." | |||
| 935 | (format "%s Sabbath candle lighting" | 935 | (format "%s Sabbath candle lighting" |
| 936 | (apply 'solar-time-string light))))))) | 936 | (apply 'solar-time-string light))))))) |
| 937 | 937 | ||
| 938 | ; from Meeus, 1991, page 167 | 938 | ;; From Meeus, 1991, page 167. |
| 939 | (defconst solar-seasons-data | 939 | (defconst solar-seasons-data |
| 940 | '((485 324.96 1934.136) | 940 | '((485 324.96 1934.136) |
| 941 | (203 337.23 32964.467) | 941 | (203 337.23 32964.467) |
| @@ -980,8 +980,8 @@ Accurate to less than a minute between 1951 and 2050." | |||
| 980 | (car (cdr x)))))) | 980 | (car (cdr x)))))) |
| 981 | solar-seasons-data))) | 981 | solar-seasons-data))) |
| 982 | (JDE (+ JDE0 (/ (* 0.00001 S) Delta-lambda))) | 982 | (JDE (+ JDE0 (/ (* 0.00001 S) Delta-lambda))) |
| 983 | ;; Ephemeris time correction. | ||
| 983 | (correction (+ 102.3 (* 123.5 T) (* 32.5 T T))) | 984 | (correction (+ 102.3 (* 123.5 T) (* 32.5 T T))) |
| 984 | ; ephemeris time correction | ||
| 985 | (JD (- JDE (/ correction 86400))) | 985 | (JD (- JDE (/ correction 86400))) |
| 986 | (date (calendar-gregorian-from-absolute (floor (- JD 1721424.5)))) | 986 | (date (calendar-gregorian-from-absolute (floor (- JD 1721424.5)))) |
| 987 | (time (- (- JD 0.5) (floor (- JD 0.5)))) | 987 | (time (- (- JD 0.5) (floor (- JD 0.5)))) |
| @@ -990,14 +990,14 @@ Accurate to less than a minute between 1951 and 2050." | |||
| 990 | (/ (/ calendar-time-zone 60.0) 24.0)) | 990 | (/ (/ calendar-time-zone 60.0) 24.0)) |
| 991 | (car (cdr (cdr date)))))) | 991 | (car (cdr (cdr date)))))) |
| 992 | 992 | ||
| 993 | ; from Meeus, 1991, page 166 | 993 | ;; From Meeus, 1991, page 166. |
| 994 | (defun solar-mean-equinoxes/solstices (k year) | 994 | (defun solar-mean-equinoxes/solstices (k year) |
| 995 | "Julian day of mean equinox/solstice K for YEAR. | 995 | "Julian day of mean equinox/solstice K for YEAR. |
| 996 | K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter | 996 | K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter |
| 997 | solstice. These formulas are only to be used between 1000 BC and 3000 AD." | 997 | solstice. These formulas are only to be used between 1000 BC and 3000 AD." |
| 998 | (let ((y (/ year 1000.0)) | 998 | (let ((y (/ year 1000.0)) |
| 999 | (z (/ (- year 2000) 1000.0))) | 999 | (z (/ (- year 2000) 1000.0))) |
| 1000 | (if (< year 1000) ; actually between -1000 and 1000 | 1000 | (if (< year 1000) ; actually between -1000 and 1000 |
| 1001 | (cond ((equal k 0) (+ 1721139.29189 | 1001 | (cond ((equal k 0) (+ 1721139.29189 |
| 1002 | (* 365242.13740 y) | 1002 | (* 365242.13740 y) |
| 1003 | (* 0.06134 y y) | 1003 | (* 0.06134 y y) |
| @@ -1018,7 +1018,7 @@ solstice. These formulas are only to be used between 1000 BC and 3000 AD." | |||
| 1018 | (* -0.00769 y y) | 1018 | (* -0.00769 y y) |
| 1019 | (* -0.00933 y y y) | 1019 | (* -0.00933 y y y) |
| 1020 | (* -0.00006 y y y y)))) | 1020 | (* -0.00006 y y y y)))) |
| 1021 | ; actually between 1000 and 3000 | 1021 | ; actually between 1000 and 3000 |
| 1022 | (cond ((equal k 0) (+ 2451623.80984 | 1022 | (cond ((equal k 0) (+ 2451623.80984 |
| 1023 | (* 365242.37404 z) | 1023 | (* 365242.37404 z) |
| 1024 | (* 0.05169 z z) | 1024 | (* 0.05169 z z) |
| @@ -1064,13 +1064,13 @@ Requires floating point." | |||
| 1064 | (+ (car (cdr (car adj)) ) | 1064 | (+ (car (cdr (car adj)) ) |
| 1065 | (/ (car (cdr adj)) 24.0)) | 1065 | (/ (car (cdr adj)) 24.0)) |
| 1066 | (car (cdr (cdr (car adj)))))) | 1066 | (car (cdr (cdr (car adj)))))) |
| 1067 | ; The following is nearly as accurate, but not quite: | 1067 | ;; The following is nearly as accurate, but not quite: |
| 1068 | ;(d0 (solar-date-next-longitude | 1068 | ;; (d0 (solar-date-next-longitude |
| 1069 | ; (calendar-astro-from-absolute | 1069 | ;; (calendar-astro-from-absolute |
| 1070 | ; (calendar-absolute-from-gregorian | 1070 | ;; (calendar-absolute-from-gregorian |
| 1071 | ; (list (+ 3 (* k 3)) 15 y))) | 1071 | ;; (list (+ 3 (* k 3)) 15 y))) |
| 1072 | ; 90)) | 1072 | ;; 90)) |
| 1073 | ;(abs-day (calendar-absolute-from-astro d))) | 1073 | ;; (abs-day (calendar-absolute-from-astro d))) |
| 1074 | (abs-day (calendar-absolute-from-gregorian d))) | 1074 | (abs-day (calendar-absolute-from-gregorian d))) |
| 1075 | (list | 1075 | (list |
| 1076 | (list (calendar-gregorian-from-absolute (floor abs-day)) | 1076 | (list (calendar-gregorian-from-absolute (floor abs-day)) |