home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8712 / 6 < prev    next >
Encoding:
Internet Message Format  |  1990-07-13  |  5.5 KB
  1. Path: uunet!husc6!necntc!ncoast!allbery
  2. From: neilc@dmscanb.oz.au.UUCP (Neil Crellin)
  3. Newsgroups: comp.sources.misc
  4. Subject: PScal - PostScript Calendar generator: leap year bug fixed
  5. Message-ID: <6404@ncoast.UUCP>
  6. Date: 11 Dec 87 02:33:43 GMT
  7. Sender: allbery@ncoast.UUCP
  8. Organization: CSIRO Division of Mathematics and Statistics
  9. Lines: 245
  10. Approved: allbery@ncoast.UUCP
  11. X-Archive: comp.sources.misc/8712/6
  12.  
  13. Dear Brandon,
  14.  
  15. Could this possibly be suitable for comp.sources.misc ? It was once
  16. a net.sources submission, which has been hacked about a little.
  17.  
  18. Some time ago, this really useful shell script to print a PostScript
  19. calendar was sent to net.sources. Unfortunately, it had a bug in the
  20. PostScript which meant that the calendar was wrong for leap years,
  21. certainly for Feb. 1988 onwards. It's short enough that rather than
  22. just post the diffs, I've re-sent the whole script, which here at dmscanb
  23. we call PScal. 
  24.  
  25.   Syntax is: PScal <month> <year>
  26.   eg.        PScal 2 1988
  27.  
  28. You should change the default printer variable below. It is set at -Plaser
  29. currently.
  30.  
  31. Regards,
  32.     Neil Crellin (neilc@dmscanb.dms.oz.au)
  33.  
  34. =-=-=-=-=-=-=-=-=-=-=-(cut here - this is not a shar)-=-=-=-=-=-=-=-=-=-=-=
  35. #!/bin/csh -f
  36. #
  37. # From: patwood@unirot.UUCP (Patrick Wood)
  38. # Newsgroups: net.sources
  39. # Subject: PostScript Calendar
  40. # Date: 7 Mar 87 18:43:51 GMT
  41. # Organization: Public Access Unix, Piscataway, NJ
  42. # 
  43. # The following is a PostScript program to print calendars.  It doesn't
  44. # work on or before 1752.
  45. # 
  46. # Shell stuff added 3/9/87 by King Ables
  47. # Leap year bug fixed Dec. 4th, 1987 by Neil Crellin (neilc@dmscanb.dms.oz.au)
  48. #
  49. set printer="-Plaser"
  50.  
  51. top:
  52. if ($#argv > 0) then
  53.     switch ("$argv[1]")
  54.         case -*:
  55.             set printer="$argv[1]"
  56.             shift argv
  57.             goto top
  58.         case *:
  59.             if ($?month) then
  60.                 set year="$argv[1]"
  61.             else if ($?year) then
  62.                 echo "usage: $0 [-Pprinter] month year"
  63.                 exit 1
  64.             else
  65.                 set month="$argv[1]"
  66.             endif
  67.             shift argv
  68.             goto top
  69.     endsw
  70. endif
  71.  
  72. if ($?year) then
  73. else 
  74.     echo "usage: $0 [-Pprinter] month year"
  75.     exit 1
  76. endif
  77.  
  78. lpr $printer <<END-OF-CALENDAR
  79. %!
  80. % PostScript program to draw calendar
  81. % Copyright (C) 1987 by Pipeline Associates, Inc.
  82. % Permission is granted to modify and distribute this free of charge.
  83.  
  84. % /month should be set to a number from 1 to 12
  85. % /year should be set to the year you want
  86. % you can change the title and date fonts, if you want
  87. % we figure out the rest
  88. % won't produce valid calendars before 1800 (weird stuff happened
  89. % in September of 1752)
  90.  
  91. /month $month def
  92. /year $year def
  93. /titlefont /Times-Bold def
  94. /dayfont /Helvetica-Bold def
  95.  
  96. /month_names [ (January) (February) (March) (April) (May) (June) (July)
  97.         (August) (September) (October) (November) (December) ] def
  98. /month_name month_names month 1 sub get def
  99.  
  100. /prtnum { 3 string cvs show} def
  101.  
  102. /drawgrid {        % draw calendar boxes
  103.     dayfont findfont 10 scalefont setfont
  104.     0 1 6 {
  105.         dup dup 100 mul 40 moveto
  106.         [ (Sun) (Mon) (Tue) (Wed) (Thu) (Fri) (Sat) ] exch get
  107.         90 center
  108.         100 mul 38 moveto
  109.         .5 setlinewidth
  110.         60 {
  111.             gsave
  112.             90 0 rlineto stroke
  113.             grestore
  114.             0 -10 rmoveto
  115.         } repeat
  116.     } for
  117.  
  118. } def
  119.  
  120. /drawnums {        % place day numbers on calendar
  121.     dayfont findfont 40 scalefont setfont
  122.     /start startday def
  123.     /days ndays def
  124.     start 100 mul 0 rmoveto
  125.     1 1 days {
  126.         /day exch def
  127.         gsave
  128.           isdouble
  129.           {
  130.             day prtdouble
  131.           }
  132.           {
  133.             day prtnum
  134.           } ifelse
  135.         grestore
  136.         day start add 7 mod 0 eq
  137.         {
  138.             currentpoint exch pop 100 sub 0 exch moveto
  139.         }
  140.         {
  141.             100 0 rmoveto
  142.         } ifelse
  143.     } for
  144. } def
  145.  
  146. /isdouble {        % is today going to be overlaid on next week's?
  147.     days start add 35 gt
  148.     {
  149.         day start add 35 gt
  150.         {
  151.             true true
  152.         }
  153.         {
  154.             day start add 28 gt
  155.             day 7 add days le and
  156.             {
  157.                 false true
  158.             }
  159.             {
  160.                 false
  161.             } ifelse
  162.         } ifelse
  163.     }
  164.     {
  165.         false
  166.     } ifelse
  167. } def
  168.  
  169. /prtdouble {
  170.     gsave
  171.       dayfont findfont 20 scalefont setfont
  172.       exch
  173.       {
  174.         30 100 rmoveto
  175.         prtnum
  176.       }
  177.       {
  178.         0 12 rmoveto
  179.         prtnum
  180.         0 -12 rmoveto
  181.         gsave
  182.           dayfont findfont 40 scalefont setfont
  183.           (/) show
  184.         grestore
  185.       } ifelse
  186.     grestore
  187. } def
  188.  
  189. /isleap {        % is this a leap year?
  190.     year 4 mod 0 eq        % multiple of 4
  191.     year 100 mod 0 ne     % not century
  192.     year 1000 mod 0 eq or and    % unless it's a millenia
  193. } def
  194.  
  195. /days_month [ 31 28 31 30 31 30 31 31 30 31 30 31 ] def
  196.  
  197. /ndays {        % number of days in this month
  198.     days_month month 1 sub get
  199.     month 2 eq    % Feb
  200.     isleap and
  201.     {
  202.         1 add
  203.     } if
  204. } def
  205.  
  206. /startday {        % starting day-of-week for this month
  207.     /off year 2000 sub def    % offset from start of "epoch"
  208.     off
  209.     off 4 idiv add        % number of leap years
  210.     off 100 idiv sub    % number of centuries
  211.     off 1000 idiv add    % number of millenia
  212.     6 add 7 mod 7 add     % offset from Jan 1 2000
  213.     /off exch def
  214.     1 1 month 1 sub {
  215.                 1 copy
  216.         days_month exch 1 sub get
  217.         exch 2 eq
  218.         isleap and
  219.         {
  220.             1 add
  221.         } if
  222.         /off exch off add def
  223.     } for
  224.     off 7 mod        % 0--Sunday, 1--monday, etc.
  225. } def
  226.  
  227. /center {        % center string in given width
  228.     /width exch def
  229.     /str exch def width str 
  230.     stringwidth pop sub 2 div 0 rmoveto str show
  231. } def
  232.  
  233. 90 rotate
  234. 50 -120 translate
  235.  
  236. titlefont findfont 48 scalefont setfont
  237. 0 60 moveto
  238. month_name show
  239. /yearstring year 10 string cvs def
  240. 700 yearstring stringwidth pop sub 60 moveto
  241. yearstring show
  242.  
  243. 0 0 moveto
  244. drawnums
  245.  
  246. 0 0 moveto
  247. drawgrid
  248.  
  249. showpage
  250.  
  251.  
  252. END-OF-CALENDAR
  253. =-=-=-=-=-=-=-=-=-=-=-=-=-=-=(cut here too)=-=-=-=-=-=-=-=-=-=-=-=-=-=
  254. Neil Crellin, CSIRO Division of Mathematics and Statistics, 
  255. GPO Box 1965, Canberra, ACT 2601, Australia.  PHONE:    +61 62 818 529
  256. ACSNET:    neilc@dmscanb.oz    ARPA: neilc%dmscanb.oz@uunet.uu.net
  257. UUCP:    ....{uunet,hplabs,mcvax,ukc,nttlab}!munnari!dmscanb.oz!neilc
  258.