home *** CD-ROM | disk | FTP | other *** search
/ Corel Draw 3 / CorelDRAW-v3.0.iso / draw / prolog.ps < prev    next >
Text File  |  1992-10-25  |  57KB  |  2,003 lines
  1. % -------------- POSTSCRIPT PROLOG FOR CORELDRAW 3.X ------
  2. % Copyright 1992 Corel Corporation.  All rights reserved.
  3.  
  4. /wCorelDict 300 dict def    % define our own dictionary
  5. wCorelDict begin                % everything is defined in our own dictionary
  6.  
  7. % -- general definition operators
  8. /bd {bind def} bind def
  9. /ld {load def} bd
  10. /xd {exch def} bd
  11. /_ null def                            % null object
  12.  
  13.  
  14. % ----- Global Color variables ---------
  15. % Current object's Fill color
  16. /$c 0 def         % Cyan component
  17. /$m 0 def        % Magenta component
  18. /$y 0 def        % yellow component
  19. /$k 0 def        % Black component
  20. /$t 1 def        % color Tint
  21. /$n _ def        % Color name(non-null for special colors only)
  22. /$o 0 def        % fill overprint flag
  23. /$fil 0 def        % current fill type: 0: solid, 1:pattern, 2: fountain, 3:PS-fill
  24.  
  25. /$bkg false def
  26.  
  27. % Current object's outline color
  28. /$C 0 def         % Cyan component
  29. /$M 0 def        % Magenta component
  30. /$Y 0 def        % yellow component
  31. /$K 0 def        % Black component
  32. /$T 1 def        % color Tint
  33. /$N _ def        % Color name(non-null for special colors only)
  34. /$O 0 def        % stroke overprint flag
  35. /$PF false def    % pattern stroke flag(0 no pattern, 1 pattern)
  36.  
  37. %--current transfo matrices--
  38. /$ctm matrix currentmatrix def    % initial general transfo matrix
  39. /$ptm matrix def                        % pen stroking matrix(defaults identity)
  40. /$ttm matrix def                        % text transfo matrix(Corel extensions)
  41. /$stm matrix def                        % "save" matrix in extended text(Corel extensions)
  42.  
  43. %--pattern parameters --
  44. % fill pattern:
  45. %/$pn () def                        % current fill pattern name
  46. %/$pm matrix def                % current pattern matrix
  47. %/$px 0 def                        % pattern x pos 
  48. %/$py 0 def                        % pattern y pos
  49. %/$pxf 0 def                        % pattern x offset 
  50. %/$pyf 0 def                        % pattern y offset
  51. %/$psx 10 def                     % current X shift between rows or tiles
  52. %/$psy 0 def                      % current Y shift between columns or tiles
  53. %/$pd [] def                        % current pattern description array
  54. %/$tx 0 def                        % current tile x pos 
  55. %/$ty 0 def                        % current tile y pos
  56.  
  57. %-- info about current path when painting the pattern    
  58. %/$llx 0 def                        % current path's bbox(used by patterns only)
  59. %/$lly 0 def                        % also used for each fountain stripes
  60. %/$urx 0 def
  61. %/$ury 0 def
  62.  
  63. %/Bbllx 0 def                    % current object's bbox(in absolute space)
  64. %/Bblly 0 def
  65. %/Bburx 0 def
  66. %/Bbury 0 def
  67.  
  68. %/$tllx 0 def                    % current OBJECT's bbox(in current Pattern space)
  69. %/$tlly 0 def
  70. %/$turx 0 def
  71. %/$tury 0 def
  72.  
  73. %-- Postscript fill variables
  74. %/$Psn null def                    % current PS-fill function name(literal)
  75. %/$Prm null def                    % current PS-fill parms(array of n params)
  76.  
  77. %-- fountain fill variables
  78. /$fst 128 def             % default # of steps in a fountain fill(can be redefined later)
  79. %/$fty 0 def             % current fountain type:0 linear, 1 radial
  80. %/$fan 0 def             % current fountain angle(if linear)
  81. /$pad 0 def                % edge pad around fountain (between 0 & 1.0)
  82. /$rox 0 def                % radial center x offset relative to bbox width
  83. /$roy 0 def                % radial center y offset relative to bbox height
  84.  
  85. %/$toc 0 def                    % TO anf FROM color components
  86. %/$tom 0 def
  87. %/$toy 0 def
  88. %/$tok 0 def
  89. %/$ton _ def                    % TO color name
  90. %/$tot    0 def                    % TO tint
  91. %/$frc 0 def
  92. %/$frm 0 def
  93. %/$fry 0 def
  94. %/$frk 0 def
  95. %/$frn _ def                    % FROM color name
  96. %/$frt    0 def                    % FROM tint
  97.  
  98. %/$dc 0 def                    % delta colors between fountain steps
  99. %/$dm 0 def 
  100. %/$dy 0 def
  101. %/$dk 0 def
  102.  
  103. % ---- Halftone screen support (black only)----------------------
  104. % NOTE: Unless modified later in the setup(generated code)section, the
  105. %           default halftone screens for fill & outline will be the    
  106. %          current device's setting.
  107. currentscreen             % establish document's default halftone screen
  108. /@dsp xd                    % default spot func
  109. /$dsp /@dsp def        % default spot func name
  110. /$dsa xd                    % default screen angle
  111. /$dsf xd                    % default screen frequency function
  112. %-- and other screen-related vars
  113. /$sdf    false def        % FLAG: non-default halftone screen for fill when true
  114. /$SDF    false def        % FLAG: non-defaul halftone screen for stroke when true
  115. %/$scp /$dsp def            % Current spot func for fill
  116. %/$sca $dsa def            % Current screen angle for fill
  117. %/$scf $dsf def            % Current screen frequency for fill
  118. %/$SCP /$dsp def            % Current spot func for stroke
  119. %/$SCA $dsa def            % Current screen angle for stroke
  120. %/$SCF $dsf def            % Current screen frequency for stroke
  121. /$Scra 0.0 def             % screen adjustment (-90 if printing landscape)
  122.  
  123. % ---- Internal operators ----------------------
  124. /$sv 0 def                % variable for save snapshots
  125. /@cp /closepath ld
  126. /@gs /gsave ld
  127. /@gr /grestore ld
  128. /@np /newpath ld
  129. /@sv {/$sv save def}bd
  130. /@rs {$sv restore}bd
  131. /@ss
  132. {
  133.     % Increment screen angle by $Scra which is 0 for portrait printing,
  134.     % -90 for landscape printing.
  135.  
  136.     exch $Scra add exch load setscreen
  137. } bd
  138.  
  139. %-- ERROR Handling  : Autoflatness for paths too complex
  140. % The next section is to avoid the limitcheck error of typesetters.
  141. % The painting operators of PostScript are rewritten to increase
  142. % flatness until either the object can be printed, or a flatness
  143. % of 10 more than the initial flatness setting has been reached.
  144. % In this case an error message is displayed and printing continues with
  145. % the next object.
  146.  
  147. % The auto-flatness will be enabled only if the value of the "AutoFlatness"
  148. % variable is true.  The code to set this variable is output by WALDO.
  149.  
  150. AutoFlatness
  151. {
  152.         % error message if path can really not be printed
  153.     /$cpx ([Error: PathTooComplex; OffendingCommand: AnyPaintingOperator]\n) def
  154.     %-- @cpx Path too complex error message function     - @cpx -
  155.     %%%%%%%%%/@err1 {$cpx print flush stop}bd % displays message and stops program
  156.  
  157.     /@err1 {$cpx print flush newpath} bd % displays message and stops program
  158.  
  159.     %-- @ifl Increase flatness             initial_flatness @ifl initial_flatness
  160.     /@ifl
  161.     {
  162.         dup currentflat exch sub 10 gt        % Is current flatness increase > 10?
  163.         {
  164.             @err1 exit
  165.         }
  166.         {
  167.             currentflat 2 add setflat
  168.         } ifelse
  169.     } bd 
  170.  
  171.     % --- Then redefine fill, eofill, clip, eoclip, & stroke
  172.     /@fill /fill ld
  173.     /fill
  174.     {
  175.         currentflat
  176.         {
  177.             {@fill}
  178.             stopped
  179.             {
  180.                 @ifl
  181.             }
  182.             {
  183.                 exit
  184.             } ifelse
  185.         } bind loop
  186.         setflat
  187.     } bd
  188.  
  189.     /@eofill /eofill ld
  190.     /eofill
  191.     {
  192.         currentflat
  193.         {
  194.             {@eofill}
  195.             stopped
  196.             {
  197.                 @ifl
  198.             }
  199.             {
  200.                 exit
  201.             } ifelse
  202.         } bind loop
  203.         setflat
  204.     } bd
  205.  
  206.     /@clip /clip ld
  207.     /clip
  208.     {
  209.         currentflat
  210.         {
  211.             {@clip}
  212.             stopped
  213.             {
  214.                 initclip @ifl
  215.             }
  216.             {
  217.                 exit
  218.             } ifelse
  219.         } bind loop
  220.         setflat
  221.     } bd
  222.  
  223.     /@eoclip /eoclip ld
  224.     /eoclip
  225.     {
  226.         currentflat
  227.         {
  228.             {@eoclip}
  229.             stopped
  230.             {
  231.                 initclip @ifl
  232.             }
  233.             {
  234.                 exit
  235.             } ifelse
  236.         } bind loop
  237.         setflat
  238.     } bd
  239.  
  240.     /@stroke /stroke ld
  241.     /stroke
  242.     {
  243.         currentflat
  244.         {
  245.             {@stroke}
  246.             stopped
  247.             {
  248.                 @ifl
  249.             }
  250.             {
  251.                 exit
  252.             } ifelse
  253.         } bind loop
  254.         setflat
  255.     } bd
  256. } if
  257.  
  258. /InRange
  259. { %def -- FORCE VALUE BETWEEN TWO LIMITS -- STACK: value minimum maximum
  260.     % if value not in range, modifies the value to be between min and max
  261.     3 -1 roll                                % get value on top
  262.     2 copy le {pop}{exch pop}ifelse    % val = min(val,MAXVAL)
  263.     2 copy ge {pop}{exch pop}ifelse    % val = max(val,MINVAL)
  264. } bd  % --- NEEDED by functions in USERPROC.TXT
  265.  
  266. /wDstChck
  267. { % RETURN THE MAXVALUE CHANGE OR UNCHANGE. MORE DOC. IN USERPROC.TXT FILE. 
  268.   2 1 roll dup 3 -1 roll
  269.   eq { 1 add } if
  270.  } bd    % --- NEEDED by functions in USERPROC.TXT
  271.  
  272. %-- @dot dot spot function      x y @dot num
  273. /@dot
  274. {    % implementation of a dot spot function for halftoning(see setscreen)
  275.     dup mul exch dup mul add 1 exch sub 2 div
  276. } bd
  277.  
  278. %-- @lin line spot function      x y @lin num
  279. /@lin
  280. {    % implementation of a line spot function for halftoning(see setscreen)
  281.     exch pop abs 1 exch sub
  282. } bd
  283.  
  284. %-- @MN    Minimum            val1 val2 @MN value
  285. /@MN
  286. {
  287.     2 copy le
  288.     {pop}
  289.     {exch pop} ifelse    % get minimum of both values
  290. } bd
  291.  
  292. % -- define the setcmykcolor operator if not already defined
  293. /setcmykcolor where    {pop}
  294. {
  295.     /setcmykcolor                     % cyan magenta yellow black setcmykcolor -
  296.     {
  297.         4 1 roll                        % send black below cyan
  298.         3 {3 index add 1 @MN 1 exch sub 3 1 roll} repeat    % convert to BLUE, GREEN and RED
  299.         setrgbcolor
  300.         pop                            % get rid of black
  301.   } bd
  302. } ifelse
  303.  
  304. % -- define the setoverprint operator if not already defined
  305. % NOTE: We do not want to redefine this operator if it is defined so that
  306. %       other apps (e.g. Ventura Separator) can separate our EPS files.
  307.  
  308. /setoverprint where {pop}
  309. {
  310.     /setoverprint                % boolean setoverprint
  311.     {
  312.         /$op xd
  313.     } bd
  314. } ifelse
  315.  
  316.  
  317. % -- define the currentoverprint operator if not already defined
  318. % NOTE: We do not want to redefine this operator if it is defined so that
  319. %       other apps (e.g. Ventura Separator) can separate our EPS files.
  320.  
  321. /currentoverprint where {pop}
  322. {
  323.     /currentoverprint        % - currentoverprint boolean
  324.     {
  325.         $op
  326.     } bd
  327. } ifelse
  328.  
  329. /setsepcolor                % greyvalue setsepcolor -
  330. {
  331.     1 exch sub setgray                % convert to ps gray
  332. } bd
  333.  
  334. /checksepcolor                % overprint greyvalue setsepcolor boolean
  335. {
  336.     1 exch sub dup setgray                % convert to ps gray
  337.  
  338.     % if white(1) and overprint(1), do not print at all (return false)
  339.     1 eq exch 1 eq and not
  340. } bd
  341.  
  342. /setprocesscolor        % cyan magenta yellow black setprocesscolor -
  343. {
  344.     ColorSeparationMode 0 eq        % Check if not performing color seps.
  345.     {
  346.         setcmykcolor
  347.     }
  348.     {
  349.         0 4 $ink sub index    % Fetch the relevant layer
  350.         exch pop                        % or zero for $ink == 4.
  351.                                                 % |- C M Y K greyvalue
  352.         5 1 roll 4 { pop } repeat        % |- greyvalue
  353.         setsepcolor
  354.     } ifelse
  355. } bd
  356.     
  357.     
  358. % -- define the findcmykcustomcolor operator if not already defined
  359. % NOTE: We do not want to redefine this operator if it is defined so that
  360. %       other apps (e.g. Ventura Separator) can separate our EPS files.
  361.  
  362. /findcmykcustomcolor where {pop}
  363. {
  364.     /findcmykcustomcolor    % cyan magenta yellow black name findcmykcustomcolor array
  365.     {
  366.         5 array astore
  367.     } bd
  368. } ifelse
  369.  
  370. % -- define the setcustomcolor operator if not already defined
  371. % NOTE: We do not want to redefine this operator if it is defined so that
  372. %       other apps (e.g. Ventura Separator) can separate our EPS files.
  373.  
  374. /setcustomcolor where    {pop}
  375. {
  376.     /setcustomcolor                     % array tint setcustomcolor -
  377.     {
  378.         ColorSeparationMode 0 eq    % Check if not performing color seps.
  379.         {
  380.             exch                                        % tint array
  381.             aload pop pop                        % |- tint cyan magenta yellow black
  382.             4
  383.             {
  384.                 4 index mul 4 1 roll    % Multiply colour by tint.
  385.             } repeat
  386.             5 -1 roll pop                        % |- cyan magenta yellow black
  387.             setcmykcolor
  388.         }
  389.         {
  390.             exch aload pop                    % |- tint cyan magenta yellow black name
  391.             CurrentInkName eq                % Check if this is the ink currently being separated.
  392.             {
  393.                 4 index                                % Fetch the tint.
  394.             }
  395.             {
  396.                 0                                            % No match, use 0.
  397.             } ifelse                                % |- tint cyan magenta yellow black greyvalue
  398.             6 1 roll
  399.             5 { pop } repeat                % |- greyvalue
  400.             setsepcolor
  401.         } ifelse
  402.     } bd
  403. } ifelse
  404.  
  405. % -- define the colorimage operator if not already defined
  406. % -- NOTE: We know we always call colorimage with ONE procedure
  407. % -- It should call the "image" operator instead
  408. % NOTE ####### Now , just skips the color info
  409. /colorimage where    {pop}
  410. {
  411.     /colorimage                         % wid hei bits matrix proc bool ncolors colorimage -
  412.     {
  413.         pop            % # of colors
  414.         pop            % BOOL always assumed false
  415.         pop            % data aquisition must be different
  416.         pop            % matrix not needed
  417.         pop            % # bits not needed
  418.  
  419.         {currentfile $dat readhexstring pop pop}        % read each row of data
  420.         repeat                                                % until all rows are read
  421.         pop                % clear the rest of the stack
  422.     } bd
  423. }ifelse
  424.  
  425.  
  426. %-- @tc tint color                cyan mag yel blk tint @tc cyan1 mag1 yel1 blk1 
  427. /@tc     % Tint current color (basically multiply 4 components with given tint)
  428. {
  429.     dup 1 ge                % see if tint >= 1
  430.     {pop}                % if it is, pop it
  431.     {                    % otherwise, multiply all 4 components
  432.         4
  433.         {
  434.             dup            % duplicate the tint
  435.             6 -1 roll    % get next component
  436.             mul            % multiply with current tint
  437.             exch            % tint back on top
  438.         } repeat
  439.         pop                % no need for tint anymore
  440.     } ifelse
  441. } bd
  442.  
  443. %-- @scc set current color        tint C M Y K name overprint @scc boolean
  444. /@scc        % -- set current color --
  445. { 
  446.     1 eq setoverprint            % Set overprint parameter.
  447.     dup _ eq                            % Check if process colour.
  448.     {
  449.         pop
  450.         setprocesscolor
  451.         pop
  452.     }
  453.     {                                            % Spot colour.
  454.         findcmykcustomcolor
  455.         exch
  456.         setcustomcolor
  457.     } ifelse
  458.  
  459.     ColorSeparationMode 0 eq    % If not doing color seps, ...
  460.     {
  461.         true
  462.     }
  463.     {
  464.         % if white(1) and overprint, do not print at all(return false)
  465.         currentgray 1 eq currentoverprint and not
  466.     } ifelse
  467. } bd
  468.  
  469. % -------------------- pattern support -----------------------
  470. %-- @sft    set first tile position  - @sft -
  471. /@sft                %set first tile position into $tx $ty (top left corners)
  472. {
  473. %    /$tx $tllx $pxf add dup $tllx gt {$pwid $psx add sub}if def    % first tile's x position(left)
  474. %    /$ty $tury $pyf sub dup $tury lt {$phei $psy add add}if def    % first tile's y position(top) 
  475.  
  476. % 3-Apr-91:KB:Adjusted position of starting tile to make PS Output match
  477. % preview and non-PS printers
  478.     /$tx $tllx $pxf add dup $tllx gt {$pwid sub}if def    % first tile's x position(left)
  479.     /$ty $tury $pyf sub dup $tury lt {$phei add}if def    % first tile's y position(top) 
  480. } bd
  481.  
  482. %-- @stb    set current bbox            - @stb -
  483. /@stb            % stores the current path's bbox into globals $llx,$lly, $urx, $ury
  484. {
  485.     pathbbox /$ury xd /$urx xd /$lly xd /$llx xd         % path's bbox
  486. } bd
  487.  
  488. %-- @ep Execute Pattern        array @ep -
  489. /@ep            % gets a pattern description from the stack and executes it
  490. {
  491.     {
  492.         cvx exec
  493.     } forall
  494. } bd
  495.  
  496. %-- @tp Tile pattern            xpos ypos @tp -
  497. /@tp    % creates a tile at specified position and plays the current
  498. {    % pattern into that tile
  499.       % first, make sure the tile woul be in the clipping path    
  500.     @sv                % save current settings
  501.     /$in true def
  502.     2 copy 
  503.     dup $lly le {/$in false def}if                % below current path?
  504.     $phei sub $ury ge {/$in false def}if        % above current path?
  505.     dup $urx ge {/$in false def}if                % right current path?
  506.     $pwid add $llx le {/$in false def}if        % left current path?
  507.     $in
  508.     {
  509.         @np
  510.         2 copy m 
  511.         $pwid 0 rl             % Create a rectangle clip box for the tile
  512.         0 $phei neg rl 
  513.         $pwid neg 0 rl 
  514.         0 $phei rl
  515.         clip @np
  516.                         % translate pattern into new tile
  517.         $pn cvlit load aload pop     % get the current pattern
  518.  
  519.         % stack: xpos ypos pat_bbox (0 0 72 72) pat_description
  520.  
  521.         7 -1 roll                        % get x tile position on top
  522.         5 index sub                        % tile llx - pattern xpos
  523.         7 -1 roll                        % get the y tile pos on top
  524.         3 index sub                        % tile ury - pattern ypos
  525.         translate
  526.         /$ctm matrix currentmatrix def    % transfo matrix changed for that tile
  527.         @ep                                % execute the pattern description into that tile
  528.         pop pop pop pop
  529.     }
  530.     {pop pop}ifelse    % current tile not visible through current clipping path
  531.     @rs                                    % restore VM
  532. } bd
  533.  
  534. %-- @th Tile pattern    horizontally    - @th -
  535. /@th                % perform tiling when inter-tile shift is only in the x direction
  536. {
  537.     @sft                %set first tile position into $tx $ty
  538.     0 1 $tly 1 sub                        % compute each tile position(in $xp, $yp)
  539.     {    
  540.         dup $psx mul $tx add                    % X position of this row
  541.         {
  542.             dup $llx gt {$pwid sub}{exit}ifelse    % make sure first x is at the left boundary
  543.         } loop
  544.         exch $phei mul $ty exch sub         % first Y position in this row
  545.                                                     % stack: first X and Y in row
  546.         0 1 $tlx 1 sub
  547.         {
  548.             $pwid mul 
  549.             3 copy
  550.             3 -1 roll add exch                        % current tile position(x increased)
  551.             @tp                                    % create a tile and play the pattern into that tile
  552.             pop
  553.         } for
  554.         pop pop                                    % end of column 1
  555.     } for
  556. } bd
  557.  
  558. %-- @tv Tile pattern    vertically    - @tv -
  559. /@tv                % perform tiling when inter-tile shift is only in the y direction
  560. {
  561.     @sft                %set first tile position into $tx $ty
  562.     0 1 $tlx 1 sub                        % compute each tile position(in $xp, $yp)
  563.     {    
  564.         dup $pwid mul $tx add                    % X position of this column
  565.         exch $psy mul $ty exch sub                % first Y position in this column
  566.         {
  567.             dup $ury lt {$phei add}{exit}ifelse    % make sure first Y is at the top boundary
  568.         } loop
  569.                                                         % stack: top X and Y in column
  570.         0 1 $tly 1 sub
  571.         {
  572.             $phei mul 
  573.             3 copy sub                            % current tile position(y decreased)
  574.             @tp                                    % create a tile and play the pattern into that tile
  575.             pop
  576.         } for
  577.         pop pop                                    % end of column 1
  578.     } for
  579. } bd
  580.  
  581. %-- @pf Pattern fill    - @pf -
  582. /@pf        % fills the current path with the current fill pattern
  583. {
  584.     @gs
  585.     $ctm setmatrix           % reset normal ctm
  586.     $pm concat                % concatenate current pattern matrix
  587.     @stb                        % current path bbox(not object bbox)
  588.     eoclip                     % current object shape is the clipping path
  589.     Bburx Bbury $pm itransform /$tury xd /$turx xd        % get object's bbox in transformed space
  590.     Bbllx Bblly $pm itransform /$tlly xd /$tllx xd        % get object's bbox in transformed space
  591.     /$wid $turx $tllx sub def        % current path width
  592.     /$hei $tury $tlly sub def        % current path height
  593.     @gs 
  594.         % fill background with white ; watch for colorseps % overprinting
  595.     $vectpat
  596.     {
  597.         1 0 0 0 0 _ $o @scc        % fill a white background
  598.         {
  599.             eofill
  600.         } if
  601.     }
  602.     {
  603.         % For bitmap fills, fill the background now and not for each tile to
  604.         % avoid seams.  Use a bitmap to fill it since the clipping path is
  605.         % treated differently for bitmaps than it is for fills.
  606.  
  607.         $t $c $m $y $k $n $o @scc
  608.         {
  609.             $tllx $tlly translate
  610.             $wid $hei scale
  611.             <00> 8 1 false [ 8 0 0 1 0 0 ] {} imagemask
  612.             /$bkg true def
  613.         } if
  614.     } ifelse
  615.     @gr        
  616.     $wid 0 gt $hei 0 gt and        % make sure current path bbox not NULL
  617.     {
  618.         $pn cvlit load aload pop         % get pattern parms on stack
  619.         /$pd xd                                % $pd = Current pattern description
  620.         3 -1 roll sub /$phei xd            % pattern width
  621.         exch sub /$pwid xd                % pattern height    
  622.         /$tlx $wid $pwid div ceiling 1 add def     %    # of tiles in the X direction
  623.         /$tly $hei $phei div ceiling 1 add def     %    # of tiles in the Y direction
  624.         $psx 0 eq                            % pattern x shift
  625.         {            
  626.             @tv                                % then tile vertically
  627.         }
  628.         {
  629.             @th                                % otherwise tile horizontally
  630.         } ifelse        
  631.     } if             % if pattern size not null
  632.  
  633.     @gr                        % restore initial graphic state
  634.     @np                        % clear the current path
  635.  
  636.     /$bkg false def
  637.  
  638. } bd
  639.  
  640. % --- fountain fill support ------------------
  641. %-- @dlt    compute deltas         - $dlt bprint -    
  642. /@dlt
  643. {                         % step 1 : get deltas between stripes into $dc $dm $dy $dk,
  644.                                  % # of steps in $fst
  645.                                  % also sets initial color values into $c $m $y $k
  646.                                  % returns bool: print or do not print
  647.     ColorSeparationMode 0 eq
  648.     {    % color separation is not active
  649.         /$dc $toc $tot mul $frc $frt mul dup /$c xd sub $fst 1 sub div def        % compute deltas  % original values
  650.         /$dm $tom $tot mul $frm $frt mul dup /$m xd sub $fst 1 sub div def
  651.         /$dy $toy $tot mul $fry $frt mul dup /$y xd sub $fst 1 sub div def
  652.         /$dk $tok $tot mul $frk $frt mul dup /$k xd sub $fst 1 sub div def
  653.         true
  654.     }
  655.     {    % color separation is active
  656.         $frt $frc $frm $fry $frk $frn $o @scc         % set gray to current FROM color 
  657.         dup
  658.         {        % store that gray value
  659.             /$frk 1 currentgray sub def
  660.         }
  661.         {
  662.             /$frk 0 def
  663.         } ifelse
  664.  
  665.         $tot $toc $tom $toy $tok $ton $o @scc        % set gray to current TO color
  666.         dup
  667.         {        % store that gray value
  668.             /$tok 1 currentgray sub def
  669.         }
  670.         {
  671.             /$tok 0 def
  672.         } ifelse
  673.         or            % leaves boolean on stack: True if either from or to colors are to be
  674.                     % printed        
  675.         dup
  676.         {        % if it is to be printed, compute deltas (in black plane only)
  677.             /$c 0 def /$m 0 def /$y 0 def /$k $frk def
  678.             /$dc 0 def /$dm 0 def /$dy 0 def 
  679.             /$dk $tok $frk sub $fst 1 sub div def        % delta gray between steps
  680.         } if        
  681.     }ifelse
  682. } bd
  683.  
  684.  
  685. %-- @ftl fountain fill linear            llx lly urx ury  @ftl -
  686. /@ftl        % generates linear fountain stripes to fill given bbox
  687. {        
  688.     1 index 4 index sub                             % Total width of bbox
  689.     dup $pad mul dup /$pdw xd                    % Store width of each pad in $pdw.
  690.  
  691.     % stack: llx lly urx ury bbox-width $pdw
  692.  
  693.     2 mul sub                                                % width of gradation
  694.     $fst div /$wid xd                                % width of each stripe
  695.     2 index sub /$hei xd                        % compute height
  696.     pop                                                         % stack: llx, lly
  697.     translate
  698.     $c $m $y $k             % starting color
  699.     
  700.     4 copy                                             % 4 colors on stack
  701.     ColorSeparationMode 0 ne                    % Doing color seps?
  702.         { 1 exch sub setgray pop pop pop}    % only use the gray component if so
  703.         {setcmykcolor}ifelse                        % otherwise, use them all
  704.     0 0 moveto 0 $hei lineto $pdw $hei lineto $pdw 0 lineto 0 0 lineto fill    % draw starting pad
  705.      $pdw 0 translate                                % next band position
  706.  
  707.     $fst                         % loop for each band
  708.     {
  709.         4 copy                 % 4 colors on stack
  710.         ColorSeparationMode 0 ne                    % Doing color seps?
  711.             { 1 exch sub setgray pop pop pop}    % only use the gray component if so
  712.             {setcmykcolor}ifelse                        % otherwise, use them all
  713.         0 0 moveto 0 $hei lineto $wid $hei lineto $wid 0 lineto 0 0 lineto fill    % draw band
  714.         $wid 0 translate            % next band position
  715.         $dk add 4 1 roll             % set colors for next band
  716.         $dy add 4 1 roll 
  717.         $dm add 4 1 roll 
  718.         $dc add 4 1 roll 
  719.     } repeat
  720.  
  721.     $dk sub 4 1 roll             % come back to last color for ending pad
  722.     $dy sub 4 1 roll 
  723.     $dm sub 4 1 roll 
  724.     $dc sub 4 1 roll 
  725.     ColorSeparationMode 0 ne                    % Doing color seps?
  726.         { 1 exch sub setgray pop pop pop}    % only use the gray component if so
  727.         {setcmykcolor}ifelse                        % otherwise, use them all
  728.     0 0 moveto 0 $hei lineto $pdw $hei lineto $pdw 0 lineto 0 0 lineto fill    % draw ending pad
  729. } bd
  730.  
  731. %-- @ftr fountain fill radial            llx lly urx ury  @ftr -
  732. /@ftr        % generates radial fountain stripes to fill given bbox
  733. {        
  734.      % get radius
  735.     1 index 4 index sub             % bbox width on stack
  736.     dup $rox mul /$row xd            % Store width of center offset in $row
  737.  
  738.     % stack: llx lly urx ury bbox-width
  739.  
  740.     2 div                                            % half bbox width 
  741.     1 index 4 index sub              % bbox height on stack
  742.  
  743.     % stack: llx lly urx ury bbox-width/2 bbox-height
  744.  
  745.     dup $roy mul /$roh xd            % Store height of center offset in $roh
  746.     2 div                                            % half bbox height 
  747.  
  748.     % stack: llx lly urx ury bbox-width/2 bbox-height/2
  749.  
  750.     2 copy dup mul exch dup mul add sqrt            % total radius on stack
  751.     $row dup mul $roh dup mul add sqrt add        % add offset to radius
  752.     
  753.     dup /$hei xd $fst div /$wid xd    % width of each band(delta radius)in $wid
  754.                                                                     % original radius in $hei
  755.                                                                     % on stack: llx lly urx ury w/2 h/2
  756.     4 index add    $roh add                    % y center with offset
  757.     exch
  758.     5 index add $row add                    % x center with offset
  759.     
  760.     exch translate                              % origin in center of bbox
  761.     pop pop pop pop                        % don't need bbox anymore
  762.  
  763.     currentflat dup 5 mul setflat             % no need for extra precision on fountain circles
  764.     $c $m $y $k             % starting color
  765.  
  766.     % Draw the background pad
  767.  
  768.     4 copy 
  769.     ColorSeparationMode 0 ne                    % Doing color seps?
  770.         { 1 exch sub setgray pop pop pop}    % only use the gray component if so
  771.         {setcmykcolor}ifelse                        % otherwise, use them all
  772.     $wid 0 moveto 0 0 $hei 0 360 arc fill    % draw circle at new center of bbox
  773.             % then scale according to the pad size
  774.     1.0 $pad 2 mul sub dup scale                    % scale around new center for pad
  775.     
  776.     $fst                         % loop for each band
  777.     {
  778.         4 copy 
  779.         ColorSeparationMode 0 ne                    % Doing color seps?
  780.             { 1 exch sub setgray pop pop pop}    % only use the gray component if so
  781.             {setcmykcolor}ifelse                        % otherwise, use them all
  782.         $wid 0 moveto 0 0 $hei 0 360 arc fill            % draw circle at new center of bbox
  783.         /$hei $hei $wid sub def        % next band radius in $hei
  784.         $dk add 4 1 roll                 % set colors for next band
  785.         $dy add 4 1 roll 
  786.         $dm add 4 1 roll 
  787.         $dc add 4 1 roll 
  788.     } repeat
  789.     pop pop pop pop     
  790.     setflat
  791. } bd
  792.  
  793. %-- @ff fountain fill current path    - @ff -
  794. /@ff
  795. {
  796.     @gs
  797.     @dlt                    % step 1 : get deltas between stripes into $dc $dm $dy $dk,
  798.                                 % # of steps in $fst
  799.                                 % also sets initial color values into $c $m $y $k
  800.                                 % puts a bool on the stack, same meaning as for @scc
  801.     {
  802.         $ctm setmatrix             % reset normal ctm
  803.         eoclip                     % current path is clipping path
  804.         newpath
  805.         Bbllx Bblly moveto    % compute size of box around current object
  806.         Bbllx Bbury lineto
  807.         Bburx Bbury lineto
  808.         Bburx Bblly lineto
  809.         $fan rotate
  810.         pathbbox
  811.         newpath
  812.  
  813.         $fty 1 eq            % fountain type ?
  814.         {@ftr}            % radial fountain
  815.         {@ftl} ifelse    % linear fountain
  816.     } if
  817.     @gr
  818.     @np
  819. } bd
  820.  
  821. %--@Pf Postscript Fill        - @Pf -
  822. /@Pf
  823. {    % Call user-defined Postscript fill with current parameters
  824.     @sv            % don't take chances, save current state
  825.                     % 20dec90:MB: Print PS fill only in composite
  826.                     %                     or in black plane of color seps.
  827.     ColorSeparationMode 0 eq  $ink 3 eq or
  828.     {            % PS fills can be printed
  829.         0 J 0 j [] 0 d                        % reset stroke attributes (all PS fills set line width)
  830.  
  831.         $t $c $m $y $k $n $o @scc    pop        % set colour
  832.  
  833.         $ctm setmatrix                        % reset matrix for PS-filling
  834.             % --- NOTE: All PS fills expect the current UNIT to be MIL (1/1000 inch)
  835.             % --- and Bburx, .. need to be specified in that unit as well.
  836.         72 1000 div dup matrix scale    % scaling matrix
  837.         dup concat                            % change current ctm
  838.         dup Bburx exch Bbury exch itransform 
  839.             ceiling cvi /Bbury xd 
  840.             ceiling cvi /Bburx xd        % change unit of BBox
  841.         Bbllx exch Bblly exch itransform 
  842.             floor cvi /Bblly xd 
  843.             floor cvi /Bbllx xd
  844.  
  845.         $Prm aload pop                        % Bring the parameters on stack
  846.         $Psn load exec                        % execute the ps fill as desired
  847.     }                
  848.     {            % Not proper color plane, fill in white instead.
  849.         1 setgray eofill
  850.     } ifelse
  851.     @rs                                    % restore original state
  852.     @np                                    % and clear the path
  853. } bd
  854.  
  855. % -------------------------------------------------------------------
  856. % -- painting attributes operators 
  857.  
  858. %-- g    Fill gray                gray g -            
  859. /g
  860. {
  861.     1 exch sub /$k xd                        % get black component
  862.     /$c 0 def /$m 0 def /$y 0 def /$t 1 def /$n _ def /$fil 0 def 
  863. } bd
  864.  
  865. %-- G    Stroke gray                gray G - 
  866. /G
  867. {
  868.     1 exch sub /$K xd                        % get black component
  869.     /$C 0 def /$M 0 def /$Y 0 def /$T 1 def /$N _ def    
  870. } bd
  871.  
  872. %-- k    Fill color                 cyan mag yel blk k -
  873. /k
  874. {
  875.     /$k xd /$y xd /$m xd /$c xd
  876.     /$t 1 def /$n _ def /$fil 0 def 
  877. } bd
  878.  
  879. %-- K    Stroke color            cyan mag yel blk K -
  880. /K
  881. {
  882.     /$K xd /$Y xd /$M xd /$C xd
  883.     /$T 1 def /$N _ def 
  884. } bd
  885.  
  886. %-- x    Fill custom color        cyan mag yel blk strname tint x -
  887. /x
  888. {
  889.     % Tint 0 is no ink; 1 is Full ink.
  890.     /$t xd /$n xd 
  891.     /$k xd /$y xd /$m xd /$c xd /$fil 0 def
  892. } bd
  893.  
  894. %-- X    Stroke custom color    cyan mag yel blk strname tint X -
  895. /X
  896. {
  897.     % Tint 0 is no ink; 1 is Full ink.
  898.     /$T xd /$N xd 
  899.     /$K xd /$Y xd /$M xd /$C xd
  900. } bd
  901.  
  902. %-- d    setdash                    array offset d -
  903. /d /setdash ld
  904.  
  905. %-- i    set current flat        flat    i -
  906. /i
  907. {
  908.     dup 0 ne {setflat} {pop} ifelse
  909. } bd
  910.  
  911. %-- j    set line join            join j -
  912. /j /setlinejoin ld
  913.  
  914. %-- J set line cap            cap J -
  915. /J /setlinecap ld
  916.  
  917. %-- M    set miter limit        value    M -
  918. /M /setmiterlimit ld
  919.  
  920. %-- w    set line width            width w -
  921. /w /setlinewidth ld
  922.  
  923. %-- O    set overprint fill    flag O -
  924. /O
  925. {
  926.     /$o xd
  927. } bd
  928.  
  929. %-- R    set overprint stroke    flag R -
  930. /R
  931. {
  932.     /$O xd
  933. } bd
  934.  
  935. %------------------------------------------------------------------------
  936. %-- path construction operators
  937.  
  938. %-- c    curveto smooth            x1 y1 x2 y2 x3 y3 c -
  939. /c /curveto ld
  940.  
  941. %-- C    curveto corner            x1 y1 x2 y2 x3 y3 C -
  942. /C /c ld
  943.  
  944. %-- v    curveto smooth            x12 y12 x3 y3 v -
  945. /v
  946. {
  947.     4 -2 roll                     % get x12 y12 on top
  948.     2 copy                        % duplicate them
  949.     6 -2 roll curveto            % move x3 y3 back to the end
  950. } bd
  951.  
  952. %-- V    curveto corner            x12 y12 x3 y3 V -
  953. /V /v ld
  954.  
  955. %-- y    curveto smooth            x1 y1 x23 y23 y -
  956. /y
  957. {
  958.     2 copy curveto                % duplicate last point 
  959. } bd
  960.  
  961. %-- Y    curveto corner            x1 y1 x23 y23 Y -
  962. /Y /y ld
  963.  
  964. %-- l    lineto smooth            x y l -
  965. /l /lineto ld
  966.  
  967. %-- L    lineto corner            x y L -
  968. /L /l ld
  969.  
  970. %-- rl rlineto                x y rl -
  971. /rl /rlineto ld
  972.  
  973. %-- m    moveto                    x y m -
  974. /m /moveto ld
  975.  
  976.  
  977. %------------------------------------------------------------------------
  978. % -- Painting operators
  979.  
  980. %-- n    newpath                    - n -
  981. /n /newpath ld
  982.  
  983. %-- N    newpath                    - N -
  984. /N /newpath ld
  985.  
  986. %-- F    fill                        - F -
  987. /F
  988. {
  989.     matrix currentmatrix        % save current transfo matrix on stack
  990.     $sdf {$scf $sca $scp @ss} if        % alternate halftone screen?
  991.     $fil 1 eq
  992.     {@pf}                     % pattern fill
  993.     {                             % 
  994.         $fil 2 eq                % fountain fill?
  995.         {@ff}                    % fountain fill path
  996.         {
  997.             $fil 3 eq            % Postscript fill?
  998.             {@Pf}                % PS fill
  999.             {
  1000.                 $t $c $m $y $k $n $o @scc                            % set FILL color, returns TRUE if we fill, FALSE if not
  1001.                 {eofill}
  1002.                 {@np} ifelse
  1003.             } ifelse
  1004.         } ifelse
  1005.     } ifelse
  1006.     $sdf {$dsf $dsa $dsp @ss} if        % reset default halftone screen
  1007.     setmatrix                     % reset original transfo matrix on stack
  1008. } bd
  1009.  
  1010. %-- f    closepath fill            - f -
  1011. /f
  1012. {
  1013.     @cp F
  1014. } bd
  1015.  
  1016. %-- S    stroke                    - s -
  1017. /S
  1018. {
  1019.     matrix currentmatrix        % save current transfo matrix on stack
  1020.     $ctm setmatrix                 % reset normal ctm
  1021.     $SDF {$SCF $SCA $SCP @ss}if        % alternate halftone screen?
  1022.     $T $C $M $Y $K $N $O @scc                            % set current stroke color, returns TRUE if we paint, FALSE if not
  1023.     {
  1024.         matrix currentmatrix
  1025.         $ptm concat            % set the pen matrix
  1026.         stroke
  1027.         setmatrix                % reset the original matrix(from stack)
  1028.     }
  1029.     {@np}ifelse
  1030.     $SDF {$dsf $dsa $dsp @ss}if        % reset default halftone screen
  1031.     setmatrix                    % reset original matrix set on stack
  1032. } bd
  1033.  
  1034. %-- s    closepath stroke         - s -
  1035. /s
  1036. {
  1037.     @cp
  1038.     S
  1039. } bd
  1040.  
  1041. %-- B    fill, then stroke        - B -
  1042. /B
  1043. {
  1044.     @gs F    @gr                    % fill
  1045.     S                                % stroke
  1046. } bd
  1047.  
  1048. %-- b    closepath, fill, stroke    - b -
  1049. /b
  1050. {
  1051.     @cp B
  1052. } bd
  1053.  
  1054. %-- W    clip path                - W -
  1055. /W
  1056. {
  1057.     eoclip                 % clip to current path
  1058. } bd
  1059.  
  1060. %-- p    pattern fill            name xpos ypos xmag ymag angle reflect_flag 
  1061. %--                                reflect_angle skew_angle skew_imposed_angle 
  1062. %--                                matrix - p -
  1063. /p
  1064. {
  1065.     /$pm xd                        % current pattern matrix
  1066.     7 {pop} repeat                % get rid of undesired parms(not implemented)
  1067.     /$pyf xd /$pxf xd            % remember X Y original offests
  1068.     /$pn xd                        % remember pattern name    
  1069.     /$fil 1 def                    % set global for filling
  1070. } bd
  1071.  
  1072. %-- P    pattern stroke            (same as p)
  1073. /P
  1074. {                % NOT IMPLEMENTED
  1075.     11 {pop} repeat                % get rid of undesired parms(not implemented)
  1076. } bd            
  1077.  
  1078.  
  1079. %-------------------------------------------------------------------------
  1080.     % --- grouping information ---
  1081. %-- u    begin group                - u -
  1082. /u {} bd
  1083.  
  1084. %-- U    end group                - U -
  1085. /U {} bd
  1086.  
  1087. %-- A    locked object            flag A -
  1088. /A {pop} bd
  1089.  
  1090. %-- q    gsave                          - g -
  1091. /q /@gs ld
  1092.  
  1093. %-- Q    grestore                    - Q -
  1094. /Q /@gr ld
  1095.  
  1096.  
  1097. %--------------------------------------------------------------------
  1098. %--- pattern operators
  1099.  
  1100. %-- E    define pattern            name llx lly urx ury description E -
  1101. % a pattern will be defined as an array of 5 entries:
  1102. %     (0)llx (1)lly (2)urx (3)ury (4)descrition
  1103. % the description is also an array of executable strings
  1104. /E
  1105. {
  1106.     5 array astore              % -- parms are in an array
  1107.     exch cvlit exch def        % -- defined with key equal to the name(string)
  1108. } bd
  1109.  
  1110. %-- `    place marker            - ` -
  1111. /` {}bd
  1112.  
  1113. %-- ~    end place                - ~ -
  1114. /~ {}bd
  1115.     
  1116. %-- @    pattern marker            - @ -    
  1117. /@ {}bd
  1118.  
  1119. %-- &    pattern marker            - & -    
  1120. /& {}bd
  1121.  
  1122. % ------------------------------------------------------------------------
  1123. % -- CORELDRAW 3.X re-encoding vector for characters above 128
  1124. /CorelDrawReencodeVect [
  1125. 16#0/grave 16#5/breve 16#6/dotaccent 16#8/ring 16#A/hungarumlaut 16#B/ogonek 16#C/caron 16#D/dotlessi
  1126. 16#82/quotesinglbase/florin/quotedblbase/ellipsis/dagger/daggerdbl
  1127. 16#88/circumflex/perthousand/Scaron/guilsinglleft/OE
  1128. 16#91/quoteleft/quoteright/quotedblleft/quotedblright/bullet/endash/emdash
  1129. 16#98/tilde/trademark/scaron/guilsinglright/oe
  1130. 16#9F/Ydieresis
  1131. 16#A1/exclamdown/cent/sterling/currency/yen/brokenbar/section
  1132. 16#a8/dieresis/copyright/ordfeminine/guillemotleft/logicalnot/minus/registered/macron
  1133. 16#b0/degree/plusminus/twosuperior/threesuperior/acute/mu/paragraph/periodcentered
  1134. 16#b8/cedilla/onesuperior/ordmasculine/guillemotright/onequarter/onehalf/threequarters/questiondown
  1135. 16#c0/Agrave/Aacute/Acircumflex/Atilde/Adieresis/Aring/AE/Ccedilla
  1136. 16#c8/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute/Icircumflex/Idieresis
  1137. 16#d0/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis/multiply
  1138. 16#d8/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls
  1139. 16#e0/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla
  1140. 16#e8/egrave/eacute/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis
  1141. 16#f0/eth/ntilde/ograve/oacute/ocircumflex/otilde/odieresis/divide
  1142. 16#f8/oslash/ugrave/uacute/ucircumflex/udieresis/yacute/thorn/ydieresis
  1143. ] def
  1144.  
  1145. % -- @cc    collect bitmap data        - @cc string
  1146. % -- NOTE: Can be temporarily redefined by @N operator
  1147. /@cc
  1148. {    % collect bitmap information from current file (used by @C)
  1149.     currentfile $dat readhexstring pop
  1150. } bd
  1151.  
  1152. % --------------------------- COREL EXTENSIONS ---------------------
  1153. % --Definitions of COREL extensions to the official AI language
  1154. % --All operators start with a @ followed by ONE letter.
  1155.  
  1156. %-- @sm save currentmatrix         - @sm -
  1157. /@sm        % save current transfo matrix into global $ctm
  1158. {    
  1159.     /$ctm $ctm currentmatrix def
  1160. } bd
  1161.  
  1162. %-- @E Define Object's bbox   bbllx bblly bburx bbury matrix @E -
  1163. /@E
  1164. {    % must be called before painting if PATTERNS, PSFILLS, or FOUNTAINS are used
  1165.     /Bbury xd /Bburx xd         % upper right of OBJECT's bbox in absolute space
  1166.     /Bblly xd /Bbllx xd        % lower left of OBJECT's bbox in absolute space
  1167. } bd
  1168.  
  1169. %-- @c Close sub Path
  1170. /@c
  1171. {    % must be called during the path description
  1172.     @cp
  1173. } bd
  1174.  
  1175. %-- @p COREL Tiled pattern fill      name xoffset yoffset xshift yshift matrix pattern_type @p -
  1176. /@p
  1177. {
  1178.     /$fil 1 def                    % set global for pattern filling
  1179.     1 eq /$vectpat xd        % pattern type: 0 - bitmap, 1 - vector
  1180.     /$pm xd                            % current pattern matrix
  1181.     /$psy xd                       % current Y shift before transformation(x & y exclusives)
  1182.     /$psx xd                      % current X shift before transformation(x & y exclusives)
  1183.     /$pyf xd /$pxf xd        % remember X Y original offests (before transformation)
  1184.     /$pn xd                            % remember pattern name    
  1185. } bd
  1186.  
  1187. %-- @P COREL Postscript Fill     parm1 .. parmn n fillname @P -
  1188. /@P
  1189. {     % COREL Postscript fill # of parms can vary 
  1190.     /$fil 3 def                % set global for filling
  1191.     /$Psn xd                    % PS-fill name
  1192.     array astore            % build array for PS-fill parms
  1193.     /$Prm xd                    % parms in Prm
  1194. } bd
  1195.  
  1196. %-- @k Fountain fill CMYK-CMYK    cy ma ye bl cy ma ye bl angle type pad xoff yoff @k -
  1197. /@k
  1198. {        % specifies that the next object will be filled with a fountain
  1199.             % angle is in degrees , "type" is a flag (0 = linear, 1 radial)
  1200.             % pad is the amount of padding to be set around edges( between 0 and 1.0 )
  1201.             % xoff & yoff indicate the radial center offset (relative to bbox size (-1 to 1))
  1202.     /$fil 2 def                % set global for filling
  1203.     /$roy xd /$rox xd /$pad xd
  1204.     /$fty    xd /$fan    xd
  1205.     $fty 1 eq {/$fan 0 def}if        % if radial fill, force angle to 0
  1206.     /$tok xd /$toy xd /$tom    xd /$toc xd
  1207.     /$frk xd /$fry xd /$frm xd /$frc xd
  1208.     /$frn _ def /$frt    1 def /$ton _ def /$tot    1 def
  1209. } bd
  1210.  
  1211. %-- @x Fountain fill custom-custom    cy ma ye bl name tint cy ma ye bl name tint angle type pad xoff yoff @x -
  1212. /@x
  1213. {        % specifies that the next object will be filled with a fountain
  1214.             % angle is in degrees , "type" is a flag (0 = linear, 1 radial)
  1215.             % pad is the amount of padding to be set around edges( between 0 and 1.0 )
  1216.             % xoff & yoff indicate the radial center offset (relative to bbox size (-1 to 1))
  1217.             % Tint 0 is no ink; 1 is Full ink.
  1218.     /$fil 2 def                % set global for filling
  1219.     /$roy xd /$rox xd /$pad xd
  1220.     /$fty    xd /$fan    xd
  1221.     /$tot    xd /$ton xd /$tok xd /$toy xd /$tom    xd /$toc xd
  1222.     /$frt    xd /$frn xd /$frk xd /$fry xd /$frm xd /$frc xd
  1223. } bd
  1224.  
  1225.  
  1226. %-- @ii image preparation         llx lly urx ury matrix @ii -
  1227. /@ii
  1228. {         % common bitmap code
  1229.     concat                    % integrate transo right away
  1230.     3 index 3 index m        % set clipping path(cropping rect)
  1231.     3 index 1 index l 
  1232.     2 copy l 
  1233.     1 index 3 index l
  1234.     3 index 3 index l
  1235.     clip                        % this is the clipping path
  1236.     pop pop pop pop        % pop cropping rect
  1237. } bd
  1238.  
  1239. % -- @i Gray/Mono bitmap        pxlwid pxlhei bits llx lly urx ury 
  1240. %                                        background foreground
  1241. %                                        cropllx croplly cropurx cropury 
  1242. %                                        matrix @i -
  1243. /@i    % gray/mono bitmap image
  1244.         % parms: pxlwid pxlhei : size of bitmap in pixels 
  1245.         %            bits : # of bits per sample
  1246.         %            llx lly urx ury : total size of bitmap(before transfos)
  1247.         %            background:    flag: 1: fill background with current fill attributes, 0: transparent background
  1248.         %            foreground:    flag: 1: mask foreground with current stroke attributes, 0: transparent foreground
  1249.         %            cropllx croplly cropurx cropury: cropping rectangle(before transfos)
  1250.         %            matrix: additional transfo matrix for stretching/rotating, etc..
  1251.         %    NOTE:    height can be negative if it comes from @N operator, in such a
  1252.         %            case, it must be printed upside down.
  1253. {
  1254.     @sm @gs                    % save current ctm and graphics state
  1255.     @ii                        % get common parameters
  1256.  
  1257.     % stack: pxlwid pxlhei bits llx lly urx ury background_flag foreground_flag
  1258.  
  1259.     6 index 1 ne                                            % grayscale bitmap
  1260.     {
  1261.         /$frg true def
  1262.         pop pop
  1263.     }
  1264.     {                                                                    % monochrome bitmap
  1265.         % When doing colour seps of a monochrome bitmap, if the background is
  1266.         % printed, then print the foreground also.
  1267.  
  1268.         1 eq                                                        % Check if foreground flag is set.
  1269.         {
  1270.             $T $C $M $Y $K $N $O @scc            % Set foreground color.
  1271.             /$frg xd
  1272.         }
  1273.         {
  1274.             /$frg false def
  1275.         } ifelse
  1276.  
  1277.         1 eq                                                        % Check if background flag is set.
  1278.         {
  1279.             @gs $ctm setmatrix
  1280.             $t $c $m $y $k $n $o @scc            % Check if background to be filled.
  1281.             {
  1282.                 eofill                                            % If bitmap to be painted, fill background.
  1283.             } if
  1284.             @gr
  1285.         } if
  1286.     } ifelse
  1287.  
  1288.     % If the background of a bitmap fill was painted in "@pf", always paint
  1289.     % the foreground.
  1290.  
  1291.     /$frg $frg $bkg or def
  1292.  
  1293.     @np                        % no path but clipping
  1294.  
  1295.     % stack: pxlwid pxlhei bits llx lly urx ury
  1296.  
  1297.     /$ury xd /$urx xd /$lly xd /$llx xd        % bitmap rectangle
  1298.     /$bts xd                                            % # of bits per sample
  1299.     /$hei xd /$wid xd                                % pixel size
  1300.  
  1301.     /$dat $wid $bts mul 8 div ceiling cvi string def                % string for data entry (each scan line)
  1302.  
  1303.     $frg                        % foreground to be printed?
  1304.     {
  1305.         $SDF {$SCF $SCA $SCP @ss}if        % alternate halftone screen? (determined by stroke attribs)
  1306.             % set params for the imagemask/image operator
  1307.         $llx $lly translate
  1308.         $urx $llx sub $ury $lly sub scale
  1309.         $wid $hei abs                                % if height is negative, print it upside down
  1310.         $bts 1 eq {false}{$bts}ifelse            % either false or #bits/sample 
  1311.         [ $wid 0 0 
  1312.           $hei neg 0 
  1313.           $hei 0 gt{$hei}{0}ifelse]     % matrix(upside down if $hei is negative)
  1314.         /@cc load                              %    @cc can be redefined by @N 
  1315.         $bts 1 eq {imagemask}{image}ifelse
  1316.         $SDF {$dsf $dsa $dsp @ss}if        % reset default halftone screen
  1317.     }
  1318.     {
  1319.         $hei abs {@cc pop} repeat            % skip all lines
  1320.     } ifelse        % in color seps, the foreground might not be printed
  1321.  
  1322.     @gr $ctm setmatrix                     % Restore graphics state & org matrix
  1323.  
  1324. } def      % not bd because @cc can be redefined by @N
  1325.  
  1326. %-- @M Short Bitmap data starts        - @M -
  1327. /@M
  1328. {    % called prior to defining a bitmap pattern/bitmap in vector pattern.
  1329.             % Immediately following this call, there are a sequence of binary
  1330.             % strings defining the bitmap data that will be put on the stack.
  1331.     @sv    % Save VM so that the space occupied by the string(s) is
  1332.             % freed at the end of @N (which performs a restore).
  1333.             % the @N operator must be called to free the stack from all those 
  1334.             % strings and to print the bitmap
  1335.             % BITMAP DATA MUST FIT IN 64K
  1336. }bd
  1337.  
  1338. %-- @N Short bitmap pattern or bitmap in a vector pattern.
  1339. %                string1 string2 ... stringn
  1340. %
  1341. %                pxlwid pxlhei bits llx lly urx ury background foreground
  1342. %                cropllx croplly cropurx cropury matrix 1 @N -
  1343. %
  1344. %                                        or
  1345. %
  1346. %                pxlwid pxlhei bits ncolors llx lly urx ury
  1347. %                cropllx croplly cropurx cropury matrix 0 @N -
  1348. %
  1349. /@N % parms: pxlwid pxlhei : size of bitmap in pixels
  1350.         %            bits : # of bits per sample
  1351.         %            ncolors : number of colors (if color bitmap)
  1352.         %            llx lly urx ury : total size of bitmap(before transfos)
  1353.         %            background:    flag: 1: fill background with current fill attributes, 0: transparent background
  1354.         %                (only for monochrome/grayscale bitmaps)
  1355.         %            foreground:    flag: 1: mask background with current stroke attributes, 0: transparent background
  1356.         %                (only for monochrome/grayscale bitmaps)
  1357.         %            cropllx croplly cropurx cropury: cropping rectangle(before transfos)
  1358.         %            matrix: additional transfo matrix for stretching/rotating, etc..
  1359.         %    NOTE:    height can be negative if it comes from @N operator, in such a
  1360.         %            case, it must be printed upside down.
  1361. {
  1362.     /@cc {} def
  1363.  
  1364.     % Make the bitmap pxl height negative, so that @i/@I knows that the data
  1365.     % is upside down.
  1366.  
  1367.     1 eq
  1368.     {
  1369.         12 -1 roll neg 12 1 roll    % height negative
  1370.         @I
  1371.     }
  1372.     {
  1373.         13 -1 roll neg 13 1 roll    % height negative
  1374.         @i
  1375.     } ifelse
  1376.     @rs
  1377. } bd
  1378.  
  1379. % -- @I Color bitmap                pxlwid pxlhei bits ncolors 
  1380. %                                        llx lly urx ury 
  1381. %                                        cropllx croplly cropurx cropury 
  1382. %                                        matrix @I -
  1383. /@I    % Color bitmap image
  1384.         % parms: pxlwid pxlhei : size of bitmap in pixels
  1385.         %            bits : # of bits per color component(24-bits color is 8 bits per component)
  1386.         %            ncolors: # of color components(RGB=3, CMYK=4)
  1387.         %            llx lly urx ury : total size of bitmap(before transfos)
  1388.         %            cropllx croplly cropurx cropury: cropping rectangle(before transfos)
  1389.         %            matrix: additional transfo matrix for stretching/rotating, etc..
  1390. {
  1391.     @sm @gs                     % save current ctm and graphics state
  1392.     @ii                        % get common parameters
  1393.     @np                        % no path but clipping
  1394.  
  1395.     % stack: pxlwid pxlhei bits ncolors llx lly urx ury
  1396.  
  1397.     /$ury xd /$urx xd /$lly xd /$llx xd        % bitmap rectangle
  1398.     /$ncl xd                                            % # of color components
  1399.     /$bts xd                                            % # of bits per color component
  1400.     /$hei xd /$wid xd                                % pixel size
  1401.     /$dat $wid $bts mul $ncl mul 8 div ceiling cvi string def    % string for data entry (each scan line)
  1402.  
  1403.     % set params for the colorimage operator
  1404.  
  1405.     $llx $lly translate
  1406.     $urx $llx sub $ury $lly sub scale        % set current scale for bitmap size
  1407.     $wid $hei abs                                        % parms for colorimage
  1408.     $bts 
  1409.     [ $wid 0 0 
  1410.       $hei neg 0  
  1411.       $hei 0 gt{$hei}{0}ifelse]     % matrix(upside down if $hei is negative)
  1412.     /@cc load     
  1413.     false $ncl
  1414.     colorimage                                        % colorimage redefined.
  1415.     @gr $ctm setmatrix                               % restore graphics state & original matrix
  1416. } bd
  1417.  
  1418. % -------------------- text support ----------------------------
  1419. %--------------------------------------------------------------------
  1420.     % -- text/font manipulation
  1421. %-- z    findfont                    fontname size z -
  1422. /z
  1423. {        % sets current font, ptsize
  1424.     exch findfont exch scalefont setfont        % set the current font
  1425. } bd
  1426.  
  1427. %-- ZB define raster font
  1428. /ZB         % fontname default_metrics_entry FontBBox FontMatrix ZB
  1429. {
  1430.     9 dict
  1431.  
  1432.     % stack: fontname default_metrics_entry FontBBox FontMatrix fontdict
  1433.  
  1434.     dup begin
  1435.  
  1436.     4 1 roll
  1437.  
  1438.     % stack: fontname fontdict default_metrics_entry FontBBox FontMatrix
  1439.  
  1440.     /FontType 3 def
  1441.     /FontMatrix xd
  1442.     /FontBBox xd
  1443.  
  1444.     % stack: fontname fontdict default_metrics_entry
  1445.  
  1446.     /Encoding 256 array def
  1447.     0 1 255
  1448.     {
  1449.         Encoding exch /.notdef put
  1450.     } for
  1451.  
  1452.     /CharStrings 256 dict def
  1453.     CharStrings /.notdef {} put
  1454.  
  1455.     /Metrics 256 dict def
  1456.  
  1457.     % stack: fontname fontdict default_metrics_entry
  1458.  
  1459.     Metrics /.notdef 3 -1 roll put
  1460.  
  1461.     % stack: fontname fontdict
  1462.  
  1463.     /BuildChar
  1464.     {
  1465.         % stack: font char
  1466.         exch
  1467.  
  1468.         % stack: char font
  1469.  
  1470.         dup /$char exch /Encoding get 3 index get def        % Get character name.
  1471.  
  1472.         % stack: char font
  1473.  
  1474.         % Get origin of next char relative to current char and bounding box
  1475.         % for current char and call setcachedevice.
  1476.  
  1477.         dup /Metrics get $char get aload pop setcachedevice
  1478.  
  1479.         begin
  1480.         Encoding exch get CharStrings exch get
  1481.         end
  1482.         exec
  1483.     } def
  1484.     end
  1485.  
  1486.     % stack: fontname fontdict
  1487.  
  1488.     definefont pop
  1489. } bd
  1490.  
  1491. /ZBAddChar    % metrics_entry char_proc char_code char_name fontname ZBAddChar
  1492. {
  1493.     findfont begin
  1494.  
  1495.     % stack: metrics_entry char_proc char_code char_name
  1496.  
  1497.     dup 4 1 roll dup 6 1 roll
  1498.  
  1499.     % stack: char_name metrics_entry char_name char_proc char_code char_name
  1500.  
  1501.     Encoding 3 1 roll put
  1502.  
  1503.     % stack: char_name metrics_entry char_name char_proc
  1504.  
  1505.     CharStrings 3 1 roll put
  1506.  
  1507.     % stack: char_name metrics_entry
  1508.  
  1509.     Metrics 3 1 roll put
  1510.     end
  1511. } bd
  1512.  
  1513. %-- Z    re-encode font            width-array encode-array newfontname fontname Z -
  1514. /Z
  1515. {
  1516.     % get font dictionary on stack
  1517.  
  1518.     findfont    
  1519.     dup maxlength 2 add dict exch        % get its size    & create new font dictionary
  1520.     % on stack: width-array encode-array newfontname new-dict old-dict
  1521.     
  1522.     % -- copy all entries from the old dict to the new dict
  1523.     dup    
  1524.     {
  1525.         1 index /FID ne                % avoid copying the FID key
  1526.         {                  
  1527.             3 index             % stack: ... newdict olddict key value newdict
  1528.             3 1 roll put    % store entry in dict
  1529.         }                
  1530.         {
  1531.             pop pop
  1532.         } ifelse
  1533.     } forall             % for all entries in the old dict
  1534.     
  1535.     % Now, get the new encoding array into the new dictionary
  1536.     % stack: width-array encode-array  newfontname new-dict old-dict
  1537.  
  1538.     pop                        % don't need old dict anymore    
  1539.  
  1540.     dup dup /Encoding get
  1541.  
  1542.     % stack: width-array encode-array newfontname newdict newdict Encoding
  1543.  
  1544.     256 array copy                % get a copy of original encoding array (to modify)
  1545.     dup /$fe xd                        % prepare a pointer to the dest Encoding array
  1546.     /Encoding exch put        % store copy of original in encoding vect
  1547.  
  1548.     % stack: width-array encode-array  newfontname new-dict
  1549.  
  1550.     dup /Fontname 3 index put    % store it's own new name in that font
  1551.  
  1552.     % stack: width-array encode-array  newfontname new-dict
  1553.  
  1554.     % store the new encoding array into the copy
  1555.  
  1556.     3 -1 roll        % |- width-array newname newdict encode-array
  1557.     dup length 0 ne
  1558.     {
  1559.         0 exch 
  1560.         {    % the array has either numbers or names; initialize counter
  1561.             dup type 0 type eq    % check for numbers
  1562.             {
  1563.                 exch pop            % throw the old number away
  1564.             }
  1565.             {                        % else, must be a char name
  1566.                 $fe exch 2 index exch put    % put it into array
  1567.                 1 add                    % get ready for next
  1568.             } ifelse
  1569.         } forall
  1570.         pop                % remove counter
  1571.     } if
  1572.  
  1573.     % stack: width-array newname newfontdict
  1574.  
  1575.     dup 256 dict
  1576.  
  1577.     %stack: width-array newname newfontdict newfontdict metricsdict
  1578.  
  1579.     dup /$met xd                % prepare a pointer to the dest Metrics dict
  1580.  
  1581.     /Metrics exch put
  1582.  
  1583.     %stack: width-array newname newfontdict
  1584.  
  1585.     % Character widths in width-array are for a 1000 unit character coordinate
  1586.     % system.  If this is not the coordinate system used for this font, the
  1587.     % character widths have to be scaled appropriately.  This scale factor
  1588.     % is being calculated here.
  1589.  
  1590.     dup /FontMatrix get
  1591.     0 get
  1592.     1000 mul
  1593.     1 exch div
  1594.  
  1595.     %stack: width-array newname newfontdict scale-factor
  1596.  
  1597.     % Add character widths in width-array to the font if width-array contains
  1598.     % 256 entries.
  1599.  
  1600.     3 index length 256 eq
  1601.     {
  1602.         0 1 255
  1603.         {
  1604.             %stack: width-array newname newfontdict scale-factor index
  1605.  
  1606.             dup $fe exch get
  1607.  
  1608.             %stack: width-array newname newfontdict scale-factor index char
  1609.  
  1610.             dup /.notdef eq
  1611.             {
  1612.                 pop pop
  1613.             }
  1614.             {
  1615.                 %stack: width-array newname newfontdict scale-factor index char
  1616.  
  1617.                 5 index
  1618.  
  1619.                 3 -1 roll get
  1620.  
  1621.                 % stack: width-array newname newfontdict scale-factor char char-width
  1622.  
  1623.                 2 index mul
  1624.  
  1625.                 $met 3 1 roll put
  1626.             } ifelse
  1627.         } for
  1628.     }    if
  1629.  
  1630.     pop
  1631.  
  1632.     %stack: width-array newname newfontdict
  1633.  
  1634.     definefont pop        % then, record that new font in the font list
  1635.  
  1636.     %stack: width-array
  1637.  
  1638.     pop
  1639.  
  1640. } bd
  1641.     
  1642. %-- @ftx Text fill(special)    string @ftx -
  1643. /@ftx     % fill text with pattern or fountain
  1644. {
  1645.     {        % loop for each character in the string
  1646.         currentpoint 3 -1 roll
  1647.         (0) dup 3 -1 roll 0 exch put        % convert integer into a string
  1648.         dup
  1649.         @gs
  1650.         true charpath                         % get character outline in path
  1651.         $ctm setmatrix                        % set matrix for pattern filling
  1652.         @@txt                                            % pattern fill or fountain fill
  1653.         @gr
  1654.         @np
  1655.  
  1656.         % set current point for next character
  1657.         stringwidth pop 3 -1 roll add exch moveto
  1658.     } forall
  1659. } bd
  1660.  
  1661.  
  1662. %--@ft    fill text object        string @ft -
  1663. /@ft            % fill current text object
  1664. {
  1665.     matrix currentmatrix exch            % save current transfo matrix on stack
  1666.     $sdf {$scf $sca $scp @ss} if    % alternate halftone screen?
  1667.     $fil 1 eq                                     % pattern fill?
  1668.     {/@@txt /@pf ld @ftx}         % pattern fill on text
  1669.     {
  1670.         $fil 2 eq                                % fountain fill?
  1671.         {/@@txt /@ff ld @ftx}        % fountain fill on text
  1672.         {
  1673.             $fil 3 eq                            % Postscript fill?
  1674.             {/@@txt /@Pf ld @ftx}    % PS fill on text
  1675.             {
  1676.                 $t $c $m $y $k $n $o @scc                    % set FILL color, returns TRUE if we fill, FALSE if not
  1677.                 {show}                                                        % show text
  1678.                 {pop} ifelse
  1679.             } ifelse
  1680.         } ifelse
  1681.     } ifelse                        
  1682.     $sdf {$dsf $dsa $dsp @ss} if        % reset default halftone screen
  1683.     setmatrix                                             % reset original transfo matrix on stack
  1684. } bd
  1685.  
  1686. %--@st    stroke text object        string @st -
  1687. /@st            % stroke current text object
  1688. {
  1689.     matrix currentmatrix exch                    % save current transfo matrix on stack
  1690.     $SDF {$SCF $SCA $SCP @ss} if            % alternate halftone screen?
  1691.     $T $C $M $Y $K $N $O @scc                    % set STROKE color, returns TRUE if we stroke, FALSE if not
  1692.     {    
  1693.         {        % loop for each character in the string
  1694.             currentpoint 3 -1 roll
  1695.             (0) dup 3 -1 roll 0 exch put    % convert integer into a string
  1696.             dup
  1697.             @gs
  1698.             true charpath                                 % get character outline in path
  1699.             $ctm setmatrix $ptm concat        % set matrix for stroking
  1700.             stroke                                                % stroke it
  1701.             @gr
  1702.             @np
  1703.  
  1704.             % set current point for next character
  1705.             stringwidth pop 3 -1 roll add exch moveto
  1706.         } forall
  1707.     }
  1708.     {pop} ifelse        % @scc
  1709.     $SDF {$dsf $dsa $dsp @ss} if        % reset default halftone screen
  1710.     setmatrix                                 % reset original transfo matrix on stack
  1711. } bd
  1712.  
  1713. %--@te    print filled text     string @te -
  1714. /@te        % prints text as filled only    
  1715. {
  1716.     @ft                        % fill that text
  1717. } bd
  1718.  
  1719. %--@tr    print stroked text     string @tr -
  1720. /@tr        % prints text as stroked only    
  1721. {
  1722.     @st                        % stroke that text
  1723. } bd
  1724.  
  1725. %--@ta    fill & stroke text      string @ta -
  1726. /@ta        % prints text as filled & stroked
  1727. {
  1728.     dup
  1729.     @gs @ft @gr                % fill the text
  1730.     @st                        % then stroke text
  1731. } bd
  1732.  
  1733. %--@t@a    stroke & fill text      string @t@a -
  1734. /@t@a        % prints text as stroked & filled 
  1735. {
  1736.     dup
  1737.     @gs @st @gr                % stroke the text
  1738.     @ft                         % then fill text
  1739. } bd
  1740.  
  1741. %-- @tm set text matrix            matrix @tm -
  1742. /@tm
  1743. {
  1744.     % Create a VM snapshot to be restored when the text object processing
  1745.     % is finished (See the T operator).  This allows memory consumed for
  1746.     % strings and matrices during processing of the text object to be freed.
  1747.  
  1748.     /$textsave save def
  1749.  
  1750.     @sm                % save current matrix
  1751.     concat
  1752. } bd
  1753.  
  1754. %-- e    filled text                - e -
  1755. /e
  1756. {
  1757.     /t {@te} def            % define operator t as @te
  1758. } bd
  1759.  
  1760. %-- r    stroked text            - r -
  1761. /r
  1762. {
  1763.     /t {@tr} def            % define operator t as @tr
  1764. } bd
  1765.  
  1766. %-- o    invisible text          - o -
  1767. /o
  1768. {
  1769.     /t {pop} def            % define operator t as nothing
  1770. } bd
  1771.  
  1772. %-- a    fill&stroke text        - a -
  1773. /a
  1774. {
  1775.     /t {@ta} def            % define operator t as @ta
  1776. } bd
  1777.  
  1778.  
  1779. %-- @a stroke&fill text        - @a -
  1780. %--@a 
  1781. /@a
  1782. {
  1783.     /t {@t@a} def            % define operator t as @t@a
  1784. } bd
  1785.  
  1786. %-- t    text body                string t -
  1787. /t {@te} def            % default value: will be redefined by a,e,o,r, and I
  1788.  
  1789. %-- T    end text (restore)        - T -
  1790. /T
  1791. {
  1792.     @np                                % Clear path.
  1793.     $ctm setmatrix        % Reset current matrix.
  1794.     /$ttm matrix def    % Reset extended text matrix.
  1795.  
  1796.     % Restore VM snapshot.
  1797.  
  1798.     $textsave restore
  1799. } bd
  1800.  
  1801.  
  1802. %-- @t 1-character text        xpos ypos string  @t -
  1803. /@t            % -- paints a 1-character string at desired position
  1804. {
  1805.     /$stm $stm currentmatrix def    % save current matrix
  1806.     3 1 roll                                            % send string to bottom
  1807.     moveto                                                % move to character position
  1808.     $ttm concat                                        % add text matrix
  1809.     t                                                          % draw the character (current t operator)
  1810.     $stm setmatrix                                % restore saved matrix
  1811. } def    % NO "bind def" because of t (can be modified)    
  1812.  
  1813. %-- @n character angle        angle @n -
  1814. /@n        % set current caracter angle (held in matrix $ttm)
  1815. {
  1816.     /$ttm exch matrix rotate def     % modify current text matrix accordingly
  1817. } bd
  1818.  
  1819. % -- @s : Mark a space        - @s -
  1820. /@s {} bd        % does nothing but mark a space character in extended text
  1821.  
  1822. % -- @l : Mark an end of line        - @l -
  1823. /@l {} bd        % does nothing but mark an end of line in extended text
  1824.  
  1825.  
  1826. %-- @B    stroke, then fill        - @B -
  1827. /@B
  1828. {
  1829.     @gs S    @gr                    % stroke
  1830.     F                                % fill
  1831. } bd
  1832.  
  1833. %-- @b closepath, stroke & fill path - @b -
  1834. /@b
  1835. {
  1836.     @cp @B
  1837. } bd
  1838.  
  1839. %-- @w  calligraphic pen matrix        [matrix] bscale width height angle @w -
  1840. /@w
  1841. {        % set pen matrix "$ptm" to desired settings
  1842.         % bscale is a flag: 1: "scale with object",  0 no scale
  1843.         % matrix is passed only if bscale is 1 (object total matrix)
  1844.  
  1845.     matrix rotate /$ptm xd        % define $ptm to be rotation matrix
  1846.     matrix scale                             % set pen shape
  1847.     $ptm dup concatmatrix /$ptm xd
  1848.     1 eq                        % if scale, concat object matrix
  1849.     {
  1850.         $ptm exch dup concatmatrix /$ptm xd
  1851.     } if
  1852.     1 w                                % basic thickness to be transformed by $ptm
  1853. } bd    
  1854.     
  1855. %-- @g setscreen for fill        freq ang spotproc 1 @g -
  1856. %or default screen for fill    0 @g -
  1857. /@g
  1858. {  % Set halftone screen for gray filling
  1859.          % parm spotproc is a spot procedure name (ex: /@dot or /@lin)
  1860.     1 eq dup /$sdf xd            % set global flag
  1861.     {    % next 3 parameters are set only if parm1 is 1
  1862.         /$scp xd                    % Current spot func for fill
  1863.  
  1864.         % 29-Jan-91:KB:Removed the negation of screen angle to make work like 1.21 did
  1865.         /$sca xd            % Current screen angle for fill
  1866.         /$scf xd                    % Current screen frequency for fill
  1867.     } if
  1868. } bd 
  1869.  
  1870. %-- @G setscreen for stroke        freq ang spotproc 1 @G -
  1871. %or default screen for stroke        0 @G -
  1872. /@G
  1873. {  % Set halftone screen for gray filling
  1874.          % parm spotproc is a spot procedure name (ex: /@dot ot /@lin)
  1875.     1 eq dup /$SDF xd            % set global flag
  1876.     {    % next 3 parameters are set only if parm1 is 1
  1877.         /$SCP xd                    % Current spot func for stroke
  1878.  
  1879.         % 29-Jan-91:KB:Removed the negation of screen angle to make work like 1.21 did
  1880.         /$SCA xd             % Current screen angle for stroke
  1881.         /$SCF xd                    % Current screen frequency for stroke
  1882.     } if
  1883. } bd
  1884.  
  1885. %-- @D setscreen for all document    freq ang spotproc @D -
  1886. /@D
  1887. {  % Set halftone screen for all document
  1888.     3 copy  @ss                % set that screen right now
  1889.     /$dsp xd                    % default spot func name
  1890.     /$dsa xd                    % default screen angle
  1891.     /$dsf xd                    % default screen frequency function
  1892. } bd
  1893.  
  1894. %-- @j Begin Arrow head            @j -
  1895. /@j
  1896. {    % -- DEF: BEGIN ARROW HEAD
  1897.             % -- Stack:  nothing  
  1898.     @sv        % this is just a save followed by a new path
  1899.     @np        % Look at @J for the corresponding restore
  1900. } bind def
  1901.  
  1902. %-- @J End Arrow head            @J -
  1903. /@J
  1904. {    % -- DEF: END ARROW HEAD
  1905.             % -- Stack:  nothing  
  1906.     @rs        % this is just a grestore; Look at @j for the corresponding save
  1907. } bind def
  1908.  
  1909. % --- color separation support---
  1910. % --@sep  Initialize color separation mode     - @sep -
  1911. /@sep
  1912. {
  1913.         %    ColorSeparationMode defines the current mode for color separation
  1914.         %  Possible values are:    0-composite(no color seps)
  1915.         %                                1-CMYK Only (maximum four colors, custom colors converted)
  1916.         %                                2-CMYK+Customs (four colors + each of the customs)
  1917.     /ColorSeparationMode where
  1918.     {pop}         
  1919.     {
  1920.         /ColorSeparationMode 0 def            % if not defined previously: composite
  1921.         /CurrentInkName (Composite) def    % if not defined previously: composite
  1922.     }ifelse
  1923.  
  1924.     ColorSeparationMode 0 eq                % if not defined previously: composite
  1925.     {
  1926.         /CurrentInkName (Composite) def
  1927.     } if
  1928.         
  1929.     %    CurrentInkName is a string defining the current color plane being 
  1930.     %  printed.  The possible values are: (case sensitive, not to be translated)
  1931.     %     (Composite), (Cyan), (Magenta), (Yellow), (Black), 
  1932.     %     or any of the custom colors defined in the document; e.g.: (Pantone 345)
  1933.     %  Custom color names are only valid when  "ColorSeparationMode" is 2.
  1934.  
  1935.     /CurrentInkName where
  1936.     {pop}         
  1937.     {
  1938.         /CurrentInkName (Composite) def        % if not defined previously: composite
  1939.     } ifelse
  1940.     
  1941.     %-- Internally, a numeric variable ($ink)    indicates the numeric value for the
  1942.     %    current ink, -1:composite, 0:cyan, 1:magenta, 2:yellow, 3:Black, 4: any custom
  1943.     CurrentInkName (Composite) eq 
  1944.     {/$ink -1 def}
  1945.     {
  1946.         CurrentInkName (Cyan) eq
  1947.         {/$ink 0 def}
  1948.         {
  1949.             CurrentInkName (Magenta) eq
  1950.             {/$ink 1 def}
  1951.             {
  1952.                 CurrentInkName (Yellow) eq
  1953.                 {/$ink 2 def}
  1954.                 {
  1955.                     CurrentInkName (Black) eq
  1956.                     {/$ink 3 def}
  1957.                     {
  1958.                         /$ink 4 def
  1959.                     } ifelse
  1960.                 } ifelse
  1961.             } ifelse
  1962.         } ifelse
  1963.     } ifelse
  1964. } bd
  1965. @sep    % -- And by default, call it (Can also be called in the setup section)
  1966.  
  1967. %-- @whi Fill Page white        - @whi -
  1968. /@whi
  1969. {    %- Fill everything white
  1970.     @gs
  1971.     -72000 dup moveto
  1972.     -72000 72000 lineto
  1973.     72000 dup lineto
  1974.     72000 -72000 lineto
  1975.     closepath 1 setgray fill
  1976.     @gr
  1977. } bd     
  1978.  
  1979. %-- @neg Print negative            - @neg -
  1980. /@neg
  1981. { %def -- MAKE ALL COLORS NEGATIVE  -- STACK: -
  1982.         % Only set the GRAY scale transfer function since WALDO only 
  1983.         % Uses negative for color separations.
  1984.     [{1 exch sub} /exec cvx currenttransfer /exec cvx] cvx settransfer
  1985.     @whi                            % fill page in white (Will be turned into white)
  1986. } bd
  1987.  
  1988. %-- @reg Print registration mark        x y @reg -
  1989. /@reg
  1990. {
  1991.     % 25-Apr-91:KB:Reset line type to solid
  1992.     [] 0 d
  1993.     0 setgray .3 setlinewidth
  1994.     2 copy 5.4 0 360 arc closepath
  1995.     2 copy moveto 9 0 rlineto 
  1996.     2 copy moveto -9 0 rlineto 
  1997.     2 copy moveto 0 9  rlineto 
  1998.     moveto 0 -9 rlineto stroke
  1999. } bd
  2000.  
  2001. /leftbracket {(\050)} def
  2002. /rightbracket {(\051)} def
  2003.