2000
%!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
      gr
412
estore } 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
.

0