annotate etc/ps-prin1.ps @ 28762:8e8534ef4b0a

PostScript level 1 compatibility, Upside-down printing and line number step. (BeginDoc, doLineNumber, SL, HL): Code fix. (isLineStep, PSL): New funs.

% === BEGIN ps-print prologue 1

% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
/ISOLatin1Encoding where {pop}{
% -- The ISO Latin-1 encoding vector isn't known, so define it.
% -- The first half is the same as the standard encoding,
% -- except for minus instead of hyphen at code 055.
/ISOLatin1Encoding
StandardEncoding 0 45 getinterval aload pop
    /minus
StandardEncoding 46 82 getinterval aload pop
%*** NOTE: the following are missing in the Adobe documentation,
%*** but appear in the displayed table:
%*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
% 0200 (128)
    /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
    /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
    /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
    /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
% 0240 (160)
    /space /exclamdown /cent /sterling
	/currency /yen /brokenbar /section
    /dieresis /copyright /ordfeminine /guillemotleft
	/logicalnot /hyphen /registered /macron
    /degree /plusminus /twosuperior /threesuperior
	/acute /mu /paragraph /periodcentered
    /cedilla /onesuperior /ordmasculine /guillemotright
	/onequarter /onehalf /threequarters /questiondown
% 0300 (192)
    /Agrave /Aacute /Acircumflex /Atilde
	/Adieresis /Aring /AE /Ccedilla
    /Egrave /Eacute /Ecircumflex /Edieresis
	/Igrave /Iacute /Icircumflex /Idieresis
    /Eth /Ntilde /Ograve /Oacute
	/Ocircumflex /Otilde /Odieresis /multiply
    /Oslash /Ugrave /Uacute /Ucircumflex
	/Udieresis /Yacute /Thorn /germandbls
% 0340 (224)
    /agrave /aacute /acircumflex /atilde
	/adieresis /aring /ae /ccedilla
    /egrave /eacute /ecircumflex /edieresis
	/igrave /iacute /icircumflex /idieresis
    /eth /ntilde /ograve /oacute
	/ocircumflex /otilde /odieresis /divide
    /oslash /ugrave /uacute /ucircumflex
	/udieresis /yacute /thorn /ydieresis
256 packedarray def
}ifelse

