tqt3/src/kernel/qpsprinter.ps

% the postscript header we use for our qpsprinter in uncompressed and commented form.
% use the makepsheader perl script to generate a compressed version of this header
% you can then paste into qpsprinter.cpp
%
% some compression of the code is done by the makepsheader script, so we don't need to 
% write too criptically here. 

/d  /def load def
/D  {bind d} bind d
/d2 {dup dup} D
/B  {0 d2} D
/W  {255 d2} D
/ED {exch d} D
/D0 {0 ED} D
/LT {lineto} D
/MT {moveto} D
/S  {stroke} D
/F  {setfont} D
/SW {setlinewidth} D
/CP {closepath} D
/RL {rlineto} D
/NP {newpath} D
/CM {currentmatrix} D
/SM {setmatrix} D
/TR {translate} D
/SD {setdash} D
/SC {aload pop setrgbcolor} D
/CR {currentfile read pop} D
/i  {index} D
/bs {bitshift} D
/scs {setcolorspace} D
/DB {dict dup begin} D
/DE {end d} D
/ie {ifelse} D
/sp {astore pop} D

% ENDUNCOMPRESSED: Warning: leave this line in. 
% Everything before this line will be left untouched by the compression



/BSt 0 d                             % brush style
/LWi 1 d                             % line width
/PSt 1 d                             % pen style
/Cx  0 d                             % current x position
/Cy  0 d                             % current y position
/WFi false d                 % winding fill
/OMo false d                 % opaque mode (not transparent)

/BCol  [ 1 1 1 ] d                   % brush color
/PCol  [ 0 0 0 ] d                   % pen color
/BkCol [ 1 1 1 ] d                   % background color
/BDArr [                             % Brush dense patterns
  0.94
  0.88
  0.63
  0.50
  0.37 
  0.12 
  0.06 
] d
/defM matrix d

/nS 0 d                              % number of saved painter states

% LArr for the Pen styles is defined in emitHeader because of scaling

% GPS: GetPenStyle 
% Returns the line pattern (from pen style PSt).
%
%   bool GPS pattern
%   true : returns draw pattern
%   false: returns fill pattern
/GPS {
  PSt 1 ge PSt 5 le and                      % valid pen pattern?
  { 
    { LArr PSt 1 sub 2 mul get }           % draw pattern
    { LArr PSt 2 mul 1 sub get } ifelse    % opaque pattern
  }
  { [] } ifelse                            % out of range => solid line
} D

% QS: QtStroke
% draw and fill current path
%
%     - QS -
/QS {                                % stroke command
  PSt 0 ne                         % != NO_PEN
  { 
    gsave
      LWi SW                         % set line width
      true GPS 0 setdash S           % draw line pattern
      OMo PSt 1 ne and               % opaque mode and not solid line?
      { 
	BkCol SC
	false GPS dup 0 get setdash S % fill in opaque pattern
      } if
    grestore
  } if
} D




%% The following operations are used to read compressed data from the file
%% Until now this is only used for image compression

% read 28 bits and leave them on tos
% 
%    - r28 num
/r28 {
  % skip past whitespace and read one character
  { currentfile read pop 
    dup 32 gt { exit } if
    pop
  } loop
  % read three more
  3 {
    currentfile read pop
  } repeat
  % make an accumulator
  0
  % for each character, shift the accumulator and add in the character
  4 {
    7 bitshift exch
    dup 128 gt { 84 sub } if 42 sub 127 and
    add
  } repeat
} D

/rA 0 d  % accumulator
/rL 0 d  % bits left

% takes number of bits, leaves number
%
%    num rB num
/rB {
  rL 0 eq {
    % if we have nothing, let's get something
    /rA r28 d
    /rL 28 d
  } if
  dup rL gt {
    % if we don't have enough, take what we have and get more
    rA exch rL sub rL exch
    /rA 0 d /rL 0 d
    rB exch bitshift add
  } {
    % else take some of what we have
    dup rA 16#fffffff 3 -1 roll bitshift not and exch
    % ... and update rL and rA
    dup rL exch sub /rL ED
    neg rA exch bitshift /rA ED
  } ifelse
} D

