comparison lisp/calendar/cal-mayan.el @ 92636:f565309f0cab

(calendar-string-to-mayan-long-count) (calendar-mayan-haab-to-string, calendar-mayan-tzolkin-to-string) (calendar-read-mayan-haab-date, calendar-read-mayan-tzolkin-date) (calendar-next-calendar-round-date) (calendar-mayan-long-count-common-era): Doc fixes.

92635:fb3f66f11422

(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 nums."
  (let ((rlc nil)
        (c (length str))
        (cc 0))
    (condition-case condition
        (progn

     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))
        (day (car haab)))
  ;; 19th month consists of 5 special days
  (if (= month 19)
      (format "%d Uayeb" day)

     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)
          (aref calendar-mayan-tzolkin-names-array (1- (cdr tzolkin)))))

(defun calendar-mayan-tzolkin-haab-on-or-before (tzolkin-date haab-date date)

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

(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)))))
         (haab-month-list (append calendar-mayan-haab-month-name-array

                                        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)))))
         (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))

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

;;;###autoload
(defun calendar-next-calendar-round-date
  (tzolkin-date haab-date &optional noecho)
  "Move cursor to next instance of Mayan HAAB-DATE TZOLKIN-DATE combination.
Echo Mayan date if NOECHO is t."
  (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-gregorian-from-absolute
    (calendar-absolute-from-mayan-long-count date)))
  (or noecho (calendar-print-mayan-date)))

(defun calendar-mayan-long-count-common-era (lc)
  "T if long count represents date in the Common Era."
  (let ((base (calendar-mayan-long-count-from-absolute 1)))
    (while (and (not (null base)) (= (car lc) (car base)))
      (setq lc (cdr lc)
            base (cdr base)))
    (or (null lc) (> (car lc) (car base)))))

92636:f565309f0cab

(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 ((rlc nil)
        (c (length str))
        (cc 0))
    (condition-case condition
        (progn

     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))
        (day (car haab)))
  ;; 19th month consists of 5 special days
  (if (= month 19)
      (format "%d Uayeb" day)

     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)
          (aref calendar-mayan-tzolkin-names-array (1- (cdr tzolkin)))))

(defun calendar-mayan-tzolkin-haab-on-or-before (tzolkin-date haab-date date)

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

(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)))))
         (haab-month-list (append calendar-mayan-haab-month-name-array

                                        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)))))
         (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))

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

;;;###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-gregorian-from-absolute
    (calendar-absolute-from-mayan-long-count date)))
  (or noecho (calendar-print-mayan-date)))

(defun calendar-mayan-long-count-common-era (lc)
  "Return non-nil if long count LC represents a date in the Common Era."
  (let ((base (calendar-mayan-long-count-from-absolute 1)))
    (while (and (not (null base)) (= (car lc) (car base)))
      (setq lc (cdr lc)
            base (cdr base)))
    (or (null lc) (> (car lc) (car base)))))