font2pcl.ps

GhostScript的源代码

   loop (Last Code) wword
   pitch dup cvi sub 256 mul cvi (Pitch Extended) wbyte
   0 (Height Extended) wbyte
   0 (Cap Height) wword			% (default)
   currentfont /UniqueID known { UniqueID } { 0 } ifelse
     16#c1000000 add (Font Number (Adobe UniqueID)) wdword
   FontName length 16 max string
     dup FontName exch cvs pop
     outfile exch 0 16 getinterval writestring	% Font Name
   WriteResolution?
    { resolution dup (X Resolution) wword (Y Resolution) wword
    }
   if
   outfile Copyright writestring	% Copyright
 } def

/writePCL		% <fontfile> <resolution> writePCL -
 {
   save
   currentfont begin
   pcldict begin
   80 dict begin		% allow for recursion
     /saved exch def
     /resolution exch def
     /outfile exch def
   matrix currentmatrix dup 4 0 put dup 5 0 put setmatrix

	% Supply some default values so we don't have to check later.

   currentfont /FontInfo known not { /FontInfo 1 dict def } if
   currentfont /FontName known not { /FontName () def } if
   /Copyright   FontInfo /Notice .knownget not { () } if   def
   /FullName
     FontInfo /FullName .knownget not
      { FontName dup length string cvs }
     if def

	% Determine the original font, and its relationship to this one.

   /OrigFont currentfont origfont def
   /OrigMatrix OrigFont /FontMatrix get def
   /OrigMatrixInverse OrigMatrix matrix invertmatrix def
   /ScaleMatrix matrix currentfont OrigFont ne
    { FontMatrix exch OrigMatrixInverse exch concatmatrix
    } if
   def
   /CurrentScaleMatrix
     matrix currentmatrix
     matrix defaultmatrix
     dup 0 get 1 index 3 get mul 0 lt
     1 index dup 1 get exch 2 get mul 0 gt or
       /flipY exch def
     dup invertmatrix
     dup concatmatrix
   def
   /negY flipY { {neg} } { {} } ifelse def

	% Print debugging information.

   /CDEBUG where { pop } { /CDEBUG false def } ifelse
   /VDEBUG where { pop } { /VDEBUG false def } ifelse
   CDEBUG { /VDEBUG true def } if
   DEBUG
    { (currentmatrix: ) print matrix currentmatrix ==
      (defaultmatrix: ) print matrix defaultmatrix ==
      (flipY: ) print flipY ==
      (scaling matrix: ) print CurrentScaleMatrix ==
      (FontMatrix: ) print FontMatrix ==
      (FontBBox: ) print /FontBBox load ==
      currentfont OrigFont ne
       { OrigFont /FontName .knownget { (orig FontName: ) print == } if
         (orig FontMatrix: ) print OrigMatrix ==
       } if
      currentfont /ScaleMatrix .knownget { (ScaleMatrix: ) print == } if
      gsave
	FontMatrix concat
	(combined matrix: ) print matrix currentmatrix ==
      grestore
      flush
    } if

	% Determine the orientation.

   ScaleMatrix matrix currentmatrix dup concatmatrix
   0 1 3
    { 1 index 1 get 0 eq 2 index 2 get 0 eq and 2 index 0 get 0 gt and
       { exit } if
      pop -90 matrix rotate exch dup concatmatrix
    }
   for
   dup type /integertype ne
    { (Only rotations by multiples of 90 degrees are supported:\n) print
      == flush
      saved end end end restore stop
    }
   if
   /orientation exch def
   /rot orientation 90 mul def
   DEBUG { (orientation: ) print orientation == flush } if

   dup dup 0 get exch 3 get negY sub abs 0.5 ge
    { (Only identical scaling in X and Y is supported:\n) print
      exch flipY 3 array astore ==
      currentdevice .devicename ==
      matrix defaultmatrix == flush
      saved end end end restore stop
    }
   if pop

	% Determine the font metrics, in the PCL character coordinate system,
	% which has +Y going towards the top of the page.

   gsave
   FontMatrix concat
     0 0 transform
     negY round cvi /r0y exch def
     round cvi /r0x exch def
   ixbbox
     negY /rury exch def  /rurx exch def
     negY /rlly exch def  /rllx exch def
     /rminx rllx rurx min def
     /rminy rlly negY rury negY min def
     /rw rurx rllx sub abs def
     /rh rury rlly sub abs def
   gsave rot neg rotate
     0 0 transform
     negY round cvi /u0y exch def
     round cvi /u0x exch def
   ixbbox
     negY /uury exch def   /uurx exch def
     negY /ully exch def   /ullx exch def
     /uw uurx ullx sub def
     /uh uury ully sub def
   grestore
   DEBUG 
    { (rmatrix: ) print matrix currentmatrix ==
      (rFontBBox: ) print [rllx rlly rurx rury] ==
      (uFontBBox: ) print [ullx ully uurx uury] ==
      flush
    } if
   grestore

	% Disable the character cache, to avoid excessive allocation
	% and memory sandbars.

   mark cachestatus   /upper exch def
   cleartomark 0 setcachelimit
   
	% Write the font header.

   writefontheader

	% Establish an image device for rasterizing characters.

   matrix currentmatrix
     dup 4 rminx neg put
     dup 5 rminy neg put
	% Round the width up to a multiple of 8
	% so we don't get garbage bits in the last byte of each row.
   rw 7 add -8 and rh <ff 00> makeimagedevice
     /cdevice exch def
   nulldevice			% prevent page device switching
   cdevice setdevice

	% Rasterize each character in turn.

   /raster   rw 7 add 8 idiv   def
   /row   raster string   def
   /zerow   row length string   def
   0 1 Encoding length 1 sub
    { /cindex exch def
      Encoding cindex get /.notdef ne
       { VDEBUG { Encoding cindex get == flush } if
         erasepage initgraphics
	 0 0 moveto currentpoint transform add
	 ( ) dup 0 cindex put show
	 currentpoint transform add exch sub round cvi
	   /cwidth exch abs def
	 rw rh devbbox
	 VDEBUG
	  { (image bbox: ) print 4 copy 4 2 roll 4 array astore == flush
	  } if
		% Save the device bounding box.
		% Note that this is in current device coordinates,
		% not PCL (right-handed) coordinates.
	 /bqx exch def  /bpx exch def  /bqy exch def  /bpy exch def
		% Re-render with the character justified to (0,0).
		% This may be either the lower left or the upper left corner.
	 bpx neg bpy neg idtransform moveto
	 erasepage
	 VDEBUG { (show point: ) print [ currentpoint transform ] == flush } if
	 ( ) dup 0 cindex put show
		% Find the bounding box.  Note that xmin and ymin are now 0,
		% xmax1 = xw, and ymax1 = yh.
	 rw rh devbbox
	   /xw exch def
		% xmin or ymin can be non-zero only if the character is blank.
	   xw 0 eq
	    { pop }
	    { dup 0 ne { (Non-zero xmin! ) print = } { pop } ifelse }
	   ifelse
	   /yh exch def
	   yh 0 eq
	    { pop }
	    { dup 0 ne { (Non-zero ymin! ) print = } { pop } ifelse }
	   ifelse

	 /xbw xw 7 add 8 idiv def
	 /xright raster 8 mul xw sub def
		% Write the Character Code command.
	 outfile (\033*c) writestring
	 outfile cindex write==only
	 outfile (E) writestring
	 	% Write the Character Definition command.
	 outfile (\033\(s) writestring
	 yh xbw mul 16 add
	 outfile exch write=only
		% Record the character position for the .PCM file.
	 /cfpos outfile fileposition 1 add def
	 outfile (W\004\000\016\001) writestring
	 orientation (Orientation) wbyte 0 (Reserved) wbyte
	 rminx bpx add r0x sub (Left Offset) wword
	 flipY { rminy bpy add neg } { rminy bqy add } ifelse r0y sub
	   (Top Offset) wword
	 xw (Character Width) wword
	 yh (Character Height) wword
	 cwidth orientation 2 ge { neg } if 4 mul (Delta X) wword
		% Write the character data.
	 flipY { 0 1 yh 1 sub } { yh 1 sub -1 0 } ifelse
	  { cdevice exch row copyscanlines
	    0 xbw getinterval
	    CDEBUG
	     { dup
	        { 8
		   { dup 128 ge { (+) } { (.) } ifelse print
		     127 and 1 bitshift
		   }
		  repeat pop
	        }
	       forall (\n) print
	     }
	    if
	    outfile exch writestring
	  }
	 for
       }
       { /bpx 0 def   /bpy 0 def   /bqx 0 def   /bqy 0 def
	 /cwidth 0 def
	 /cfpos 0 def
       }
      ifelse

    }
   for

	% Wrap up.

   upper setcachelimit
   outfile closefile

   nulldevice			% prevent page device switching
   saved end end end restore

 } def

% Provide definitions for testing with older or non-custom interpreters.

/.findzeros where { pop (%END) .skipeof } if
/.findzeros
 { userdict begin   /zs exch def   /zl zs length def
   0 { dup zl ge { exit } if dup zs exch get 0 ne { exit } if 1 add } loop
   zl { dup 0 eq { exit } if dup 1 sub zs exch get 0 ne { exit } if 1 sub } loop
   exch 3 bitshift exch 3 bitshift
   2 copy lt
    { exch zs 1 index -3 bitshift get
       { dup 16#80 and 0 ne { exit } if exch 1 add exch 1 bitshift } loop pop
      exch zs 1 index -3 bitshift 1 sub get
       { dup 1 and 0 ne { exit } if exch 1 sub exch -1 bitshift } loop pop
    }
   if end
 } bind def
%END

/write=only where { pop (%END) .skipeof } if
/w=s 128 string def
/write=only
 { w=s cvs writestring
 } bind def
%END

%**************** Test
/PCLTEST where {
  pop
  /DEBUG true def
  /CDEBUG true def
  /VDEBUG true def
  /Times-Roman findfont 10 scalefont setfont
  (t.pcf) (w) file
  300 72 div dup scale
  300 writePCL
  flush quit
} if