comparison lisp/calendar/cal-mayan.el @ 93645:8b04f0b12fa3

(calendar-mayan-string-from-long-count): Rename calendar-string-to-mayan-long-count. Update callers. (calendar-mayan-print-date): Rename calendar-print-mayan-date. Update callers, keep old name as alias. (calendar-mayan-read-haab-date): Rename calendar-read-mayan-haab-date. Update callers. (calendar-mayan-read-tzolkin-date): Rename calendar-read-mayan-tzolkin-date. Update callers. (calendar-mayan-next-haab-date): Rename calendar-next-haab-date. Keep old name as alias. (calendar-mayan-previous-haab-date): Rename calendar-previous-haab-date. Keep old name as alias. (calendar-mayan-next-tzolkin-date): Rename calendar-next-tzolkin-date. Keep old name as alias. (calendar-mayan-previous-tzolkin-date): Rename calendar-previous-tzolkin-date. Keep old name as alias. (calendar-mayan-next-round-date): Rename calendar-next-calendar-round-date. Keep old name as alias. (calendar-mayan-previous-round-date): Rename calendar-previous-calendar-round-date. Keep old name as alias. (calendar-mayan-long-count-to-absolute): Rename calendar-absolute-from-mayan-long-count. Keep old name as alias. (calendar-mayan-goto-long-count-date): Rename calendar-goto-mayan-long-count-date. Keep old name as alias.

93644:05a344ce267f

(defun calendar-mayan-long-count-to-string (mayan-long-count)
  "Convert MAYAN-LONG-COUNT into traditional written form."
  (apply 'format (cons "%s.%s.%s.%s.%s" mayan-long-count)))

(defun calendar-string-to-mayan-long-count (str)
  "Given STR, a string of format \"%d.%d.%d.%d.%d\", return list of numbers."
  (let ((end 0)
        rlc)
    (condition-case nil
        (progn

            (calendar-mayan-long-count-to-string long-count)
            (calendar-mayan-tzolkin-to-string tzolkin)
            (calendar-mayan-haab-to-string haab))))

;;;###cal-autoload
(defun calendar-print-mayan-date ()
  "Show the Mayan long count, tzolkin, and haab equivalents of date."
  (interactive)
  (message "Mayan date: %s"
           (calendar-mayan-date-string (calendar-cursor-to-date t))))

(defun calendar-read-mayan-haab-date ()
  "Prompt for a Mayan haab date."
  (let* ((completion-ignore-case t)
         (haab-day (calendar-read
                    "Haab kin (0-19): "
                    (lambda (x) (and (>= x 0) (< x 20)))))

                                        (mapcar 'list haab-month-list)
                                        nil t)
                       (calendar-make-alist haab-month-list 1) t))))
    (cons haab-day haab-month)))

(defun calendar-read-mayan-tzolkin-date ()
  "Prompt for a Mayan tzolkin date."
  (let* ((completion-ignore-case t)
         (tzolkin-count (calendar-read
                         "Tzolkin kin (1-13): "
                         (lambda (x) (and (> x 0) (< x 14)))))

                                          nil t)
                         (calendar-make-alist tzolkin-name-list 1) t))))
    (cons tzolkin-count tzolkin-name)))