/reencodeFontISO{ %def
  dup
  length 12 add dict	% Make a new font (a new dict the same size
			% as the old one) with room for our new symbols.

  begin			% Make the new font the current dictionary.


    {1 index /FID ne
     {def}{pop pop}ifelse
    }forall		% Copy each of the symbols from the old dictionary
			% to the new one except for the font ID.

    currentdict /FontType get 0 ne{
      /Encoding ISOLatin1Encoding def	% Override the encoding with
					% the ISOLatin1 encoding.
    }if

    % Use the font's bounding box to determine the ascent, descent,
    % and overall height; don't forget that these values have to be
    % transformed using the font's matrix.

%          ^    (x2 y2)
%          |       |
%          |       v
%          |  +----+ - -
%          |  |    |   ^
%          |  |    |   | Ascent (usually > 0)
%          |  |    |   |
% (0 0) -> +--+----+-------->
%             |    |   |
%             |    |   v Descent (usually < 0)
% (x1 y1) --> +----+ - -

    currentdict /FontType get 0 ne{
      /FontBBox load aload pop			% -- x1 y1 x2 y2
      FontMatrix transform /Ascent  exch def pop
      FontMatrix transform /Descent exch def pop
    }{
      /PrimaryFont FDepVector 0 get def
      PrimaryFont /FontBBox get aload pop
      PrimaryFont /FontMatrix get transform /Ascent exch def pop
      PrimaryFont /FontMatrix get transform /Descent exch def pop
    }ifelse

    /FontHeight Ascent Descent sub def	% use `sub' because descent < 0

    % Define these in case they're not in the FontInfo
    % (also, here they're easier to get to).
    /UnderlinePosition  Descent 0.70 mul def
    /OverlinePosition   Descent UnderlinePosition sub Ascent add def
    /StrikeoutPosition  Ascent 0.30 mul def
    /LineThickness      FontHeight 0.05 mul def
    /Xshadow            FontHeight  0.08 mul def
    /Yshadow            FontHeight -0.09 mul def
    /SpaceBackground    Descent neg UnderlinePosition add def
    /XBox               Descent neg def
    /YBox               LineThickness 0.7 mul def

    currentdict		% Leave the new font on the stack
    end			% Stop using the font as the current dictionary.
    definefont		% Put the font into the font dictionary
    pop			% Discard the returned font.
}bind def

/DefFont{				% Font definition
  findfont exch scalefont reencodeFontISO
}def

/F{					% Font selection
  findfont
  dup /Ascent            get /Ascent            exch def
  dup /Descent           get /Descent           exch def
  dup /FontHeight        get /FontHeight        exch def
  dup /UnderlinePosition get /UnderlinePosition exch def
  dup /OverlinePosition  get /OverlinePosition  exch def
  dup /StrikeoutPosition get /StrikeoutPosition exch def
  dup /LineThickness     get /LineThickness     exch def
  dup /Xshadow           get /Xshadow           exch def
  dup /Yshadow           get /Yshadow           exch def
  dup /SpaceBackground   get /SpaceBackground   exch def
  dup /XBox              get /XBox              exch def
  dup /YBox              get /YBox              exch def
  setfont
}def

/FG /setrgbcolor load def

/bg false def
/BG{
  dup /bg exch def
  {mark 4 1 roll ]}
  {[ 1.0 1.0 1.0 ]}
  ifelse
  /bgcolor exch def
}def

%  B    width    C
%   +-----------+
%               | Ascent  (usually > 0)
% A +           +
%               | Descent (usually < 0)
%   +-----------+
%  E    width    D

/dobackground{				% width --
  currentpoint				% -- width x y
  gsave
    newpath
    moveto				% A (x y)
    0 Ascent rmoveto			% B
    dup 0 rlineto			% C
    0 Descent Ascent sub rlineto	% D
    neg 0 rlineto			% E
    closepath
    FillBgColor
  grestore
}def

/eolbg{					% dobackground until right margin
  PrintWidth				% -- x-eol
  currentpoint pop			% -- cur-x
  sub					% -- width until eol
  dobackground
}def

/PSL{bg{eolbg}if  0  currentpoint exch pop LineHeight sub  moveto}def
/PLN{PrintLineNumber{doLineNumber}if}def

/SL{PSL isLineStep pop}def		% Soft Linefeed

/HL{PSL PLN}def				% Hard Linefeed

% Some debug
/dcp{currentpoint exch 40 string cvs print (, ) print =}def
/dp{print 2 copy  exch 40 string cvs print (, ) print =}def

/W{
  ( ) stringwidth	% Get the width of a space in the current font.
  pop			% Discard the Y component.
  mul			% Multiply the width of a space
			% by the number of spaces to plot
  bg{dup dobackground}if
  0 rmoveto
}def

/Effect 0 def
/EF{/Effect exch def}def

% stack:  string  |-  --
% effect: 1  - underline  2   - strikeout  4  - overline
%         8  - shadow     16  - box        32 - outline
/S{
  /xx currentpoint dup Descent add /yy exch def
  Ascent add /YY exch def def
  dup stringwidth pop xx add /XX exch def
  Effect 8 and 0 ne{
    /yy yy Yshadow add def
    /XX XX Xshadow add def
  }if
  bg{
    true
    Effect 16 and 0 ne
      {SpaceBackground doBox}
      {xx yy XX YY doRect}
    ifelse
  }if						% background
  Effect 16 and 0 ne{false 0 doBox}if		% box
  Effect 8  and 0 ne{dup doShadow}if		% shadow
  Effect 32 and 0 ne
    {true doOutline}				% outline
    {show}					% normal text
  ifelse
  Effect 1  and 0 ne{UnderlinePosition Hline}if	% underline
  Effect 2  and 0 ne{StrikeoutPosition Hline}if	% strikeout
  Effect 4  and 0 ne{OverlinePosition  Hline}if	% overline
}bind def

% stack:  position  |-  --
/Hline{
  currentpoint exch pop add dup
  gsave
  newpath
  xx exch moveto
  XX exch lineto
  closepath
  LineThickness setlinewidth stroke
  grestore
}bind def

% stack:  fill-or-not delta  |-  --
/doBox{
  /dd exch def
  xx XBox sub dd sub yy YBox sub dd sub
  XX XBox add dd add YY YBox add dd add
  doRect
}bind def

% stack:  fill-or-not lower-x lower-y upper-x upper-y  |-  --
/doRect{
  /rYY exch def
  /rXX exch def
  /ryy exch def
  /rxx exch def
  gsave
  newpath
  rXX rYY moveto
  rxx rYY lineto
  rxx ryy lineto
  rXX ryy lineto
  closepath
  % top of stack: fill-or-not
    {FillBgColor}
    {LineThickness setlinewidth stroke}
  ifelse
  grestore
}bind def

% stack:  string  |-  --
/doShadow{
  gsave
  Xshadow Yshadow rmoveto
  false doOutline
  grestore
}bind def

/st 1 string def

% stack:  string fill-or-not  |-  --
/doOutline{
  /-fillp- exch def
  /-ox- currentpoint /-oy- exch def def
  gsave
  LineThickness setlinewidth
  {st 0 3 -1 roll put
   st dup true charpath
   -fillp- {gsave FillBgColor grestore}if
   stroke stringwidth
   -oy- add /-oy- exch def
   -ox- add /-ox- exch def
   -ox- -oy- moveto
  }forall
  grestore
  -ox- -oy- moveto
}bind def

% stack:  --
/FillBgColor{bgcolor aload pop setrgbcolor fill}bind def

/L0 6 /Times-Italic DefFont

% stack:  -- |- boolean
/isLineStep{
  SyncLineZebra
  {PrintLineStep 1 gt
   {/PrintLineStep PrintLineStep 1 sub def false}	% or inside zebra
   {/PrintLineStep ZebraHeight def true}ifelse}		% or 1st zebra line
  {LineNumber 1 sub PrintLineStep mod 0 eq}ifelse	% or line step
}def

% stack:  --
/doLineNumber{
  /LineNumber where
  {pop
   isLineStep			% or line step
   LineNumber Lines ge or	% or last line
   {currentfont
    gsave
    0.0 0.0 0.0 setrgbcolor
    /L0 findfont setfont
    LineNumber Lines ge
    {(end      )}
    {LineNumber 6 string cvs (      ) strcat}ifelse
    dup stringwidth pop neg 0 rmoveto
    show
    grestore
    setfont}if
    /LineNumber LineNumber 1 add def
  }if
}def

% stack: color-specifier |- --
/SetColor{dup type /realtype eq{setgray}{aload pop setrgbcolor}ifelse}def

% stack: --
/printZebra{
  gsave
  ZebraColor SetColor
  /double-zebra ZebraHeight ZebraHeight add def
  /yiter double-zebra LineHeight mul neg def
  /xiter PrintWidth InterColumn add def
  NumberOfColumns{LinesPerColumn doColumnZebra xiter 0 rmoveto}repeat
  grestore
}def

% stack:  lines-per-column |- --
/doColumnZebra{
  gsave
  dup double-zebra idiv{ZebraHeight doZebra 0 yiter rmoveto}repeat
  double-zebra mod
  dup 0 le{pop}{dup ZebraHeight gt {pop ZebraHeight}if doZebra}ifelse
  grestore
}def

% stack:  zebra-height (in lines) |- --
/doZebra{
  /zh exch 0.05 sub LineHeight mul def
  gsave
  0 LineHeight 0.65 mul rmoveto
  PrintWidth 0 rlineto
  0 zh neg rlineto
  PrintWidth neg 0 rlineto
  0 zh rlineto
  fill
  grestore
}def

% stack: --
/printBackground{
  /BackgroundColor where{
    pop gsave BackgroundColor SetColor
    NumberOfColumns{
     gsave
     0 LineHeight 0.65 mul rmoveto
     PrintWidth 0 rlineto
     0 PrintHeight neg rlineto
     PrintWidth neg 0 rlineto
     0 PrintHeight rlineto
     fill
     grestore
     PrintWidth InterColumn add 0 rmoveto
    }repeat
    grestore
  }if
}def

% tx ty rotation xscale yscale xpos ypos BeginBackImage
/BeginBackImage{
  /-save-image- save def
  /showpage{}def
  translate
  scale
  rotate
  translate
}def

/EndBackImage{-save-image- restore}def

% string fontsize fontname rotation gray xpos ypos ShowBackText
/ShowBackText{
  gsave
  translate
  setgray
  rotate
  findfont exch dup /-offset- exch -0.25 mul def scalefont setfont
  0 -offset- moveto
  /-saveLineThickness- LineThickness def
  /LineThickness 1 def
  false doOutline
  /LineThickness -saveLineThickness- def
  grestore
}def

/BeginDoc{
  % ---- Remember space width of the normal text font `f0'.
  /SpaceWidth /f0 findfont setfont ( ) stringwidth pop def
  % ---- save the state of the document (useful for ghostscript!)
  /docState save def
  % ---- [andrewi] set PageSize based on chosen dimensions
  UseSetpagedevice{
    BMark /PageSize [PageWidth LandscapePageHeight] EMark setpagedevice
  }{
    LandscapeMode{
      % ---- translate to bottom-right corner of Portrait page
      LandscapePageHeight 0 translate
      90 rotate
    }if
  }ifelse
  % ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
  /JackGhostscript where{pop 1 27.7 29.7 div scale}if
  UpsideDown{PageWidth LandscapePageHeight translate 180 rotate}if
  % ---- N-Up printing
  N-Up 1 gt{
    % ---- landscape
    N-Up-Landscape{
      PageWidth 0 translate
      90 rotate
    }if
    N-Up-Margin dup translate
    % ---- scale
    LandscapeMode{
      /HH PageWidth def
      /WW LandscapePageHeight def
    }{
      /HH LandscapePageHeight def
      /WW PageWidth def
    }ifelse
    WW N-Up-Margin sub N-Up-Margin sub
    N-Up-Landscape
     {N-Up-Lines div HH}{N-Up-Columns N-Up-Missing add div WW}ifelse
    div dup scale
    0 N-Up-Repeat 1 sub LandscapePageHeight mul translate
    % ---- go to start position in page matrix
    N-Up-XStart N-Up-Missing 0.5 mul
    LandscapeMode{
      LandscapePageHeight mul N-Up-YStart add
    }{
      PageWidth mul add N-Up-YStart
    }ifelse
    translate
  }if
  /ColumnWidth PrintWidth InterColumn add def
  % ---- translate to lower left corner of TEXT
  LeftMargin BottomMargin translate
  % ---- define where  printing will start
  /f0 F					% this installs Ascent
  /PrintStartY PrintHeight Ascent sub def
  /ColumnIndex 1 def
  /N-Up-Counter N-Up-End 1 sub def
}def

