maceache@fox.nstn.ns.ca (Tim Maceachern) (05/25/91)
Please find below a revised calendar program for postscript printers.
It will print single months in landscape fashion with nice boxes for
you to write notes in... It will also print Julian day numbers in
the boxes. As well, it will do a landscape yearly calendar. A demo
will be printed if you just print the file as is. To print other months
or the yearly calendar, read the instructions at the end of the file
and edit to your liking.
Enjoy...
Tim MacEachern Software Kinetics Ltd.
maceache@fox.nstn.ns.ca or maceache@corp.nstn.ns.ca
cut here (make sure the file starts with the %! characters )
---------------------------------------------------------------------
%!PS-Adobe-1.0
% PostScript program to draw calendar
% Copyright (C) 1987 by Pipeline Associates, Inc.
% Permission is granted to modify and distribute this free of charge.
% won't produce valid calendars before 1800 (weird stuff happened
% in September of 1752)
% Modified by Tim MacEachern, Software Kinetics Ltd., April 91 to print
% Julian day numbers, to centre labels, to draw nice day-boxes, add stack
% comments.
% Some routines revised simply because I used to be a Forth programmer,
% and don't like to use local variables. Month printing has been made
% into a word, there is a word to annotate day boxes and a word has
% been created to print a whole year (although in rather small type).
% Edit in one of the examples at the bottom of the file before printing.
% Comments to maceache@corp.nstn.ns.ca
%-------Customization
/titlefont /Times-Bold def % font for month name, year number
/dayfont /Helvetica-Bold def % font for day names, day & julian numbers
/number_size 40 def % relative point size of day numbers
/julian_number_size 25 def % relative point size of julian day numbers
/print_julian false def % true: print Julian day numbers, false: don't
%-------Code
/str_convert 9 string def % room to format numbers to ascii strings
/idiv {div cvi} def % Bug fix for version 41.0 of Postscript
/month_names [ (January) (February) (March) (April) (May) (June) (July)
(August) (September) (October) (November) (December) ] def
/julian_day_no % day month year -- int : compute julian day number
% from CACM Algorithm number 199
{over 2 gt {exch 3 sub exch} {exch 9 add exch 1 sub} ifelse
dup 100 idiv exch over 100 mul sub % day month* century year*
1461 mul 4 idiv
exch 146097 mul 4 idiv add
exch 153 mul 2 add 5 idiv add add 1721119 add} def
/over % x y -- x y x : duplicate second-from-top stack element
{1 index} def
/prtnum % day -- : print day number at current cursorposition
{ str_convert cvs show} def
/prtjuliannum % day -- : print Julian day number at current cursorpos
% warning: uses local variables month, year
{ month year julian_day_no
1 1 year julian_day_no sub 1 add
str_convert cvs show} def
/drawgrid { % -- : draw calendar boxes
dayfont findfont 15 scalefont setfont
0 1 6 {
dup dup 100 mul 40 moveto
[ (Sunday) (Monday) (Tuesday) (Wednesday) (Thursday) (Friday) (Saturday) ]
exch get
100 center
100 mul 35 moveto
.5 setlinewidth
5 {
gsave
100 0 rlineto 0 -100 rlineto -100 0 rlineto
0 100 rlineto stroke
grestore
0 -100 rmoveto
} repeat
} for
} def
/drawnums { % place day numbers on calendar
/scaled_dayfont dayfont findfont number_size scalefont def
/scaled_julian_dayfont dayfont findfont julian_number_size scalefont def
/start startday def
/days ndays def
start 100 mul 0 rmoveto
1 1 days {
/day exch def
isdouble
{
gsave scaled_dayfont setfont day prtdouble grestore
print_julian
{gsave 0 -60 rmoveto
isdouble pop
scaled_julian_dayfont setfont
day prtjuliandouble grestore} if
}
{
gsave scaled_dayfont setfont day prtnum grestore
print_julian
{gsave 0 -60 rmoveto
scaled_julian_dayfont setfont
day prtjuliannum grestore} if
} ifelse
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?
% -- false : this day is not double
% -- true true : this is the later double day
% -- false true : this is the earlier double day
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 { % flag day -- : print day in double-day box,
% flag=true means later day (30 or 31)
gsave
dayfont findfont number_size 2 div scalefont setfont
exch
{
30 100 rmoveto
prtnum
}
{
0 12 rmoveto
prtnum
0 -12 rmoveto
gsave
scaled_dayfont setfont
(/) show
grestore
} ifelse
grestore
} def
/prtjuliandouble % flag day -- : print one double number (first if flag=false)
% actually prints both day numbers when called for the first one
{ gsave
scaled_julian_dayfont setfont
exch
{
pop
}
{
dup prtjuliannum
(/) show
7 add prtjuliannum
} ifelse
grestore
} def
/isleap { % -- flag : 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 { % -- n : number of days in this month
days_month month 1 sub get
month 2 eq % Feb
isleap and
{
1 add
} if
} def
/startday { % -- n : starting day-of-week for this month, Sunday=0
1 month year julian_day_no 1 add 7 mod } def
/center { % str width - : center string in given width
1 index stringwidth pop sub 2 div 0 rmoveto show } def
%%%%%%%%%%%%%%%%%%%%%%%%
% User-callable routines
%%%%%%%%%%%%%%%%%%%%%%%%
/print_month { % year month -- : print a monthly calendar
gsave
/month exch def
/year exch def
titlefont findfont 44 scalefont setfont
-10 100 moveto 720 0 rlineto 0 -572 rlineto -720 0 rlineto
0 572 rlineto stroke
0 64 moveto
month_names month 1 sub get show
year str_convert cvs dup stringwidth pop 700 exch sub 64 moveto show
0 0 moveto drawnums
0 0 moveto drawgrid
grestore } def
/atday { % str y_offset dayno -- : annotate day, use y_offset -15 to -65
% warning : must be used after print_month, which sets variables
gsave
start add 1 sub exch over 7 idiv -100 mul add % y coord
exch 7 mod 100 mul 50 add % x coord
exch moveto
0 center
grestore} def
/print_landscape_year { % year -- : print a yearly calendar, landscape mode
/year exch def
90 rotate
titlefont findfont 54 scalefont setfont
0 -70 moveto year 10 string cvs 72 11 mul center
20 -120 translate
0 1 11 {
gsave
dup 4 mod 188 mul over 4 idiv -160 mul translate
0.25 0.25 scale
year exch 1 add print_month
grestore } for
} def
% /#copies 1 def % number of copies of the page to print
% Examples of use of these functions. To use an example, remove the percent
% sign from column one of each line of the example you want to run.
%
% Example 1: print two month calendars, one with julian day numbers, one
% without
%
90 rotate 50 -120 translate 1991 4 print_month
showpage
/print_julian true def
90 rotate 50 -120 translate 1991 5 print_month
showpage
%
% Example 2: print a calendar with annotation of day boxes
%
% 90 rotate 50 -120 translate 2010 3 print_month
% titlefont findfont 15 scalefont setfont
% (Ed's) -20 20 atday
% (Last) -36 20 atday
% (Day) -52 20 atday
%
% (Government) -15 10 atday
% (Cancels) -30 10 atday
% (Pension) -45 10 atday
% (Plan) -60 10 atday
% showpage
%
% Example 3: print a whole year out
%
% 1991 print_landscape_year
% showpage