;;;
;;; File-name: DISCDATE.EL
;;; Time-stamp: <Dis, 50 Dis 3161>
;;; Calle Englund ce@lysator.liu.se, 3 may 1995

(defvar disc-language 'english "")
(make-variable-buffer-local 'disc-language)
(set-default 'disc-language 'english)

(defvar disc-verboseness 1 "")
(make-variable-buffer-local 'disc-verboseness)
(set-default 'disc-verboseness 1)

(defvar disc-hollidays-p t "")
(make-variable-buffer-local 'disc-hollidays-p)
(set-default 'disc-hollidays-p t)

(defvar disc-format
  '((english . [("Today is " (disc-fmt-dayname)
		 (if (disc-fmt-daynum) 
		     (concat
		      ", the " (disc-fmt-daynum)
		      " day of " (disc-fmt-season)))
		 " in the YOLD " (disc-fmt-year))
		((disc-fmt-dayname)
		 (if (disc-fmt-daynum)
		     (concat
		      ", the " (disc-fmt-daynum t)
		      " day of " (disc-fmt-season)))
		 " in the YOLD " (disc-fmt-year))
		((disc-fmt-dayname)
		 (if (disc-fmt-daynum)
		     (concat
		      ", the " (disc-fmt-daynum)
		      " of " (disc-fmt-season)))
		 " in " (disc-fmt-year))
		((disc-fmt-dayname t)
		 ", "
		 (disc-fmt-daynum t)
		 " "
		 (disc-fmt-season t)
		 " "
		 (disc-fmt-year))
		((disc-fmt-daynum t)
		 " "
		 (disc-fmt-season t)
		 " "
		 (disc-fmt-year))])
    (svenska . [("Idag är det " (disc-fmt-dayname)
		 (if (disc-fmt-daynum)
		     (concat
		      ", den " (disc-fmt-daynum)
		      " dagen i " (disc-fmt-season)))
		 ", Gudinnans år " (disc-fmt-year))
		((disc-fmt-dayname)
		 (if (disc-fmt-daynum)
		     (concat
		      ", den " (disc-fmt-daynum )
		      " dagen i " (disc-fmt-season)))
		 ", Gudinnans år " (disc-fmt-year))
		((disc-fmt-dayname)
		 (if (disc-fmt-daynum)
		     (concat
		      ", den " (disc-fmt-daynum)
		      " i " (disc-fmt-season)))
		 ", " (disc-fmt-year))
		((disc-fmt-dayname t)
		 ", "
		 (disc-fmt-daynum t)
		 " "
		 (disc-fmt-season t)
		 " "
		 (disc-fmt-year))
		((disc-fmt-daynum t)
		 " "
		 (disc-fmt-season t)
		 " "
		 (disc-fmt-year))]))
  "")

(defvar disc-days
  '((english . ["Sweetmorn"
		"Boomtime"
		"Pungenday"
		"Prickle-Prickle"
		"Setting Orange"])
    (svenska . ["Ljuvmorgon"
		"Hausse"
		"Bitterdag"
		"Törne-tagg"
		"Nedgång"]))
  "")

(defvar disc-seasons
  '((english . ["Chaos"
		"Discord"
		"Confusion"
		"Bureaucracy"
		"The Aftermath"])
    (svenska . ["Kaos"
		"Disharmoni"
		"Förvirring"
		"Byråkrati"
		"Efterbörd"]))
  "")

(defvar disc-hollidays
  '((english . [("Mungday" . "Chaoflux")
		("Mojoday" . "Discoflux")
		("Syaday"  . "Confuflux")
		("Zaraday" . "Bureflux")
		("Maladay" . "Afflux")]))
  "")

(defvar disc-endings
  '((english . [":th" ":st" ":nd" ":rd"])
    (svenska . [":e"  ":a"  ":a"  ":e"]))
  "")
     

(defun disc-lang (alist)
  ""
  (or (cdr (assoc disc-language alist))
      (cdr (car alist))))

(defun disc-makeday (tmstr)
  ""
  (let* ((mlens	'(("Jan" 0 . 0)
		  ("Feb" 31 . 31)
		  ("Mar" 60 . 59)
		  ("Apr" 91 . 90)
		  ("May" 121 . 120)
		  ("Jun" 152 . 151)
		  ("Jul" 182 . 181)
		  ("Aug" 213 . 212)
		  ("Sep" 244 . 243)
		  ("Oct" 274 . 273)
		  ("Nov" 305 . 304)
		  ("Dec" 335 . 334)))
	 (year (+ 1166 (string-to-int (substring tmstr 20))))
	 (skott (= (mod year 4) 2))
	 (mpair (assoc (substring tmstr 4 7) mlens))
	 (mbeg (if skott (car (cdr mpair)) (cdr (cdr mpair))))
	 (dayspast (+ mbeg -1 (string-to-int (substring tmstr 8 10))))
	 (day (if skott
		  (cond ((= dayspast 59)
			 -1)
			((> dayspast 59)
			 (mod (1- dayspast) 73))
			(t (mod dayspast 73)))
		(mod dayspast 73)))
	 (season (if skott
		     (/ (1- dayspast) 73)
		   (/ dayspast 73))))
    (list year season day)))

(defun disc-ending (day)
  "=> \":rd\""
  (let ((disc-endings (disc-lang disc-endings))
	(foo (mod day 10)))
    (cond ((and (> day 10) (< day 14))
	   (aref disc-endings 0))
	  ((= foo 1) (aref disc-endings 1))
	  ((= foo 2) (aref disc-endings 2))
	  ((= foo 3) (aref disc-endings 3))
	  (t (aref disc-endings 0)))))

(defun disc-fmt-dayname (&optional short)
  "=> \"Fooday\""
  (cond ((= day 0)
	 (if short "Tib" "St. Tib's Day!"))
	((and disc-hollidays-p
	      (= day 5))
	 (if short (substring (car (aref disc-hollidays season)) 0 3)
	   (car (aref disc-hollidays season))))
	((and disc-hollidays-p
	      (= day 50))
	 (if short (substring (cdr (aref disc-hollidays season)) 0 3)
	   (cdr (aref disc-hollidays season))))
	(t (if short (substring (aref disc-days 
				      (mod (+ day -1 (* season 73)) 5))
				0 3)
	     (aref disc-days (mod (+ day -1 (* season 73)) 5))))))

(defun disc-fmt-daynum (&optional force)
  "=> \"5:th\""
  (if (and (not force)
	   (or (= day 0)
	       (and disc-hollidays-p
		    (= day 5))
	       (and disc-hollidays-p
		    (= day 50))))
      nil
    (concat (int-to-string day) (if (not force) (disc-ending day)))))

(defun disc-fmt-season (&optional short)
  "=> \"Chaos\""
  (if short (substring (aref disc-seasons season) 0 3)
    (aref disc-seasons season)))

(defun disc-fmt-year ()
  "=> \"3161\""
  (int-to-string year))


(defun disc-date-string (&optional tmstr)
  ""
  (let* ((disc-hollidays (disc-lang disc-hollidays))
	 (disc-days (disc-lang disc-days))
	 (disc-seasons (disc-lang disc-seasons))
	 (disc-format (disc-lang disc-format))
	 (foo (disc-makeday (or tmstr (current-time-string))))
	 (year (nth 0 foo))
	 (season (nth 1 foo))
	 (day (1+ (nth 2 foo))))
    (mapconcat '(lambda (element) (eval element))
	       (aref disc-format disc-verboseness) "")))

(provide 'discdate)
;
; Local Variables:
; mode: emacs-lisp
; disc-language: svenska
; disc-verboseness: 3
; End: