[alt.sources] Postscript Calendar Program

rolf@warwick.UUCP (Rolf Howarth) (09/18/89)

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@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@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@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@uk.ac.warwick.flame
Coventry,  CV4 7AL,  England.	  UUCP:	  {uunet,mcvax}!ukc!warwick!rolf
-------------------------------------------------------------------------

map@gaak.LCS.MIT.Edu (Michael A. Patton) (09/20/89)

After receiving Rolf's post, I added a few "features" to the script.
It now has defaults for everything on the command line (these defaults
are, of course, the ones I like, your mileage may vary).  Hack away.

	-Mike
----------------------------------------------------------------
#!/bin/csh -f
# pscal - Postscript year calendar
#
# Originally...
# From: patwood@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@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@flame.warwick.ac.uk)
#
# Modified to add defaults		Sep 1989 - MAP@LCS.MIT.Edu
#	printer	defaults to your "default" printer
#	title	defaults to "user's calendar"
#	month	defaults to January
#	year	defaults to this year
# Note: if there is a message and you wish to default the month or year,
#	the first word of the message cannot begin with a digit.
#	
#
# Usage: pscal [-Pprinter] [[month] year] [message ...] , eg.
#     pscal -Ppsc 9 1989 "Rolf's Calendar"
# will produce a twelve month calendar from Sept 89 to Aug 90.

# printer defaults to the default (i.e. we say nothing, lpr figures it out)
set printer=""

top:
if ($#argv > 0) then
	switch ("$argv[1]")
		case -P*:
			set printer="$argv[1]"
			shift argv
			goto top
		case -*:
			echo "usage: $0 [-Pprinter] [[month] year] [title ...]"
			exit 1
		case [0-9]*:
			if ($?name) then
			    set name="$name $argv[1]"
			else
			    if ($?month) then
				if ($?year) then
				    set name="$argv[1]"
				else
				    set year="$argv[1]"
				endif
			    else
				set month="$argv[1]"
			    endif
			endif
			shift argv
			goto top
		case *:
			if ($?name) then
			    set name="$name $argv[1]"
			else
			    set name="$argv[1]"
			endif
			shift argv
			goto top
	endsw
endif

if ($?year) then
else
	if ($?month) then
		set year=$month
	else
		set year=`date|awk '{print $6}'`
	endif
	set month=1
endif

if ($?name) then
else
	set name="$user's calendar"
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

dre@cs.nott.ac.uk (David Evans) (09/20/89)

I had a quick look through the PostScript code and noticed that the leap year
calculation is wrong - despite being fixed!  Centuries are leap years only
if divisible by 400, not 1000!  The "isleap" procedure should be changed to
the following:

/isleap {		% is this a leap year?
	year 4 mod 0 eq		% multiple of 4
	year 100 mod 0 ne 	% not century
	year 400 mod 0 eq or and       % unless its a century divisible by 400
} def


+-----------------------------------------------------------------------------+
|  David R Evans,			   JANET:  dre@cs.nott.ac.uk	      |
|  Electronic Publishing Research Group,   ARPA:   dre%nott.cs@cs.ucl.ac.uk   |
|  Department of Computer Science,	   UUCP:   ... !mcvax!ukc!nott-cs!dre |
|  University of Nottingham,		   Tel.	   NOTTINGHAM(0602) 484848    |
|  NOTTINGHAM, ENGLAND, NG7 2RD.		   Ext. 2765		      |
+-----------------------------------------------------------------------------+

cdl@mplvax.EDU (Carl Lowenstein) (09/21/89)

In article <7878@robin.cs.nott.ac.uk> dre@cs.nott.ac.uk (David Evans) writes:
>I had a quick look through the PostScript code and noticed that the leap year
>calculation is wrong - despite being fixed!  Centuries are leap years only
>if divisible by 400, not 1000!  The "isleap" procedure should be changed . . .

So also should the "startday" procedure similarly be changed to:

	off 400 idiv add	% Gregorian correction

This makes the calendar repeat every 400 years, as it really does.
Of course, you won't notice this until the year 2400.

For us people who use inch-size paper, there are various x-translation
constants that should be somewhat smaller, like 190 instead of 200 picas.
Really these should be paramaterized, but this is left as an exercise
for the student.


-- 
	carl lowenstein		marine physical lab	u.c. san diego
	{decvax|ucbvax}	!ucsd!mplvax!cdl
	cdl@mpl.ucsd.edu