Path: utzoo!mnetor!uunet!husc6!necntc!ncoast!allbery
From: neilc@dmscanb.oz.au.UUCP (Neil Crellin)
Newsgroups: comp.sources.misc
Subject: PScal - PostScript Calendar generator: leap year bug fixed
Message-ID: <6404@ncoast.UUCP>
Date: 11 Dec 87 02:33:43 GMT
Sender: allbery@ncoast.UUCP
Organization: CSIRO Division of Mathematics and Statistics
Lines: 245
Approved: allbery@ncoast.UUCP
X-Archive: comp.sources.misc/8712/6


Dear Brandon,

Could this possibly be suitable for comp.sources.misc ? It was once
a net.sources submission, which has been hacked about a little.

Some time ago, this really useful shell script to print a PostScript
calendar was sent to net.sources. Unfortunately, it had a bug in the
PostScript which meant that the calendar was wrong for leap years,
certainly for Feb. 1988 onwards. It's short enough that rather than
just post the diffs, I've re-sent the whole script, which here at dmscanb
we call PScal. 

  Syntax is: PScal <month> <year>
  eg.        PScal 2 1988

You should change the default printer variable below. It is set at -Plaser
currently.

Regards,
	Neil Crellin (neilc@dmscanb.dms.oz.au)

=-=-=-=-=-=-=-=-=-=-=-(cut here - this is not a shar)-=-=-=-=-=-=-=-=-=-=-=
#!/bin/csh -f
#
# 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)
#
set printer="-Plaser"

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

if ($?year) then
else 
	echo "usage: $0 [-Pprinter] month year"
	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)

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

/month_names [ (January) (February) (March) (April) (May) (June) (July)
		(August) (September) (October) (November) (December) ] def
/month_name month_names month 1 sub get def

/prtnum { 3 string cvs show} def

/drawgrid {		% draw calendar boxes
	dayfont findfont 10 scalefont setfont
	0 1 6 {
		dup dup 100 mul 40 moveto
		[ (Sun) (Mon) (Tue) (Wed) (Thu) (Fri) (Sat) ] exch get
		90 center
		100 mul 38 moveto
		.5 setlinewidth
		60 {
			gsave
			90 0 rlineto stroke
			grestore
			0 -10 rmoveto
		} repeat
	} for

} def

/drawnums {		% place day numbers on calendar
	dayfont findfont 40 scalefont setfont
	/start startday def
	/days ndays def
	start 100 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 100 sub 0 exch moveto
		}
		{
			100 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 20 scalefont setfont
	  exch
	  {
		30 100 rmoveto
		prtnum
	  }
	  {
		0 12 rmoveto
		prtnum
		0 -12 rmoveto
		gsave
		  dayfont findfont 40 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
50 -120 translate

titlefont findfont 48 scalefont setfont
0 60 moveto
month_name show
/yearstring year 10 string cvs def
700 yearstring stringwidth pop sub 60 moveto
yearstring show

0 0 moveto
drawnums

0 0 moveto
drawgrid

showpage


END-OF-CALENDAR
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=(cut here too)=-=-=-=-=-=-=-=-=-=-=-=-=-=
Neil Crellin, CSIRO Division of Mathematics and Statistics, 
GPO Box 1965, Canberra, ACT 2601, Australia.  PHONE:	+61 62 818 529
ACSNET:	neilc@dmscanb.oz	ARPA: neilc%dmscanb.oz@uunet.uu.net
UUCP:	....{uunet,hplabs,mcvax,ukc,nttlab}!munnari!dmscanb.oz!neilc