/EndDoc{
  % ---- restore the state of the document (useful for ghostscript!)
  docState restore
}def

/BeginDSCPage{
  % ---- when 1st column, save the state of the page
  ColumnIndex 1 eq{
    /pageState save def
  }if
  % ---- save the state of the column
  /columnState save def
}def

/PrintHeaderWidth PrintOnlyOneHeader{PrintPageWidth}{PrintWidth}ifelse def

/BeginPage{
  % ---- when 1st column, print all background effects
  ColumnIndex 1 eq{
    0 PrintStartY moveto		% move to where printing will start
    printBackground
    Zebra {printZebra}if
    printGlobalBackground
    printLocalBackground
  }if
  PrintHeader{
    PrintOnlyOneHeader{ColumnIndex 1 eq}{true}ifelse{
      PrintHeaderFrame{HeaderFrame}if
      HeaderText
    }if
  }if
  0 PrintStartY moveto			% move to where printing will start
  PLN
}def

/EndPage{bg{eolbg}if}def

/EndDSCPage{
  ColumnIndex NumberOfColumns eq{
    % ---- restore the state of the page
    pageState restore
    /ColumnIndex 1 def
    % ---- N-up printing
    N-Up 1 gt{
      N-Up-Counter 0 gt{
	% ---- Next page on same row
	/N-Up-Counter N-Up-Counter 1 sub def
	N-Up-XColumn N-Up-YColumn
      }{
	% ---- Next page on next line
	/N-Up-Counter N-Up-End 1 sub def
	N-Up-XLine N-Up-YLine
      }ifelse
      translate
    }if
  }{ % else
    % ---- restore the state of the current column
    columnState restore
    % ---- and translate to the next column
    ColumnWidth 0 translate
    /ColumnIndex ColumnIndex 1 add def
  }ifelse
}def

