Lines Matching +defs:calendar +defs:next +defs:calendar +defs:round +defs:date
1 ;;; cal-mayan.el --- calendar functions for the Mayan calendars
9 ;; Keywords: calendar
10 ;; Human-Keywords: Mayan calendar, Maya, calendar, diary
31 ;; This collection of functions implements the features of calendar.el and
32 ;; diary.el that deal with the Mayan calendar. It was written jointly by
56 (defvar date)
58 (require 'calendar)
60 (defconst calendar-mayan-days-before-absolute-zero 1137142
61 "Number of days of the Mayan calendar epoch before absolute day 0.
66 (defconst calendar-mayan-haab-at-epoch '(8 . 18)
67 "Mayan haab date at the epoch.")
69 (defconst calendar-mayan-haab-month-name-array
73 (defconst calendar-mayan-tzolkin-at-epoch '(4 . 20)
74 "Mayan tzolkin date at the epoch.")
76 (defconst calendar-mayan-tzolkin-names-array
80 (defun calendar-mayan-long-count-from-absolute (date)
82 (let ((long-count (+ date calendar-mayan-days-before-absolute-zero)))
93 (defun calendar-mayan-long-count-to-string (mayan-long-count)
97 (defun calendar-string-to-mayan-long-count (str)
115 (defun calendar-mayan-haab-from-absolute (date)
116 "Convert absolute DATE into a Mayan haab date (a pair)."
117 (let* ((long-count (+ date calendar-mayan-days-before-absolute-zero))
120 (car calendar-mayan-haab-at-epoch)
121 (* 20 (1- (cdr calendar-mayan-haab-at-epoch))))
127 (defun calendar-mayan-haab-difference (date1 date2)
128 "Number of days from Mayan haab DATE1 to next occurrence of haab date DATE2."
133 (defun calendar-mayan-haab-on-or-before (haab-date date)
134 "Absolute date of latest HAAB-DATE on or before absolute DATE."
135 (- date
136 (% (- date
137 (calendar-mayan-haab-difference
138 (calendar-mayan-haab-from-absolute 0) haab-date))
141 (defun calendar-next-haab-date (haab-date &optional noecho)
142 "Move cursor to next instance of Mayan HAAB-DATE.
143 Echo Mayan date if NOECHO is t."
144 (interactive (list (calendar-read-mayan-haab-date)))
145 (calendar-goto-date
146 (calendar-gregorian-from-absolute
147 (calendar-mayan-haab-on-or-before
148 haab-date
150 (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
151 (or noecho (calendar-print-mayan-date)))
153 (defun calendar-previous-haab-date (haab-date &optional noecho)
155 Echo Mayan date if NOECHO is t."
156 (interactive (list (calendar-read-mayan-haab-date)))
157 (calendar-goto-date
158 (calendar-gregorian-from-absolute
159 (calendar-mayan-haab-on-or-before
160 haab-date
161 (1- (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
162 (or noecho (calendar-print-mayan-date)))
164 (defun calendar-mayan-haab-to-string (haab)
165 "Convert Mayan haab date (a pair) into its traditional written form."
173 (aref calendar-mayan-haab-month-name-array (1- month))))))
175 (defun calendar-mayan-tzolkin-from-absolute (date)
176 "Convert absolute DATE into a Mayan tzolkin date (a pair)."
177 (let* ((long-count (+ date calendar-mayan-days-before-absolute-zero))
178 (day (calendar-mod
179 (+ long-count (car calendar-mayan-tzolkin-at-epoch))
181 (name (calendar-mod
182 (+ long-count (cdr calendar-mayan-tzolkin-at-epoch))
186 (defun calendar-mayan-tzolkin-difference (date1 date2)
187 "Number of days from Mayan tzolkin DATE1 to next occurrence of tzolkin DATE2."
195 (defun calendar-mayan-tzolkin-on-or-before (tzolkin-date date)
196 "Absolute date of latest TZOLKIN-DATE on or before absolute DATE."
197 (- date
198 (% (- date (calendar-mayan-tzolkin-difference
199 (calendar-mayan-tzolkin-from-absolute 0)
200 tzolkin-date))
203 (defun calendar-next-tzolkin-date (tzolkin-date &optional noecho)
204 "Move cursor to next instance of Mayan TZOLKIN-DATE.
205 Echo Mayan date if NOECHO is t."
206 (interactive (list (calendar-read-mayan-tzolkin-date)))
207 (calendar-goto-date
208 (calendar-gregorian-from-absolute
209 (calendar-mayan-tzolkin-on-or-before
210 tzolkin-date
212 (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
213 (or noecho (calendar-print-mayan-date)))
215 (defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho)
217 Echo Mayan date if NOECHO is t."
218 (interactive (list (calendar-read-mayan-tzolkin-date)))
219 (calendar-goto-date
220 (calendar-gregorian-from-absolute
221 (calendar-mayan-tzolkin-on-or-before
222 tzolkin-date
223 (1- (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
224 (or noecho (calendar-print-mayan-date)))
226 (defun calendar-mayan-tzolkin-to-string (tzolkin)
227 "Convert Mayan tzolkin date (a pair) into its traditional written form."
230 (aref calendar-mayan-tzolkin-names-array (1- (cdr tzolkin)))))
232 (defun calendar-mayan-tzolkin-haab-on-or-before (tzolkin-date haab-date date)
233 "Absolute date that is Mayan TZOLKIN-DATE and HAAB-DATE.
234 Latest such date on or before DATE.
237 (calendar-mayan-haab-difference
238 (calendar-mayan-haab-from-absolute 0)
239 haab-date))
241 (calendar-mayan-tzolkin-difference
242 (calendar-mayan-tzolkin-from-absolute 0)
243 tzolkin-date))
246 (- date
247 (mod (- date
252 (defun calendar-read-mayan-haab-date ()
253 "Prompt for a Mayan haab date"
255 (haab-day (calendar-read
258 (haab-month-list (append calendar-mayan-haab-month-name-array
265 (calendar-make-alist haab-month-list 1) t))))
268 (defun calendar-read-mayan-tzolkin-date ()
269 "Prompt for a Mayan tzolkin date"
271 (tzolkin-count (calendar-read
274 (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))
280 (calendar-make-alist tzolkin-name-list 1) t))))
283 (defun calendar-next-calendar-round-date
284 (tzolkin-date haab-date &optional noecho)
285 "Move cursor to next instance of Mayan HAAB-DATE TZOLKIN-DATE combination.
286 Echo Mayan date if NOECHO is t."
287 (interactive (list (calendar-read-mayan-tzolkin-date)
288 (calendar-read-mayan-haab-date)))
289 (let ((date (calendar-mayan-tzolkin-haab-on-or-before
290 tzolkin-date haab-date
291 (+ 18980 (calendar-absolute-from-gregorian
292 (calendar-cursor-to-date))))))
293 (if (not date)
294 (error "%s, %s does not exist in the Mayan calendar round"
295 (calendar-mayan-tzolkin-to-string tzolkin-date)
296 (calendar-mayan-haab-to-string haab-date))
297 (calendar-goto-date (calendar-gregorian-from-absolute date))
298 (or noecho (calendar-print-mayan-date)))))
300 (defun calendar-previous-calendar-round-date
301 (tzolkin-date haab-date &optional noecho)
303 Echo Mayan date if NOECHO is t."
304 (interactive (list (calendar-read-mayan-tzolkin-date)
305 (calendar-read-mayan-haab-date)))
306 (let ((date (calendar-mayan-tzolkin-haab-on-or-before
307 tzolkin-date haab-date
308 (1- (calendar-absolute-from-gregorian
309 (calendar-cursor-to-date))))))
310 (if (not date)
311 (error "%s, %s does not exist in the Mayan calendar round"
312 (calendar-mayan-tzolkin-to-string tzolkin-date)
313 (calendar-mayan-haab-to-string haab-date))
314 (calendar-goto-date (calendar-gregorian-from-absolute date))
315 (or noecho (calendar-print-mayan-date)))))
317 (defun calendar-absolute-from-mayan-long-count (c)
318 "Compute the absolute date corresponding to the Mayan Long Count C.
325 (- ; days before absolute date 0
326 calendar-mayan-days-before-absolute-zero)))
328 (defun calendar-mayan-date-string (&optional date)
329 "String of Mayan date of Gregorian DATE.
330 Defaults to today's date if DATE is not given."
331 (let* ((d (calendar-absolute-from-gregorian
332 (or date (calendar-current-date))))
333 (tzolkin (calendar-mayan-tzolkin-from-absolute d))
334 (haab (calendar-mayan-haab-from-absolute d))
335 (long-count (calendar-mayan-long-count-from-absolute d)))
337 (calendar-mayan-long-count-to-string long-count)
338 (calendar-mayan-tzolkin-to-string tzolkin)
339 (calendar-mayan-haab-to-string haab))))
341 (defun calendar-print-mayan-date ()
342 "Show the Mayan long count, tzolkin, and haab equivalents of date."
344 (message "Mayan date: %s"
345 (calendar-mayan-date-string (calendar-cursor-to-date t))))
347 (defun calendar-goto-mayan-long-count-date (date &optional noecho)
348 "Move cursor to Mayan long count DATE. Echo Mayan date unless NOECHO is t."
353 (calendar-string-to-mayan-long-count
355 (calendar-mayan-long-count-to-string
356 (calendar-mayan-long-count-from-absolute
357 (calendar-absolute-from-gregorian
358 (calendar-current-date))))))))
359 (if (calendar-mayan-long-count-common-era datum)
362 (calendar-goto-date
363 (calendar-gregorian-from-absolute
364 (calendar-absolute-from-mayan-long-count date)))
365 (or noecho (calendar-print-mayan-date)))
367 (defun calendar-mayan-long-count-common-era (lc)
368 "T if long count represents date in the Common Era."
369 (let ((base (calendar-mayan-long-count-from-absolute 1)))
375 (defun diary-mayan-date ()
377 (format "Mayan date: %s" (calendar-mayan-date-string date)))