(defun calendar (year)
    (define months-list '(("JANUARY" 31) ("FEBRUARY" 28) ("MARCH" 31) ("APRIL" 30) ("MAY" 31) ("JUNE" 30) ("JULY" 31) ("AUGUST" 31) ("SEPTEMBER" 30) ("OCTOBER" 31) ("NOVEMBER" 30) ("DECEMBER" 31)))
    (define days #("      Sunday            " "Monday            " "Tuesday           " "Wednesday         " "Thursday          " "Friday            " "Saturday"))
    (defun gauss-algorithm (a)
        (rem (+ 1 (+ (* 5 (rem (- a 1) 4)) (* 4 (rem (- a 1) 100)) (* 6 (rem (- a 1) 400)))) 7))
    (defun range (start end)
        (if (<= start end)
            (cons start (range (+ start 1) end))))
    (defun string-repeat (s n)
        (if (= n 0)
            ""
            (string-append s (string-repeat s (- n 1)))))
    (defun print-month (number-of-days start-day)
        (defun print-days (day day-of-week end-day)
            (if (= day-of-week 7)
                (begin
                    (newline)
                    (define day-of-week 0)))
            (display (string-repeat " " 8))
            (if (= day-of-week 0)
                (display (string-repeat " " 6)))
            (if (< day 10)
                (display " "))
            (display day)
            (display (string-repeat " " 8))
            (if (= day end-day)
                (begin
                    (fresh-line)
                    (+ day-of-week 1))
                (print-days (+ day 1) (+ day-of-week 1) end-day)))
        (mapcar (lambda (n) (display (vector-ref days n))) (range 0 6))
        (newline)
        (display (string-repeat (string-repeat " " 18) start-day))
        (print-days 1 start-day number-of-days))
    (defun leap-yearp (y)
        (and (= (mod year 4) 0) (or (/= (mod year 100) 0) (= (mod year 400) 0))))
    (define months (make-table))
    (mapcar (lambda (month) (table-set! months (car month) (cadr month))) months-list)
    (if (leap-yearp year)
        (table-set! months "FEBRUARY" 29))
    (defun print-calendar (calendar-months weekday)
        (newline)
        (newline)
        (display (string-repeat " " 60))
        (display (caar calendar-months))
        (newline)
        (define next-month-starts (print-month (table-ref months (caar calendar-months)) weekday))
        (if (cdr calendar-months)
            (print-calendar (cdr calendar-months) next-month-starts)))
    (display (string-repeat " " 60))
    (display "******** SNOOPY CALENDAR ")
    (display year)
    (display " ********")
    (newline)
    (newline)
    (print-calendar months-list (gauss-algorithm year)))

(calendar 1969)