% uncompresses image data from currentfile until the string on the
% stack is full; leaves the string there.  
% assumes that nothing could conceivably go wrong, ie. the compressed data has
% to be in the correct format and the length of the string has to be exactly right
% to hold the compressed data
%
%    string uc string
%
%%% Warning: if you change the method here, change the table in qpsprinter.cpp:compress()!
/uc {
  /rL 0 d
  0
  { % string pos
    dup 2 index length ge { exit } if
    1 rB
    1 eq { % compressed
      3 rB % string pos bits
      dup 3 ge {
	1 add dup rB % string pos bits extra
	1 index 5 ge {
	  1 index 6 ge {
	    1 index 7 ge {
	      1 index 8 ge {
		128 add
	      } if
	      64 add
	    } if
	    32 add
	  } if
	  16 add
	} if
	3 add
	exch pop
      } if
      3 add
      % string pos length
      exch 10 rB 1 add
      % string length pos dist
      {
	dup 3 index lt {
	  dup
	} {
	  2 index
	} ifelse % string length pos dist length-this-time
	4 index 3 index 3 index sub 2 index getinterval
	5 index 4 index 3 -1 roll putinterval
	dup 4 -1 roll add 3 1 roll
	4 -1 roll exch sub 
	dup 0 eq { exit } if
	3 1 roll
      } loop % string pos dist length
      pop pop
    } { % uncompressed
      3 rB 1 add
      {
	2 copy 8 rB put 1 add
      } repeat
    } ifelse
  } loop
  pop
} D

%% image drawing routines

/sl D0 % ### is this needed ?

% defines for QCI
/QCIgray D0 /QCIcolor D0 /QCIindex D0

% this method prints color images if colorimage is available, otherwise
% converts the string to a grayscale image and uses the reular postscript image
% operator for printing.
% Arguments are the same as for the image operator:
% 
%     width height bits/sample matrix datasrc QCI -
/QCI {
  /colorimage where {
    pop
    false 3 colorimage
  }{  % the hard way, based on PD code by John Walker <kelvin@autodesk.com>
    exec /QCIcolor ED
    /QCIgray QCIcolor length 3 idiv string d
    0 1 QCIcolor length 3 idiv 1 sub
    { /QCIindex ED
      /x QCIindex 3 mul d
      QCIgray QCIindex
      QCIcolor x       get 0.30 mul
      QCIcolor x 1 add get 0.59 mul
      QCIcolor x 2 add get 0.11 mul
      add add cvi
      put
    } for
    QCIgray image
  } ifelse
} D

% general image drawing routine, used from the postscript driver
%
% Draws images with and without mask with 1, 8 and 24(rgb) bits depth.
%
%     width height matrix image 1|8|24 mask|false x y di
%
% width and height specify the width/height of the image,
% matrix a transformation matrix, image a procedure holding the image data
% (same for mask) and x/y an additional translation.
%
% ### should move the translation into the matrix!!!
/di 
{
  gsave
    translate
    1 index 1 eq { % bitmap
      false eq { % no mask, draw solid background
	pop
	true 3 1 roll % width height false matrix image
	4 index
	4 index
	false
	4 index
	4 index
	imagemask
	BkCol SC
	imagemask
      } { 
	pop
	false 3 1 roll % width height false matrix image
	imagemask
      } ifelse
    } { 
      dup false ne { 
	% have a mask, see if we can use it
	/languagelevel where {
	  pop
	  languagelevel 3 ge 
	} { false } ifelse
      } { 
	false 
      } ifelse

      {
	% languagelevel3, we can use image mask and dicts

	% store the image mask
	/ma exch d
	% select colorspace according to 8|24 bit depth and set the decode array /dc
	8 eq {
	  /dc [0 1] d
	  /DeviceGray
	} {
	  /dc [0 1 0 1 0 1] d
	  /DeviceRGB
	} ifelse
	setcolorspace
	% the image data
	/im exch d
	% transformation matrix
	/mt exch d
	% width and height
	/h exch def
	/w exch def
	% the image dict
	/id
	7 dict dup begin
	  /ImageType 1 d
	  /Width		        w d
	  /Height		        h d
	  /ImageMatrix            mt d
	  /DataSource		im d
	  /BitsPerComponent	8 d
	  /Decode		        dc d
	end d
	% the mask dictionary
	/md
	7 dict dup begin
	  /ImageType		1 d
	  /Width		        w d
	  /Height		        h d
	  /ImageMatrix            mt d
	  /DataSource		ma d
	  /BitsPerComponent	1 d
	  /Decode		        [0 1] d
	end d
	% and the combined image dict
	4 dict dup begin
	  /ImageType 3 d
	  /DataDict id d
	  /MaskDict md d
	  /InterleaveType 3 d
	end 
	image
      } {
	pop % no mask or can't use it, get rid of it
	8 % width height image 8|24 8 matrix
	4 1 roll
	8 eq { % grayscale
	  image
	} { %color
	  QCI
	} ifelse
      } ifelse
    } ifelse
  grestore    
} d




