sys/lib/ghostscript/font2pcl.ps

   1 %    Copyright (C) 1993, 1994, 1995, 1997 Aladdin Enterprises.  All rights reserved.
   2 %
   3 % This software is provided AS-IS with no warranty, either express or
   4 % implied.
   5 %
   6 % This software is distributed under license and may not be copied,
   7 % modified or distributed except as expressly authorized under the terms
   8 % of the license contained in the file LICENSE in this distribution.
   9 %
  10 % For more information about licensing, please refer to
  11 % http://www.ghostscript.com/licensing/. For information on
  12 % commercial licensing, go to http://www.artifex.com/licensing/ or
  13 % contact Artifex Software, Inc., 101 Lucas Valley Road #110,
  14 % San Rafael, CA  94903, U.S.A., +1(415)492-9861.
  15
  16 % $Id: font2pcl.ps,v 1.5 2002/06/02 12:03:28 mpsuzuki Exp $
  17 % font2pcl.ps
  18 % Write out a font as a PCL bitmap font.
  19
  20 /pcldict 60 dict def
  21
  22 % Write out the current font as a PCL bitmap font.
  23 % The current transformation matrix defines the font size and orientation.
  24
  25 /WriteResolution? false def     % true=use "resolution bound font" format,
  26                                 % false=use older format
  27
  28 /LJ4 false def                  % true=use LJ4 Typeface code
  29                                 % false=use LJIIP/IID/IIIx Typeface code
  30
  31 pcldict begin           % internal procedures
  32
  33 /findstring     % <string> <substring> findstring <bool>
  34  { search { pop pop pop true } { pop false } ifelse
  35  } def
  36
  37         % Determine which set of keywords is present in a string.
  38         % The last keyword set must be empty.
  39
  40 /keysearch      % <string> <array of arrays of keywords> keysearch <index>
  41  { 0 1 2 index length 1 sub
  42     { 2 copy get true exch
  43        {        % Stack: <string> <a.a.k.> <index> <bool> <keyword>
  44          4 index exch findstring and
  45        }
  46       forall
  47        { 0 exch getinterval exit
  48        }
  49       if pop
  50     }
  51    for
  52    exch pop length      % invalid index if missing
  53  } def
  54
  55         % Determine the device height of a string in quarter-dots.
  56
  57 /charheight             % <string> charheight <int>
  58  { gsave newpath 0 0 moveto false charpath
  59    pathbbox exch pop exch sub exch pop 0 exch grestore
  60    dtransform add abs 4 mul cvi
  61  } def
  62
  63         % Compute an integer version of the transformed FontBBox.
  64
  65 /inflate                % <num> inflate <num>
  66  { dup 0 gt { ceiling } { floor } ifelse
  67  } def
  68 /ixbbox                 % - ixbbox <llx> <lly> <urx> <ury>
  69  { /FontBBox load aload pop             % might be executable or literal
  70    4 2 roll transform exch truncate cvi exch truncate cvi
  71    4 2 roll transform exch inflate cvi exch inflate cvi
  72  } def
  73
  74         % Determine the original font of a possibly transformed font.
  75         % Since some badly behaved PostScript files construct transformed
  76         % fonts "by hand", we can't just rely on the OrigFont pointers.
  77         % Instead, if a font with the given name exists, and if its
  78         % entries for FontType and UniqueID match those of the font we
  79         % obtain by following the OrigFont chain, we use that font.
  80
  81 /origfont
  82  {  { dup /OrigFont known not { exit } if /OrigFont get } loop
  83    FontDirectory 1 index /FontName get .knownget
  84     {           % Stack: origfont namedfont
  85       1 index /FontType get 1 index /FontType get eq
  86        { 1 index /UniqueID .knownget
  87           { 1 index /UniqueID .knownget
  88              { eq { exch } if }
  89              { pop }
  90             ifelse
  91           }
  92          if
  93        }
  94       if pop
  95     }
  96    if
  97  } def
  98
  99
 100         % Determine the bounding box of the current device's image.
 101         % Free variables: row, zerow.
 102
 103 /devbbox                % <rw> <rh> devbbox <ymin> <ymax1> <xmin> <xmax1>
 104  {              % Find top and bottom whitespace.
 105    dup
 106     { dup 0 eq { exit } if 1 sub
 107       dup currentdevice exch row copyscanlines
 108       zerow ne { 1 add exit } if
 109     }
 110    loop         % ymax1
 111    0
 112     { 2 copy eq { exit } if
 113       dup currentdevice exch row copyscanlines
 114       zerow ne { exit } if
 115       1 add
 116     }
 117    loop         % ymin
 118    exch
 119                 % Find left and right whitespace.
 120    3 index 0
 121                 % Stack: rw rh ymin ymax1 xmin xmax1
 122    3 index 1 4 index 1 sub
 123     { currentdevice exch row copyscanlines .findzeros
 124       exch 4 1 roll .max 3 1 roll .min exch
 125     }
 126    for          % xmin xmax1
 127                 % Special check: xmin > xmax1 if height = 0
 128    2 copy gt { exch pop dup } if
 129    6 -2 roll pop pop
 130
 131  } def
 132
 133         % Write values on outfile.
 134
 135  /w1 { 255 and outfile exch write } def
 136  /w2 { dup -8 bitshift w1 w1 } def
 137  /wbyte                 % <byte> <label> wbyte
 138   { VDEBUG { print ( =byte= ) print dup == flush } { pop } ifelse w1
 139   } def
 140  /wword                 % <word16> <label> wword
 141   { VDEBUG { print ( =word= ) print dup == flush } { pop } ifelse w2
 142   } def
 143  /wdword                % <word32> <label> wdword
 144   { VDEBUG { print ( =dword= ) print dup == flush } { pop } ifelse
 145     dup -16 bitshift w2 w2
 146   } def
 147
 148 /style.posture.keys
 149  [ { (Italic) } { (Oblique) }
 150    { }
 151  ] def
 152 /style.posture.values <010100> def
 153
 154 /style.appearance.width.keys
 155  [ { (Ultra) (Compressed) }
 156    { (Extra) (Compressed) }
 157    { (Extra) (Condensed) }
 158    { (Extra) (Extended) }
 159    { (Extra) (Expanded) }
 160    { (Compressed) }
 161    { (Condensed) }
 162    { (Extended) }
 163    { (Expanded) }
 164    { }
 165  ] def
 166 /style.appearance.width.values <04030207070201060600> def
 167
 168 /width.type.keys
 169  [ { (Ultra) (Compressed) }
 170    { (Extra) (Compressed) }
 171    { (Extra) (Condensed) }
 172    { (Extra) (Expanded) }
 173    { (Compressed) }
 174    { (Condensed) }
 175    { (Expanded) }
 176    { }
 177  ] def
 178 /width.type.values <fbfcfd03fdfe0200> def
 179
 180 /stroke.weight.keys
 181  [ { (Ultra) (Thin) }
 182    { (Ultra) (Black) }
 183    { (Extra) (Thin) }
 184    { (Extra) (Light) }
 185    { (Extra) (Bold) }
 186    { (Extra) (Black) }
 187    { (Demi) (Light) }
 188    { (Demi) (Bold) }
 189    { (Semi) (Light) }
 190    { (Semi) (Bold) }
 191    { (Thin) }
 192    { (Light) }
 193    { (Bold) }
 194    { (Black) }
 195    { }
 196  ] def
 197 /stroke.weight.values <f907fafc0406fe02ff01fbfd030500> def
 198
 199 /vendor.keys
 200  [ { (Agfa) }
 201    { (Bitstream) }
 202    { (Linotype) }
 203    { (Monotype) }
 204    { (Adobe) }
 205    { }
 206  ] def
 207 /vendor.default.index 4 def             % might as well be Adobe
 208 /old.vendor.values <020406080a00> def
 209 /new.vendor.values <010203040500> def
 210 /vendor.initials (CBLMA\000) def
 211
 212 currentdict readonly end pop            % pcldict
 213
 214
 215 % Convert and write a PCL font for the current font and transformation.
 216
 217 % Write the font header.  We split this off only to avoid overflowing
 218 % the limit on the maximum size of a procedure.
 219 % Free variables: outfile uury u0y rw rh orientation uh ully
 220 /writefontheader
 221  { outfile (\033\)s) writestring
 222    outfile 64 WriteResolution? { 4 add } if
 223      Copyright length add write==only
 224    outfile (W) writestring
 225    WriteResolution? { 20 68 } { 0 64 } ifelse
 226      (Font Descriptor Size) wword
 227      (Header Format) wbyte
 228    1 (Font Type) wbyte
 229    FullName style.posture.keys keysearch style.posture.values exch get
 230    FullName style.appearance.width.keys keysearch
 231      style.appearance.width.values exch get 4 mul add
 232    PaintType 2 eq { 32 add } if
 233      /style exch def
 234    style -8 bitshift (Style MSB) wbyte
 235    0 (Reserved) wbyte
 236    /baseline uury 1 sub u0y sub def
 237      baseline (Baseline Position) wword
 238    rw (Cell Width) wword
 239    rh (Cell Height) wword
 240    orientation (Orientation) wbyte
 241    FontInfo /isFixedPitch .knownget not { false } if
 242     { 0 } { 1 } ifelse (Spacing) wbyte
 243         % Use loop/exit to fake a multiple-exit block.
 244     { Encoding StandardEncoding eq { 10 (J) exit } if
 245       Encoding ISOLatin1Encoding eq { 11 (J) exit } if
 246       Encoding SymbolEncoding eq { 19 (M) exit } if
 247       Encoding DingbatsEncoding eq { 10 (L) exit } if
 248 %      (Warning: unknown Encoding, using ISOLatin1.\n) print flush
 249       11 (J) exit
 250     }
 251    loop
 252    0 get 64 sub exch 32 mul add (Symbol Set) wword
 253    ( ) stringwidth pop 0 dtransform add abs 4 mul
 254      /pitch exch def
 255    pitch cvi (Pitch) wword
 256    uh 4 mul (Height) wword                      % Height
 257    (x) charheight (x-Height) wword
 258    FullName width.type.keys keysearch
 259      width.type.values exch get (Width Type) wbyte
 260    style 255 and (Style LSB) wbyte
 261    FullName stroke.weight.keys keysearch
 262      stroke.weight.values exch get (Stroke Weight) wbyte
 263    FullName vendor.keys keysearch
 264      dup vendor.initials exch get 0 eq
 265       {         % No vendor in FullName, try Notice
 266         pop Copyright vendor.keys keysearch
 267         dup vendor.initials exch get 0 eq { pop vendor.default.index } if
 268       }
 269      if
 270      /vendor.index exch def
 271    0 (Typeface LSB) wbyte               % punt
 272    0 (Typeface MSB) wbyte               % punt
 273    0 (Serif Style) wbyte                % punt
 274    2 (Quality) wbyte
 275    0 (Placement) wbyte
 276    gsave FontMatrix concat rot neg rotate
 277    /ulwidth
 278      FontInfo /UnderlineThickness .knownget
 279       { 0 exch dtransform exch pop abs }
 280       { resolution 100 div }
 281      ifelse def
 282    FontInfo /UnderlinePosition .knownget
 283     { 0 exch transform exch pop negY ulwidth 2 div add }
 284     { ully ulwidth add }
 285    ifelse u0y sub
 286    round cvi 1 .max 255 .min (Underline Position) wbyte
 287    ulwidth round cvi 1 .max 255 .min (Underline Thickness) wbyte
 288    grestore
 289    uh 1.2 mul 4 mul cvi (Text Height) wword
 290    (average lowercase character) dup stringwidth
 291      pop 0 dtransform add abs
 292      exch length div 4 mul cvi (Text Width) wword
 293    0
 294     { dup Encoding exch get /.notdef ne { exit } if
 295       1 add
 296     }
 297    loop (First Code) wword
 298    255
 299     { dup Encoding exch get /.notdef ne { exit } if
 300       1 sub
 301     }
 302    loop (Last Code) wword
 303    pitch dup cvi sub 256 mul cvi (Pitch Extended) wbyte
 304    0 (Height Extended) wbyte
 305    0 (Cap Height) wword                 % (default)
 306    currentfont /UniqueID known { UniqueID } { 0 } ifelse
 307      16#c1000000 add (Font Number (Adobe UniqueID)) wdword
 308    FontName length 16 .max string
 309      dup FontName exch cvs pop
 310      outfile exch 0 16 getinterval writestring  % Font Name
 311    WriteResolution?
 312     { resolution dup (X Resolution) wword (Y Resolution) wword
 313     }
 314    if
 315    outfile Copyright writestring        % Copyright
 316  } def
 317
 318 /writePCL               % <fontfile> <resolution> writePCL -
 319  {
 320    save
 321    currentfont begin
 322    pcldict begin
 323    80 dict begin                % allow for recursion
 324      /saved exch def
 325      /resolution exch def
 326      /outfile exch def
 327    matrix currentmatrix dup 4 0 put dup 5 0 put setmatrix
 328
 329         % Supply some default values so we don't have to check later.
 330
 331    currentfont /FontInfo known not { /FontInfo 1 dict def } if
 332    currentfont /FontName known not { /FontName () def } if
 333    /Copyright   FontInfo /Notice .knownget not { () } if   def
 334    /FullName
 335      FontInfo /FullName .knownget not
 336       { FontName dup length string cvs }
 337      if def
 338
 339         % Determine the original font, and its relationship to this one.
 340
 341    /OrigFont currentfont origfont def
 342    /OrigMatrix OrigFont /FontMatrix get def
 343    /OrigMatrixInverse OrigMatrix matrix invertmatrix def
 344    /ScaleMatrix matrix currentfont OrigFont ne
 345     { FontMatrix exch OrigMatrixInverse exch concatmatrix
 346     } if
 347    def
 348    /CurrentScaleMatrix
 349      matrix currentmatrix
 350      matrix defaultmatrix
 351      dup 0 get 1 index 3 get mul 0 lt
 352      1 index dup 1 get exch 2 get mul 0 gt or
 353        /flipY exch def
 354      dup invertmatrix
 355      dup concatmatrix
 356    def
 357    /negY flipY { {neg} } { {} } ifelse def
 358
 359         % Print debugging information.
 360
 361    /CDEBUG where { pop } { /CDEBUG false def } ifelse
 362    /VDEBUG where { pop } { /VDEBUG false def } ifelse
 363    CDEBUG { /VDEBUG true def } if
 364    DEBUG
 365     { (currentmatrix: ) print matrix currentmatrix ==
 366       (defaultmatrix: ) print matrix defaultmatrix ==
 367       (flipY: ) print flipY ==
 368       (scaling matrix: ) print CurrentScaleMatrix ==
 369       (FontMatrix: ) print FontMatrix ==
 370       (FontBBox: ) print /FontBBox load ==
 371       currentfont OrigFont ne
 372        { OrigFont /FontName .knownget { (orig FontName: ) print == } if
 373          (orig FontMatrix: ) print OrigMatrix ==
 374        } if
 375       currentfont /ScaleMatrix .knownget { (ScaleMatrix: ) print == } if
 376       gsave
 377         FontMatrix concat
 378         (combined matrix: ) print matrix currentmatrix ==
 379       grestore
 380       flush
 381     } if
 382
 383         % Determine the orientation.
 384
 385    ScaleMatrix matrix currentmatrix dup concatmatrix
 386    0 1 3
 387     { 1 index 1 get 0 eq 2 index 2 get 0 eq and 2 index 0 get 0 gt and
 388        { exit } if
 389       pop -90 matrix rotate exch dup concatmatrix
 390     }
 391    for
 392    dup type /integertype ne
 393     { (Only rotations by multiples of 90 degrees are supported:\n) print
 394       == flush
 395       saved end end end restore stop
 396     }
 397    if
 398    /orientation exch def
 399    /rot orientation 90 mul def
 400    DEBUG { (orientation: ) print orientation == flush } if
 401
 402    dup dup 0 get exch 3 get negY sub abs 0.5 ge
 403     { (Only identical scaling in X and Y is supported:\n) print
 404       exch flipY 3 array astore ==
 405       currentdevice .devicename ==
 406       matrix defaultmatrix == flush
 407       saved end end end restore stop
 408     }
 409    if pop
 410
 411         % Determine the font metrics, in the PCL character coordinate system,
 412         % which has +Y going towards the top of the page.
 413
 414    gsave
 415    FontMatrix concat
 416      0 0 transform
 417      negY round cvi /r0y exch def
 418      round cvi /r0x exch def
 419    ixbbox
 420      negY /rury exch def  /rurx exch def
 421      negY /rlly exch def  /rllx exch def
 422      /rminx rllx rurx .min def
 423      /rminy rlly negY rury negY .min def
 424      /rw rurx rllx sub abs def
 425      /rh rury rlly sub abs def
 426    gsave rot neg rotate
 427      0 0 transform
 428      negY round cvi /u0y exch def
 429      round cvi /u0x exch def
 430    ixbbox
 431      negY /uury exch def   /uurx exch def
 432      negY /ully exch def   /ullx exch def
 433      /uw uurx ullx sub def
 434      /uh uury ully sub def
 435    grestore
 436    DEBUG
 437     { (rmatrix: ) print matrix currentmatrix ==
 438       (rFontBBox: ) print [rllx rlly rurx rury] ==
 439       (uFontBBox: ) print [ullx ully uurx uury] ==
 440       flush
 441     } if
 442    grestore
 443
 444         % Disable the character cache, to avoid excessive allocation
 445         % and memory sandbars.
 446
 447    mark cachestatus   /upper exch def
 448    cleartomark 0 setcachelimit
 449
 450         % Write the font header.
 451
 452    writefontheader
 453
 454         % Establish an image device for rasterizing characters.
 455
 456    matrix currentmatrix
 457      dup 4 rminx neg put
 458      dup 5 rminy neg put
 459         % Round the width up to a multiple of 8
 460         % so we don't get garbage bits in the last byte of each row.
 461    rw 7 add -8 and rh <ff 00> makeimagedevice
 462      /cdevice exch def
 463    nulldevice                   % prevent page device switching
 464    cdevice setdevice
 465
 466         % Rasterize each character in turn.
 467
 468    /raster   rw 7 add 8 idiv   def
 469    /row   raster string   def
 470    /zerow   row length string   def
 471    0 1 Encoding length 1 sub
 472     { /cindex exch def
 473       Encoding cindex get /.notdef ne
 474        { VDEBUG { Encoding cindex get == flush } if
 475          erasepage initgraphics
 476          0 0 moveto currentpoint transform add
 477          ( ) dup 0 cindex put show
 478          currentpoint transform add exch sub round cvi
 479            /cwidth exch abs def
 480          rw rh devbbox
 481          VDEBUG
 482           { (image bbox: ) print 4 copy 4 2 roll 4 array astore == flush
 483           } if
 484                 % Save the device bounding box.
 485                 % Note that this is in current device coordinates,
 486                 % not PCL (right-handed) coordinates.
 487          /bqx exch def  /bpx exch def  /bqy exch def  /bpy exch def
 488                 % Re-render with the character justified to (0,0).
 489                 % This may be either the lower left or the upper left corner.
 490          bpx neg bpy neg idtransform moveto
 491          erasepage
 492          VDEBUG { (show point: ) print [ currentpoint transform ] == flush } if
 493          ( ) dup 0 cindex put show
 494                 % Find the bounding box.  Note that xmin and ymin are now 0,
 495                 % xmax1 = xw, and ymax1 = yh.
 496          rw rh devbbox
 497            /xw exch def
 498                 % xmin or ymin can be non-zero only if the character is blank.
 499            xw 0 eq
 500             { pop }
 501             { dup 0 ne { (Non-zero xmin! ) print = } { pop } ifelse }
 502            ifelse
 503            /yh exch def
 504            yh 0 eq
 505             { pop }
 506             { dup 0 ne { (Non-zero ymin! ) print = } { pop } ifelse }
 507            ifelse
 508
 509          /xbw xw 7 add 8 idiv def
 510          /xright raster 8 mul xw sub def
 511                 % Write the Character Code command.
 512          outfile (\033*c) writestring
 513          outfile cindex write==only
 514          outfile (E) writestring
 515                 % Write the Character Definition command.
 516          outfile (\033\(s) writestring
 517          yh xbw mul 16 add
 518          outfile exch write=only
 519                 % Record the character position for the .PCM file.
 520          /cfpos outfile fileposition 1 add def
 521          outfile (W\004\000\016\001) writestring
 522          orientation (Orientation) wbyte 0 (Reserved) wbyte
 523          rminx bpx add r0x sub (Left Offset) wword
 524          flipY { rminy bpy add neg } { rminy bqy add } ifelse r0y sub
 525            (Top Offset) wword
 526          xw (Character Width) wword
 527          yh (Character Height) wword
 528          cwidth orientation 2 ge { neg } if 4 mul (Delta X) wword
 529                 % Write the character data.
 530          flipY { 0 1 yh 1 sub } { yh 1 sub -1 0 } ifelse
 531           { cdevice exch row copyscanlines
 532             0 xbw getinterval
 533             CDEBUG
 534              { dup
 535                 { 8
 536                    { dup 128 ge { (+) } { (.) } ifelse print
 537                      127 and 1 bitshift
 538                    }
 539                   repeat pop
 540                 }
 541                forall (\n) print
 542              }
 543             if
 544             outfile exch writestring
 545           }
 546          for
 547        }
 548        { /bpx 0 def   /bpy 0 def   /bqx 0 def   /bqy 0 def
 549          /cwidth 0 def
 550          /cfpos 0 def
 551        }
 552       ifelse
 553
 554     }
 555    for
 556
 557         % Wrap up.
 558
 559    upper setcachelimit
 560    outfile closefile
 561
 562    nulldevice                   % prevent page device switching
 563    saved end end end restore
 564
 565  } def
 566
 567 % Provide definitions for testing with older or non-custom interpreters.
 568
 569 /.findzeros where { pop (%END) .skipeof } if
 570 /.findzeros
 571  { userdict begin   /zs exch def   /zl zs length def
 572    0 { dup zl ge { exit } if dup zs exch get 0 ne { exit } if 1 add } loop
 573    zl { dup 0 eq { exit } if dup 1 sub zs exch get 0 ne { exit } if 1 sub } loop
 574    exch 3 bitshift exch 3 bitshift
 575    2 copy lt
 576     { exch zs 1 index -3 bitshift get
 577        { dup 16#80 and 0 ne { exit } if exch 1 add exch 1 bitshift } loop pop
 578       exch zs 1 index -3 bitshift 1 sub get
 579        { dup 1 and 0 ne { exit } if exch 1 sub exch -1 bitshift } loop pop
 580     }
 581    if end
 582  } bind def
 583 %END
 584
 585 /write=only where { pop (%END) .skipeof } if
 586 /w=s 128 string def
 587 /write=only
 588  { w=s cvs writestring
 589  } bind def
 590 %END
 591
 592 %**************** Test
 593 /PCLTEST where {
 594   pop
 595   /DEBUG true def
 596   /CDEBUG true def
 597   /VDEBUG true def
 598   /Times-Roman findfont 10 scalefont setfont
 599   (t.pcf) (w) file
 600   300 72 div dup scale
 601   300 writePCL
 602   flush quit
 603 } if