Create a routine that will generate a text calendar for any year.
Test the calendar by generating a calendar for the year 1969, on a device of the time.
Choose one of the following devices:

 A line printer with a width of 132 characters.
 An IBM 3278 model 4 terminal (80×43 display with accented characters). Target formatting the months of the year to fit nicely across the 80 character width screen. Restrict number of lines in test output to 43.


(Ideally, the program will generate well-formatted calendars for any page width from 20 characters up.)

Kudos (κῦδος) for routines that also transition from Julian to Gregorian calendar.

This task is inspired by Real Programmers Don't Use PASCAL by Ed Post, Datamation, volume 29 number 7, July 1983.

THE REAL PROGRAMMER'S NATURAL HABITAT
"Taped to the wall is a line-printer Snoopy calender for the year 1969."

For further Kudos see task CALENDAR, where all code is to be in UPPERCASE.

For economy of size, do not actually include Snoopy generation in either the code or the output, instead just output a place-holder.



Related task

   Five weekends


(ql:quickload '(date-calc))
 
(defparameter *day-row* "Su Mo Tu We Th Fr Sa")
(defparameter *calendar-margin* 3)
 
(defun month-to-word (month)
  "Translate a MONTH from 1 to 12 into its word representation."
  (svref #("January" "February" "March" "April"
           "May" "June" "July" "August"
           "September" "October" "November" "December")
         (1- month)))
 
(defun month-strings (year month)
  "Collect all of the strings that make up a calendar for a given
MONTH and YEAR."
  `(,(date-calc:center (month-to-word month) (length *day-row*))
     ,*day-row*
     ;; We can assume that a month calendar will always fit into a 7 by 6 block
     ;; of values. This makes it easy to format the resulting strings.
     ,@ (let ((days (make-array (* 7 6) :initial-element nil)))
          (loop :for i :from (date-calc:day-of-week year month 1)
             :for day :from 1 :to (date-calc:days-in-month year month)
             :do (setf (aref days i) day))
          (loop :for i :from 0 :to 5
             :collect
             (format nil "~{~:[  ~;~2,d~]~^ ~}"
                     (loop :for day :across (subseq days (* i 7) (+ 7 (* i 7)))
                        :append (if day (list day day) (list day))))))))
 
(defun calc-columns (characters margin-size)
  "Calculate the number of columns given the number of CHARACTERS per
column and the MARGIN-SIZE between them."
  (multiple-value-bind (cols excess)
      (truncate characters (+ margin-size (length *day-row*)))
    (incf excess margin-size)
    (if (>= excess (length *day-row*))
        (1+ cols)
        cols)))
 
(defun take (n list)
  "Take the first N elements of a LIST."
  (loop :repeat n :for x :in list :collect x))
 
(defun drop (n list)
  "Drop the first N elements of a LIST."
  (cond ((or (<= n 0) (null list)) list)
        (t (drop (1- n) (cdr list)))))
 
(defun chunks-of (n list)
  "Split the LIST into chunks of size N."
  (assert (> n 0))
  (loop :for x := list :then (drop n x)
     :while x
     :collect (take n x)))
 
(defun print-calendar (year &key (characters 80) (margin-size 3))
  "Print out the calendar for a given YEAR, optionally specifying
a width limit in CHARACTERS and MARGIN-SIZE between months."
  (assert (>= characters (length *day-row*)))
  (assert (>= margin-size 0))
  (let* ((calendars (loop :for month :from 1 :to 12
                       :collect (month-strings year month)))
         (column-count (calc-columns characters margin-size))
         (total-size (+ (* column-count (length *day-row*))
                        (* (1- column-count) margin-size)))
         (format-string (concatenate 'string
                                     "~{~a~^~" (write-to-string margin-size) ",0@T~}~%")))
    (format t "~a~%~a~%~%"
            (date-calc:center "[Snoopy]" total-size)
            (date-calc:center (write-to-string year) total-size))
    (loop :for row :in (chunks-of column-count calendars)
       :do (apply 'mapcar
                  (lambda (&rest heads)
                    (format t format-string heads))
                  row))))