% stack: number-of-pages-per-sheet |- --
/BeginSheet{
  /sheetState save def
  /pages-per-sheet exch def
  % ---- N-up printing
  N-Up 1 gt N-Up-Border and pages-per-sheet 0 gt and{
    % ---- page border
    gsave
    0 setgray
    LeftMargin neg BottomMargin neg moveto
    N-Up-Repeat
    {N-Up-End
     {gsave
      PageWidth 0 rlineto
      0 LandscapePageHeight rlineto
      PageWidth neg 0 rlineto
      closepath stroke
      grestore
      /pages-per-sheet pages-per-sheet 1 sub def
      pages-per-sheet 0 le{exit}if
      N-Up-XColumn N-Up-YColumn rmoveto
     }repeat
     pages-per-sheet 0 le{exit}if
     N-Up-XLine N-Up-XColumn sub N-Up-YLine rmoveto
    }repeat
    grestore
  }if
}def

/EndSheet{
  showpage
  sheetState restore
}def

/SetHeaderLines{			% nb-lines --
  /HeaderLines exch def
  % ---- bottom up
  HeaderPad
  HeaderLines 1 sub HeaderLineHeight mul add
  HeaderTitleLineHeight add
  HeaderPad add
  /HeaderHeight exch def
}def

% |---------|
% |  tm     |
% |---------|
% |  header |
% |-+-------| <-- (x y)
% |  ho     |
% |---------|
% |  text   |
% |-+-------| <-- (0 0)
% |  bm     |
% |---------|

