a2ps 1:4.14-1.3 / usr / share / a2ps / ps / base.ps

% 
% Base of a2ps' prologues
%
% $Id: base.ps,v 1.1.1.1.2.2 2007/12/29 01:58:26 mhatta Exp $
%

%
% This file is part of a2ps.
% 
% This program is free software; you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation; either version 3, or (at your option)
% any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program; see the file COPYING.  If not, write to
% the Free Software Foundation, 59 Temple Place - Suite 330,
% Boston, MA 02111-1307, USA.

% Variables and Functions
%
% Variables from `outside'
%	v:		virtual page number in current page
%	sx:		number of chars in lines' prefix
%	tab:		tab size (in chars)
% Functions
%	title:		title
%	footer:		footer
%	border:		border around the body text
% Coordinates
%	x, y:		the virtual pages (arrays)
%	x0, y0:		the current line content (x0 does not include
% 			the line numbers)
%	snx, sny:	left footer
%	dx, dy:		the l-footer
%	lx, ly:		the r-header
%	fnx, fny:	the c-footer
%	scx, scy:	the sheet center
% Font sizes
%	fnfs:		center title
%	bfs:		body
%	dfs:		date
% Fonts
%	df:		footer/header
%	sf:		symbol
%	fnf:		center title
% Widths and heigths
%	cw:		a Courier char
%	pw, ph:		page
%	sw, sh:		sheet
%	th:		v.p. title
% Margins
%	hm:		header
%	ury:		top
%	urx:		right
%	llx:		left

% -- code follows this line --
%%Copyright: (c) 1988, 89, 90, 91, 92, 93 Miguel Santana
%%Copyright: (c) 1995, 96, 97, 98 Akim Demaille, Miguel Santana
%%DocumentProcessColors: Black
% Check PostScript language level.
/languagelevel where {
  pop /gs_languagelevel languagelevel def
} {
  /gs_languagelevel 1 def
} ifelse

% EPSF import as in the Red Book
/BeginInclude {
  /b4_Inc_state save def    		% Save state for cleanup
  /dict_count countdictstack def	% Count objects on dict stack
  /op_count count 1 sub def		% Count objects on operand stack 
  userdict begin
    0 setgray 0 setlinecap
    1 setlinewidth 0 setlinejoin
    10 setmiterlimit [ ] 0 setdash newpath
    gs_languagelevel 1 ne {
      false setstrokeadjust false setoverprint 
    } if
} bind def

/EndInclude {
  count op_count sub { pos } repeat	% Clean up stacks
  countdictstack dict_count sub { end } repeat
  b4_Inc_state restore
} bind def

/BeginEPSF {
  BeginInclude
  /showpage { } def
} bind def

/EndEPSF {
  EndInclude
} bind def

% Page prefeed
/page_prefeed {         % bool -> -
  statusdict /prefeed known {
    statusdict exch /prefeed exch put
  } {
    pop
  } ifelse
} bind def

/deffont {
  findfont exch scalefont def
} bind def

/reencode_font {
  findfont reencode 2 copy definefont pop def
} bind def

% Function c-show (str => -)
% centers text only according to x axis.
/c-show { 
  dup stringwidth pop
  2 div neg 0 rmoveto
  show
} bind def

% Function l-show (str => -)
% prints texts so that it ends at currentpoint
/l-show {
  dup stringwidth pop neg 
  0 
  rmoveto show
} bind def

% center-fit show (str w => -)
% show centered, and scale currentfont so that the width is less than w
/cfshow {
  exch dup stringwidth pop
  % If the title is too big, try to make it smaller
  3 2 roll 2 copy
  gt
  { % if, i.e. too big
    exch div
    currentfont exch scalefont setfont
  } { % ifelse
    pop pop 
  }
  ifelse
  c-show			% center title
} bind def

% Return the y size of the current font
% - => fontsize
/currentfontsize {
  currentfont /FontType get 0 eq {
    currentfont /FontMatrix get 3 get
  }{
    currentfont /FontMatrix get 3 get 1000 mul
  } ifelse
} bind def

% reencode the font
% <encoding-vector> <fontdict> -> <newfontdict>
/reencode { %def
  dup length 5 add dict begin
    { %forall
      % <vector> <key> <val>
      1 index /FID ne 
      { def }{ pop pop } ifelse
    } forall
    /Encoding exch def % -

    % 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.
    % We use `load' because sometimes BBox is executable, sometimes not.
    % Since we need 4 numbers an not an array avoid BBox from being executed
    /FontBBox load aload pop
    FontMatrix transform /Ascent exch def pop
    FontMatrix transform /Descent exch def pop
    /FontHeight Ascent Descent sub def

    % Get the underline position and thickness if they're defined.
    % Use 1 if they are not defined.
    currentdict /FontInfo 2 copy known
    { get
      /UnderlinePosition 2 copy % <FontInfo> /UP <FontInfo> /UP
      2 copy known
      { get }{ pop pop 1 } ifelse
      0 exch FontMatrix transform exch pop
      def % <FontInfo>

      /UnderlineThickness 2 copy % <FontInfo> /UT <FontInfo> /UT
      2 copy known
      { get }{ pop pop 1 } ifelse
      0 exch FontMatrix transform exch pop
      def % <FontInfo>
      pop % -
    }{ pop pop
    } ifelse

    currentdict
  end 
} bind def