;;;###cal-autoload
(defun calendar-next-haab-date (haab-date &optional noecho)
  "Move cursor to next instance of Mayan HAAB-DATE.
Echo Mayan date unless NOECHO is non-nil."
  (interactive (list (calendar-read-mayan-haab-date)))
  (calendar-goto-date
   (calendar-gregorian-from-absolute
    (calendar-mayan-haab-on-or-before
     haab-date
     (+ 365
        (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
  (or noecho (calendar-print-mayan-date)))

;;;###cal-autoload
(defun calendar-previous-haab-date (haab-date &optional noecho)
  "Move cursor to previous instance of Mayan HAAB-DATE.
Echo Mayan date unless NOECHO is non-nil."
  (interactive (list (calendar-read-mayan-haab-date)))
  (calendar-goto-date
   (calendar-gregorian-from-absolute
    (calendar-mayan-haab-on-or-before
     haab-date
     (1- (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
  (or noecho (calendar-print-mayan-date)))

(defun calendar-mayan-haab-to-string (haab)
  "Convert Mayan HAAB date (a pair) into its traditional written form."
  (let ((month (cdr haab)))
    (format "%d %s" (car haab)          ; day

                 (calendar-mayan-tzolkin-from-absolute 0)
                 tzolkin-date))
        260)))

;;;###cal-autoload
(defun calendar-next-tzolkin-date (tzolkin-date &optional noecho)
  "Move cursor to next instance of Mayan TZOLKIN-DATE.
Echo Mayan date unless NOECHO is non-nil."
  (interactive (list (calendar-read-mayan-tzolkin-date)))
  (calendar-goto-date
   (calendar-gregorian-from-absolute
    (calendar-mayan-tzolkin-on-or-before
     tzolkin-date
     (+ 260
        (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
  (or noecho (calendar-print-mayan-date)))

;;;###cal-autoload
(defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho)
  "Move cursor to previous instance of Mayan TZOLKIN-DATE.
Echo Mayan date unless NOECHO is non-nil."
  (interactive (list (calendar-read-mayan-tzolkin-date)))
  (calendar-goto-date
   (calendar-gregorian-from-absolute
    (calendar-mayan-tzolkin-on-or-before
     tzolkin-date
     (1- (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
  (or noecho (calendar-print-mayan-date)))

(defun calendar-mayan-tzolkin-to-string (tzolkin)
  "Convert Mayan TZOLKIN date (a pair) into its traditional written form."
  (format "%d %s"
          (car tzolkin)

                   (+ haab-difference (* 365 difference)))
                18980))
      nil)))

;;;###cal-autoload
(defun calendar-next-calendar-round-date (tzolkin-date haab-date
                                                       &optional noecho)
  "Move cursor to next instance of Mayan TZOLKIN-DATE HAAB-DATE combination.
Echo Mayan date unless NOECHO is non-nil."
  (interactive (list (calendar-read-mayan-tzolkin-date)
                     (calendar-read-mayan-haab-date)))
  (let ((date (calendar-mayan-tzolkin-haab-on-or-before
               tzolkin-date haab-date
               (+ 18980 (calendar-absolute-from-gregorian
                         (calendar-cursor-to-date))))))
    (if (not date)
        (error "%s, %s does not exist in the Mayan calendar round"
               (calendar-mayan-tzolkin-to-string tzolkin-date)
               (calendar-mayan-haab-to-string haab-date))
      (calendar-goto-date (calendar-gregorian-from-absolute date))
      (or noecho (calendar-print-mayan-date)))))

;;;###cal-autoload
(defun calendar-previous-calendar-round-date
  (tzolkin-date haab-date &optional noecho)
  "Move to previous instance of Mayan TZOLKIN-DATE HAAB-DATE combination.
Echo Mayan date unless NOECHO is non-nil."
  (interactive (list (calendar-read-mayan-tzolkin-date)
                     (calendar-read-mayan-haab-date)))
  (let ((date (calendar-mayan-tzolkin-haab-on-or-before
               tzolkin-date haab-date
               (1- (calendar-absolute-from-gregorian
                    (calendar-cursor-to-date))))))
    (if (not date)
        (error "%s, %s does not exist in the Mayan calendar round"
               (calendar-mayan-tzolkin-to-string tzolkin-date)
               (calendar-mayan-haab-to-string haab-date))
      (calendar-goto-date (calendar-gregorian-from-absolute date))
      (or noecho (calendar-print-mayan-date)))))

(defun calendar-absolute-from-mayan-long-count (c)
  "Compute the absolute date corresponding to the Mayan Long Count C.
Long count is a list (baktun katun tun uinal kin)"
  (+ (* (nth 0 c) 144000)               ; baktun
     (* (nth 1 c) 7200)                 ; katun
     (* (nth 2 c) 360)                  ; tun

      (setq lc (cdr lc)
            base (cdr base)))
    (or (null lc) (> (car lc) (car base)))))

;;;###cal-autoload
(defun calendar-goto-mayan-long-count-date (date &optional noecho)
  "Move cursor to Mayan long count DATE.
Echo Mayan date unless NOECHO is non-nil."
  (interactive
   (let (datum)
     (while (not (setq datum
                       (calendar-string-to-mayan-long-count
                        (read-string
                         "Mayan long count (baktun.katun.tun.uinal.kin): "
                         (calendar-mayan-long-count-to-string
                          (calendar-mayan-long-count-from-absolute
                           (calendar-absolute-from-gregorian

                       datum (if (calendar-mayan-long-count-common-era datum)
                                 (list datum)))))
     datum))
  (calendar-goto-date
   (calendar-gregorian-from-absolute
    (calendar-absolute-from-mayan-long-count date)))
  (or noecho (calendar-print-mayan-date)))

(defvar date)

;; To be called from list-sexp-diary-entries, where DATE is bound.
;;;###diary-autoload

93645:8b04f0b12fa3

(defun calendar-mayan-long-count-to-string (mayan-long-count)
  "Convert MAYAN-LONG-COUNT into traditional written form."
  (apply 'format (cons "%s.%s.%s.%s.%s" mayan-long-count)))

(defun calendar-mayan-string-from-long-count (str)
  "Given STR, a string of format \"%d.%d.%d.%d.%d\", return list of numbers."
  (let ((end 0)
        rlc)
    (condition-case nil
        (progn

            (calendar-mayan-long-count-to-string long-count)
            (calendar-mayan-tzolkin-to-string tzolkin)
            (calendar-mayan-haab-to-string haab))))

;;;###cal-autoload
(defun calendar-mayan-print-date ()
  "Show the Mayan long count, tzolkin, and haab equivalents of date."
  (interactive)
  (message "Mayan date: %s"
           (calendar-mayan-date-string (calendar-cursor-to-date t))))

(define-obsolete-function-alias 'calendar-print-mayan-date
  'calendar-mayan-print-date "23.1")

(defun calendar-mayan-read-haab-date ()
  "Prompt for a Mayan haab date."
  (let* ((completion-ignore-case t)
         (haab-day (calendar-read
                    "Haab kin (0-19): "
                    (lambda (x) (and (>= x 0) (< x 20)))))

                                        (mapcar 'list haab-month-list)
                                        nil t)
                       (calendar-make-alist haab-month-list 1) t))))
    (cons haab-day haab-month)))

(defun calendar-mayan-read-tzolkin-date ()
  "Prompt for a Mayan tzolkin date."
  (let* ((completion-ignore-case t)
         (tzolkin-count (calendar-read
                         "Tzolkin kin (1-13): "
                         (lambda (x) (and (> x 0) (< x 14)))))

                                          nil t)
                         (calendar-make-alist tzolkin-name-list 1) t))))
    (cons tzolkin-count tzolkin-name)))

;;;###cal-autoload
(defun calendar-mayan-next-haab-date (haab-date &optional noecho)
  "Move cursor to next instance of Mayan HAAB-DATE.
Echo Mayan date unless NOECHO is non-nil."
  (interactive (list (calendar-mayan-read-haab-date)))
  (calendar-goto-date
   (calendar-gregorian-from-absolute
    (calendar-mayan-haab-on-or-before
     haab-date
     (+ 365
        (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
  (or noecho (calendar-mayan-print-date)))

(define-obsolete-function-alias 'calendar-next-haab-date
  'calendar-mayan-next-haab-date "23.1")

;;;###cal-autoload
(defun calendar-mayan-previous-haab-date (haab-date &optional noecho)
  "Move cursor to previous instance of Mayan HAAB-DATE.
Echo Mayan date unless NOECHO is non-nil."
  (interactive (list (calendar-mayan-read-haab-date)))
  (calendar-goto-date
   (calendar-gregorian-from-absolute
    (calendar-mayan-haab-on-or-before
     haab-date
     (1- (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
  (or noecho (calendar-mayan-print-date)))

(define-obsolete-function-alias 'calendar-previous-haab-date
  'calendar-mayan-previous-haab-date "23.1")

(defun calendar-mayan-haab-to-string (haab)
  "Convert Mayan HAAB date (a pair) into its traditional written form."
  (let ((month (cdr haab)))
    (format "%d %s" (car haab)          ; day

                 (calendar-mayan-tzolkin-from-absolute 0)
                 tzolkin-date))
        260)))

;;;###cal-autoload
(defun calendar-mayan-next-tzolkin-date (tzolkin-date &optional noecho)
  "Move cursor to next instance of Mayan TZOLKIN-DATE.
Echo Mayan date unless NOECHO is non-nil."
  (interactive (list (calendar-mayan-read-tzolkin-date)))
  (calendar-goto-date
   (calendar-gregorian-from-absolute
    (calendar-mayan-tzolkin-on-or-before
     tzolkin-date
     (+ 260
        (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
  (or noecho (calendar-mayan-print-date)))

(define-obsolete-function-alias 'calendar-next-tzolkin-date
  'calendar-mayan-next-tzolkin-date "23.1")

;;;###cal-autoload
(defun calendar-mayan-previous-tzolkin-date (tzolkin-date &optional noecho)
  "Move cursor to previous instance of Mayan TZOLKIN-DATE.
Echo Mayan date unless NOECHO is non-nil."
  (interactive (list (calendar-mayan-read-tzolkin-date)))
  (calendar-goto-date
   (calendar-gregorian-from-absolute
    (calendar-mayan-tzolkin-on-or-before
     tzolkin-date
     (1- (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
  (or noecho (calendar-mayan-print-date)))

(define-obsolete-function-alias 'calendar-previous-tzolkin-date
  'calendar-mayan-previous-tzolkin-date "23.1")

(defun calendar-mayan-tzolkin-to-string (tzolkin)
  "Convert Mayan TZOLKIN date (a pair) into its traditional written form."
  (format "%d %s"
          (car tzolkin)

                   (+ haab-difference (* 365 difference)))
                18980))
      nil)))

;;;###cal-autoload
(defun calendar-mayan-next-round-date (tzolkin-date haab-date
                                                       &optional noecho)
  "Move cursor to next instance of Mayan TZOLKIN-DATE HAAB-DATE combination.
Echo Mayan date unless NOECHO is non-nil."
  (interactive (list (calendar-mayan-read-tzolkin-date)
                     (calendar-mayan-read-haab-date)))
  (let ((date (calendar-mayan-tzolkin-haab-on-or-before
               tzolkin-date haab-date
               (+ 18980 (calendar-absolute-from-gregorian
                         (calendar-cursor-to-date))))))
    (if (not date)
        (error "%s, %s does not exist in the Mayan calendar round"
               (calendar-mayan-tzolkin-to-string tzolkin-date)
               (calendar-mayan-haab-to-string haab-date))
      (calendar-goto-date (calendar-gregorian-from-absolute date))
      (or noecho (calendar-mayan-print-date)))))

(define-obsolete-function-alias 'calendar-next-calendar-round-date
  'calendar-mayan-next-round-date "23.1")

;;;###cal-autoload
(defun calendar-mayan-previous-round-date
  (tzolkin-date haab-date &optional noecho)
  "Move to previous instance of Mayan TZOLKIN-DATE HAAB-DATE combination.
Echo Mayan date unless NOECHO is non-nil."
  (interactive (list (calendar-mayan-read-tzolkin-date)
                     (calendar-mayan-read-haab-date)))
  (let ((date (calendar-mayan-tzolkin-haab-on-or-before
               tzolkin-date haab-date
               (1- (calendar-absolute-from-gregorian
                    (calendar-cursor-to-date))))))
    (if (not date)
        (error "%s, %s does not exist in the Mayan calendar round"
               (calendar-mayan-tzolkin-to-string tzolkin-date)
               (calendar-mayan-haab-to-string haab-date))
      (calendar-goto-date (calendar-gregorian-from-absolute date))
      (or noecho (calendar-mayan-print-date)))))

(define-obsolete-function-alias 'calendar-previous-calendar-round-date
  'calendar-mayan-previous-round-date "23.1")

(defun calendar-mayan-long-count-to-absolute (c)
  "Compute the absolute date corresponding to the Mayan Long Count C.
Long count is a list (baktun katun tun uinal kin)"
  (+ (* (nth 0 c) 144000)               ; baktun
     (* (nth 1 c) 7200)                 ; katun
     (* (nth 2 c) 360)                  ; tun

      (setq lc (cdr lc)
            base (cdr base)))
    (or (null lc) (> (car lc) (car base)))))

;;;###cal-autoload
(defun calendar-mayan-goto-long-count-date (date &optional noecho)
  "Move cursor to Mayan long count DATE.
Echo Mayan date unless NOECHO is non-nil."
  (interactive
   (let (datum)
     (while (not (setq datum
                       (calendar-mayan-string-from-long-count
                        (read-string
                         "Mayan long count (baktun.katun.tun.uinal.kin): "
                         (calendar-mayan-long-count-to-string
                          (calendar-mayan-long-count-from-absolute
                           (calendar-absolute-from-gregorian

                       datum (if (calendar-mayan-long-count-common-era datum)
                                 (list datum)))))
     datum))
  (calendar-goto-date
   (calendar-gregorian-from-absolute
    (calendar-mayan-long-count-to-absolute date)))
  (or noecho (calendar-mayan-print-date)))

(define-obsolete-function-alias 'calendar-goto-mayan-long-count-date
  'calendar-mayan-goto-long-count-date "23.1")

(defvar date)

;; To be called from list-sexp-diary-entries, where DATE is bound.
;;;###diary-autoload