/HeaderFrameStart{			% -- x y
  0  PrintHeight HeaderOffset add
}def

/HeaderFramePath{
  PrintHeaderWidth	0			rlineto
  0			HeaderHeight		rlineto
  PrintHeaderWidth neg	0			rlineto
  0			HeaderHeight neg	rlineto
}def

/HeaderFrame{
  gsave
    0.4 setlinewidth
    % ---- fill a black rectangle (the shadow of the next one)
    HeaderFrameStart moveto
    1 -1 rmoveto
    HeaderFramePath
    0 setgray fill
    % ---- do the next rectangle ...
    HeaderFrameStart moveto
    HeaderFramePath
    gsave 0.9 setgray fill grestore	% filled with grey
    gsave 0 setgray stroke grestore	% drawn  with black
  grestore
}def

/HeaderStart{
  HeaderFrameStart
  exch HeaderPad add exch	% horizontal pad
  % ---- bottom up
  HeaderPad add			% vertical   pad
  HeaderDescent sub
  HeaderLineHeight HeaderLines 1 sub mul add
}def

/strcat{
  dup length 3 -1 roll dup length dup 4 -1 roll add string dup
  0 5 -1 roll putinterval
  dup 4 2 roll exch putinterval
}def

/pagenumberstring{
  PageNumber 32 string cvs
  ShowNofN{
    (/) strcat
    PageCount 32 string cvs strcat
  }if
}def

/HeaderText{
  HeaderStart moveto

  HeaderLinesRight HeaderLinesLeft	% -- rightLines leftLines

  % ---- hack: `PN 1 and'  ==  `PN 2 modulo'

  % ---- if even page number and duplex, then exchange left and right
  PageNumber 1 and 0 eq DuplexValue and{exch}if

  { % ---- process the left lines
    aload pop
    exch F
    gsave
      dup xcheck{exec}if
      show
    grestore
    0 HeaderLineHeight neg rmoveto
  }forall

  HeaderStart moveto

  { % ---- process the right lines
    aload pop
    exch F
    gsave
      dup xcheck{exec}if
      dup stringwidth pop
      PrintHeaderWidth exch sub HeaderPad 2 mul sub 0 rmoveto
      show
    grestore
    0 HeaderLineHeight neg rmoveto
  }forall
}def

/ReportFontInfo{
  2 copy
  /t0 3 1 roll DefFont
  /t0 F
  /lh FontHeight def
  /sw ( ) stringwidth pop def
  /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch
  stringwidth pop exch div def
  /t1 12 /Helvetica-Oblique DefFont
  /t1 F
  gsave
    (languagelevel = ) show
    languagelevel 32 string cvs show
  grestore
  0 FontHeight neg rmoveto
  gsave
    (For ) show
    128 string cvs show
    ( ) show
    32 string cvs show
    ( point, the line height is ) show
    lh 32 string cvs show
    (, the space width is ) show
    sw 32 string cvs show
    (,) show
  grestore
  0 FontHeight neg rmoveto
  gsave
    (and a crude estimate of average character width is ) show
    aw 32 string cvs show
    (.) show
  grestore
  0 FontHeight neg rmoveto
}def

/cm{ % cm to point
  72 mul 2.54 div
}def

/ReportAllFontInfo{
  FontDirectory
  { % key = font name  value = font dictionary
    pop 10 exch ReportFontInfo
  }forall
}def

% 3 cm 20 cm moveto  10 /Courier ReportFontInfo  showpage
% 3 cm 20 cm moveto  ReportAllFontInfo           showpage

% === END ps-print prologue 1