;;; Commentary:
-;; This collection of functions implements the features of calendar.el,
-;; diary.el, and holiday.el that deal with times of day, sunrise/sunset, and
-;; equinoxes/solstices.
+;; See calendar.el. This file implements features that deal with
+;; times of day, sunrise/sunset, and equinoxes/solstices.
;; Based on the ``Almanac for Computers 1984,'' prepared by the Nautical
;; Almanac Office, United States Naval Observatory, Washington, 1984, on
;; 2. Equinox/solstice times will be accurate to the minute for years
;; 1951--2050. For other years the times will be within +/- 1 minute.
-;; Technical details of all the calendrical calculations can be found in
-;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
-;; and Nachum Dershowitz, Cambridge University Press (2001).
-
;;; Code:
-(if (fboundp 'atan)
- (require 'lisp-float-type)
- (error "Solar calculations impossible since floating point is unavailable"))
-
+(require 'calendar)
(require 'cal-dst)
-(require 'cal-julian)
+;; calendar-absolute-from-astro and v versa are cal-autoloads.
+;;;(require 'cal-julian)
(defcustom calendar-time-display-form
(/ (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 (eq (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"))))
+ (if (eq (aref calendar-longitude 2) 'east) "E" "W"))))
"Expression evaluating to the name of the calendar location.
For example, \"New York City\". The default value is just the
variable `calendar-latitude' paired with the variable `calendar-longitude'.
calendar-latitude
(let ((lat (+ (aref calendar-latitude 0)
(/ (aref calendar-latitude 1) 60.0))))
- (if (equal (aref calendar-latitude 2) 'north)
+ (if (eq (aref calendar-latitude 2) 'north)
lat
(- lat)))))
calendar-longitude
(let ((long (+ (aref calendar-longitude 0)
(/ (aref calendar-longitude 1) 60.0))))
- (if (equal (aref calendar-longitude 2) 'east)
+ (if (eq (aref calendar-longitude 2) 'east)
long
(- long)))))
(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 ((= quad 2) (+ deg 180))
+ ((= quad 3) (+ deg 180))
+ ((= quad 4) (+ deg 360))
+ (t deg))))
(defun solar-atn2 (x y)
"Arctangent of point X, Y."
(/ (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 (eq (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)
+ (if (eq (aref calendar-longitude 2) 'east)
"E" "W"))))))
(calendar-standard-time-zone-name
(if (< arg 16) calendar-standard-time-zone-name
(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 ((= k 0) (+ 1721139.29189
+ (* 365242.13740 y)
+ (* 0.06134 y y)
+ (* 0.00111 y y y)
+ (* -0.00071 y y y y)))
+ ((= k 1) (+ 1721233.25401
+ (* 365241.72562 y)
+ (* -0.05323 y y)
+ (* 0.00907 y y y)
+ (* 0.00025 y y y y)))
+ ((= k 2) (+ 1721325.70455
+ (* 365242.49558 y)
+ (* -0.11677 y y)
+ (* -0.00297 y y y)
+ (* 0.00074 y y y y)))
+ ((= 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 ((= k 0) (+ 2451623.80984
+ (* 365242.37404 z)
+ (* 0.05169 z z)
+ (* -0.00411 z z z)
+ (* -0.00057 z z z z)))
+ ((= k 1) (+ 2451716.56767
+ (* 365241.62603 z)
+ (* 0.00325 z z)
+ (* 0.00888 z z z)
+ (* -0.00030 z z z z)))
+ ((= k 2) (+ 2451810.21715
+ (* 365242.01767 z)
+ (* -0.11575 z z)
+ (* 0.00337 z z z)
+ (* 0.00078 z z z z)))
+ ((= k 3) (+ 2451900.05952
+ (* 365242.74049 z)
+ (* -0.06223 z z)
+ (* -0.00823 z z z)
+ (* 0.00032 z z z z)))))))
(defvar displayed-month) ; from generate-calendar
(defvar displayed-year)
(defun solar-equinoxes-solstices ()
"Local date and time of equinoxes and solstices, if visible in the calendar.
Requires floating point."
- (let ((m displayed-month)
- (y displayed-year))
- (increment-calendar-month m y (cond ((= 1 (% m 3)) -1)
- ((= 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
- (if calendar-time-zone calendar-daylight-savings-starts))
- (calendar-daylight-savings-ends
- (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))
- (d1 (list (car d0) (floor (cadr d0)) (nth 2 d0)))
- (h0 (* 24 (- (cadr d0) (floor (cadr d0)))))
- (adj (dst-adjust-time d1 h0))
- (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
- ;; (calendar-astro-from-absolute
- ;; (calendar-absolute-from-gregorian
- ;; (list (+ 3 (* k 3)) 15 y)))
- ;; 90))
- ;; (abs-day (calendar-absolute-from-astro d)))
- (abs-day (calendar-absolute-from-gregorian d)))
- (list
- (list (calendar-gregorian-from-absolute (floor abs-day))
- (format "%s %s"
- (nth k (if (and calendar-latitude
- (< (calendar-latitude) 0))
- solar-s-hemi-seasons
- solar-n-hemi-seasons))
- (solar-time-string
- (* 24 (- abs-day (floor abs-day)))
- (if (dst-in-effect abs-day)
- calendar-daylight-time-zone-name
- calendar-standard-time-zone-name))))))))
+ (let* ((m displayed-month)
+ (y displayed-year)
+ (calendar-standard-time-zone-name
+ (if calendar-time-zone calendar-standard-time-zone-name "UTC"))
+ (calendar-daylight-savings-starts
+ (if calendar-time-zone calendar-daylight-savings-starts))
+ (calendar-daylight-savings-ends
+ (if calendar-time-zone calendar-daylight-savings-ends))
+ (calendar-time-zone (if calendar-time-zone calendar-time-zone 0))
+ (k (progn
+ (increment-calendar-month m y (cond ((= 1 (% m 3)) -1)
+ ((= 2 (% m 3)) 1)
+ (t 0)))
+ (1- (/ m 3))))
+ (d0 (solar-equinoxes/solstices k y))
+ (d1 (list (car d0) (floor (cadr d0)) (nth 2 d0)))
+ (h0 (* 24 (- (cadr d0) (floor (cadr d0)))))
+ (adj (dst-adjust-time d1 h0))
+ (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
+ ;; (calendar-astro-from-absolute
+ ;; (calendar-absolute-from-gregorian
+ ;; (list (+ 3 (* k 3)) 15 y)))
+ ;; 90))
+ ;; (abs-day (calendar-absolute-from-astro d)))
+ (abs-day (calendar-absolute-from-gregorian d)))
+ (list
+ (list (calendar-gregorian-from-absolute (floor abs-day))
+ (format "%s %s"
+ (nth k (if (and calendar-latitude
+ (< (calendar-latitude) 0))
+ solar-s-hemi-seasons
+ solar-n-hemi-seasons))
+ (solar-time-string
+ (* 24 (- abs-day (floor abs-day)))
+ (if (dst-in-effect abs-day)
+ calendar-daylight-time-zone-name
+ calendar-standard-time-zone-name)))))))
(provide 'solar)