/BF {                                % brush fill
  gsave
    BSt 1 eq                          % solid brush?
    {
      BCol SC
      WFi { fill } { eofill } ifelse
    } if
    BSt 2 ge BSt 8 le and             % dense pattern?
    {
      BDArr BSt 2 sub get /sc ED 
      % the following line scales the brush color according to the pattern. the higher the pattern the lighter the color.
      BCol 
      { 
	1. exch sub sc mul 1. exch sub 
      } forall 
      3 array astore
      SC 
      WFi { fill } { eofill } ifelse
    } if
    BSt 9 ge BSt 14 le and            % brush pattern?
    {
      WFi { clip } { eoclip } ifelse
      defM SM
      pathbbox                        % left upper right lower
      3 index 3 index translate
      4 2 roll                        % right lower left upper
      3 2 roll                        % right left upper lower
      exch                            % left right lower upper
      sub /h ED
      sub /w ED
      OMo {
	NP
	0 0 MT
	0 h RL
	w 0 RL
	0 h neg RL
	CP
	BkCol SC
	fill
      } if
      BCol SC
      0.3 SW
      NP
      BSt 9 eq BSt 11 eq or           % horiz or cross pattern
      { 0 4 h
	{ dup 0 exch MT w exch LT } for
      } if
      BSt 10 eq BSt 11 eq or          % vert or cross pattern
      { 0 4 w
	{ dup 0 MT h LT } for
      } if
      BSt 12 eq BSt 14 eq or          % F-diag or diag cross
      { w h gt
	{ 0 6 w h add
	  { dup 0 MT h sub h LT } for
	} { 0 6 w h add
	  { dup 0 exch MT w sub w exch LT } for
	} ifelse
      } if
      BSt 13 eq BSt 14 eq or          % B-diag or diag cross
      { w h gt
	{ 0 6 w h add
	  { dup h MT h sub 0 LT } for
	} { 0 6 w h add
	  { dup w exch MT w sub 0 exch LT } for
	} ifelse
      } if
      S
    } if
    BSt 24 eq                         % CustomPattern
    
    {
    } if
  grestore
} D

% for arc
/mat matrix d
/ang1 D0 /ang2 D0
/w D0 /h D0
/x D0 /y D0

/ARC {                               % Generic ARC function [ X Y W H ang1 ang2 ]
  /ang2 ED /ang1 ED /h ED /w ED /y ED /x ED
  mat CM pop
  x w 2 div add y h 2 div add TR
  1 h w div neg scale
  ang2 0 ge
  {0 0 w 2 div ang1 ang1 ang2 add arc }
  {0 0 w 2 div ang1 ang1 ang2 add arcn} ifelse
  mat SM
} D

/C D0

/P {                                 % PdcDrawPoint [x y]
  NP
  MT
  0.5 0.5 rmoveto
  0  -1 RL
  -1 0 RL
  0  1 RL
  CP
  fill
} D

/M {                                 % PdcMoveTo [x y]
  /Cy ED /Cx ED
} D

/L {                                 % PdcLineTo [x y]
  NP
  Cx Cy MT
  /Cy ED /Cx ED
  Cx Cy LT
  QS
} D

/DL {                                % PdcDrawLine [x1 y1 x0 y0]
  NP
  MT
  LT
  QS
} D

/HL {                                % PdcDrawLine [x1 y x0]
  1 index DL
} D

/VL {                                % PdcDrawLine [x y1 y0]
  2 index exch DL
} D

