(defconstant *delta-t* 86400)
(defun find-week-days (year month date)
(let* ((e-day
(/ (encode-universal-time 0 0 0 date month year 0) *delta-t*))
(what-day (mod e-day 7))
(monday (- e-day what-day)))
(loop for i from 0 to 4
and name in '(Mon Tue Wed Thr Fri) do
(multiple-value-bind (sec min hour d h y)
(decode-universal-time (* (+ i monday) *delta-t*))
(format t "~a-~a-~a (~a)~%" y h d name)))))
;CL-USER> (find-week-days 2007 7 31)
;2007-7-30 (MON)
;2007-7-31 (TUE)
;2007-8-1 (WED)
;2007-8-2 (THR)
;2007-8-3 (FRI)
ytakenaka
#358()
[
Common Lisp
]
Rating0/0=0.00
(defconstant *delta-t* 86400) (defun find-week-days (year month date) (let* ((e-day (/ (encode-universal-time 0 0 0 date month year 0) *delta-t*)) (what-day (mod e-day 7)) (monday (- e-day what-day))) (loop for i from 0 to 4 and name in '(Mon Tue Wed Thr Fri) do (multiple-value-bind (sec min hour d h y) (decode-universal-time (* (+ i monday) *delta-t*)) (format t "~a-~a-~a (~a)~%" y h d name))))) ;CL-USER> (find-week-days 2007 7 31) ;2007-7-30 (MON) ;2007-7-31 (TUE) ;2007-8-1 (WED) ;2007-8-2 (THR) ;2007-8-3 (FRI)Rating0/0=0.00-0+
[ reply ]