Mercurial > emacs
comparison lisp/calendar/cal-mayan.el @ 49598:0d8b17d428b5
Trailing whitepace deleted.
| author | Juanma Barranquero <lekktu@gmail.com> |
|---|---|
| date | Tue, 04 Feb 2003 13:24:35 +0000 |
| parents | 7a94f1c588c4 |
| children | 695cf19ef79e d7ddb3e565de |
comparison
equal
deleted
inserted
replaced
| 49597:e88404e8f2cf | 49598:0d8b17d428b5 |
|---|---|
| 135 (calendar-mayan-haab-difference | 135 (calendar-mayan-haab-difference |
| 136 (calendar-mayan-haab-from-absolute 0) haab-date)) | 136 (calendar-mayan-haab-from-absolute 0) haab-date)) |
| 137 365))) | 137 365))) |
| 138 | 138 |
| 139 (defun calendar-next-haab-date (haab-date &optional noecho) | 139 (defun calendar-next-haab-date (haab-date &optional noecho) |
| 140 "Move cursor to next instance of Mayan HAAB-DATE. | 140 "Move cursor to next instance of Mayan HAAB-DATE. |
| 141 Echo Mayan date if NOECHO is t." | 141 Echo Mayan date if NOECHO is t." |
| 142 (interactive (list (calendar-read-mayan-haab-date))) | 142 (interactive (list (calendar-read-mayan-haab-date))) |
| 143 (calendar-goto-date | 143 (calendar-goto-date |
| 144 (calendar-gregorian-from-absolute | 144 (calendar-gregorian-from-absolute |
| 145 (calendar-mayan-haab-on-or-before | 145 (calendar-mayan-haab-on-or-before |
| 147 (+ 365 | 147 (+ 365 |
| 148 (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) | 148 (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) |
| 149 (or noecho (calendar-print-mayan-date))) | 149 (or noecho (calendar-print-mayan-date))) |
| 150 | 150 |
| 151 (defun calendar-previous-haab-date (haab-date &optional noecho) | 151 (defun calendar-previous-haab-date (haab-date &optional noecho) |
| 152 "Move cursor to previous instance of Mayan HAAB-DATE. | 152 "Move cursor to previous instance of Mayan HAAB-DATE. |
| 153 Echo Mayan date if NOECHO is t." | 153 Echo Mayan date if NOECHO is t." |
| 154 (interactive (list (calendar-read-mayan-haab-date))) | 154 (interactive (list (calendar-read-mayan-haab-date))) |
| 155 (calendar-goto-date | 155 (calendar-goto-date |
| 156 (calendar-gregorian-from-absolute | 156 (calendar-gregorian-from-absolute |
| 157 (calendar-mayan-haab-on-or-before | 157 (calendar-mayan-haab-on-or-before |
| 197 (calendar-mayan-tzolkin-from-absolute 0) | 197 (calendar-mayan-tzolkin-from-absolute 0) |
| 198 tzolkin-date)) | 198 tzolkin-date)) |
| 199 260))) | 199 260))) |
| 200 | 200 |
| 201 (defun calendar-next-tzolkin-date (tzolkin-date &optional noecho) | 201 (defun calendar-next-tzolkin-date (tzolkin-date &optional noecho) |
| 202 "Move cursor to next instance of Mayan TZOLKIN-DATE. | 202 "Move cursor to next instance of Mayan TZOLKIN-DATE. |
| 203 Echo Mayan date if NOECHO is t." | 203 Echo Mayan date if NOECHO is t." |
| 204 (interactive (list (calendar-read-mayan-tzolkin-date))) | 204 (interactive (list (calendar-read-mayan-tzolkin-date))) |
| 205 (calendar-goto-date | 205 (calendar-goto-date |
| 206 (calendar-gregorian-from-absolute | 206 (calendar-gregorian-from-absolute |
| 207 (calendar-mayan-tzolkin-on-or-before | 207 (calendar-mayan-tzolkin-on-or-before |
| 209 (+ 260 | 209 (+ 260 |
| 210 (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) | 210 (calendar-absolute-from-gregorian (calendar-cursor-to-date)))))) |
| 211 (or noecho (calendar-print-mayan-date))) | 211 (or noecho (calendar-print-mayan-date))) |
| 212 | 212 |
| 213 (defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho) | 213 (defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho) |
| 214 "Move cursor to previous instance of Mayan TZOLKIN-DATE. | 214 "Move cursor to previous instance of Mayan TZOLKIN-DATE. |
| 215 Echo Mayan date if NOECHO is t." | 215 Echo Mayan date if NOECHO is t." |
| 216 (interactive (list (calendar-read-mayan-tzolkin-date))) | 216 (interactive (list (calendar-read-mayan-tzolkin-date))) |
| 217 (calendar-goto-date | 217 (calendar-goto-date |
| 218 (calendar-gregorian-from-absolute | 218 (calendar-gregorian-from-absolute |
| 219 (calendar-mayan-tzolkin-on-or-before | 219 (calendar-mayan-tzolkin-on-or-before |
| 228 (aref calendar-mayan-tzolkin-names-array (1- (cdr tzolkin))))) | 228 (aref calendar-mayan-tzolkin-names-array (1- (cdr tzolkin))))) |
| 229 | 229 |
| 230 (defun calendar-mayan-tzolkin-haab-on-or-before (tzolkin-date haab-date date) | 230 (defun calendar-mayan-tzolkin-haab-on-or-before (tzolkin-date haab-date date) |
| 231 "Absolute date that is Mayan TZOLKIN-DATE and HAAB-DATE. | 231 "Absolute date that is Mayan TZOLKIN-DATE and HAAB-DATE. |
| 232 Latest such date on or before DATE. | 232 Latest such date on or before DATE. |
| 233 Returns nil if such a tzolkin-haab combination is impossible." | 233 Returns nil if such a tzolkin-haab combination is impossible." |
| 234 (let* ((haab-difference | 234 (let* ((haab-difference |
| 235 (calendar-mayan-haab-difference | 235 (calendar-mayan-haab-difference |
| 236 (calendar-mayan-haab-from-absolute 0) | 236 (calendar-mayan-haab-from-absolute 0) |
| 237 haab-date)) | 237 haab-date)) |
| 238 (tzolkin-difference | 238 (tzolkin-difference |
| 251 "Prompt for a Mayan haab date" | 251 "Prompt for a Mayan haab date" |
| 252 (let* ((completion-ignore-case t) | 252 (let* ((completion-ignore-case t) |
| 253 (haab-day (calendar-read | 253 (haab-day (calendar-read |
| 254 "Haab kin (0-19): " | 254 "Haab kin (0-19): " |
| 255 '(lambda (x) (and (>= x 0) (< x 20))))) | 255 '(lambda (x) (and (>= x 0) (< x 20))))) |
| 256 (haab-month-list (append calendar-mayan-haab-month-name-array | 256 (haab-month-list (append calendar-mayan-haab-month-name-array |
| 257 (and (< haab-day 5) '("Uayeb")))) | 257 (and (< haab-day 5) '("Uayeb")))) |
| 258 (haab-month (cdr | 258 (haab-month (cdr |
| 259 (assoc-ignore-case | 259 (assoc-ignore-case |
| 260 (completing-read "Haab uinal: " | 260 (completing-read "Haab uinal: " |
| 261 (mapcar 'list haab-month-list) | 261 (mapcar 'list haab-month-list) |
| 270 "Tzolkin kin (1-13): " | 270 "Tzolkin kin (1-13): " |
| 271 '(lambda (x) (and (> x 0) (< x 14))))) | 271 '(lambda (x) (and (> x 0) (< x 14))))) |
| 272 (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil)) | 272 (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil)) |
| 273 (tzolkin-name (cdr | 273 (tzolkin-name (cdr |
| 274 (assoc-ignore-case | 274 (assoc-ignore-case |
| 275 (completing-read "Tzolkin uinal: " | 275 (completing-read "Tzolkin uinal: " |
| 276 (mapcar 'list tzolkin-name-list) | 276 (mapcar 'list tzolkin-name-list) |
| 277 nil t) | 277 nil t) |
| 278 (calendar-make-alist tzolkin-name-list 1))))) | 278 (calendar-make-alist tzolkin-name-list 1))))) |
| 279 (cons tzolkin-count tzolkin-name))) | 279 (cons tzolkin-count tzolkin-name))) |
| 280 | 280 |
| 324 calendar-mayan-days-before-absolute-zero))) | 324 calendar-mayan-days-before-absolute-zero))) |
| 325 | 325 |
| 326 (defun calendar-mayan-date-string (&optional date) | 326 (defun calendar-mayan-date-string (&optional date) |
| 327 "String of Mayan date of Gregorian DATE. | 327 "String of Mayan date of Gregorian DATE. |
| 328 Defaults to today's date if DATE is not given." | 328 Defaults to today's date if DATE is not given." |
| 329 (let* ((d (calendar-absolute-from-gregorian | 329 (let* ((d (calendar-absolute-from-gregorian |
| 330 (or date (calendar-current-date)))) | 330 (or date (calendar-current-date)))) |
| 331 (tzolkin (calendar-mayan-tzolkin-from-absolute d)) | 331 (tzolkin (calendar-mayan-tzolkin-from-absolute d)) |
| 332 (haab (calendar-mayan-haab-from-absolute d)) | 332 (haab (calendar-mayan-haab-from-absolute d)) |
| 333 (long-count (calendar-mayan-long-count-from-absolute d))) | 333 (long-count (calendar-mayan-long-count-from-absolute d))) |
| 334 (format "Long count = %s; tzolkin = %s; haab = %s" | 334 (format "Long count = %s; tzolkin = %s; haab = %s" |
| 346 "Move cursor to Mayan long count DATE. Echo Mayan date unless NOECHO is t." | 346 "Move cursor to Mayan long count DATE. Echo Mayan date unless NOECHO is t." |
| 347 (interactive | 347 (interactive |
| 348 (let (lc) | 348 (let (lc) |
| 349 (while (not lc) | 349 (while (not lc) |
| 350 (let ((datum | 350 (let ((datum |
| 351 (calendar-string-to-mayan-long-count | 351 (calendar-string-to-mayan-long-count |
| 352 (read-string "Mayan long count (baktun.katun.tun.uinal.kin): " | 352 (read-string "Mayan long count (baktun.katun.tun.uinal.kin): " |
| 353 (calendar-mayan-long-count-to-string | 353 (calendar-mayan-long-count-to-string |
| 354 (calendar-mayan-long-count-from-absolute | 354 (calendar-mayan-long-count-from-absolute |
| 355 (calendar-absolute-from-gregorian | 355 (calendar-absolute-from-gregorian |
| 356 (calendar-current-date)))))))) | 356 (calendar-current-date)))))))) |
| 359 (list lc))) | 359 (list lc))) |
| 360 (calendar-goto-date | 360 (calendar-goto-date |
| 361 (calendar-gregorian-from-absolute | 361 (calendar-gregorian-from-absolute |
| 362 (calendar-absolute-from-mayan-long-count date))) | 362 (calendar-absolute-from-mayan-long-count date))) |
| 363 (or noecho (calendar-print-mayan-date))) | 363 (or noecho (calendar-print-mayan-date))) |
| 364 | 364 |
| 365 (defun calendar-mayan-long-count-common-era (lc) | 365 (defun calendar-mayan-long-count-common-era (lc) |
| 366 "T if long count represents date in the Common Era." | 366 "T if long count represents date in the Common Era." |
| 367 (let ((base (calendar-mayan-long-count-from-absolute 1))) | 367 (let ((base (calendar-mayan-long-count-from-absolute 1))) |
| 368 (while (and (not (null base)) (= (car lc) (car base))) | 368 (while (and (not (null base)) (= (car lc) (car base))) |
| 369 (setq lc (cdr lc) | 369 (setq lc (cdr lc) |