Newsgroups: comp.sources.postscript From: Hierophant Subject: v01i025: calendar - A simple calendar, PostScript level-2, Part01/01 Followup-To: comp.sources.d Summary: A simple calendar, PostScript level-2, with joke holiday names. Reply-To: Hierophant Organization: Dept. of Computer Science, Brown University Date: Sat, 6 Mar 1993 22:05:13 GMT Submitted-by: Hierophant Posting-number: Volume 01, Issue 25 Archive-name: calendar/part01 Environment: PostScript Keywords: calendar, level-2 A simple calendar program in PostScript level 2, with joke holiday names. You can run it in level one PostScript by uncommenting the lines specified below. #! /bin/sh # This is a shell archive. Remove anything before this line, then feed it # into a shell via "sh file" or similar. To overwrite existing files, # type "sh file -c". # The tool that generated this appeared in the comp.sources.unix newsgroup; # send mail to comp-sources-unix@uunet.uu.net if you want that tool. # Contents: calendar.ps # Wrapped by jgm@tahoe on Sat Mar 6 17:02:24 1993 PATH=/bin:/usr/bin:/usr/ucb ; export PATH echo If this archive is complete, you will see the following message: echo ' "shar: End of archive."' if test -f 'calendar.ps' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'calendar.ps'\" else echo shar: Extracting \"'calendar.ps'\" \(7055 characters\) sed "s/^X//" >'calendar.ps' <<'END_OF_FILE' X%!PS-Adobe-2.0 X%%DocumentFonts: Times-Roman Times-Bold X%%Title: simple-calendar v1.0 (R&S version) X%%Creator: TjW X%%CreationDate: 18 Nov 1991 X%%Pages: 1 X%%EndComments X%% X%% this code Copyleft 1993 root@sanger.chem.nd.edu X%% except, of course, for the BreakIntoLines code (Adobe Blue Book) X%% and the R&S dates (Nickelodion R&S Calendar) X%% distribution unlimited if this header left intact X%% X%% caveat: there might be some PS Level II operators - the only one X%% that comes to mind is selectfont, which can be simulated with the X%% below code. X%% X%% FOR LEVEL ONE POSTSCRIPT UNCOMMENT THIS SELECTFONT DEFINITION X%% X%% /selectfont { X%% exch findfont exch scalefont setfont X%% } def X%% X X/inch {72 mul} def %% inch-to-points X X/LM .1 inch def %% left margin (landscape) X/RM 10.75 inch def %% right margin (landscape) X/TM 7.7 inch def %% top margin (landscape) X/BM .75 inch def %% bottom margin (landscape) X/IM 2 inch def %% indent margin X/NM 6.5 inch def %% name margin X/XM 0 def %% spare margin X/scratch 20 string def %% scratch string X/YL TM def %% current Y-position X/XL LM def %% current X-position X/wordbreak ( ) def %% for BreakIntoLines X X%% X%% generate sizes of things based on above X%% X%% landscaped X%% X X/top TM def X/bottom BM def X/left LM def X/right RM def X/high TM BM sub 5 div def X/wide right left sub 7 div def X X%% X%% current position X%% X X/horiz 0 def X/vert 0 def X X%% X%% offset of numbers from (top,left) cell; doubled for line weight X%% X X/offset 7 def X X%% util procs X%% X X/MoveTo {/YL exch def /XL exch def XL YL moveto } def X X/newline { currentpoint exch pop XL exch 14 sub dup /YL exch def moveto } def X X%% box draw settings X X/initbox { X offset 2 mul setlinewidth X 1 setlinejoin X 1 setlinecap X} def X X%% draw inner box X X/drawinline { X setlinewidth setgray newpath X left bottom moveto X left top lineto X right top lineto X right bottom lineto X left bottom lineto X closepath stroke X} def X X%% draw outer box X X/drawoutline { X setlinewidth setgray newpath X LM BM moveto X LM TM lineto X RM TM lineto X RM BM lineto X LM BM lineto X closepath stroke X} def X X%% draw boxes within X X/drawgrid { X setlinewidth setgray X 0 1 4 { X newpath X high mul bottom add dup left exch moveto X right exch lineto stroke X } for X X 0 1 6 { X newpath X wide mul left add dup top moveto X bottom lineto stroke X } for X} def X X%% draw days of week X X/drawdays { X setgray selectfont X 0 1 6 { X dup wide mul offset 2 mul add top moveto X days exch get dup X stringwidth pop wide exch sub 2 div 0 rmoveto X show X } for X} def X X%% draw month name X X/drawmonth { X months exch get dup X stringwidth pop right left sub exch sub 2 div top offset 2 mul add X moveto show X} def X X%% BreakIntoLines, courtesy Adobe Blue Book X X/BreakIntoLines { X /proc exch def X /linewidth exch def X /textstring exch def X X /breakwidth wordbreak stringwidth pop def X /curwidth 0 def X /lastwordbreak 0 def X /startchar 0 def X /restoftext textstring def X X { restoftext wordbreak search { X /nextword exch def pop X /restoftext exch def X /wordwidth nextword stringwidth pop def X X curwidth wordwidth add linewidth gt { X textstring startchar X lastwordbreak startchar sub X getinterval show proc X /startchar lastwordbreak def X /curwidth wordwidth breakwidth add def } { X /curwidth curwidth wordwidth add X breakwidth add def } ifelse X /lastwordbreak lastwordbreak nextword length add 1 add def } X { X pop exit } ifelse } loop X /lastchar textstring length def X textstring startchar lastchar startchar sub X getinterval show proc } def X X%% X%% data tables X%% X X/days [ X (Sunday) X (Monday) X (Tuesday) X (Wednesday) X (Thursday) X (Friday) X (Saturday) X] def X X/months [ X (January) X (February) X (March) X (April) X (May) X (June) X (July) X (August) X (September) X (October) X (November) X (December) X] def X X/holidays [ X% jan X [ [ 5 (Under-leg Noise Making Day) ] X [ 15 (Lederhosen Pride Day) ] X [ 0 () ] ] X% feb X [ [ 3 (Dr. Stupid's Birthday) ] X [ 20 (Soggy Hairball Flinging Day) ] X [ 0 () ] ] X% mar X [ [ 4 (Bloated Sack of Protoplasm Day) ] X [ 18 (Powdered Toast Man's Day) ] X [ 22 (Space Madness Telethon Begins) ] X [ 0 () ] ] X% apr X [ [ 13 (Muddy Mudskipper's Birthday) ] X [ 23 (Gritty Kitty Tasting Festival begins) ] X [ 0 () ] ] X% may X [ [ 1 (Stinky Wizzleteat's Birthday) ] X [ 13 (Happy Helmet Destruction Day) ] X [ 0 () ] ] X% jun X [ [ 11 (Log Day) ] X [ 0 () ] ] X% jul X [ [ 17 (Mr. Horse's Birthday) ] X [ 18 (Firedogs Fire Safety Week begins) ] X [ 0 () ] ] X% aug X [ [ 5 (Happy Happy Joy Joy Festival begins) ] X [ 11 (Ren Hoek & Stimpy hit airwaves '91) ] X [ 27 (Albino Cave Hoek Preservation Day) ] X [ 0 () ] ] X% sep X [ [ 28 (Gritty Kitty Contest Deadline) ] X [ 0 () ] ] X% oct X [ [ 7 (National Implosion Week begins) ] X [ 0 () ] ] X% nov X [ [ 20 (Shaving Scum Appreciation Day) ] X [ 0 () ] ] X% dec X [ [ 20 (Nose Goblins Picking Day) ] X [ 0 () ] ] X] def X X%% days minus one table; how to do leap years? X%% X/howmany [ 30 27 30 29 29 29 30 30 29 30 29 30 ] def X X%% X%% thisday is the current day of the week, 0=sunday X%% its initial value is day of the week of the first day of the year X%% i should calculate this somehow X%% X%% january 1993 began on a friday X%% X X/thisday 5 def X X%% X%% main loop X X0 1 11 { X 8.5 inch 0 inch translate 90 rotate X /Times-Bold 14 selectfont X /thismonth exch def X /holi 0 def X /thisholiday holidays thismonth get def X initbox X 0.85 offset 2 div drawgrid X 0.75 offset drawinline X 0.75 offset drawoutline X /Times-Bold 14 0 drawdays X /Times-Bold findfont [64 0 5.4 24 0 0] makefont setfont X thismonth drawmonth X /Times-Roman 72 selectfont 0.90 setgray X howmany thismonth get /thesedays exch def X /horiz left thisday wide mul add def X /vert top high sub def X 0 1 thesedays { X /today exch def X horiz offset add /h1 exch def X vert offset add /v1 exch def X h1 v1 moveto X% draw date first (!) X today 1 add scratch cvs show X thisholiday holi get 0 get 1 sub today eq { X /thefont currentfont def X /Times-Roman 10 selectfont 0 setgray X thisholiday holi get 1 get X dup stringwidth pop wide gt { X h1 v1 15 add moveto X wide 15 sub { currentpoint exch pop 12 sub h1 exch moveto } X BreakIntoLines X } { X h1 v1 moveto show X } ifelse X /holi holi 1 add def X thefont setfont 0.90 setgray X } if X /thisday thisday 1 add def X /horiz horiz wide add def X thisday 7 eq { X /vert vert high sub def X /horiz left def X /thisday 0 def X } if X X } for X showpage X} for END_OF_FILE if test 7055 -ne `wc -c <'calendar.ps'`; then echo shar: \"'calendar.ps'\" unpacked with wrong size! fi # end of 'calendar.ps' fi echo shar: End of archive. exit 0