PostScript Calendar
patwood at unirot.UUCP
patwood at unirot.UUCP
Sun Mar 8 04:43:51 AEST 1987
The following is a PostScript program to print calendars. It doesn't
work on or before 1752.
Pat Wood
%!
% 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 3 def
/year 1987 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 {
days_month exch 1 sub get
month 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
More information about the Comp.sources.unix
mailing list