/R {                                 % PdcDrawRect [x y w h]
  /h ED /w ED /y ED /x ED
  NP
  x y MT
  0 h RL
  w 0 RL
  0 h neg RL
  CP
  BF
  QS
} D

/ACR {                                       % add clip rect
  /h ED /w ED /y ED /x ED
  x y MT
  0 h RL
  w 0 RL
  0 h neg RL
  CP
} D

/xr D0 /yr D0
/rx D0 /ry D0 /rx2 D0 /ry2 D0

/RR {                                % PdcDrawRoundRect [x y w h xr yr]
  /yr ED /xr ED /h ED /w ED /y ED /x ED
  xr 0 le yr 0 le or
  {x y w h R}                  % Do rect if one of rounding values is less than 0.
  {xr 100 ge yr 100 ge or
    {x y w h E}                    % Do ellipse if both rounding values are larger than 100
    {
      /rx xr w mul 200 div d
      /ry yr h mul 200 div d
      /rx2 rx 2 mul d
      /ry2 ry 2 mul d
      NP
      x rx add y MT
      x               y               rx2 ry2 180 -90
      x               y h add ry2 sub rx2 ry2 270 -90
      x w add rx2 sub y h add ry2 sub rx2 ry2 0   -90
      x w add rx2 sub y               rx2 ry2 90  -90
      ARC ARC ARC ARC
      CP
      BF
      QS
    } ifelse
  } ifelse
} D

/E {                         % PdcDrawEllipse [x y w h]
  /h ED /w ED /y ED /x ED
  mat CM pop
  x w 2 div add y h 2 div add translate
  1 h w div scale
  NP
  0 0 w 2 div 0 360 arc
  mat SM
  BF
  QS
} D

/A {                         % PdcDrawArc [x y w h ang1 ang2]
  16 div exch 16 div exch
  NP
  ARC
  QS
} D

/PIE {                               % PdcDrawPie [x y w h ang1 ang2]
  /ang2 ED /ang1 ED /h ED /w ED /y ED /x ED
  NP
  x w 2 div add y h 2 div add MT
  x y w h ang1 16 div ang2 16 div ARC
  CP
  BF
  QS
} D

/CH {                                % PdcDrawChord [x y w h ang1 ang2]
  16 div exch 16 div exch
  NP
  ARC
  CP
  BF
  QS
} D

/BZ {                                % PdcDrawCubicBezier [4 points]
  curveto
  QS
} D

/CRGB {                              % Compute RGB [R G B] => R/255 G/255 B/255
  255 div 3 1 roll
  255 div 3 1 roll
  255 div 3 1 roll
} D


/BC {                                % PdcSetBkColor [R G B]
  CRGB
  BkCol astore pop
} D

/BR {                                % PdcSetBrush [style R G B]
  CRGB
  BCol astore pop
  /BSt ED
} D

/WB {                                % set white solid brush
  1 W BR
} D

/NB {                                % set nobrush
  0 B BR
} D

/PE {                                % PdcSetPen [style width R G B Cap Join]
  setlinejoin setlinecap
  CRGB
  PCol astore pop
  /LWi ED
  /PSt ED
  LWi 0 eq { 0.25 /LWi ED } if % ### 3.0 remove this line
  PCol SC
} D

/P1 {                                % PdcSetPen [R G B]
  1 0 5 2 roll 0 0 PE
} D

/ST {                                % SET TRANSFORM [matrix]
  defM setmatrix
  concat
} D

%% Font handling

