home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / vrac / pslwgs15.zip / PSLWGRAY.PSF < prev    next >
Text File  |  1994-12-10  |  11KB  |  314 lines
  1. *ps_lw_gs
  2.  
  3. % ** Start user custom prolog for portrait orientation with linewidth
  4. %    and gray scale control by AutoCAD color number.
  5.  
  6. ;% Set up a small dictionary for our own use
  7. /UserPrologDict 50 dict def UserPrologDict begin
  8. ;
  9. ;% Save our version in case PSFILLs care
  10. /LGP_version 1.5 def
  11.  
  12. % The following section sets up the mapping of AutoCAD color numbers
  13. %  to line widths.
  14.  
  15. % Note that the linewidths specified below are _minimums_.  Explicit
  16. %     linewidths (for example, a polyline with width) that are larger
  17. %     than the minimum override the minimum.  Also note that if the
  18. %     coordinate system is distorted, lines in the shorter direction
  19. %     will be thicker than the minimum (for example, a block inserted
  20. %     with X and Y scale factors that are not equal in magnitude).  On
  21. %     a system with fewer dots per inch in one direction than the other
  22. %     this should work, but I haven't tested it.
  23.  
  24. % An array containing the desired line width in inches for any of the
  25. %     first sixteen colors.  May be expanded or contracted if desired.
  26. %     Colors that are not covered in this array are mapped to the
  27. %     width specified for the last entry in the array.
  28.  
  29. /LGP_colortowidth
  30.   [
  31.     0.001          % Color 1 (red)
  32.     0.001          % Color 2 (yellow)
  33.     0.006          % Color 3 (green)
  34.     0.006          % Color 4 (cyan)
  35.     0.001          % Color 5 (blue)
  36.     0.001          % Color 6 (magenta)
  37.     0.001          % Color 7 (white)
  38.     0.001          % Color 8
  39.     0.001          % Color 9
  40.     0.001          % Color 10
  41.     0.001          % Color 11
  42.     0.001          % Color 12
  43.     0.001          % Color 13
  44.     0.001          % Color 14
  45.     0.001          % Color 15
  46.   ] def
  47.  
  48. % Now the map of AutoCAD color numbers to gray scales.
  49.  
  50. % Each line should have one number between the square brackets on that line.
  51. %  This number should range from 0 (black) to 1 (white).
  52.  
  53. % This array must have at least as many entries as LGP_colortowidth.  If it
  54. %  has more entries than LGP_colortowidth, the extra entries are ignored.
  55. %  Colors that are not covered in this array are mapped to the RGB color
  56. %  specified for the last used entry in the array.
  57.  
  58. /LGP_ACADcolortoPScolor
  59.   [
  60.     [ 0.00 ]          % Color 1 (red)
  61.     [ 0.00 ]          % Color 2 (yellow)
  62.     [ 0.00 ]          % Color 3 (green)
  63.     [ 0.00 ]          % Color 4 (cyan)
  64.     [ 0.00 ]          % Color 5 (blue)
  65.     [ 0.00 ]          % Color 6 (magenta)
  66.     [ 1.00 ]          % Color 7 (white)
  67.     [ 0.00 ]          % Color 8
  68.     [ 0.00 ]          % Color 9
  69.     [ 0.00 ]          % Color 10
  70.     [ 0.00 ]          % Color 11
  71.     [ 0.00 ]          % Color 12
  72.     [ 0.00 ]          % Color 13
  73.     [ 0.00 ]          % Color 14
  74.     [ 0.60 ]          % Color 15
  75.   ] def
  76.  
  77. ;% Set up an alias for the function that sets the current color
  78. ;%  values for the PostScript interpreter.  This allows the code section
  79. ;%  to be independent of the color model.
  80.  
  81. /LGP_setcolor { setgray } bind def
  82.  
  83. ;%  START THE CODE SECTION
  84. ;
  85. ;% First some preliminary stuff
  86. ;
  87. ;% A routine to find the square root of the sum of the squares of the top
  88. ;%  two numbers of the stack
  89. ;
  90. ;%     num1 num2 LGP_SqrtSumSquares sqrt(num1*num1 + num2*num2)
  91. ;
  92. /LGP_SqrtSumSquares { dup mul exch dup mul add sqrt } bind def
  93. ;
  94. % A routine to find the minimum non-zero magnitude of either the X scale
  95. %     factor or the Y scale factor of a given transformation matrix.
  96. %     Assumes at least one of the scale factor magnitudes is non-zero.
  97. ;
  98. ;%     CTM LGP_MinScaleMag (minimum scale factor, dots per unit)
  99. ;
  100. /LGP_MinScaleMag { 
  101. ;  % Get the elements of the matrix
  102.    aload
  103. ;  % Discard the original matrix and the translation entries
  104.    pop pop pop 
  105. ;  % Arrange the stack to get the X coefficents and Y coefficients
  106. ;  %     together
  107.    4 1 roll exch 4 -1 roll
  108. ;  % Find the magnitude of the vector defined by the Y coefficients
  109.    LGP_SqrtSumSquares
  110. ;  % Bring the X coefficients to the top of the stack
  111.    3 1 roll
  112. ;  % Find the magnitude of the vector defined by the X coefficients
  113.    LGP_SqrtSumSquares
  114. ;  % Copy the two magnitudes
  115.    2 copy
  116. ;  % If the Y magnitude is greater than the X magnitude ...
  117.    gt
  118. ;  % Swap the X and Y magnitudes
  119.    { exch } if
  120. ;  % If the minimum magnitude, now one down in the stack, is zero
  121. ;  %  then swap so the maximum (assumed non-zero) magnitude
  122. ;  %  is one down in the stack
  123.    exch dup 0.0 ne { exch } if
  124. ;  % The maximum magnitude is on top of the stack, discard it
  125.    pop
  126. ;  % Leaving the minimum magnitude on the stack
  127. } bind def
  128. ;
  129. ;% Get the dot-pitches per inch for this printer (accounting for
  130. ;%     the possibility that it may be different in X and Y directions;
  131. ;%     we pick the minimum)
  132. ;
  133. /LGP_printerdotsperinch matrix defaultmatrix LGP_MinScaleMag 72 mul def
  134. ;
  135. ;% Convert the array of line widths in inches to line widths in dots
  136. ;
  137. LGP_colortowidth { LGP_printerdotsperinch mul } forall
  138.   LGP_colortowidth astore /LGP_colortowidth def
  139. ;
  140. ;% Initialize the current minimum and desired line widths in current dots.
  141. ;%     These numbers are arbitrary and will be overriden immediately.
  142. ;
  143. /LGP_minwidth 1 def
  144. /LGP_desiredwidth 1 def
  145. ;
  146. ;% Set up an array in which to simulate a stack of values of
  147. ;%     LGP_desirewidth (and, not incidentally, load it with a dummy
  148. ;%     value to be removed at the final "grestore" of the EPS file)
  149. ;
  150. /LGP_dw_stack [ LGP_desiredwidth ] def
  151. ;
  152. ;% This ends the stuff that initializes
  153. end
  154. ;
  155. ;% Now the routines that really DO things.
  156. ;
  157. ;% A "front end" for the stroke function.  Sets the line width to
  158. ;%     the desired line width before stroking, so the line width
  159. ;%     will always be the desired value no matter what machinations
  160. ;%     have gone on with the scale.  NOTE that this procedure and
  161. ;%     the binding that follows it MUST precede the "front end"
  162. ;%     for the setlinewidth procedure
  163. ;
  164. /LGP_strokefrontend {
  165.   UserPrologDict begin
  166. ; % Get the current desired line width in dots
  167.   LGP_desiredwidth
  168. ; % Get the current scale factor in dots per unit
  169.   matrix currentmatrix LGP_MinScaleMag
  170. ; % Divide desired line width in dots by dots per unit to get units
  171.   div 
  172.   setlinewidth
  173.   end
  174. } bind def
  175. ;
  176. ;% Bind our front end to the original stroke function for speed
  177. ;
  178. /stroke { LGP_strokefrontend stroke } bind def
  179. ;
  180. ;% A front end for the setlinewidth function.  If the requested line
  181. ;%     width in inches is greater than LGP_minwidth, sets the line
  182. ;%     width to the requested value and sets LGP_desiredwidth to the
  183. ;%     requested line width in dots.  If the requested line width
  184. ;%     is less than LGP_minwidth, uses LGP_minwidth instead.
  185. ;%     NOTE that this front end and the binding that follows MUST
  186. ;%     follow the stroke front end and its binding.
  187. ;
  188. ;%     num setlinewidth -
  189. ;
  190. /LGP_setlwfrontend {
  191.   UserPrologDict begin
  192. ; % Get the current scale factor in dots per unit
  193.   matrix currentmatrix LGP_MinScaleMag
  194. ; % Save copies of the current dots per unit and requested linewidth
  195.   2 copy
  196. ; % And convert the requested line width (in units) to dots
  197.   mul
  198. ; % Compare the requested line width to the current minimum line width
  199.   dup LGP_minwidth gt
  200. ;   % Here the requested line width is greater than our minimum
  201.     {
  202. ;     % Set the current desired line width in dots
  203.       /LGP_desiredwidth exch def
  204. ;     % Discard the extra copy of the current inches per unit, leaving
  205. ;     %   the requested line width in units on the stack
  206.       pop
  207.     }
  208. ;   % Here the requested line width is less than our minimum
  209.     {
  210. ;     % Discard the requested line width in dots
  211.       pop
  212. ;     % Get our minimum line width in dots and save a copy
  213.       LGP_minwidth dup
  214. ;     % Save the current desired line width in dots
  215.       /LGP_desiredwidth exch def
  216. ;     % Convert the desired line width in dots to units
  217.       exch div
  218. ;     % Discard the originally requested line width, leaving our
  219. ;     %   minimum line width in units on the stack
  220.       exch pop
  221.     }
  222.   ifelse
  223.   end
  224. } bind def
  225. ;
  226. ;% Bind the setlinewidth front end to the setlinewidth function for speed
  227. ;
  228. /setlinewidth { LGP_setlwfrontend setlinewidth } bind def
  229. ;
  230. ;% A routine to set desired line width and color or gray scale whenever
  231. ;%     AutoCAD changes colors.  Doesn't actually set the line width (just
  232. ;%     saves it in LGP_desiredwidth and LGP_minwidth), does actually
  233. ;%     set the color or gray scale
  234. ;
  235. ;%     (color number) (red value) (green value) (blue value) ACADColor -
  236. ;
  237. /ACADColor {
  238.   UserPrologDict begin
  239. ; % Discard the RGB values of the color
  240.   pop pop pop
  241. ; % If the color number is greater than the number of elements in the
  242. ; %    array, use the highest number that's covered in the array
  243.   dup LGP_colortowidth length gt { pop LGP_colortowidth length } if
  244. ; % Convert the color number into a zero-based array index
  245.   1 sub
  246. ; % Save the index for later (for the gray scale array)
  247.   dup
  248. ; % Get the desired line width in dots and save it both as the minimum
  249. ; %     and the desired value
  250.   LGP_colortowidth exch get /LGP_minwidth exch dup /LGP_desiredwidth exch
  251.   def def
  252. ; % Get the desired color or gray scale value array ...
  253.   LGP_ACADcolortoPScolor exch get 
  254. ; % Extract the elements of the array and discard the array
  255.   aload pop
  256. ; % Implement the new color or gray scale
  257.   LGP_setcolor
  258.   end
  259. } bind def
  260. ;
  261. ;% A "front end" for the gsave function.  Simulates pushing LGP_desiredwidth
  262. ;%     on a stack (really an array).  In effect, LGP_desiredwidth is saved
  263. ;%     along with the graphics state.
  264. ;
  265. /LGP_gsavefrontend {
  266.   UserPrologDict begin
  267. ; % Put the name of our array on the stack
  268.   /LGP_dw_stack
  269. ; % Start an array
  270.   [
  271. ; % Put the array itself on the stack, unload its elements onto the stack,
  272. ; %     and discard the array that "aload" leaves on top
  273.   LGP_dw_stack aload pop
  274. ; % Put the current value of LGP_desiredwidth on the stack
  275.   LGP_desiredwidth
  276. ; % End the array and save it
  277.   ] def
  278.   end
  279. } bind def
  280. ;
  281. ;% Bind our front end to the original gsave function for speed
  282. ;
  283. /gsave { LGP_gsavefrontend gsave} bind def
  284. ;
  285. ;% A "front end" for the grestore function.  Simulates popping
  286. ;%     LGP_desiredwidth from a stack (really an array).  In effect,
  287. ;%     LGP_desiredwidth is restored along with the graphics state
  288. ;
  289. /LGP_grestorefrontend {
  290.   UserPrologDict begin
  291. ; % Put the name of our array on the stack
  292.   /LGP_dw_stack
  293. ; % Start an array
  294.   [
  295. ; % Put the array itself on the stack, unload its elements onto the stack,
  296. ; %     and discard the array that "aload" leaves on top
  297.   LGP_dw_stack aload pop
  298. ; % Store the last value in the array into LGP_desiredwidth
  299.   /LGP_desiredwidth exch def
  300. ; % End the array and save it
  301.   ] def
  302.   end
  303. } bind def
  304. ;
  305. ;% Bind our front end to the original grestore function for speed
  306. ;
  307. /grestore { LGP_grestorefrontend grestore} bind def
  308. ;
  309. ;% If the setstrokeadjust procedure is available, activate stroke adjustment
  310. ;
  311. /setstrokeadjust where { pop true setstrokeadjust } if
  312. ;
  313. % ** End user custom prolog
  314.