-;;; cal-mayan.el --- calendar functions for the Mayan calendars.
+;;; cal-mayan.el --- calendar functions for the Mayan calendars
-;; Copyright (C) 1992 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1993, 1995, 1997, 2001, 2002, 2003, 2004, 2005,
+;; 2006 Free Software Foundation, Inc.
;; Author: Stewart M. Clamen <clamen@cs.cmu.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: Mayan calendar, Maya, calendar, diary
+;; Maintainer: Glenn Morris <rgm@gnu.org>
+;; Keywords: calendar
+;; Human-Keywords: Mayan calendar, Maya, calendar, diary
;; This file is part of GNU Emacs.
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Comments, improvements, and bug reports should be sent to Reingold.
;; Technical details of the Mayan calendrical calculations can be found in
+;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
+;; and Nachum Dershowitz, Cambridge University Press (2001), and in
;; ``Calendrical Calculations, Part II: Three Historical Calendars''
;; by E. M. Reingold, N. Dershowitz, and S. M. Clamen,
-;; Report Number UIUCDCS-R-92-1743, Department of Computer Science,
-;; University of Illinois, April, 1992.
+;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
+;; pages 383-404.
;;; Code:
-(require 'calendar)
-
-(defun mayan-mod (m n)
- "Returns M mod N; value is *always* non-negative when N>0."
- (let ((v (% m n)))
- (if (and (> 0 v) (> n 0))
- (+ v n)
- v)))
+(defvar date)
-(defun mayan-adjusted-mod (m n)
- "Non-negative remainder of M/N with N instead of 0."
- (1+ (mayan-mod (1- m) n)))
+(require 'calendar)
-(defconst calendar-mayan-days-before-absolute-zero 1137140
- "Number of days of the Mayan calendar epoch before absolute day 0 (that is,
-Dec 31, 0 (Gregorian)), according to the Goodman-Martinez-Thompson
-correlation. This correlation is not universally accepted, as it still a
-subject of astro-archeological research. Using 1232041 will give you the
-correlation used by Spinden.")
+(defconst calendar-mayan-days-before-absolute-zero 1137142
+ "Number of days of the Mayan calendar epoch before absolute day 0.
+This is the Goodman-Martinez-Thompson correlation used by almost all experts,
+but some use 1137140. Using 1232041 gives you Spinden's correlation; using
+1142840 gives you Hochleitner's correlation.")
(defconst calendar-mayan-haab-at-epoch '(8 . 18)
"Mayan haab date at the epoch.")
(condition-case condition
(progn
(while (< cc c)
- (let ((datum (read-from-string str cc)))
- (if (not (integerp (car datum)))
- (signal 'invalid-read-syntax (car datum))
- (setq rlc (cons (car datum) rlc))
- (setq cc (cdr datum)))))
+ (let* ((start (string-match "[0-9]+" str cc))
+ (end (match-end 0))
+ datum)
+ (setq datum (read (substring str start end)))
+ (setq rlc (cons datum rlc))
+ (setq cc end)))
(if (not (= (length rlc) 5)) (signal 'invalid-read-syntax nil)))
(invalid-read-syntax nil))
(reverse rlc)))
(cons day month)))
(defun calendar-mayan-haab-difference (date1 date2)
- "Number of days from Mayan haab date DATE1 to the next occurrence of Mayan
-haab date DATE2."
- (mayan-mod (+ (* 20 (- (cdr date2) (cdr date1)))
- (- (car date2) (car date1)))
- 365))
+ "Number of days from Mayan haab DATE1 to next occurrence of haab date DATE2."
+ (mod (+ (* 20 (- (cdr date2) (cdr date1)))
+ (- (car date2) (car date1)))
+ 365))
(defun calendar-mayan-haab-on-or-before (haab-date date)
"Absolute date of latest HAAB-DATE on or before absolute DATE."
- (- date
- (mod (- date
- (calendar-mayan-haab-difference
- (calendar-mayan-haab-from-absolute 0) haab-date))
- 365)))
+ (- date
+ (% (- date
+ (calendar-mayan-haab-difference
+ (calendar-mayan-haab-from-absolute 0) haab-date))
+ 365)))
(defun calendar-next-haab-date (haab-date &optional noecho)
- "Move cursor to next instance of Mayan HAAB-DATE.
+ "Move cursor to next instance of Mayan HAAB-DATE.
Echo Mayan date if NOECHO is t."
(interactive (list (calendar-read-mayan-haab-date)))
(calendar-goto-date
(or noecho (calendar-print-mayan-date)))
(defun calendar-previous-haab-date (haab-date &optional noecho)
- "Move cursor to previous instance of Mayan HAAB-DATE.
+ "Move cursor to previous instance of Mayan HAAB-DATE.
Echo Mayan date if NOECHO is t."
(interactive (list (calendar-read-mayan-haab-date)))
(calendar-goto-date
(defun calendar-mayan-tzolkin-from-absolute (date)
"Convert absolute DATE into a Mayan tzolkin date (a pair)."
(let* ((long-count (+ date calendar-mayan-days-before-absolute-zero))
- (day (mayan-adjusted-mod
+ (day (calendar-mod
(+ long-count (car calendar-mayan-tzolkin-at-epoch))
13))
- (name (mayan-adjusted-mod
+ (name (calendar-mod
(+ long-count (cdr calendar-mayan-tzolkin-at-epoch))
20)))
(cons day name)))
(defun calendar-mayan-tzolkin-difference (date1 date2)
- "Number of days from Mayan tzolkin date DATE1 to the next occurrence of
-Mayan tzolkin date DATE2."
+ "Number of days from Mayan tzolkin DATE1 to next occurrence of tzolkin DATE2."
(let ((number-difference (- (car date2) (car date1)))
(name-difference (- (cdr date2) (cdr date1))))
- (mayan-mod (+ number-difference
- (* 13 (mayan-mod (* 3 (- number-difference name-difference))
- 20)))
- 260)))
+ (mod (+ number-difference
+ (* 13 (mod (* 3 (- number-difference name-difference))
+ 20)))
+ 260)))
(defun calendar-mayan-tzolkin-on-or-before (tzolkin-date date)
"Absolute date of latest TZOLKIN-DATE on or before absolute DATE."
- (- date
- (mod (- date (calendar-mayan-tzolkin-difference
- (calendar-mayan-tzolkin-from-absolute 0)
- tzolkin-date))
- 260)))
+ (- date
+ (% (- date (calendar-mayan-tzolkin-difference
+ (calendar-mayan-tzolkin-from-absolute 0)
+ tzolkin-date))
+ 260)))
(defun calendar-next-tzolkin-date (tzolkin-date &optional noecho)
- "Move cursor to next instance of Mayan TZOLKIN-DATE.
+ "Move cursor to next instance of Mayan TZOLKIN-DATE.
Echo Mayan date if NOECHO is t."
(interactive (list (calendar-read-mayan-tzolkin-date)))
(calendar-goto-date
(or noecho (calendar-print-mayan-date)))
(defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho)
- "Move cursor to previous instance of Mayan TZOLKIN-DATE.
+ "Move cursor to previous instance of Mayan TZOLKIN-DATE.
Echo Mayan date if NOECHO is t."
(interactive (list (calendar-read-mayan-tzolkin-date)))
(calendar-goto-date
(aref calendar-mayan-tzolkin-names-array (1- (cdr tzolkin)))))
(defun calendar-mayan-tzolkin-haab-on-or-before (tzolkin-date haab-date date)
- "Absolute date of latest date on or before date that is Mayan TZOLKIN-DATE
-and HAAB-DATE; returns nil if such a tzolkin-haab combination is impossible."
+ "Absolute date that is Mayan TZOLKIN-DATE and HAAB-DATE.
+Latest such date on or before DATE.
+Returns nil if such a tzolkin-haab combination is impossible."
(let* ((haab-difference
(calendar-mayan-haab-difference
(calendar-mayan-haab-from-absolute 0)
(difference (- tzolkin-difference haab-difference)))
(if (= (% difference 5) 0)
(- date
- (mayan-mod (- date
- (+ haab-difference (* 365 difference)))
- 18980))
+ (mod (- date
+ (+ haab-difference (* 365 difference)))
+ 18980))
nil)))
(defun calendar-read-mayan-haab-date ()
(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
+ (haab-month-list (append calendar-mayan-haab-month-name-array
(and (< haab-day 5) '("Uayeb"))))
(haab-month (cdr
- (assoc
- (capitalize
- (completing-read "Haab uinal: "
- (mapcar 'list haab-month-list)
- nil t))
- (calendar-make-alist
- haab-month-list 1 'capitalize)))))
+ (assoc-string
+ (completing-read "Haab uinal: "
+ (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 ()
'(lambda (x) (and (> x 0) (< x 14)))))
(tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))
(tzolkin-name (cdr
- (assoc
- (capitalize
- (completing-read "Tzolkin uinal: "
+ (assoc-string
+ (completing-read "Tzolkin uinal: "
(mapcar 'list tzolkin-name-list)
- nil t))
- (calendar-make-alist
- tzolkin-name-list 1 'capitalize)))))
+ nil t)
+ (calendar-make-alist tzolkin-name-list 1) t))))
(cons tzolkin-count tzolkin-name)))
-(defun calendar-next-tzolkin-date (tzolkin-date &optional noecho)
- "Move cursor to next instance of Mayan TZOLKIN-DATE.
-Echo Mayan date if NOECHO is t."
- (interactive (list (calendar-read-mayan-tzolkin-date)))
- (let* ((date (calendar-absolute-from-gregorian (calendar-cursor-to-date)))
- (tomorrow-tzolkin-date
- (calendar-mayan-tzolkin-from-absolute (1+ date))))
- (calendar-goto-date
- (calendar-gregorian-from-absolute
- (+ date 1
- (calendar-mayan-tzolkin-difference
- tomorrow-tzolkin-date tzolkin-date)))))
- (or noecho (calendar-print-mayan-date)))
-
(defun calendar-next-calendar-round-date
(tzolkin-date haab-date &optional noecho)
- "Move cursor to next instance of Mayan HAAB-DATE TZOKLIN-DATE combination.
+ "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)))
(defun calendar-previous-calendar-round-date
(tzolkin-date haab-date &optional noecho)
- "Move cursor to previous instance of Mayan TZOKLIN-DATE HAAB-DATE
-combination. Echo Mayan date if NOECHO is t."
+ "Move to previous instance of Mayan TZOLKIN-DATE HAAB-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
(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$, which is a list (baktun katun tun uinal kin)"
+ "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
(- ; days before absolute date 0
calendar-mayan-days-before-absolute-zero)))
-(defun calendar-print-mayan-date ()
- "Show the Mayan long count, tzolkin, and haab equivalents of the date
-under the cursor."
- (interactive)
+(defun calendar-mayan-date-string (&optional date)
+ "String of Mayan date of Gregorian DATE.
+Defaults to today's date if DATE is not given."
(let* ((d (calendar-absolute-from-gregorian
- (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!"))))
+ (or date (calendar-current-date))))
(tzolkin (calendar-mayan-tzolkin-from-absolute d))
(haab (calendar-mayan-haab-from-absolute d))
(long-count (calendar-mayan-long-count-from-absolute d)))
- (message "Mayan date: Long count = %s; tzolkin = %s; haab = %s"
- (calendar-mayan-long-count-to-string long-count)
- (calendar-mayan-tzolkin-to-string tzolkin)
- (calendar-mayan-haab-to-string haab))))
+ (format "Long count = %s; tzolkin = %s; haab = %s"
+ (calendar-mayan-long-count-to-string long-count)
+ (calendar-mayan-tzolkin-to-string tzolkin)
+ (calendar-mayan-haab-to-string haab))))
+
+(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-goto-mayan-long-count-date (date &optional noecho)
"Move cursor to Mayan long count DATE. Echo Mayan date unless NOECHO is t."
(let (lc)
(while (not lc)
(let ((datum
- (calendar-string-to-mayan-long-count
+ (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-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)))
(defun diary-mayan-date ()
"Show the Mayan long count, haab, and tzolkin dates as a diary entry."
- (let* ((d (calendar-absolute-from-gregorian date))
- (tzolkin (calendar-mayan-tzolkin-from-absolute d))
- (haab (calendar-mayan-haab-from-absolute d))
- (long-count (calendar-mayan-long-count-from-absolute d)))
- (format "Mayan date: Long count = %s; tzolkin = %s; haab = %s"
- (calendar-mayan-long-count-to-string long-count)
- (calendar-mayan-tzolkin-to-string haab)
- (calendar-mayan-haab-to-string tzolkin))))
+ (format "Mayan date: %s" (calendar-mayan-date-string date)))
(provide 'cal-mayan)
+;;; arch-tag: 54f35144-cd0f-4873-935a-a60129de07df
;;; cal-mayan.el ends here