#!MUNGERPATH

; Copyright (c) 2001, 2002, 2003, James Bailie <jimmy@mammothcheese.ca>.
; All rights reserved.
;
; Redistribution and use in source form, with or without
; modification, are permitted provided that the following conditions are met:
;
;     * Redistributions of source code must retain the above copyright
; notice, this list of conditions and the following disclaimer.
;     * The name of James Bailie may not be used to endorse or promote
; products derived from this software without specific prior written permission.
;
; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS"
; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
; POSSIBILITY OF SUCH DAMAGE.

(fatal)

; Find the name of the current month, and its first and last day values.

(let ((local (localtime (time))))
   (setq today (caddr local))
   (setq mon (stringify (month (cadr local)) " " (car local)))
   (setq first_day (date2days (car local) (cadr local) 1))

   (if (eq 12 (cadr local))
      (setq last_day (date2days (+ 1 (car local)) 1 1))
      (setq last_day (date2days (car local) (+ 1 (cadr local)) 1))))

; Find first Sunday of calendar.  May be part of previous month.

(setq sunday first_day)

(while (car (weekday sunday))
   (dec sunday))

; Print the name of the month centered above the calendar.

(let ((pad (/ (- 27 (length mon)) 2)))
   (iterate pad (print " ")))

(print mon)
(newline)

; Print the calendar.

(println "Sun Mon Tue Wed Thu Fri Sat")

(let ((dom 0))

   (for (day sunday (dec last_day))

      (if (< day first_day)
         (print "    ")

         (setq dom (caddr (days2date day)))

         (print " ")

         (when (eq dom today)
            (bg_white)
            (fg_black))

         (print dom)

         (when (eq dom today)
            (bg_black)
            (fg_white))

         (print " ")
         (when (< dom 10)
            (print " "))

         (when (eq 6 (car (weekday day)))
            (newline)))))

(when (not (eq 6 (car (weekday last_day))))
   (newline))

(quit)
