Lisp练习-打印月历

;;;; print 12 months accroding index in a week

;; if year is leap year?
(defun is-leap-year (year)
  (or 
   (and 
    (= 0 (mod year 4))
    (/= 0 (mod year 100)))
   (= 0 (mod year 400))))

;; return n
;; n  means first day of the year is in the n-th day in the week.
(defun first-day-of-year (year)
  (let* ((x (- year 1)) (y (* x 365)))
    (loop for z from 1 to x
	 when (is-leap-year z)
	 do (incf y))
    (mod y 7)))

;; days-in-month
(defun days-in-month (year month)
  (if 
   (or
    (< month 1)
    (> month 12))
   (return-from days-in-month 0))
  (cond
    ((find month '(1 3 5 7 8 10 12)) (return-from days-in-month 31))
    ((find month '(4 6 9 11)) (return-from days-in-month 30))
    ((is-leap-year year) (return-from days-in-month 29))
    (28)))

;; print month table.
(defun print-month-table (year)
  (let ((week-index (first-day-of-year year)))
    (format t "week-index: ~d~%" week-index)
    (loop for month from 1 to 12
       do
	 (format t "~d-~d~%" year month)
	 (format t "SUN  MON  TUE  WEN  THR  FRI  SAT~%")
	 (format t "=================================~%")
	 (loop repeat (mod (+ week-index 1) 7)
	    do
	      (format t "     "))
	 (loop for day from 1 to (days-in-month year month)
	    do
	      (format t "~2d   " day)
	      (setf week-index (mod (+ week-index 1) 7))
	      (if (= 6 week-index)
		  (format t "~%")))
	 (format t "~%"))))