diff options
| author | Glenn Morris | 2008-03-14 07:24:41 +0000 |
|---|---|---|
| committer | Glenn Morris | 2008-03-14 07:24:41 +0000 |
| commit | e7148377c1a45b7b2cfbe9c9fcb553db131a8bde (patch) | |
| tree | 799a54d98ce99916b5cef53a8f12924aa87bea94 | |
| parent | f852191f5e7d97b7fe359116ac563d0137a8c117 (diff) | |
| download | emacs-e7148377c1a45b7b2cfbe9c9fcb553db131a8bde.tar.gz emacs-e7148377c1a45b7b2cfbe9c9fcb553db131a8bde.zip | |
Reorder so that functions are defined before use.
(displayed-month, displayed-year): Move declarations where needed.
(solar-get-number): Move definition before use. Use unless.
(solar-equatorial-coordinates): Simplify.
(solar-sunrise-and-sunset): Use let rather than let*.
(solar-longitude, solar-equinoxes-solstices): Use cadr, nth
| -rw-r--r-- | lisp/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/calendar/solar.el | 549 |
2 files changed, 281 insertions, 275 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 75125030b4b..ced8820c45f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,5 +1,12 @@ | |||
| 1 | 2008-03-14 Glenn Morris <rgm@gnu.org> | 1 | 2008-03-14 Glenn Morris <rgm@gnu.org> |
| 2 | 2 | ||
| 3 | * calendar/solar.el: Reorder so that functions are defined before use. | ||
| 4 | (displayed-month, displayed-year): Move declarations where needed. | ||
| 5 | (solar-get-number): Move definition before use. Use unless. | ||
| 6 | (solar-equatorial-coordinates): Simplify. | ||
| 7 | (solar-sunrise-and-sunset): Use let rather than let*. | ||
| 8 | (solar-longitude, solar-equinoxes-solstices): Use cadr, nth | ||
| 9 | |||
| 3 | * startup.el (command-line-1): Rename -internal-script back to | 10 | * startup.el (command-line-1): Rename -internal-script back to |
| 4 | -scriptload (reverts previous change). | 11 | -scriptload (reverts previous change). |
| 5 | 12 | ||
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index d0b02b4b111..78071bb5db8 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el | |||
| @@ -54,9 +54,6 @@ | |||
| 54 | 54 | ||
| 55 | ;;; Code: | 55 | ;;; Code: |
| 56 | 56 | ||
| 57 | (defvar displayed-month) | ||
| 58 | (defvar displayed-year) | ||
| 59 | |||
| 60 | (if (fboundp 'atan) | 57 | (if (fboundp 'atan) |
| 61 | (require 'lisp-float-type) | 58 | (require 'lisp-float-type) |
| 62 | (error "Solar calculations impossible since floating point is unavailable")) | 59 | (error "Solar calculations impossible since floating point is unavailable")) |
| @@ -206,6 +203,13 @@ Needed for polar areas, in order to know whether the day lasts 0 or 24 hours.") | |||
| 206 | long | 203 | long |
| 207 | (- long))))) | 204 | (- long))))) |
| 208 | 205 | ||
| 206 | (defun solar-get-number (prompt) | ||
| 207 | "Return a number from the minibuffer, prompting with PROMPT. | ||
| 208 | Returns nil if nothing was entered." | ||
| 209 | (let ((x (read-string prompt ""))) | ||
| 210 | (unless (string-equal x "") | ||
| 211 | (string-to-number x)))) | ||
| 212 | |||
| 209 | (defun solar-setup () | 213 | (defun solar-setup () |
| 210 | "Prompt for `calendar-longitude', `calendar-latitude', `calendar-time-zone'." | 214 | "Prompt for `calendar-longitude', `calendar-latitude', `calendar-time-zone'." |
| 211 | (beep) | 215 | (beep) |
| @@ -223,13 +227,6 @@ Needed for polar areas, in order to know whether the day lasts 0 or 24 hours.") | |||
| 223 | "Enter difference from Coordinated Universal Time (in minutes): ") | 227 | "Enter difference from Coordinated Universal Time (in minutes): ") |
| 224 | ))) | 228 | ))) |
| 225 | 229 | ||
| 226 | (defun solar-get-number (prompt) | ||
| 227 | "Return a number from the minibuffer, prompting with PROMPT. | ||
| 228 | Returns nil if nothing was entered." | ||
| 229 | (let ((x (read-string prompt ""))) | ||
| 230 | (if (not (string-equal x "")) | ||
| 231 | (string-to-number x)))) | ||
| 232 | |||
| 233 | (defun solar-sin-degrees (x) | 230 | (defun solar-sin-degrees (x) |
| 234 | "Return sin of X degrees." | 231 | "Return sin of X degrees." |
| 235 | (sin (degrees-to-radians (mod x 360.0)))) | 232 | (sin (degrees-to-radians (mod x 360.0)))) |
| @@ -299,36 +296,182 @@ Both arguments are in degrees." | |||
| 299 | (* (solar-sin-degrees obliquity) | 296 | (* (solar-sin-degrees obliquity) |
| 300 | (solar-sin-degrees longitude)))) | 297 | (solar-sin-degrees longitude)))) |
| 301 | 298 | ||
| 302 | (defun solar-sunrise-and-sunset (time latitude longitude height) | 299 | (defun solar-ecliptic-coordinates (time sunrise-flag) |
| 303 | "Sunrise, sunset and length of day. | 300 | "Return solar longitude, ecliptic inclination, equation of time, nutation. |
| 304 | Parameters are the midday TIME and the LATITUDE, LONGITUDE of the location. | 301 | Values are for TIME in Julian centuries of Ephemeris Time since |
| 302 | January 1st, 2000, at 12 ET. Longitude and inclination are in | ||
| 303 | degrees, equation of time in hours, and nutation in seconds of longitude. | ||
| 304 | If SUNRISE-FLAG is non-nil, only calculate longitude and inclination." | ||
| 305 | (let* ((l (+ 280.46645 | ||
| 306 | (* 36000.76983 time) | ||
| 307 | (* 0.0003032 time time))) ; sun mean longitude | ||
| 308 | (ml (+ 218.3165 | ||
| 309 | (* 481267.8813 time))) ; moon mean longitude | ||
| 310 | (m (+ 357.52910 | ||
| 311 | (* 35999.05030 time) | ||
| 312 | (* -0.0001559 time time) | ||
| 313 | (* -0.00000048 time time time))) ; sun mean anomaly | ||
| 314 | (i (+ 23.43929111 (* -0.013004167 time) | ||
| 315 | (* -0.00000016389 time time) | ||
| 316 | (* 0.0000005036 time time time))) ; mean inclination | ||
| 317 | (c (+ (* (+ 1.914600 | ||
| 318 | (* -0.004817 time) | ||
| 319 | (* -0.000014 time time)) | ||
| 320 | (solar-sin-degrees m)) | ||
| 321 | (* (+ 0.019993 (* -0.000101 time)) | ||
| 322 | (solar-sin-degrees (* 2 m))) | ||
| 323 | (* 0.000290 | ||
| 324 | (solar-sin-degrees (* 3 m))))) ; center equation | ||
| 325 | (L (+ l c)) ; total longitude | ||
| 326 | ;; Longitude of moon's ascending node on the ecliptic. | ||
| 327 | (omega (+ 125.04 | ||
| 328 | (* -1934.136 time))) | ||
| 329 | ;; nut = nutation in longitude, measured in seconds of angle. | ||
| 330 | (nut (unless sunrise-flag | ||
| 331 | (+ (* -17.20 (solar-sin-degrees omega)) | ||
| 332 | (* -1.32 (solar-sin-degrees (* 2 l))) | ||
| 333 | (* -0.23 (solar-sin-degrees (* 2 ml))) | ||
| 334 | (* 0.21 (solar-sin-degrees (* 2 omega)))))) | ||
| 335 | (ecc (unless sunrise-flag ; eccentricity of earth's orbit | ||
| 336 | (+ 0.016708617 | ||
| 337 | (* -0.000042037 time) | ||
| 338 | (* -0.0000001236 time time)))) | ||
| 339 | (app (+ L ; apparent longitude of sun | ||
| 340 | -0.00569 | ||
| 341 | (* -0.00478 | ||
| 342 | (solar-sin-degrees omega)))) | ||
| 343 | (y (unless sunrise-flag | ||
| 344 | (* (solar-tangent-degrees (/ i 2)) | ||
| 345 | (solar-tangent-degrees (/ i 2))))) | ||
| 346 | ;; Equation of time, in hours. | ||
| 347 | (time-eq (unless sunrise-flag | ||
| 348 | (/ (* 12 (+ (* y (solar-sin-degrees (* 2 l))) | ||
| 349 | (* -2 ecc (solar-sin-degrees m)) | ||
| 350 | (* 4 ecc y (solar-sin-degrees m) | ||
| 351 | (solar-cosine-degrees (* 2 l))) | ||
| 352 | (* -0.5 y y (solar-sin-degrees (* 4 l))) | ||
| 353 | (* -1.25 ecc ecc (solar-sin-degrees (* 2 m))))) | ||
| 354 | 3.1415926535)))) | ||
| 355 | (list app i time-eq nut))) | ||
| 356 | |||
| 357 | (defun solar-ephemeris-correction (year) | ||
| 358 | "Ephemeris time minus Universal Time during Gregorian YEAR. | ||
| 359 | Result is in days. For the years 1800-1987, the maximum error is | ||
| 360 | 1.9 seconds. For the other years, the maximum error is about 30 seconds." | ||
| 361 | (cond ((and (<= 1988 year) (< year 2020)) | ||
| 362 | (/ (+ year -2000 67.0) 60.0 60.0 24.0)) | ||
| 363 | ((and (<= 1900 year) (< year 1988)) | ||
| 364 | (let* ((theta (/ (- (calendar-astro-from-absolute | ||
| 365 | (calendar-absolute-from-gregorian | ||
| 366 | (list 7 1 year))) | ||
| 367 | (calendar-astro-from-absolute | ||
| 368 | (calendar-absolute-from-gregorian | ||
| 369 | '(1 1 1900)))) | ||
| 370 | 36525.0)) | ||
| 371 | (theta2 (* theta theta)) | ||
| 372 | (theta3 (* theta2 theta)) | ||
| 373 | (theta4 (* theta2 theta2)) | ||
| 374 | (theta5 (* theta3 theta2))) | ||
| 375 | (+ -0.00002 | ||
| 376 | (* 0.000297 theta) | ||
| 377 | (* 0.025184 theta2) | ||
| 378 | (* -0.181133 theta3) | ||
| 379 | (* 0.553040 theta4) | ||
| 380 | (* -0.861938 theta5) | ||
| 381 | (* 0.677066 theta3 theta3) | ||
| 382 | (* -0.212591 theta4 theta3)))) | ||
| 383 | ((and (<= 1800 year) (< year 1900)) | ||
| 384 | (let* ((theta (/ (- (calendar-astro-from-absolute | ||
| 385 | (calendar-absolute-from-gregorian | ||
| 386 | (list 7 1 year))) | ||
| 387 | (calendar-astro-from-absolute | ||
| 388 | (calendar-absolute-from-gregorian | ||
| 389 | '(1 1 1900)))) | ||
| 390 | 36525.0)) | ||
| 391 | (theta2 (* theta theta)) | ||
| 392 | (theta3 (* theta2 theta)) | ||
| 393 | (theta4 (* theta2 theta2)) | ||
| 394 | (theta5 (* theta3 theta2))) | ||
| 395 | (+ -0.000009 | ||
| 396 | (* 0.003844 theta) | ||
| 397 | (* 0.083563 theta2) | ||
| 398 | (* 0.865736 theta3) | ||
| 399 | (* 4.867575 theta4) | ||
| 400 | (* 15.845535 theta5) | ||
| 401 | (* 31.332267 theta3 theta3) | ||
| 402 | (* 38.291999 theta4 theta3) | ||
| 403 | (* 28.316289 theta4 theta4) | ||
| 404 | (* 11.636204 theta4 theta5) | ||
| 405 | (* 2.043794 theta5 theta5)))) | ||
| 406 | ((and (<= 1620 year) (< year 1800)) | ||
| 407 | (let ((x (/ (- year 1600) 10.0))) | ||
| 408 | (/ (+ (* 2.19167 x x) (* -40.675 x) 196.58333) 60.0 60.0 24.0))) | ||
| 409 | (t (let* ((tmp (- (calendar-astro-from-absolute | ||
| 410 | (calendar-absolute-from-gregorian | ||
| 411 | (list 1 1 year))) | ||
| 412 | 2382148)) | ||
| 413 | (second (- (/ (* tmp tmp) 41048480.0) 15))) | ||
| 414 | (/ second 60.0 60.0 24.0))))) | ||
| 305 | 415 | ||
| 416 | (defun solar-ephemeris-time (time) | ||
| 417 | "Ephemeris Time at moment TIME. | ||
| 306 | TIME is a pair with the first component being the number of Julian centuries | 418 | TIME is a pair with the first component being the number of Julian centuries |
| 307 | elapsed at 0 Universal Time, and the second component being the universal | 419 | elapsed at 0 Universal Time, and the second component being the universal |
| 308 | time. For instance, the pair corresponding to November 28, 1995 at 16 UT is | 420 | time. For instance, the pair corresponding to November 28, 1995 at 16 UT is |
| 309 | \(-0.040945 16), -0.040945 being the number of Julian centuries elapsed between | 421 | \(-0.040945 16), -0.040945 being the number of Julian centuries elapsed between |
| 310 | Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. | 422 | Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. |
| 311 | 423 | ||
| 312 | HEIGHT is the angle the center of the sun has over the horizon for the contact | 424 | Result is in Julian centuries of ephemeris time." |
| 313 | we are trying to find. For sunrise and sunset, it is usually -0.61 degrees, | 425 | (let* ((t0 (car time)) |
| 314 | accounting for the edge of the sun being on the horizon. | 426 | (ut (cadr time)) |
| 427 | (t1 (+ t0 (/ (/ ut 24.0) 36525))) | ||
| 428 | (y (+ 2000 (* 100 t1))) | ||
| 429 | (dt (* 86400 (solar-ephemeris-correction (floor y))))) | ||
| 430 | (+ t1 (/ (/ dt 86400) 36525)))) | ||
| 315 | 431 | ||
| 316 | Coordinates are included because this function is called with latitude=1 | 432 | (defun solar-equatorial-coordinates (time sunrise-flag) |
| 317 | degrees to find out if polar regions have 24 hours of sun or only night." | 433 | "Right ascension (in hours) and declination (in degrees) of the sun at TIME. |
| 318 | (let* ((rise-time (solar-moment -1 latitude longitude time height)) | 434 | TIME is a pair with the first component being the number of |
| 319 | (set-time (solar-moment 1 latitude longitude time height)) | 435 | Julian centuries elapsed at 0 Universal Time, and the second |
| 320 | (day-length)) | 436 | component being the universal time. For instance, the pair |
| 321 | (if (not (and rise-time set-time)) | 437 | corresponding to November 28, 1995 at 16 UT is (-0.040945 16), |
| 322 | (if (or (and (> latitude 0) | 438 | -0.040945 being the number of Julian centuries elapsed between |
| 323 | solar-northern-spring-or-summer-season) | 439 | Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. SUNRISE-FLAG is passed |
| 324 | (and (< latitude 0) | 440 | to `solar-ecliptic-coordinates'." |
| 325 | (not solar-northern-spring-or-summer-season))) | 441 | (let ((ec (solar-ecliptic-coordinates (solar-ephemeris-time time) |
| 326 | (setq day-length 24) | 442 | sunrise-flag))) |
| 327 | (setq day-length 0)) | 443 | (list (solar-right-ascension (car ec) (cadr ec)) |
| 328 | (setq day-length (- set-time rise-time))) | 444 | (solar-declination (car ec) (cadr ec))))) |
| 329 | (list (if rise-time (+ rise-time (/ calendar-time-zone 60.0)) nil) | 445 | |
| 330 | (if set-time (+ set-time (/ calendar-time-zone 60.0)) nil) | 446 | (defun solar-horizontal-coordinates (time latitude longitude sunrise-flag) |
| 331 | day-length))) | 447 | "Azimuth and height of the sun at TIME, LATITUDE, and LONGITUDE. |
| 448 | TIME is a pair with the first component being the number of | ||
| 449 | Julian centuries elapsed at 0 Universal Time, and the second | ||
| 450 | component being the universal time. For instance, the pair | ||
| 451 | corresponding to November 28, 1995 at 16 UT is (-0.040945 16), | ||
| 452 | -0.040945 being the number of Julian centuries elapsed between | ||
| 453 | Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. SUNRISE-FLAG | ||
| 454 | is passed to `solar-ecliptic-coordinates'. Azimuth and | ||
| 455 | height (between -180 and 180) are both in degrees." | ||
| 456 | (let* ((ut (cadr time)) | ||
| 457 | (ec (solar-equatorial-coordinates time sunrise-flag)) | ||
| 458 | (st (+ solar-sidereal-time-greenwich-midnight | ||
| 459 | (* ut 1.00273790935))) | ||
| 460 | ;; Hour angle (in degrees). | ||
| 461 | (ah (- (* st 15) (* 15 (car ec)) (* -1 (calendar-longitude)))) | ||
| 462 | (de (cadr ec)) | ||
| 463 | (azimuth (solar-atn2 (- (* (solar-cosine-degrees ah) | ||
| 464 | (solar-sin-degrees latitude)) | ||
| 465 | (* (solar-tangent-degrees de) | ||
| 466 | (solar-cosine-degrees latitude))) | ||
| 467 | (solar-sin-degrees ah))) | ||
| 468 | (height (solar-arcsin | ||
| 469 | (+ (* (solar-sin-degrees latitude) (solar-sin-degrees de)) | ||
| 470 | (* (solar-cosine-degrees latitude) | ||
| 471 | (solar-cosine-degrees de) | ||
| 472 | (solar-cosine-degrees ah)))))) | ||
| 473 | (if (> height 180) (setq height (- height 360))) | ||
| 474 | (list azimuth height))) | ||
| 332 | 475 | ||
| 333 | (defun solar-moment (direction latitude longitude time height) | 476 | (defun solar-moment (direction latitude longitude time height) |
| 334 | "Sunrise/sunset at location. | 477 | "Sunrise/sunset at location. |
| @@ -377,6 +520,37 @@ Uses binary search." | |||
| 377 | (setq possible nil)) ; the sun never sets | 520 | (setq possible nil)) ; the sun never sets |
| 378 | (if possible utmoment))) | 521 | (if possible utmoment))) |
| 379 | 522 | ||
| 523 | (defun solar-sunrise-and-sunset (time latitude longitude height) | ||
| 524 | "Sunrise, sunset and length of day. | ||
| 525 | Parameters are the midday TIME and the LATITUDE, LONGITUDE of the location. | ||
| 526 | |||
| 527 | TIME is a pair with the first component being the number of Julian centuries | ||
| 528 | elapsed at 0 Universal Time, and the second component being the universal | ||
| 529 | time. For instance, the pair corresponding to November 28, 1995 at 16 UT is | ||
| 530 | \(-0.040945 16), -0.040945 being the number of Julian centuries elapsed between | ||
| 531 | Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. | ||
| 532 | |||
| 533 | HEIGHT is the angle the center of the sun has over the horizon for the contact | ||
| 534 | we are trying to find. For sunrise and sunset, it is usually -0.61 degrees, | ||
| 535 | accounting for the edge of the sun being on the horizon. | ||
| 536 | |||
| 537 | Coordinates are included because this function is called with latitude=1 | ||
| 538 | degrees to find out if polar regions have 24 hours of sun or only night." | ||
| 539 | (let ((rise-time (solar-moment -1 latitude longitude time height)) | ||
| 540 | (set-time (solar-moment 1 latitude longitude time height)) | ||
| 541 | day-length) | ||
| 542 | (if (not (and rise-time set-time)) | ||
| 543 | (if (or (and (> latitude 0) | ||
| 544 | solar-northern-spring-or-summer-season) | ||
| 545 | (and (< latitude 0) | ||
| 546 | (not solar-northern-spring-or-summer-season))) | ||
| 547 | (setq day-length 24) | ||
| 548 | (setq day-length 0)) | ||
| 549 | (setq day-length (- set-time rise-time))) | ||
| 550 | (list (if rise-time (+ rise-time (/ calendar-time-zone 60.0)) nil) | ||
| 551 | (if set-time (+ set-time (/ calendar-time-zone 60.0)) nil) | ||
| 552 | day-length))) | ||
| 553 | |||
| 380 | (defun solar-time-string (time time-zone) | 554 | (defun solar-time-string (time time-zone) |
| 381 | "Printable form for decimal fraction TIME in TIME-ZONE. | 555 | "Printable form for decimal fraction TIME in TIME-ZONE. |
| 382 | Format used is given by `calendar-time-display-form'." | 556 | Format used is given by `calendar-time-display-form'." |
| @@ -388,13 +562,27 @@ Format used is given by `calendar-time-display-form'." | |||
| 388 | (24-hours (format "%02d" 24-hours))) | 562 | (24-hours (format "%02d" 24-hours))) |
| 389 | (mapconcat 'eval calendar-time-display-form ""))) | 563 | (mapconcat 'eval calendar-time-display-form ""))) |
| 390 | 564 | ||
| 391 | |||
| 392 | (defun solar-daylight (time) | 565 | (defun solar-daylight (time) |
| 393 | "Printable form for TIME expressed in hours." | 566 | "Printable form for TIME expressed in hours." |
| 394 | (format "%d:%02d" | 567 | (format "%d:%02d" |
| 395 | (floor time) | 568 | (floor time) |
| 396 | (floor (* 60 (- time (floor time)))))) | 569 | (floor (* 60 (- time (floor time)))))) |
| 397 | 570 | ||
| 571 | (defun solar-julian-ut-centuries (date) | ||
| 572 | "Number of Julian centuries since 1 Jan, 2000 at noon UT for Gregorian DATE." | ||
| 573 | (/ (- (calendar-absolute-from-gregorian date) | ||
| 574 | (calendar-absolute-from-gregorian '(1 1.5 2000))) | ||
| 575 | 36525.0)) | ||
| 576 | |||
| 577 | (defun solar-date-to-et (date ut) | ||
| 578 | "Ephemeris Time at Gregorian DATE at Universal Time UT (in hours). | ||
| 579 | Expressed in Julian centuries of Ephemeris Time." | ||
| 580 | (solar-ephemeris-time (list (solar-julian-ut-centuries date) ut))) | ||
| 581 | |||
| 582 | (defun solar-time-equation (date ut) | ||
| 583 | "Equation of time expressed in hours at Gregorian DATE at Universal time UT." | ||
| 584 | (nth 2 (solar-ecliptic-coordinates (solar-date-to-et date ut) nil))) | ||
| 585 | |||
| 398 | (defun solar-exact-local-noon (date) | 586 | (defun solar-exact-local-noon (date) |
| 399 | "Date and Universal Time of local noon at *local date* DATE. | 587 | "Date and Universal Time of local noon at *local date* DATE. |
| 400 | The date may be different from the one asked for, but it will be the right | 588 | The date may be different from the one asked for, but it will be the right |
| @@ -415,6 +603,22 @@ local date. The second component of date should be an integer." | |||
| 415 | (calendar-absolute-from-gregorian nd))) | 603 | (calendar-absolute-from-gregorian nd))) |
| 416 | (list nd ut))) | 604 | (list nd ut))) |
| 417 | 605 | ||
| 606 | (defun solar-sidereal-time (t0) | ||
| 607 | "Sidereal time (in hours) in Greenwich at T0 Julian centuries. | ||
| 608 | T0 must correspond to 0 hours UT." | ||
| 609 | (let* ((mean-sid-time (+ 6.6973746 | ||
| 610 | (* 2400.051337 t0) | ||
| 611 | (* 0.0000258622 t0 t0) | ||
| 612 | (* -0.0000000017222 t0 t0 t0))) | ||
| 613 | (et (solar-ephemeris-time (list t0 0.0))) | ||
| 614 | (nut-i (solar-ecliptic-coordinates et nil)) | ||
| 615 | (nut (nth 3 nut-i)) ; nutation | ||
| 616 | (i (cadr nut-i))) ; inclination | ||
| 617 | (mod (+ (mod (+ mean-sid-time | ||
| 618 | (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0) | ||
| 619 | 24.0) | ||
| 620 | 24.0))) | ||
| 621 | |||
| 418 | (defun solar-sunrise-sunset (date) | 622 | (defun solar-sunrise-sunset (date) |
| 419 | "List of *local* times of sunrise, sunset, and daylight on Gregorian DATE. | 623 | "List of *local* times of sunrise, sunset, and daylight on Gregorian DATE. |
| 420 | Corresponding value is nil if there is no sunrise/sunset." | 624 | Corresponding value is nil if there is no sunrise/sunset." |
| @@ -467,161 +671,6 @@ Corresponding value is nil if there is no sunrise/sunset." | |||
| 467 | (eval calendar-location-name) | 671 | (eval calendar-location-name) |
| 468 | (nth 2 l)))) | 672 | (nth 2 l)))) |
| 469 | 673 | ||
| 470 | (defun solar-julian-ut-centuries (date) | ||
| 471 | "Number of Julian centuries since 1 Jan, 2000 at noon UT for Gregorian DATE." | ||
| 472 | (/ (- (calendar-absolute-from-gregorian date) | ||
| 473 | (calendar-absolute-from-gregorian '(1 1.5 2000))) | ||
| 474 | 36525.0)) | ||
| 475 | |||
| 476 | (defun solar-ephemeris-time (time) | ||
| 477 | "Ephemeris Time at moment TIME. | ||
| 478 | TIME is a pair with the first component being the number of Julian centuries | ||
| 479 | elapsed at 0 Universal Time, and the second component being the universal | ||
| 480 | time. For instance, the pair corresponding to November 28, 1995 at 16 UT is | ||
| 481 | \(-0.040945 16), -0.040945 being the number of Julian centuries elapsed between | ||
| 482 | Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. | ||
| 483 | |||
| 484 | Result is in Julian centuries of ephemeris time." | ||
| 485 | (let* ((t0 (car time)) | ||
| 486 | (ut (cadr time)) | ||
| 487 | (t1 (+ t0 (/ (/ ut 24.0) 36525))) | ||
| 488 | (y (+ 2000 (* 100 t1))) | ||
| 489 | (dt (* 86400 (solar-ephemeris-correction (floor y))))) | ||
| 490 | (+ t1 (/ (/ dt 86400) 36525)))) | ||
| 491 | |||
| 492 | (defun solar-date-next-longitude (d l) | ||
| 493 | "First time after day D when solar longitude is a multiple of L degrees. | ||
| 494 | D is a Julian day number. L must be an integer divisor of 360. | ||
| 495 | The result is for `calendar-location-name', and is in local time | ||
| 496 | \(including any daylight saving rules) expressed in astronomical (Julian) | ||
| 497 | day numbers. The values of `calendar-daylight-savings-starts', | ||
| 498 | `calendar-daylight-savings-starts-time', `calendar-daylight-savings-ends', | ||
| 499 | `calendar-daylight-savings-ends-time', `calendar-daylight-time-offset', | ||
| 500 | and `calendar-time-zone' are used to interpret local time." | ||
| 501 | (let* ((long) | ||
| 502 | (start d) | ||
| 503 | (start-long (solar-longitude d)) | ||
| 504 | (next (mod (* l (1+ (floor (/ start-long l)))) 360)) | ||
| 505 | (end (+ d (* (/ l 360.0) 400))) | ||
| 506 | (end-long (solar-longitude end))) | ||
| 507 | (while ; bisection search for nearest minute | ||
| 508 | (< 0.00001 (- end start)) | ||
| 509 | ;; start <= d < end | ||
| 510 | ;; start-long <= next < end-long when next != 0 | ||
| 511 | ;; when next = 0, we look for the discontinuity (start-long is near 360 | ||
| 512 | ;; and end-long is small (less than l). | ||
| 513 | (setq d (/ (+ start end) 2.0) | ||
| 514 | long (solar-longitude d)) | ||
| 515 | (if (or (and (not (zerop next)) (< long next)) | ||
| 516 | (and (zerop next) (< l long))) | ||
| 517 | (setq start d | ||
| 518 | start-long long) | ||
| 519 | (setq end d | ||
| 520 | end-long long))) | ||
| 521 | (/ (+ start end) 2.0))) | ||
| 522 | |||
| 523 | (defun solar-horizontal-coordinates (time latitude longitude sunrise-flag) | ||
| 524 | "Azimuth and height of the sun at TIME, LATITUDE, and LONGITUDE. | ||
| 525 | TIME is a pair with the first component being the number of | ||
| 526 | Julian centuries elapsed at 0 Universal Time, and the second | ||
| 527 | component being the universal time. For instance, the pair | ||
| 528 | corresponding to November 28, 1995 at 16 UT is (-0.040945 16), | ||
| 529 | -0.040945 being the number of Julian centuries elapsed between | ||
| 530 | Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. SUNRISE-FLAG | ||
| 531 | is passed to `solar-ecliptic-coordinates'. Azimuth and | ||
| 532 | height (between -180 and 180) are both in degrees." | ||
| 533 | (let* ((ut (cadr time)) | ||
| 534 | (ec (solar-equatorial-coordinates time sunrise-flag)) | ||
| 535 | (st (+ solar-sidereal-time-greenwich-midnight | ||
| 536 | (* ut 1.00273790935))) | ||
| 537 | ;; Hour angle (in degrees). | ||
| 538 | (ah (- (* st 15) (* 15 (car ec)) (* -1 (calendar-longitude)))) | ||
| 539 | (de (cadr ec)) | ||
| 540 | (azimuth (solar-atn2 (- (* (solar-cosine-degrees ah) | ||
| 541 | (solar-sin-degrees latitude)) | ||
| 542 | (* (solar-tangent-degrees de) | ||
| 543 | (solar-cosine-degrees latitude))) | ||
| 544 | (solar-sin-degrees ah))) | ||
| 545 | (height (solar-arcsin | ||
| 546 | (+ (* (solar-sin-degrees latitude) (solar-sin-degrees de)) | ||
| 547 | (* (solar-cosine-degrees latitude) | ||
| 548 | (solar-cosine-degrees de) | ||
| 549 | (solar-cosine-degrees ah)))))) | ||
| 550 | (if (> height 180) (setq height (- height 360))) | ||
| 551 | (list azimuth height))) | ||
| 552 | |||
| 553 | (defun solar-equatorial-coordinates (time sunrise-flag) | ||
| 554 | "Right ascension (in hours) and declination (in degrees) of the sun at TIME. | ||
| 555 | TIME is a pair with the first component being the number of | ||
| 556 | Julian centuries elapsed at 0 Universal Time, and the second | ||
| 557 | component being the universal time. For instance, the pair | ||
| 558 | corresponding to November 28, 1995 at 16 UT is (-0.040945 16), | ||
| 559 | -0.040945 being the number of Julian centuries elapsed between | ||
| 560 | Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. SUNRISE-FLAG is passed | ||
| 561 | to `solar-ecliptic-coordinates'." | ||
| 562 | (let* ((tm (solar-ephemeris-time time)) | ||
| 563 | (ec (solar-ecliptic-coordinates tm sunrise-flag))) | ||
| 564 | (list (solar-right-ascension (car ec) (car (cdr ec))) | ||
| 565 | (solar-declination (car ec) (car (cdr ec)))))) | ||
| 566 | |||
| 567 | (defun solar-ecliptic-coordinates (time sunrise-flag) | ||
| 568 | "Return solar longitude, ecliptic inclination, equation of time, nutation. | ||
| 569 | Values are for TIME in Julian centuries of Ephemeris Time since | ||
| 570 | January 1st, 2000, at 12 ET. Longitude and inclination are in | ||
| 571 | degrees, equation of time in hours, and nutation in seconds of longitude. | ||
| 572 | If SUNRISE-FLAG is non-nil, only calculate longitude and inclination." | ||
| 573 | (let* ((l (+ 280.46645 | ||
| 574 | (* 36000.76983 time) | ||
| 575 | (* 0.0003032 time time))) ; sun mean longitude | ||
| 576 | (ml (+ 218.3165 | ||
| 577 | (* 481267.8813 time))) ; moon mean longitude | ||
| 578 | (m (+ 357.52910 | ||
| 579 | (* 35999.05030 time) | ||
| 580 | (* -0.0001559 time time) | ||
| 581 | (* -0.00000048 time time time))) ; sun mean anomaly | ||
| 582 | (i (+ 23.43929111 (* -0.013004167 time) | ||
| 583 | (* -0.00000016389 time time) | ||
| 584 | (* 0.0000005036 time time time))) ; mean inclination | ||
| 585 | (c (+ (* (+ 1.914600 | ||
| 586 | (* -0.004817 time) | ||
| 587 | (* -0.000014 time time)) | ||
| 588 | (solar-sin-degrees m)) | ||
| 589 | (* (+ 0.019993 (* -0.000101 time)) | ||
| 590 | (solar-sin-degrees (* 2 m))) | ||
| 591 | (* 0.000290 | ||
| 592 | (solar-sin-degrees (* 3 m))))) ; center equation | ||
| 593 | (L (+ l c)) ; total longitude | ||
| 594 | ;; Longitude of moon's ascending node on the ecliptic. | ||
| 595 | (omega (+ 125.04 | ||
| 596 | (* -1934.136 time))) | ||
| 597 | ;; nut = nutation in longitude, measured in seconds of angle. | ||
| 598 | (nut (unless sunrise-flag | ||
| 599 | (+ (* -17.20 (solar-sin-degrees omega)) | ||
| 600 | (* -1.32 (solar-sin-degrees (* 2 l))) | ||
| 601 | (* -0.23 (solar-sin-degrees (* 2 ml))) | ||
| 602 | (* 0.21 (solar-sin-degrees (* 2 omega)))))) | ||
| 603 | (ecc (unless sunrise-flag ; eccentricity of earth's orbit | ||
| 604 | (+ 0.016708617 | ||
| 605 | (* -0.000042037 time) | ||
| 606 | (* -0.0000001236 time time)))) | ||
| 607 | (app (+ L ; apparent longitude of sun | ||
| 608 | -0.00569 | ||
| 609 | (* -0.00478 | ||
| 610 | (solar-sin-degrees omega)))) | ||
| 611 | (y (unless sunrise-flag | ||
| 612 | (* (solar-tangent-degrees (/ i 2)) | ||
| 613 | (solar-tangent-degrees (/ i 2))))) | ||
| 614 | ;; Equation of time, in hours. | ||
| 615 | (time-eq (unless sunrise-flag | ||
| 616 | (/ (* 12 (+ (* y (solar-sin-degrees (* 2 l))) | ||
| 617 | (* -2 ecc (solar-sin-degrees m)) | ||
| 618 | (* 4 ecc y (solar-sin-degrees m) | ||
| 619 | (solar-cosine-degrees (* 2 l))) | ||
| 620 | (* -0.5 y y (solar-sin-degrees (* 4 l))) | ||
| 621 | (* -1.25 ecc ecc (solar-sin-degrees (* 2 m))))) | ||
| 622 | 3.1415926535)))) | ||
| 623 | (list app i time-eq nut))) | ||
| 624 | |||
| 625 | (defconst solar-data-list | 674 | (defconst solar-data-list |
| 626 | '((403406 4.721964 1.621043) | 675 | '((403406 4.721964 1.621043) |
| 627 | (195207 5.937458 62830.348067) | 676 | (195207 5.937458 62830.348067) |
| @@ -705,8 +754,8 @@ The values of `calendar-daylight-savings-starts', | |||
| 705 | (mapcar (lambda (x) | 754 | (mapcar (lambda (x) |
| 706 | (* (car x) | 755 | (* (car x) |
| 707 | (sin (mod | 756 | (sin (mod |
| 708 | (+ (car (cdr x)) | 757 | (+ (cadr x) |
| 709 | (* (car (cdr (cdr x))) U)) | 758 | (* (nth 2 x) U)) |
| 710 | (* 2 pi))))) | 759 | (* 2 pi))))) |
| 711 | solar-data-list))))) | 760 | solar-data-list))))) |
| 712 | (aberration | 761 | (aberration |
| @@ -716,89 +765,36 @@ The values of `calendar-daylight-savings-starts', | |||
| 716 | (nutation (* -0.0000001 (+ (* 834 (sin A1)) (* 64 (sin A2)))))) | 765 | (nutation (* -0.0000001 (+ (* 834 (sin A1)) (* 64 (sin A2)))))) |
| 717 | (mod (radians-to-degrees (+ longitude aberration nutation)) 360.0))) | 766 | (mod (radians-to-degrees (+ longitude aberration nutation)) 360.0))) |
| 718 | 767 | ||
| 719 | (defun solar-ephemeris-correction (year) | 768 | (defun solar-date-next-longitude (d l) |
| 720 | "Ephemeris time minus Universal Time during Gregorian YEAR. | 769 | "First time after day D when solar longitude is a multiple of L degrees. |
| 721 | Result is in days. For the years 1800-1987, the maximum error is | 770 | D is a Julian day number. L must be an integer divisor of 360. |
| 722 | 1.9 seconds. For the other years, the maximum error is about 30 seconds." | 771 | The result is for `calendar-location-name', and is in local time |
| 723 | (cond ((and (<= 1988 year) (< year 2020)) | 772 | \(including any daylight saving rules) expressed in astronomical (Julian) |
| 724 | (/ (+ year -2000 67.0) 60.0 60.0 24.0)) | 773 | day numbers. The values of `calendar-daylight-savings-starts', |
| 725 | ((and (<= 1900 year) (< year 1988)) | 774 | `calendar-daylight-savings-starts-time', `calendar-daylight-savings-ends', |
| 726 | (let* ((theta (/ (- (calendar-astro-from-absolute | 775 | `calendar-daylight-savings-ends-time', `calendar-daylight-time-offset', |
| 727 | (calendar-absolute-from-gregorian | 776 | and `calendar-time-zone' are used to interpret local time." |
| 728 | (list 7 1 year))) | 777 | (let* ((long) |
| 729 | (calendar-astro-from-absolute | 778 | (start d) |
| 730 | (calendar-absolute-from-gregorian | 779 | (start-long (solar-longitude d)) |
| 731 | '(1 1 1900)))) | 780 | (next (mod (* l (1+ (floor (/ start-long l)))) 360)) |
| 732 | 36525.0)) | 781 | (end (+ d (* (/ l 360.0) 400))) |
| 733 | (theta2 (* theta theta)) | 782 | (end-long (solar-longitude end))) |
| 734 | (theta3 (* theta2 theta)) | 783 | (while ; bisection search for nearest minute |
| 735 | (theta4 (* theta2 theta2)) | 784 | (< 0.00001 (- end start)) |
| 736 | (theta5 (* theta3 theta2))) | 785 | ;; start <= d < end |
| 737 | (+ -0.00002 | 786 | ;; start-long <= next < end-long when next != 0 |
| 738 | (* 0.000297 theta) | 787 | ;; when next = 0, we look for the discontinuity (start-long is near 360 |
| 739 | (* 0.025184 theta2) | 788 | ;; and end-long is small (less than l). |
| 740 | (* -0.181133 theta3) | 789 | (setq d (/ (+ start end) 2.0) |
| 741 | (* 0.553040 theta4) | 790 | long (solar-longitude d)) |
| 742 | (* -0.861938 theta5) | 791 | (if (or (and (not (zerop next)) (< long next)) |
| 743 | (* 0.677066 theta3 theta3) | 792 | (and (zerop next) (< l long))) |
| 744 | (* -0.212591 theta4 theta3)))) | 793 | (setq start d |
| 745 | ((and (<= 1800 year) (< year 1900)) | 794 | start-long long) |
| 746 | (let* ((theta (/ (- (calendar-astro-from-absolute | 795 | (setq end d |
| 747 | (calendar-absolute-from-gregorian | 796 | end-long long))) |
| 748 | (list 7 1 year))) | 797 | (/ (+ start end) 2.0))) |
| 749 | (calendar-astro-from-absolute | ||
| 750 | (calendar-absolute-from-gregorian | ||
| 751 | '(1 1 1900)))) | ||
| 752 | 36525.0)) | ||
| 753 | (theta2 (* theta theta)) | ||
| 754 | (theta3 (* theta2 theta)) | ||
| 755 | (theta4 (* theta2 theta2)) | ||
| 756 | (theta5 (* theta3 theta2))) | ||
| 757 | (+ -0.000009 | ||
| 758 | (* 0.003844 theta) | ||
| 759 | (* 0.083563 theta2) | ||
| 760 | (* 0.865736 theta3) | ||
| 761 | (* 4.867575 theta4) | ||
| 762 | (* 15.845535 theta5) | ||
| 763 | (* 31.332267 theta3 theta3) | ||
| 764 | (* 38.291999 theta4 theta3) | ||
| 765 | (* 28.316289 theta4 theta4) | ||
| 766 | (* 11.636204 theta4 theta5) | ||
| 767 | (* 2.043794 theta5 theta5)))) | ||
| 768 | ((and (<= 1620 year) (< year 1800)) | ||
| 769 | (let ((x (/ (- year 1600) 10.0))) | ||
| 770 | (/ (+ (* 2.19167 x x) (* -40.675 x) 196.58333) 60.0 60.0 24.0))) | ||
| 771 | (t (let* ((tmp (- (calendar-astro-from-absolute | ||
| 772 | (calendar-absolute-from-gregorian | ||
| 773 | (list 1 1 year))) | ||
| 774 | 2382148)) | ||
| 775 | (second (- (/ (* tmp tmp) 41048480.0) 15))) | ||
| 776 | (/ second 60.0 60.0 24.0))))) | ||
| 777 | |||
| 778 | (defun solar-sidereal-time (t0) | ||
| 779 | "Sidereal time (in hours) in Greenwich at T0 Julian centuries. | ||
| 780 | T0 must correspond to 0 hours UT." | ||
| 781 | (let* ((mean-sid-time (+ 6.6973746 | ||
| 782 | (* 2400.051337 t0) | ||
| 783 | (* 0.0000258622 t0 t0) | ||
| 784 | (* -0.0000000017222 t0 t0 t0))) | ||
| 785 | (et (solar-ephemeris-time (list t0 0.0))) | ||
| 786 | (nut-i (solar-ecliptic-coordinates et nil)) | ||
| 787 | (nut (nth 3 nut-i)) ; nutation | ||
| 788 | (i (cadr nut-i))) ; inclination | ||
| 789 | (mod (+ (mod (+ mean-sid-time | ||
| 790 | (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0) | ||
| 791 | 24.0) | ||
| 792 | 24.0))) | ||
| 793 | |||
| 794 | (defun solar-time-equation (date ut) | ||
| 795 | "Equation of time expressed in hours at Gregorian DATE at Universal time UT." | ||
| 796 | (nth 2 (solar-ecliptic-coordinates (solar-date-to-et date ut) nil))) | ||
| 797 | |||
| 798 | (defun solar-date-to-et (date ut) | ||
| 799 | "Ephemeris Time at Gregorian DATE at Universal Time UT (in hours). | ||
| 800 | Expressed in Julian centuries of Ephemeris Time." | ||
| 801 | (solar-ephemeris-time (list (solar-julian-ut-centuries date) ut))) | ||
| 802 | 798 | ||
| 803 | ;;;###autoload | 799 | ;;;###autoload |
| 804 | (defun sunrise-sunset (&optional arg) | 800 | (defun sunrise-sunset (&optional arg) |
| @@ -1018,6 +1014,9 @@ solstice. These formulas are only to be used between 1000 BC and 3000 AD." | |||
| 1018 | (* -0.00823 z z z) | 1014 | (* -0.00823 z z z) |
| 1019 | (* 0.00032 z z z z))))))) | 1015 | (* 0.00032 z z z z))))))) |
| 1020 | 1016 | ||
| 1017 | (defvar displayed-month) ; from generate-calendar | ||
| 1018 | (defvar displayed-year) | ||
| 1019 | |||
| 1021 | ;;;###holiday-autoload | 1020 | ;;;###holiday-autoload |
| 1022 | (defun solar-equinoxes-solstices () | 1021 | (defun solar-equinoxes-solstices () |
| 1023 | "Local date and time of equinoxes and solstices, if visible in the calendar. | 1022 | "Local date and time of equinoxes and solstices, if visible in the calendar. |
| @@ -1036,8 +1035,8 @@ Requires floating point." | |||
| 1036 | (calendar-time-zone (if calendar-time-zone calendar-time-zone 0)) | 1035 | (calendar-time-zone (if calendar-time-zone calendar-time-zone 0)) |
| 1037 | (k (1- (/ m 3))) | 1036 | (k (1- (/ m 3))) |
| 1038 | (d0 (solar-equinoxes/solstices k y)) | 1037 | (d0 (solar-equinoxes/solstices k y)) |
| 1039 | (d1 (list (car d0) (floor (car (cdr d0))) (car (cdr (cdr d0))))) | 1038 | (d1 (list (car d0) (floor (cadr d0)) (nth 2 d0))) |
| 1040 | (h0 (* 24 (- (car (cdr d0)) (floor (car (cdr d0)))))) | 1039 | (h0 (* 24 (- (cadr d0) (floor (cadr d0))))) |
| 1041 | (adj (dst-adjust-time d1 h0)) | 1040 | (adj (dst-adjust-time d1 h0)) |
| 1042 | (d (list (caar adj) | 1041 | (d (list (caar adj) |
| 1043 | (+ (car (cdar adj)) | 1042 | (+ (car (cdar adj)) |