;;;; fuzzytime.lisp

(IN-PACKAGE #:FUZZYTIME)

(EXPORT '(*FUZZYTIME-FORMAT* *MINUTE-GRANULARITY*))

(PUSHNEW '(#\F LOCAL-TIME-TO-FUZZY) *SCREEN-MODE-LINE-FORMATTERS* :TEST 'EQUAL)

(DEFPARAMETER *MINUTE-GRANULARITY* 10
  "Minutes are rounded to the nearest multiple of *minute-granularity*")

(DEFPARAMETER *FUZZYTIME-FORMAT*
  '(:MINUTES :HOURS " in the " :PERIOD " on " :DOW
    " the " :DAY " of " :MONTH)
  "Format of the output, a list of strings and keywords. Valid keywords are:
:minutes
:hours
:period
:dow (name of the day of the week)
:udow (name of the day of the week, capitalised)
:dn (number of the day of the week)
:day (day of the month)
:mnum (number of the month)
:month (name of the month, capitalised)
:umonth (name of the month)")

(DEFVAR *MONTH-NAMES*
  (MAKE-ARRAY '(12) :INITIAL-CONTENTS
              '("january" "february" "march" "april" "may" "june" "july"
                "august" "september" "october" "november" "december")))

(DEFVAR *DOW-NAMES*
  (MAKE-ARRAY '(7) :INITIAL-CONTENTS
              '("monday" "tuesday" "wednesday"
                "thursday" "friday" "saturday"
                "sunday")))

(DEFUN MINUTES-TO-WORDS (MIN)
  (IF (OR (<= MIN 0) (>= MIN 60)) ""
      (FLET ((FRAC (M) (COND
                         ((= M 30) "half")
                         ((= M 15) "quarter")
                         (T (FORMAT NIL "~r" M)))))
        (FORMAT NIL "~a ~a " (FRAC (IF (> MIN 30) (- 60 MIN) MIN))
                (IF (> MIN 30) "to" "past")))))

(DEFUN HOUR-TO-WORDS (HOUR MIN)
  (LET ((H (MOD
            (IF (> MIN 30) (1+ HOUR) HOUR )
            12)))
    (FORMAT NIL "~r~a"
            (IF (= H 0) 12 H)
            (IF (OR (= MIN 0) (= MIN 60)) " o'clock" ""))))

(DEFUN PERIOD-INDICATOR (HOUR)
  (IF (< HOUR 12) "morning"
      (IF (< HOUR 17) "afternoon" "evening")))

(DEFUN LOCAL-TIME-TO-FUZZY (ML)
  (DECLARE (IGNORE ML))
  (MULTIPLE-VALUE-BIND (SECONDS MINUTES HOUR DAY MONTH YEAR DOW)
      (GET-DECODED-TIME)
    (DECLARE (IGNORE SECONDS) (IGNORE YEAR))
    (LET* ((MIN (* *MINUTE-GRANULARITY*
                   (ROUND (/ MINUTES *MINUTE-GRANULARITY*))))
           (MS (MINUTES-TO-WORDS MIN))
           (HS (HOUR-TO-WORDS HOUR MIN))
           (PS (PERIOD-INDICATOR HOUR))
           (DN (ELT *DOW-NAMES* DOW))
           (MN (ELT *MONTH-NAMES* (1- MONTH))))
      (APPLY #'CONCATENATE 'STRING
             (LOOP FOR E IN *FUZZYTIME-FORMAT* COLLECT
                  (CASE E
                    (:MINUTES MS)
                    (:HOURS HS)
                    (:PERIOD PS)
                    (:DOW DN)
                    (:UDOW (STRING-CAPITALIZE DN))
                    (:MONTH MN)
                    (:UMONTH (STRING-CAPITALIZE MN))
                    (:DNUM (FORMAT NIL "~a" DOW))
                    (:DAY (FORMAT NIL "~:r" DAY))
                    (:MNUM (FORMAT NIL "~a" MONTH))
                    (OTHERWISE E)))))))