DiesRomanus

Print Gregorian calendar dates in Roman format.

Common Lisp

(This almost works.)

                                          ; Kalends/Nones/Ides ablative case
(defconstant +kni-ablative+   '("Kalendis" "Nonis" "Idebus"))
                                          ; Kalends/Nones/Ides accusative case
(defconstant +kni-accusative+ '("Kalendas" "Nonas" "Idus"   "Kalendas"))
                                          
(defconstant +month-ablative+             ; Month names ablative
  '("Januariis"    "Februariis" "Martiis"     "Aprilibus"  
    "Maiis"        "Juniis"     "Juliis"      "Augustis"
    "Septembribus" "Octobribus" "Novembribus" "Decembribus"))

(defconstant +month-accusative+           ; Month names accusative
  '("Januarias"    "Februarias" "Martias"     "Apriles"  
    "Maias"        "Junias"     "Julias"      "Augustas"   
    "Septembres"   "Octobres"   "Novembres"   "Decembres"))

(defconstant +ordinal+                    ; Ordinal numbers accusative case
  '("primum"                              ;   first
    "secundum"                            ;   second
    "tertium"                             ;   third
    "quartum"                             ;   fourth
    "quintum"                             ;   fifth
    "sextus"                              ;   sixth
    "septimum"                            ;   seventh
    "octavum"                             ;   eighth
    "nonum"                               ;   ninth
    "decimum"                             ;   tenth
    "undecimum"                           ;   eleventh
    "duodecimum"                          ;   twelfth
    "tertium decimum"                     ;   thirteenth
    "quartum decimum"                     ;   fourteenth
    "quintum decimum"                     ;   fifteenth
    "sextum decimum"                      ;   sixteenth
    "septimum decimum"                    ;   seventeenth
    "duodevicensimum"                     ;   eighteenth
    "undevicensimum"                      ;   nineteenth
    "vicensimum"))                        ;   twentieth

(defun hodie ()
  "Current local date in Roman format."
  (let ((ut (multiple-value-list (get-decoded-time))))
    (ymd->rdat (nth 5 ut) (nth 4 ut) (nth 3 ut))))

(defun ymd->rdat (y m d)
  "Convert Gregorian date year (y)/month (m)/day (d) to Roman format."
  (let* ((m0 (1- m))                      ; Month (0-base)
         (b (bissextilep y))              ; Bissextile flag
         (n (- (nones-of-month m0) d))    ; Days before Nones
         (i (- (ides-of-month m0) d))     ; Days before Ides
         (e (- (end-of-month m0 b) d))    ; Days before end-of-month
         (k (kalends-nones-ides d n i))   ; K/N/I closest to date
         (yk y)                           ; Year of K/N/I day
         (mk m0))                         ; Month of K/N/I day
    (if (= k 3)
      (if (= m0 11)
        (progn (setq yk (1+ y)) (setq mk 0))
        (progn (setq yk y) (setq mk (1+ m0)))))
    (format t "~a anno Domini ~@r" 
      (die-mense k mk b (cond       ; !!! <-- propagate mk !!!
                         ((= k 0) 1)
                         ((= k 1) (1+ n))
                         ((= k 2) (1+ i))
                         (t       (+ e 2)))) 
      yk)))

(defun nones-of-month (m)
  "Nones day for month (m (0-base))."
  (let ((d '(5  5  7  5  7  5  7  5  5  7  5  5)))
    (nth m d)))

(defun ides-of-month (m)
  "Ides day for month (m (0-base))."
  (let ((d '(13 13 15 13 15 13 15 13 13 15 13 13)))
    (nth m d)))

(defun end-of-month (m b)
  "Last day of month (m (0-base)); bissextile flag (b)."
  (let* ((d '(31 28 31 30 31 30 31 31 30 31 30 31))
         (e (nth m d)))
    (if (and b (= m 1)) (1+ e) e)))

(defun kalends-nones-ides (d n i)
  "Kalends/Nones/Ides for day of month (d); days before Nones (n); days before Ides (i)."
  (cond
    ((= d 1) 0)   ; Kalends
    ((< i 0) 3)   ; Before next month's Kalends
    ((< n 0) 2)   ; On or before Ides
    (t       1))) ; On or before Nones

(defun bissextilep (y)
  "Is Gregorian year y a bissextile (leap) year?"
  (cond
    ((and (zerop (mod y 4)) (/= (mod y 100) 0)) t)
    ((zerop (mod y 400)) t)
    (t nil)))

(defun die-mense (k m b a)
  "Roman day/month for ante diem count (a) before Kalends/Nones/Ides (k) of month (m); bessextile flag (b)."
  (cond
    ((= a 1) (kni-day k m))
    ((= a 2) (pridie k m))
    (t       (ante-diem a k m b))))

(defun kni-day (k m)
  "Kalends/Nones/Ides (k (0-3)) and month (m (0-11) in Latin."
  (format t "~a ~a" (nth k +kni-ablative+) (nth m +month-ablative+)))

(defun pridie (k m)
  "Day before Kalends/Nones/Ides (k (0-3)) of month (m (0-11)) in Latin."
  (format t "pridie ~a ~a" (nth k +kni-accusative+) (nth m +month-accusative+)))

(defun ante-diem (a k m b)
  "Ante diem countdown (a) to Kalends/Nones/Ides (k (0-3)) of month (m (0-11)); bissextile year flag (b)."
  (format t "ante diem ~a ~a"
    (if (and b (= k 3) (= m 2) (> a 6))
      (concatenate
       (if (= a 7) "bis ")
       (nth (1- a) +ordinal+))
      (nth a +ordinal+))
    (nth m +month-accusative+)))
      
(defun kni-month (k m)
  "Index for next month if counting down to next month's Kalends (k (0-3)) for current month (m (0-11))."
  (if (= k 3)
    (if (= m 11) 0 (1+ m))
    m))