home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / GRAPHICS / PSCRIPT / PSCROSWD.ZIP / CROSSWRD.PRG < prev   
Encoding:
Text File  |  1991-12-18  |  4.8 KB  |  166 lines
  1. ===== listing begins here ====
  2.  
  3. %**************************************
  4. %Crossword:  Creates a crossword puzzle form or solution from the input
  5. %file.  Squares are automatically numbered.  Use a "#" for black squares
  6. %and a "." for blank squares.
  7. /BORDER
  8. { newpath
  9.   COL BOXES ROW BOXES moveto
  10.   -1 BOXES 0 BOXES rlineto
  11.   0 BOXES -1 BOXES rlineto
  12.   1 BOXES 0 BOXES rlineto
  13.   closepath
  14.   stroke
  15. } def
  16.  
  17. /NUMBER
  18. { COL 1 sub BOXES ROW BOXES moveto
  19.   1 6 div BOXES 1 3 div neg BOXES rmoveto
  20.   /Courier findfont PTSIZ scalefont setfont
  21.   NEXTNUMBER 20 string cvs show
  22.   /NEXTNUMBER NEXTNUMBER 1 add def
  23. } def
  24.  
  25. /LETTER
  26. { /LET exch def
  27.   COL .8 sub BOXES ROW .9 sub BOXES moveto
  28.   /Courier findfont .8 BOXES scalefont setfont
  29.   LET show
  30. } def
  31.  
  32. /BLACK
  33. { newpath
  34.   COL BOXES ROW BOXES moveto
  35.   -1 BOXES 0 BOXES rlineto
  36.   0 BOXES -1 BOXES rlineto
  37.   1 BOXES 0 BOXES rlineto
  38.   closepath
  39.   fill
  40. } def
  41.  
  42. /DOLINE
  43. { 1 1 COLS
  44.   { /COL exch def
  45.     BORDER
  46.     NEWSTRING COL 1 sub 1 getinterval dup (#) eq
  47.       { BLACK pop }
  48.       { COL 1 eq
  49.         { NUMBER }
  50.         { OLDSTRING COL 1 sub 1 getinterval (#) eq
  51.           NEWSTRING COL 2 sub 1 getinterval (#) eq or { NUMBER } if
  52.         }
  53.         ifelse
  54.         dup (.) eq {pop ( )} if LETTER
  55.       }
  56.     ifelse
  57.   } for
  58.    OLDSTRING 0 NEWSTRING putinterval
  59.   /ROW ROW 1 sub def
  60. } def
  61.  
  62. /MAIN
  63. { /Courier findfont 8 scalefont setfont
  64.   /INCH {72 mul} def
  65.   .6 INCH 10.6 INCH translate
  66.   /NEXTNUMBER 1 def
  67.   /ROW 0 def
  68.   currentfile read {pop} {quit} ifelse
  69.   currentfile 512 string readline not {quit} if
  70.   0 0 moveto
  71.   dup
  72.   length /COLS exch def
  73.   /NEWSTRING COLS string def
  74.   NEWSTRING exch 0 exch putinterval
  75.   /OLDSTRING COLS string def
  76.   0 1 COLS 1 sub { OLDSTRING exch (#) putinterval } for
  77.   /BOX 7.5 INCH COLS div def
  78.   /BOXES {BOX mul} def
  79.   /PTSIZ 5 18 div BOXES def
  80.   { DOLINE currentfile NEWSTRING readline not {exit} if } loop
  81.   showpage
  82. } def
  83. MAIN
  84. %************************************
  85. %PS_DOUBLE:  Two column, 80-character landscape mode
  86. %!PS-Adobe-1.0
  87. %%Creator: Carl J Lydick
  88. %%DocumentFonts: Courier
  89. %%Pages: (atend)
  90. /Courier findfont 6 scalefont setfont
  91. /N {showpage 90 rotate 0 -618 translate /H 538 def /V 71 def} def
  92. /O {/H 538 def /V 431 def} def
  93. /P {V 431 ne {O} {N} ifelse} def
  94. /Q { V H moveto dup length 80 gt {0 80 getinterval} if show /H H 7 sub def
  95.    H 79 le {P} if} def
  96. /R 0 def
  97. /S 512 string def
  98. /T {(<FF>) search {R 0 ne {Q pop P} {pop pop /R 1 def} ifelse T} if} def
  99. /L {90 rotate 0 -618 translate /H 538 def /V 71 def
  100.    {currentfile S readline not {exit} if T Q} loop showpage} def
  101. L<FF>
  102. %***********************************
  103. %PS_LANDSCAPE 132-character landscape
  104. %!PS-Adobe-1.0
  105. %%Creator: Carl J Lydick
  106. %%DocumentFonts: Courier
  107. %%Pages: (atend)
  108. /Courier findfont 9 scalefont setfont
  109. /P {showpage 90 rotate 0 -618 translate /H 594 def} def
  110. /Q {36 H moveto dup length 132 gt {0 132 getinterval} if show /H H 9.5 sub def
  111.     H 30 le {P} if} def
  112. /R 0 def
  113. /S 512 string def
  114. /T {(<FF>) search {R 0 ne {Q pop P} {pop pop /R 1 def} ifelse T} if} def
  115. /L {90 rotate 0 -618 translate /H 594 def {currentfile S readline not {exit} if
  116.     T Q} loop showpage} def
  117. L<FF>
  118. %*********************************
  119. %PS_PORTRAIT 80-character portrait
  120. %!PS-Adobe-1.0
  121. %%Creator: Carl J Lydick
  122. %%DocumentFonts: Courier
  123. %%Pages: (atend)
  124. /Courier findfont 11 scalefont setfont
  125. /P {showpage /H 750 def} def
  126. /Q { 36 H moveto dup length 80 gt {0 80 getinterval} if show /H H 12 sub def
  127.    H 30 le {P} if} def
  128. /R 0 def
  129. /S 512 string def
  130. /T {(<FF>) search {R 0 ne {Q pop P} {pop pop /R 1 def} ifelse T} if} def
  131. /L {/H 750 def {currentfile S readline not {exit} if T Q} loop showpage} def
  132. L<FF>
  133. %******************************
  134. %PS_WIDE 132-character portrait
  135. %!PS-Adobe-1.0
  136. %%Creator: Carl J Lydick
  137. %%DocumentFonts: Courier
  138. %%Pages: (atend)
  139. /Courier findfont 6 scalefont setfont
  140. /P {showpage /H 750 def} def
  141. /Q { 36 H moveto dup length 132 gt {0 132 getinterval} if show /H H 7 sub def
  142.    H 30 le {P} if} def
  143. /R 0 def
  144. /S 512 string def
  145. /T {(<FF>) search {R 0 ne {Q pop P} {pop pop /R 1 def} ifelse T} if} def
  146. /L {/H 750 def {currentfile S readline not {exit} if T Q} loop showpage} def
  147. L<FF>
  148. %*******************************************************
  149. %PS_NUMBERED:  80-character portrait with pages numbered
  150. %!PS-Adobe-1.0
  151. %%Creator: Carl J Lydick
  152. %%DocumentFonts: Courier
  153. %%Pages: (atend)
  154. /Courier findfont 11 scalefont setfont
  155. /NUM 1 def
  156. /SNUM 8 string def
  157. /N { 540 30 moveto NUM SNUM cvs show /NUM NUM 1 add def} def
  158. /P { N showpage /H 750 def} def
  159. /Q { 36 H moveto dup length 80 gt {0 80 getinterval} if show /H H 12 sub def
  160.    H 54 le {P} if} def
  161. /R 0 def
  162. /S 512 string def
  163. /T {(<FF>) search {R 0 ne {Q pop P} {pop pop /R 1 def} ifelse T} if} def
  164. /L {/H 750 def {currentfile S readline not {exit} if T Q} loop N showpage} def
  165. L<FF>
  166.