% the next three commands are for defining fonts. The first one
% tries to find the most suitable printer font out of a fontlist.
% if encoding is false the default one will be used.
/MF {                                % newname encoding fontlist
  % this function tries to find a suitable postscript font. 
  % We try quite hard not to get courier for a
  % proportional font. The following takes an array of fonts. 
  % The algorithm will take the first font that
  % gives a match (defined as not resulting in a courier font).
  % each entry in the table is an array of the form [ /Fontname x-stretch slant ]
  % x-strtch can be used to stretch/squeeze the font in x direction. 
  % This gives better results when eg substituting helvetica for arial
  % slant is an optional slant. 0 is non slanted, 0.2 is a typical value for a syntetic oblique.
  % encoding can be either an encoding vector of false if the default font encoding is requested.
  true exch true exch                          % push a dummy on the stack,
  {                          % so the loop over the array will leave a font in any case when exiting.
    exch pop exch pop                 % (dummy | oldfont) (dummy | fontdict) fontarray
    dup 0 get dup findfont           % get the fontname from the array and load it
    dup /FontName get                % see if the font exists
    3 -1 roll eq {                   % see if fontname and the one provided are equal
      exit
    } if
  } forall
  exch                               % font fontarray

  % newname encoding font fontarray      defines a postscript font
  dup
  1 get /fxscale exch def            % define scale, sland and encoding
  2 get /fslant exch def
  exch /fencoding exch def
  [ fxscale 0 fslant 1 0 0 ] makefont        % transform font accordingly
  fencoding false eq {               % check if we have an encoding and use it if available
  } {
    dup maxlength dict begin         % copy font
      {
	1 index /FID ne                        % don't copy FID, as it's not allowed in PS Level 1
	{def}{pop pop}ifelse
      } forall
      /Encoding fencoding def          % replace encoding
      currentdict 
    end
  } ifelse
  definefont pop
} D

% an embedded font. This is used for the base fonts of the composite font used later on.
/MFEmb {                             % newname encoding fontname
  findfont dup length dict 
  begin
    {
      1 index /FID ne
      {d}{pop pop}ifelse
    } forall
    /Encoding ED currentdict 
  end
  definefont pop
} D

% DF: define font
% used to get a scaled version of an already loaded font
%
%    newname pointsize fontmame DF -
/DF {
  findfont
  % get the fontsize on top of the stack and define font matrix
  /fs 3 -1 roll d [ fs 0 0 fs -1 mul 0 0 ]  
  makefont
  d
} D

/ty 0 d
/Y {
  /ty ED
} D

/Tl { % draw underline/strikeout line: () w x y lw ->Tl-> () w x
  gsave 
    setlinewidth
    NP 1 index exch MT
    1 index 0 rlineto stroke
  grestore
} D

/XYT {  % [string [x/y displacement array] width x]
  ty MT % pops x

  /xyshow where { % interpreter has xyshow
    pop pop
    xyshow
  } { % use ashow
    exch pop % string cwidth
    1 index % string cwidth string
    dup length 2 div exch % string cwidth length string     !have to divide by 2 since we use unicode!
    stringwidth pop % string cwidth length pwidth
    3 -1 roll % string length pwidth cwidth
    exch sub exch div % string extraperchar
    exch 0 exch % extraperchar 0 string
    ashow
  } ifelse
} D

/AT {
  ty MT % pops x
  1 index % string cwidth string
  dup length 2 div exch % string cwidth length string     !have to divide by 2 since we use unicode!
  stringwidth pop % string cwidth length pwidth
  3 -1 roll % string length pwidth cwidth
  exch sub exch div % string extraperchar
  exch 0 exch % extraperchar 0 string
  ashow
} D

%% start of page
/QI {
  /C save d
  pageinit
  /Cx  0 d                         % reset current x position
  /Cy  0 d                         % reset current y position
  /OMo false d
} D

%% end of page
/QP {                                % show page
  C restore
  showpage
} D

% merges one key value pair into the page device dict
%
%    key value SPD -
/SPD {
  /setpagedevice where {
    1 dict dup begin 3 1 roll def end
    setpagedevice
  } { pop pop } ifelse
} D

/SV {                                % Save painter state
  BSt LWi PSt Cx Cy WFi OMo BCol PCol BkCol
  /nS nS 1 add d
  gsave
} D

/RS {                                % Restore painter state
  nS 0 gt
  { grestore
    /BkCol ED /PCol ED /BCol ED /OMo ED /WFi ED
    /Cy ED /Cx ED /PSt ED /LWi ED /BSt ED
    /nS nS 1 sub d
  } if
} D

/CLSTART {                           % clipping start
  /clipTmp matrix CM d             % save current matrix
  defM SM                          % Page default matrix
  NP
} D

/CLEND {                             % clipping end
  clip
  NP
  clipTmp SM                       % restore the current matrix
} D

/CLO {                               % clipping off
  grestore                         % restore top of page state
  gsave                            % save it back again
    defM SM                          % set coordsys (defensive progr.)
} D