% composite fonts for ASCII-EUC mixed strings
% Version 1.2 1/31/1990
% Original Ken'ichi HANDA (handa@etl.go.jp)
% Modified Norio Katayama (katayama@rd.nacsis.ac.jp),1998
% Extend & Fix Koji Nakamaru (maru@on.cs.keio.ac.jp), 1999
% Anyone can freely copy, modify, distribute this program.

/copyfont {	% font-dic extra-entry-count  copyfont  font-dic
	1 index maxlength add dict begin
	{	1 index /FID ne 2 index /UniqueID ne and
		{def} {pop pop} ifelse
	} forall
	currentdict
	end
} bind def

/compositefont { % ASCIIFontName EUCFontName RomanScale RomanOffset Rot(T/F) compositefont font
    /RomanRotation exch def
    /RomanOffset exch def
    /RomanScale exch def
    userdict /fixeucfont_dict known not {
	userdict begin
	    /fixeucfont_dict 2 dict begin
		/UpperByteEncoding [
		    16#00 1 16#20 { pop 0 } for
		    16#21 1 16#28 { 16#20 sub } for
		    16#29 1 16#2F { pop 0 } for
		    16#30 1 16#74 { 16#27 sub } for
		    16#75 1 16#FF { pop 0 } for
		] def
	        /LowerByteEncoding [
		    16#00 1 16#A0 { pop /.notdef } for
		    16#A1 1 16#FE { 16#80 sub 16 2 string cvrs
				    (cXX) dup 1 4 -1 roll
				    putinterval cvn } for
		    /.notdef
		] def
		currentdict
	    end def
	end
    } if
    findfont dup /FontType get 0 eq {
	14 dict begin
	    %
	    % 7+8 bit EUC font
	    %
	    12 dict begin
		/EUCFont exch def
		/FontInfo (7+8 bit EUC font) readonly def
		/PaintType 0 def
		/FontType 0 def
		/FontMatrix matrix def
		% /FontName
		/Encoding fixeucfont_dict /UpperByteEncoding get def
		/FMapType 2 def
		EUCFont /WMode known
		{ EUCFont /WMode get /WMode exch def }
		{ /WMode 0 def } ifelse
		/FDepVector [
		    EUCFont /FDepVector get 0 get
		    [ 16#21 1 16#28 {} for 16#30 1 16#74 {} for ]
		    {
			13 dict begin
			    /EUCFont EUCFont def
			    /UpperByte exch 16#80 add def	
			    % /FontName
			    /FontInfo (EUC lower byte font) readonly def
			    /PaintType 0 def
			    /FontType 3 def
			    /FontMatrix matrix def
			    /FontBBox {0 0 0 0} def
			    /Encoding
				fixeucfont_dict /LowerByteEncoding get def
			    % /UniqueID
			    % /WMode
			    /BuildChar {
				gsave
				exch dup /EUCFont get setfont
				/UpperByte get
				2 string
				dup 0 4 -1 roll put
				dup 1 4 -1 roll put
				dup stringwidth setcharwidth
				0 0 moveto show
				grestore
			    } bind def
			    currentdict
			end
			/lowerbytefont exch definefont
		    } forall
		] def
		currentdict
	    end
	    /eucfont exch definefont
	    exch
	    findfont 1 copyfont dup begin
		RomanRotation {
			/FontMatrix FontMatrix
			[ 0 RomanScale neg RomanScale 0 RomanOffset neg 0 ]
			matrix concatmatrix def
		}{
			/FontMatrix FontMatrix
			[ RomanScale 0 0 RomanScale 0 RomanOffset ] matrix concatmatrix
			def
			/CDevProc
			    {pop pop pop pop 0 exch -1000 exch 2 div 880} def
		} ifelse
	    end
	    /asciifont exch definefont
	    exch
	    /FDepVector [ 4 2 roll ] def
	    /FontType 0 def
	    /WMode 0 def
	    /FMapType 4 def
	    /FontMatrix matrix def
	    /Encoding [0 1] def
	    /FontBBox {0 0 0 0} def
%	    /FontHeight 1.0 def % XXXX
	    /FontHeight RomanScale 1.0 ge { RomanScale }{ 1.0 } ifelse def
	    /Descent -0.3 def   % XXXX
	    currentdict
	end
	/tmpfont exch definefont
	pop
	/tmpfont findfont
    }{
	pop findfont 0 copyfont
    } ifelse
} def	

