Acorn User 8/AU_CD8.iso/Utilities/!PSUtils/ps/getafmhd

Text File | 1997-01-24 | 6KB | 345 lines

% (c) 1993 by Robert Joop <[e-mail]>
% inspired by two other versions of this theme which are
%    getafm 1.00 (c) AJCD
% and getafm.ps by an unknown author,
%    modified by J. Daniel Smith <[e-mail]>

% Metrics dictionary code added by AJCD, 7/6/93

/getafmdict 100 dict dup begin

  /buf 256 string def
  /buf2 16 string def

  /prany    % dict dictname printname -> dict
  {
    2 index 2 index cvn known
    {
      print % printname
      ( ) print
      1 index exch cvn get =
    }
    {
      (Comment /FontInfo contains no /) print
      2 copy eq
      {
        = % printname
    pop % dictname
      }
      {
    exch
    print % dictname
    (, therefore no ) print
    = % printname
      }
      ifelse
    }
    ifelse
  }
  bind def

  /printfontname
  {
    (FontName)dup prany
  }
  bind def

  /printfontinfo
  {
    dup /FontInfo known
    {
      dup /FontInfo get
    (FullName)dup prany
    (FamilyName)dup prany
    (Weight)dup prany
    (ItalicAngle)dup prany
    (isFixedPitch)(IsFixedPitch) prany
    (UnderlinePosition)dup prany
    (UnderlineThickness)dup prany
    (Version)(version) prany
    (Notice)dup prany
      pop
    }
    {
      (Comment Font lacks a /FontInfo!)=
    }
    ifelse
  }
  bind def

  /prbbox % llx lly urx ury -> -
  {
    4 1 roll 3 1 roll exch % swap top 4 elements
    4 { ( ) print buf cvs print } repeat
  }
  bind def

  /getbbox % fontdict chardict character -> fontdict chardict llx lly urx ury
  {
    gsave
      2 index setfont 0 0 moveto
      false charpath flattenpath pathbbox
    grestore
  }
  bind def

  /printmiscinfo
  {
    dup /FontBBox known
    {
      (FontBBox) print
      dup /FontBBox get aload pop prbbox ()=
    }
    {
      (Comment missing required /FontBBox)=
      quit
    }
    ifelse
    2 copy exch get
      dup /H known
      1 index /x known and
      1 index /d known and
      1 index /p known and
      dup /looksRoman exch def
      {
    (CapHeight ) print
    (H) getbbox
    ceiling cvi = pop pop pop
    (XHeight ) print
    (x) getbbox
    ceiling cvi = pop pop pop
    (Ascender ) print
    (d) getbbox
    ceiling cvi = pop pop pop
    (Descender ) print
    (p) getbbox
    pop pop floor cvi = pop
      }
      {
    (Comment font doesn't contain H, x, d and p; therefore no CapHeight, XHeight, Ascender and Descender)=
      }
      ifelse
    pop
    dup /Encoding get
      [
    [ (ISOLatin1Encoding) /ISOLatin1Encoding ]
    [ (AdobeStandardEncoding) /StandardEncoding ]
      ]
      {
    aload pop dup where
    {
      exch get 2 index eq
      {
        (EncodingScheme ) print
        buf cvs =
      }
      {
        pop
      }
      ifelse
    }
    {
      pop pop
    }
    ifelse
      }
      forall
    pop
  }
  bind def

  /printcharmetric
  {
    % chardictname fontdict charnamedict encoding charindex charname

    4 index dup length dict dup begin exch
      {
    1 index /FID ne
    2 index /UniqueID ne
    and
    {
      1 index /Encoding eq { 256 array copy } if
      def
    }
    { pop pop }
    ifelse
      }
      forall
    end
    dup /Encoding get 32 3 index put
    /f2 exch definefont
    setfont

    (C ) print
    1 index buf cvs print

    ( ; WX ) print
% Metrics entries are:
%       1 number:               which is the character width
%       an array of 2 numbers:  which are the left sidebearing and width
%       an array of 4 numbers:  x & y left sidebearing, width and height
    dup 5 index         % /charname fontdict
    dup /Metrics known {
       /Metrics get exch 2 copy known {
          get dup type /arraytype eq {
             dup length 2 eq
             {1 get} {2 get} ifelse
          } if
          round cvi buf cvs print
       } {
          pop pop ( ) stringwidth pop round cvi buf cvs print
       } ifelse
    } {
       pop pop ( ) stringwidth pop round cvi buf cvs print
    } ifelse

    ( ; N ) print
    dup buf cvs print

    ( ; B) print
    gsave
      newpath 0 0 moveto
      ( ) true charpath flattenpath pathbbox
    grestore
    2 { ceiling cvi 4 1 roll } repeat
    2 { floor cvi 4 1 roll } repeat
    prbbox

    looksRoman
    {
      [
    [ /f [ /i /f /l ] ]
    [ /ff [ /i /l ] ]
      ]
      {
    aload pop 1 index 3 index eq
    {
      {
        1 index buf cvs
        length
        1 index buf2 cvs dup length
        2 index add
        buf
        4 2 roll putinterval
        buf 0
        3 -1 roll getinterval
        dup cvn
        7 index
        exch known
        {
          exch
          ( ; L ) print
          buf2 cvs print
          ( ) print
          print
        }
        {
          pop pop
        }
        ifelse
      }
      forall
      pop
    }
    {
      pop pop
    }
    ifelse
      }
      forall
    }
    if
    pop

    ( ;)=
  }
  bind def

  /printcharmetrics
  {
    (StartCharMetrics ) print
    2 copy exch get length 1 sub buf cvs =

    256 dict dup begin
      1 index /Encoding get
      { null def }
      forall
    end
    % chardictname fontdict charnamedict
    1 index /Encoding get
    0 1 255
    {
      % encoding index
      2 copy get
      dup /.notdef eq { pop } { printcharmetric } ifelse
      pop % index
    } for

    -1
    3 index 5 index get
    {
      pop
      dup /.notdef eq
      { pop }
      {
    % chardictname fontdict charnamedict encoding charindex charname
    dup 4 index exch known
    { pop }
    { printcharmetric }
    ifelse
      }
      ifelse
    }
    forall
    % charnamedict encoding index
    pop pop pop

    (EndCharMetrics)=
  }
  bind def

  /printfontmetrics
  {
    (StartFontMetrics 3.0)=
    (Comment Produced by getafm 3.0 (which is by [e-mail]))=

    printfontname
    printfontinfo
    printmiscinfo
    printcharmetrics

    (EndFontMetrics)=
  }
  bind def

end def

/getafm
{
  getafmdict begin
    save exch
      findfont 1000 scalefont

      null
      [ /CharDefs /CharData /CharProcs /CharStrings ]
      {
    2 index 1 index known { exch } if
    pop
      }
      forall
      dup null eq
      {
    (can't find dictionary with character data!)=
    quit
      }
      if
      exch % dictname fontdict

      printfontmetrics

      pop pop
    restore
  end
}
bind def