aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2008-03-08 21:27:23 +0000
committerGlenn Morris2008-03-08 21:27:23 +0000
commit53bee0c9ea662e4e7a14f04680a0674947586f13 (patch)
tree72ed4578edc4b8052ce255d01ff2698012f97f42
parent754c5007639b4dd81ca1781f03f243fa456ef63e (diff)
downloademacs-53bee0c9ea662e4e7a14f04680a0674947586f13.tar.gz
emacs-53bee0c9ea662e4e7a14f04680a0674947586f13.zip
Formatting changes only.
-rw-r--r--lisp/calendar/solar.el92
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
349Uses binary search." 349Uses 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
430Corresponding value is nil if there is no sunrise/sunset." 430Corresponding 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,
702calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and 702calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and
703calendar-time-zone are used to interpret local time." 703calendar-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
924use when highlighting the day in the calendar." 924use 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.
996K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter 996K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter
997solstice. These formulas are only to be used between 1000 BC and 3000 AD." 997solstice. 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))