/slantfont {	% FontName slant-degree  slantfont  font'
    exch findfont 1 copyfont begin
    [ 1 0 4 -1 roll 1 0 0 ] FontMatrix exch matrix concatmatrix
    /FontMatrix exch def
    currentdict
    end
} def

% Function print line number (<string> # -)
/# {
  gsave
    sx cw mul neg 2 div 0 rmoveto
    f# setfont
    c-show
  grestore
} bind def

% -------- Some routines to enlight plain b/w printings ---------

% Underline
% width --
/dounderline {
  currentpoint
  gsave
    moveto
    0 currentfont /Descent get currentfontsize mul rmoveto
    0 rlineto
    stroke
  grestore
} bind def

% Underline a string
% string --
/dounderlinestring {
  stringwidth pop
  dounderline
} bind def

/UL {
  /ul exch store
} bind def

% Draw a box of WIDTH wrt current font
% width --
/dobox {
  currentpoint
  gsave
    newpath
    moveto
    0 currentfont /Descent get currentfontsize mul rmoveto
    dup 0 rlineto
    0 currentfont /FontHeight get currentfontsize mul rlineto
    neg 0 rlineto
    closepath
    stroke
  grestore
} bind def

/BX {
  /bx exch store
} bind def

% Box a string
% string --
/doboxstring {
  stringwidth pop
  dobox
} bind def

%
% ------------- Color routines ---------------
%
/FG /setrgbcolor load def

% Draw the background
% width --
/dobackground {
  currentpoint
  gsave
    newpath
    moveto
    0 currentfont /Descent get currentfontsize mul rmoveto
    dup 0 rlineto
    0 currentfont /FontHeight get currentfontsize mul rlineto
    neg 0 rlineto
    closepath
    bgcolor aload pop setrgbcolor
    fill
  grestore
} bind def

% Draw bg for a string
% string --
/dobackgroundstring {
  stringwidth pop
  dobackground
} bind def


/BG {
  dup /bg exch store
  { mark 4 1 roll ] /bgcolor exch store } if
} bind def


/Show {
  bg { dup dobackgroundstring } if
  ul { dup dounderlinestring } if
  bx { dup doboxstring } if
  show
} bind def

% Function T(ab), jumps to the n-th tabulation in the current line
/T {
  cw mul x0 add
  bg { dup currentpoint pop sub dobackground } if
  ul { dup currentpoint pop sub dounderline } if
  bx { dup currentpoint pop sub dobox } if
  y0 moveto
} bind def

% Function n: move to the next line
/n {
  /y0 y0 bfs sub store
  x0 y0 moveto
} bind def

% Function N: show and move to the next line
/N {
  Show
  /y0 y0 bfs sub store
  x0 y0 moveto
} bind def

/S {
  Show
} bind def

%%BeginSetup
/bgcolor [ 0 0 0 ] def
/bg false def
/ul false def
/bx false def
%%EndSetup