time-to-date				;autoloads date.kl

;;=============================================================================
;;                    days-to-date
;;=============================================================================

;;AUTOLOAD: days-to-date
;;AUTODOC: days-to-date "transorms number of days in readable date"
;; (days-to-date number-of-days)
;;
;; from a number-of days since 1/1/1970, returns a list
;; of (year month day day-of-the-week-0=sunday)
;; year is year (4 digits)
;; month is 1-12
;; day is 1-31
;; day-of-the-week: 0 sunday, 1 = monday, etc...
;; WARNING: although these functions can theorically handle dates between
;; 1-Jan-70 and sometime near 5881620, hangling of dates in the far future can 
;; be dramatically slow.

(defun days-to-date (days &aux
    wday
    yleap
    (mon 0)
    (year 1970)
    ip
  )
  (setq wday (mod (+ 4 days) 7))
  (if (< wday 0)
    (+= wday 7)
  )
  (if (>= days 0)
    (catch 'Done
      (while t
	(setq yleap (isleap year))
	(if (< days (if yleap 366 365))
	  (throw 'Done)
	)
	(++ year)
	(-= days (if yleap 366 365))
    ))
    (catch 'Done
      (while t
	(-- year)
	(setq yleap (isleap year))
	(+= days (if yleap 366 365))
	(if (< days 0)
	  (throw 'Done)
  ))))
  
  (setq ip (if yleap time-to-date:leapyear-months
      time-to-date:year-months
  ))
  
  (while (>= days (getn ip mon))
    (-= days (getn ip mon))
    (++ mon)
  )
      
  (list year (+ mon 1) (+ days 1) wday)
)

;;=============================================================================
;;                    date-to-days
;;=============================================================================

;;AUTOLOAD: date-to-days
;;AUTODOC: date-to-days "transorms date as list of numbers into days"
;; (date-to-days (year month day))
;;
;; from a date in form: (year month day), returns the number of days
;; since 1/1/1970)
;; year is year (4 digits)
;; month is 1-12
;; day is 1-31
;; an optional day-of-the-week element can be added to the end of the list, 
;; allowing date-to-days to be given the output of days-to-date
;; WARNING: although these functions can theorically handle dates between
;; 1-Jan-70 and sometime near 5881620, hangling of dates in the far future can
;; be dramatically slow.
 
(defun date-to-days (args &aux
    (year (get args 0 1970))
    (month (- (get args 1 1) 1))
    (day (- (get args 2 1) 1))
    yleap
    ym
    (y 1970)
  )
  (if (< year 1970) 
    (if (< year 70) (+= year 2000) (+= year 1900))
  )
  (if (>= month 12) (progn
      (+= year (/ month 12))
      (setq month (mod month 12))
  ))
  (setq yleap (isleap year))
  (setq ym (if yleap time-to-date:leapyear-months
      time-to-date:year-months))
  (dotimes (m month)
    (setq day (+ day (get ym m 0)))
  )
  (while (< y year)
    (setq day (+ day (if (isleap y) 366 365)))
    (incf y 1)
  )
  day
)
  
