Postscript Calendar Program

[Rolf Howarth]

Here's some PostScript, with a shell script front end, to produce a year
calendar. It will show 12 months starting from any month, so it is useful
for producing academic year calendars etc. As it stands it sends its
output straight to lpr, but it's trivial to change.

-Rolf

-------------------------------------------------------------------------
#!/bin/csh -f
# yearcal - Postscript year calendar      Rolf Howarth 17/9/89
#
# Originally...
# From: patwood at unirot.UUCP (Patrick Wood)
# Newsgroups: net.sources
# Subject: PostScript Calendar
# Date: 7 Mar 87 18:43:51 GMT
# Organization: Public Access Unix, Piscataway, NJ
# 
# The following is a PostScript program to print calendars.  It doesn't
# work on or before 1752.
# 
# Shell stuff added 3/9/87 by King Ables
# Leap year bug fixed Dec. 4th, 1987 by Neil Crellin (neilc at dmscanb.dms.oz.au)
#
# Modified to produce calendar for whole year Aug 1988 - Rolf
# Twelve months from any month - 17/9/89 Rolf Howarth (rolf at flame.warwick.ac.uk)
#
# Usage: yearcal [-Pprinter] month year message ... , eg.
#     yearcal -Ppsc 9 1989 "Rolf's Calendar"
# will produce a twelve month calendar from Sept 89 to Aug 90.

set printer="-Ppsc"

top:
if ($#argv > 0) then
	switch ("$argv[1]")
		case -*:
			set printer="$argv[1]"
			shift argv
			goto top
		case *:
			if ($?month) then
			    if ($?year) then
				if ($?name) then
				    set name="$name $argv[1]"
				else
				    set name="$argv[1]"
				endif
			    else
				set year="$argv[1]"
			    endif
			else
				set month="$argv[1]"
			endif
			shift argv
			goto top
	endsw
endif

if ($?year) then
else 
	echo "usage: $0 [-Pprinter] month year message ..."
	exit 1
endif

lpr $printer <<END-OF-CALENDAR
%!
% PostScript program to draw calendar
% Copyright (C) 1987 by Pipeline Associates, Inc.
% Permission is granted to modify and distribute this free of charge.

% /month should be set to a number from 1 to 12
% /year should be set to the year you want
% you can change the title and date fonts, if you want
% we figure out the rest
% won't produce valid calendars before 1800 (weird stuff happened
% in September of 1752)

/year $year def
/month $month 1 sub def
/titlefont /Times-Bold def
/dayfont /Helvetica-Bold def

/month_names [ (January) (February) (March) (April) (May) (June) (July)
		(August) (September) (October) (November) (December) ] def

/prtnum { 3 string cvs show} def

/drawgrid {		% draw calendar boxes
	dayfont findfont 7 scalefont setfont
	0 1 6 {
		dup dup 25 mul 12 moveto
		[ (Sun) (Mon) (Tue) (Wed) (Thu) (Fri) (Sat) ] exch get
		22.5 center
		25 mul 11.5 moveto
		.1 setlinewidth
		50 {
			gsave
			22 0 rlineto stroke
			grestore
			0 -2.5 rmoveto
		} repeat
	} for

} def

/drawnums {		% place day numbers on calendar
	dayfont findfont 12 scalefont setfont
	/start startday def
	/days ndays def
	start 25 mul 0 rmoveto
	1 1 days {
		/day exch def
		gsave
		  isdouble
		  {
			day prtdouble
		  }
		  {
			day prtnum
		  } ifelse
		grestore
		day start add 7 mod 0 eq
		{
			currentpoint exch pop 25 sub 0 exch moveto
		}
		{
			25 0 rmoveto
		} ifelse
	} for
} def

/isdouble {		% is today going to be overlaid on next week's?
	days start add 35 gt
	{
		day start add 35 gt
		{
			true true
		}
		{
			day start add 28 gt
			day 7 add days le and
			{
				false true
			}
			{
				false
			} ifelse
		} ifelse
	}
	{
		false
	} ifelse
} def

/prtdouble {
	gsave
	  dayfont findfont 6 scalefont setfont
	  exch
	  {
		9 25 rmoveto
		prtnum
	  }
	  {
		0 4 rmoveto
		prtnum
		0 -4 rmoveto
		gsave
		  dayfont findfont 12 scalefont setfont
		  (/) show
		grestore
	  } ifelse
	grestore
} def

/isleap {		% is this a leap year?
	year 4 mod 0 eq		% multiple of 4
	year 100 mod 0 ne 	% not century
	year 1000 mod 0 eq or and	% unless it's a millenia
} def

/days_month [ 31 28 31 30 31 30 31 31 30 31 30 31 ] def

/ndays {		% number of days in this month
	days_month month 1 sub get
	month 2 eq	% Feb
	isleap and
	{
		1 add
	} if
} def

/startday {		% starting day-of-week for this month
	/off year 2000 sub def	% offset from start of "epoch"
	off
	off 4 idiv add		% number of leap years
	off 100 idiv sub	% number of centuries
	off 1000 idiv add	% number of millenia
	6 add 7 mod 7 add 	% offset from Jan 1 2000
	/off exch def
	1 1 month 1 sub {
                1 copy
		days_month exch 1 sub get
		exch 2 eq
		isleap and
		{
			1 add
		} if
		/off exch off add def
	} for
	off 7 mod		% 0--Sunday, 1--monday, etc.
} def

/center {		% center string in given width
	/width exch def
	/str exch def width str 
	stringwidth pop sub 2 div 0 rmoveto str show
} def

90 rotate
40 -100 translate
titlefont findfont 36 scalefont setfont
/yearstring 10 string def
year yearstring cvs
month 0 ne {
    yearstring 4 47 put	% 47 is ascii for slash
    yearstring 5 year 1 add 100 mod 2 string cvs putinterval
    } if
0 40 moveto
($name) show
775 yearstring stringwidth pop sub 40 moveto
% 388 yearstring stringwidth pop 2 div sub 36 moveto
yearstring show

/showmonth {
    titlefont findfont 12 scalefont setfont
    0 20 moveto
    month_names month 1 sub get show
    0 0 moveto
    drawnums
    0 0 moveto
    drawgrid
} def

/nextmonth {
    month 1 add dup 13 eq {/year year 1 add def pop 1} if
    /month exch def
    showmonth
    } def

nextmonth
200 0 translate
nextmonth
200 0 translate
nextmonth
200 0 translate
nextmonth
-600 -160 translate
nextmonth
200 0 translate
nextmonth
200 0 translate
nextmonth
200 0 translate
nextmonth
-600 -160 translate
nextmonth
200 0 translate
nextmonth
200 0 translate
nextmonth
200 0 translate
nextmonth

showpage

END-OF-CALENDAR

-------------------------------------------------------------------------
Rolf Howarth,			  Tel:	  +44 203 523523 ext.2485
Dept. of Computer Science,	  Fax:	      203 525714
University of Warwick,		  JANET:  rolf at uk.ac.warwick.flame
Coventry,  CV4 7AL,  England.	  UUCP:	  {uunet,mcvax}!ukc!warwick!rolf
-------------------------------------------------------------------------