Newsgroups: comp.sources.postscript
From: rogers@hicomb.hi.com (Andrew Rogers)
Subject: v01i096: deskcal - A desk calendar on a dodecahedron, Part01/01
Followup-To: comp.sources.d
Summary: Build your own dodecahedron with a calendar on it.
Reply-To: rogers@hicomb.hi.com (Andrew Rogers)
Organization: Flames 'R Us
Date: Tue, 1 Jun 1993 20:34:39 GMT

Submitted-by: rogers@hicomb.hi.com (Andrew Rogers)
Posting-number: Volume 01, Issue 96
Archive-name: deskcal/part01
Environment: PostScript
Keywords: calendar

Some time ago, Ole Arntzen posted a program to print templates for generic
polyhedra; as an example, he included code to generate a dodecahedron.  I've
added code to his "polyeder.ps" to turn his dodecahedron into a 12-month
desk calendar.  Hope you like it...

Andrew Rogers

#! /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:  deskcal.ps
# Wrapped by jgm@vegas on Tue Jun  1 15:31:58 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 'deskcal.ps' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'deskcal.ps'\"
else
  echo shar: Extracting \"'deskcal.ps'\" \(5169 characters\)
  sed "s/^X//" >'deskcal.ps' <<'END_OF_FILE'
X%!PS-Adobe-1.0
X%%Title: deskcal.ps version 1.0 alpha.
X%%Creator: Andrew Rogers (adapted from Ole Arntzen's polyeder.ps)
X%%CreationDate: 6/1/93
X%%Pages: 1
X%%EndComments
X
X%----------------------------------------------------------------------
X% A small program to create a dodecahedral desk calendar; adapted from
X% Ole Arntzen's (olea@ii.uib.no) generic polyhedron program, polyeder.ps,
X% by Andrew Rogers
X%
X% This program is public domain.
X%
X%----------------------------------------------------------------------
X
X/year 1993 def			% define desired year here
X
X/pos 0 def						% starting position
X/mon [1 8 2 7 6 11 5 12 10 4 9 3] def			% position -> month
X/ndays [0 31 28 31 30 31 30 31 31 30 31 30 31] def	% month lengths
X
X/name [() (January) (February) (March) (April) (May) (June) (July)
X          (August) (September) (October) (November) (December)] def
X/wkday [(Su) (Mo) (Tu) (We) (Th) (Fr) (Sa)] def
X
X/LineLength 80 def  			% length of the edges
X/fsize LineLength 10 idiv def		% font size
X
X/center {		% str width center
X/width exch def
X/str exch def
Xwidth str stringwidth pop sub 2 div 0 rmoveto str show
X} def
X
X/strcat {		% str1 str2 >> str1str2
X2 copy
Xlength exch length
Xdup 3 -1 roll add
Xstring
Xdup 0 6 -1 roll putinterval
Xdup 3 -1 roll 4 -1 roll putinterval
X} def
X
X/printcal {
X  /m mon pos get def			% convert position to month
X
X  gsave
X  /Helvetica-Bold findfont fsize scalefont setfont
X
X  /Y LineLength 1.05 mul def
X  0 Y moveto
X  name m get (  ) strcat year 4 string cvs strcat LineLength center
X
X  /l ndays m get def 			% calculate length, starting offset
X  /s start def
X  1 1 m 1 sub {
X    /i exch def
X    /s s ndays i get add def
X  } for
X  /s s 7 mod def
X
X  % calculate centering information for weekdays/dates
X
X  /Helvetica-Bold findfont fsize 1 sub scalefont setfont
X  /w3 (222) stringwidth pop def
X  /w2 (22) stringwidth pop def
X  /X LineLength w3 6 mul w2 add sub 2 div def
X
X  /Helvetica-Bold findfont fsize 2 sub scalefont setfont
X  /Y Y fsize 1.5 mul sub def
X  0 1 6 {				% weekdays
X    /w exch def
X    X w w3 mul add Y moveto
X    wkday w get w2 center
X  } for
X
X  /Helvetica-Bold findfont fsize 1 sub scalefont setfont
X  /Y Y fsize sub def
X
X  1 1 l {				% dates
X    /d exch 3 string cvs def
X    X s 7 mod w3 mul add w2 add d stringwidth pop sub
X      Y s 7 idiv fsize mul sub moveto
X    d show
X    /s s 1 add def
X  } for
X  grestore
X  /pos pos 1 add def
X} def
X
X/ReadCharacter
X{
X% This routine looks for an interesting character, and return it on
X% the stack.  Illegal character => Quit.
X  /OneCharacter 1 string def
X  {
X    currentfile OneCharacter readstring % Read one character.
X    not { (Unexpected end of FILE.  Quit) print quit } if
X    OneCharacter (e) eq OneCharacter (f) eq or { exit } if
X    OneCharacter (3) ge OneCharacter (9) le and { exit } if
X    pop
X
X    OneCharacter (%) eq
X    {   % Found commentcharacter, drop rest of line.
X      {
X        currentfile OneCharacter readstring     % Read one character.
X        not { (Unexpected end of FILE.  Quit) print quit } if
X        pop
X        OneCharacter (\012) eq { exit } if
X      } loop
X    }
X    {
X      OneCharacter ( ) gt
X      {
X        % Illegal character => Quit.
X        (Illegal characeter: ") print
X        OneCharacter print
X        ("\012.  Quit) print
X        quit
X      } if
X    } ifelse
X  } loop
X} def
X
X/DrawEdge
X{
X  0 0 moveto
X  LineLength 0 lineto stroke
X} def
X
X/DrawFlip
X{
X  [1 4] 4 setdash
X  0 0 moveto
X  LineLength 0 lineto stroke
X  [] 0 setdash
X  0 0 moveto
X  LineLength 0.5 mul LineLength 0.3125 mul neg lineto
X  LineLength 0 lineto stroke
X} def
X
X/InnerLoop
X{
X  /OneCharacter ReadCharacter def   % Read one character.
X  OneCharacter (e) eq { DrawEdge }
X    { OneCharacter (f) eq { DrawFlip } { DrawPolygon } ifelse } ifelse
X
X  LineLength 0 translate
X  CurrentAngle rotate
X} def
X
X/DrawPolygon
X{
X  [1 4] 4 setdash
X  0 0 moveto
X  LineLength 0 lineto stroke
X  [] 0 setdash
X  CurrentAngle  % Put previous CurrentAngle on stack for later use.
X
X  /NumEdges OneCharacter cvi def
X  /CurrentAngle 360 NumEdges div def
X  180 CurrentAngle add rotate
X
X  NumEdges 1 sub {
X    InnerLoop
X  } repeat
X
X  printcal
X
X  LineLength 0 translate    % Transformer back to start.
X  180 rotate
X
X  /CurrentAngle exch def    % Fetch CurrentAngle from the stack.
X} def
X
X/DrawPolyhedron
X{
X
X  /OneCharacter ReadCharacter def   % Read one character.
X  /NumEdges OneCharacter cvi def
X  /CurrentAngle 360 NumEdges div def
X
X  printcal
X
X  NumEdges {
X    InnerLoop
X  } repeat
X
X} def
X
X0 setlinewidth      % Set line thickness.
X
X% calculate starting day of year; adjust month lengths for leap year
X
X/y1 year 1 sub def
X/start year y1 4 idiv add y1 100 idiv sub y1 400 idiv add 7 mod def
X
Xyear 4 mod 0 eq year 100 mod 0 ne year 400 mod 0 eq or and {
X  ndays 2 29 put
X} if
X
X% Draw pentagon dodecaheadron.
X
Xgsave
X270 350 translate   % Translate to make the polyhedron fit the paper.
XDrawPolyhedron
X5                 % This is a comment.
X 5 f 5fff    e ee % Blanks are ignored.
X 5 f 5fff    e ee
X 5 f 5fff    e ee
X 5 f 5ff5eeeee ee
X 5 f 5fff    e ee
Xgrestore
X
X% Print some instructions.
X
X/Helvetica findfont 12 scalefont setfont
X40 40 moveto
X(Cut along solid line; fold along dotted lines.) show
X
Xshowpage
END_OF_FILE
  if test 5169 -ne `wc -c <'deskcal.ps'`; then
    echo shar: \"'deskcal.ps'\" unpacked with wrong size!
  fi
  # end of 'deskcal.ps'
fi
echo shar: End of archive.
exit 0