🚀 go-pugleaf

I posted a program to make fonttables 23 Sep 92.
Some people have asked how to show the characters that are NOT in the
encoding. So I have produced a program that can do that.

This time I put it inside a selfcontained shellscript that works for UNIX
but if you strip all before %! and after FLUFFSTOPPER it is a simple
PostScript file again.

The fonttable procedure still takes a (maybe reencoded) font and a notestring
as argument. But also three booleans that decide whether the program should
do a fonttable, and/or a character list, and whether the character list
(if any) only should contain unencoded characters.
If both table and list is wanted, the program tries to fit both on the same
page.

Does it sound complicated? Just save it to a file. Execute it, and try the
three examples the program suggests.

Note for GhostScript: The character list is constructed by dynamically
encoding the (unencoded) characters into .notdef entries. If not enough
such entries exist for all characters, they will be reused.
But the cache-mechanism in GhostScript ignores dynamic encoding-changes
(known ghostscript bug), so the output will start to repeat itself when
the .notdef entries all are used. But it is possible to use the ghostscript
option -dNOCACHE for a slower but correct output.

-----------------------------cut here----------------------------------------
#!/bin/sh
# fonttable, a UNIX script for PostScript font tables.
# The resulting PostScript fonttable program is listed on stdout.

case "$1"x in
  x|-hx) echo "$0 outputs a postscript file that displays the characters of a font."
     echo "USAGE: $0 font [encoding] [comment] [table:y/n] [list:y/n] [encoded:y/n]"
     echo "(Default is yes yes yes)"
     echo
     echo "example: send a listing of all characters in Courier to printer:"
     echo "  $0 Courier Standard '' n y n | lpr"
     echo "example: do an ISOLatin1 Helvetica fonttable. Show with GhostScript:"
     echo "  $0 Helvetica ISOLatin1 ISO8859/1 >! /tmp/qq; gs /tmp/qq"
     echo "example: ISOLatin1 Helvetica fonttable without list of unencoded characters:"
     echo "  $0 Helvetica ISOLatin1 ISO8859/1 y n | lpr"
     echo
     echo "Encodings: Standard ISOLatin1 ISOLatin2"
  exit 0;;
  *) font=$1
esac
cat $font.ps 2>/dev/null
#cat tablefont.ps 2>/dev/null
cat << FLUFFSTOPPER
%!PS-Adobe-2.0
%%Title: fonttable.ps
%%Creator: fred@nada.kth.se
%%CreationDate:	23 Sep 1992
%%EndComments

% This program prints the 16x16 encoding table of a font.
% The character names in the encoding vector are also included.
% It can also make list all characters in the font.
% To work it must find defined characters names in a dictionary with
% a name found in CharDictNames.
%
% This program is in the public domain.
%
% The different encodings are not necessary and can be removed.

/mm { 72 25.4 div mul } bind def
/cellx 11 mm def      % x-size of character cell.
/celly 13 mm def      % y-size of character cell.
/notdefgray 0.96 def  % grayshade for undefined char.

% Fonts used
/TR /Times-Roman findfont def
/TB /Times-Bold findfont def	% for title
/TI /Times-Italic findfont def	% for hex and oct
/TRS TR cellx 0.15 mul scalefont def	% small font for character names

% Names to look for a CharNames-dict in fonts.
/CharDictNames [ /CharStrings/CharDefs/CharProcs/CharData ] def

% General reencode procedure
/reencode { % Encodingvector font /newname reencode -> font
  exch dup maxlength dict dup begin
    exch { 1 index /FID ne { def } { pop pop } ifelse } forall
    /Encoding 4 -1 roll def
  end definefont
} def

/ISOLatin1 [
/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
/.notdef/.notdef/.notdef/.notdef/.notdef/space/exclam/quotedbl/numbersign
/dollar/percent/ampersand/quoteright/parenleft/parenright/asterisk/plus
/comma/hyphen/period/slash/zero/one/two/three/four/five/six/seven/eight/nine
/colon/semicolon/less/equal/greater/question/at/A/B/C/D/E/F/G/H/I/J/K/L/M/N
/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash/bracketright/asciicircum
/underscore/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q/r/s/t/u/v/w/x/y/z
/braceleft/bar/braceright/asciitilde/.notdef/.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
/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/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/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 ] def

/ISOLatin2 [
% ? Uring or Udotaccent, Jmacron ?
/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
/.notdef/.notdef/.notdef/.notdef/.notdef/space/exclam/quotedbl/numbersign
/dollar/percent/ampersand/quoteright/parenleft/parenright/asterisk/plus
/comma/hyphen/period/slash/zero/one/two/three/four/five/six/seven/eight/nine
/colon/semicolon/less/equal/greater/question/at/A/B/C/D/E/F/G/H/I/J/K/L/M/N
/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash/bracketright/asciicircum
/underscore/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q/r/s/t/u/v/w/x/y/z
/braceleft/bar/braceright/asciitilde/.notdef/.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
/space/Lacute/ogonek/Lslash/currency/Lcaron/Sacute/section/dieresis/Scaron
/Scedilla/Tcaron/Zacute/hyphen/Zcaron/Zdotaccent/degree/lacute/breve/lslash
/acute/lcaron/sacute/caron/cedilla/scaron/scedilla/tcaron/zacute/dotaccent
/zcaron/zdotaccent/Agrave/Aacute/Acircumflex/Abreve/Adieresis/Aogonek/Cacute
/Ccedilla/Ccaron/Eacute/Eogonek/Edieresis/Ecaron/Iacute/Icircumflex/Dcaron
/Eth/Nacute/Ncaron/Oacute/Ocircumflex/Ohungarumlaut/Odieresis/Racute/Rcaron
/Uring/Uacute/Uhungarumlaut/Udieresis/Yacute/Jmacron/germandbls/agrave/aacute
/acircumflex/abreve/adieresis/aogonek/cacute/ccedilla/ccaron/eacute/eogonek
/edieresis/ecaron/iacute/icircumflex/dcaron/dbar/nacute/ncaron/oacute
/ocircumflex/ohungarumlaut/odieresis/racute/rcaron/udotaccent/uacute
/uhungarumlaut/udieresis/yacute/tcedilla/hungarumlaut ] def

/Standard /StandardEncoding load def

/rope 50 string def

% center string around current position
/center { % string center ->
  gsave dup stringwidth pop -0.5 mul 0 rmoveto show grestore
} bind def

/onecell {
%  dup =
  dup fencoding exch get dup /.notdef eq
    { pop pop /notdef true def
      gsave cellx 0 rlineto 0 celly rlineto cellx neg 0 rlineto
      closepath notdefgray setgray fill grestore }
    { gsave cellx 0.5 mul celly cellx 0.16 mul sub rmoveto
      TRS setfont rope cvs center
% for decimal code in lower left cell corner uncomment next line
%      grestore gsave TRS setfont 1 mm 1 mm rmoveto dup rope cvs show
% for char 33-126 in lower left cell corner uncomment next two lines
%      dup 33 ge 1 index 126 le and { grestore gsave TRS setfont 1 mm 1 mm
%        rmoveto ( ) dup 0 3 index put show } if
      ( ) dup 0 4 -1 roll put grestore
      gsave cellx 0.5 mul yup rmoveto center grestore }
   ifelse
} bind def

% print a column of the encoding
/column { % colnumber column ->
  dup cellx mul 16celly celly sub moveto
  16 mul 1 1 index 15 add {
     onecell 0 celly neg rmoveto
  } for
} bind def

/doheader {
  0 17celly celly 0.7 mul add moveto
  gsave TB fsize scalefont setfont (Font: ) show currentpoint grestore moveto
  TR fsize scalefont setfont fontname show 
  17cellx currentpoint exch pop moveto
  notestring dup stringwidth pop neg 0 rmoveto show
%  uncomment next three line and comment above for grapheme-count in list
%  TR celly 0.5 mul scalefont setfont
%  C length 1 sub % namesarray length
%  rope cvs dup stringwidth pop
%  ( graphemes) dup stringwidth pop 3 -1 roll add neg 0 rmoveto exch show show
} def

% shellsort: sort an array in alphabetic order
/shellsort { % array shellsort -> array
  local begin
  /Array exch def /len Array length def
  len 0 ne {
    /step 1 len ln 2 ln div cvi bitshift 1 sub def
    { 0 1 len step sub 1 sub
      { /ix exch def /flg true def
        { flg ix 0 ge and not { exit } if
          Array ix get
          Array ix step add get dup
          cmp1 cvs 2 index cmp2 cvs lt
            { Array exch ix exch put
              Array exch ix step add exch put
              /ix ix step sub def }
            { pop pop /flg false def }
          ifelse
        } loop
      } for
      step 2 idiv dup 0 eq { pop exit } if
      /step exch def
    } loop
  } if
  Array end
} dup 0 7 dict dup begin % dict for local variables
  /cmp1 50 string def
  /cmp2 50 string def
end put def % shellsort

/makenamelist { % makenamelist -> array
  /C null def
  /fencoding fencoding dup length array copy def
  CharDictNames {
    dup currentfont exch known
      { currentfont exch get /C exch def exit } { pop } ifelse
  } forall
  C type /dicttype eq {
    [
      /Encodingdict fencoding length dict dup begin
        fencoding { null def } forall
      end def
      C { pop
        unonlylist { dup Encodingdict exch known { pop } if } if
        dup /.notdef eq { pop } if
      } forall
    ] shellsort
    dup length 0 eq { (No unencoded.\n) print } if
  }
  { [] (No CharDefs.\n) print }
  ifelse
} def

/showlist {
  /listarray exch def
  fencoding currentfont rand reencode setfont
  /p -1 def
  /l -1 def
  /first true def
  0 1 listarray length 1 sub {
    /p p 1 add def
    p 256 eq { /p 0 def } if
    dup 17 mod 0 eq {
      /l l 1 add def
      l 17 mod 0 eq {
        first not { gsave showpage grestore } if
        extrapage {
          gsave doheader
          0 17celly 3 mm add moveto TR celly 0.33 mul scalefont setfont
          unonlylist {
            (The following characters are not present in the encoding.) show
          } if
          grestore
          0 17celly moveto
        } { gsave 17cellx 17celly 3 mm add moveto
            TR celly 0.33 mul scalefont setfont
            (Characters below the table are not present in the encoding.) dup
            stringwidth pop neg 0 rmoveto show grestore
            0 -2 mm moveto
        } ifelse
        /first false def
      } if
      0 currentpoint exch pop moveto 0 celly neg rmoveto
    } if
    { fencoding p get /.notdef ne
        { /p p 1 add def p 256 eq { /p 0 def exit } if }
        { exit }
      ifelse
    } loop
%    p =
    /prev fencoding p get def
    fencoding p listarray 4 -1 roll get put
    p onecell
    gsave cellx 0 rlineto 0 celly rlineto cellx neg 0 rlineto closepath
    0 setlinewidth stroke grestore
    cellx 0 rmoveto
    fencoding p /prev load put
  } for
} def

% make a table
/fonttable { % font notestring dotable dolist unonlylist fonttable ->
  /unonlylist exch def
  /dolist exch def
  /dotable exch def
  /notestring exch def
  /zeiv save def
    /fsize celly 0.6 mul def
    /16cellx 16 cellx mul def
    /16celly 16 celly mul def  
    /17cellx 16cellx cellx add def
    /17celly 16celly celly add def
    fsize scalefont setfont
    /fontname currentfont /FontName known {
      currentfont /FontName get dup type /stringtype ne { 100 string cvs } if
    } { () } ifelse def
    /fencoding currentfont /Encoding get cvlit def
    dolist {
       /namesarray makenamelist def
       namesarray length 0 eq { /dolist false def } if
       /listlines namesarray length 17 div 0.5 add round def
%       (Listlines: ) print listlines =
    } if
    clippath pathbbox newpath /ytop exch def pop /ybot exch def pop
    15 mm ytop ybot add 0.5 mul translate
    /extrapage dotable not def
    dolist dotable and {
      /fitlines ytop ybot sub 10 mm sub celly 18.3 mul sub celly div cvi def
%      (Fitlines: ) print fitlines =
      fitlines listlines ge
        { 18.3 listlines add celly mul 2 mm add -0.5 mul
          listlines celly mul add 5 mm add 0 exch translate
%   (Page:) print ytop ybot sub =
%   (Remains:) print ytop ybot sub 18 listlines add celly mul 2 mm add sub dup =
%   (Half:) print 2 div = flush
        }
        { /extrapage true def 0 celly -9.1 mul translate } % ej rum: c 18
      ifelse
    } { 0 celly -9.1 mul translate } ifelse
    /yup fsize 0.3 mul def
    dotable {
      /notdef false def
      cellx 0 translate
      0 1 15 { column } for
      0 0 moveto 0 16celly rlineto 16cellx 0 rlineto 0 16celly neg rlineto
      closepath 2 setlinewidth stroke
      cellx neg 0 translate
      0 1 17 { celly mul 0 exch moveto 17cellx 0 rlineto } for
      0 1 17 { cellx mul 0 moveto 0 17celly rlineto } for
      0 setlinewidth stroke
      gsave
        TI fsize 0.9 mul scalefont setfont
        cellx 2 div 16celly celly sub yup add moveto
        (0123456789ABCDEF)
          { ( ) dup 0 4 -1 roll put center 0 celly neg rmoveto } forall
        cellx 2 div 16celly fsize 0.2 mul add moveto (hex) center
        cellx 0 rmoveto
        (0123456789ABCDEF)
          { ( x) dup 0 4 -1 roll put center cellx 0 rmoveto } forall
        cellx 2 div 16celly celly sub yup add celly 0.5 mul add moveto
        TI fsize 0.4 mul scalefont setfont
        (0123456701234567)
          { ( ) dup 0 4 -1 roll put center 0 celly neg rmoveto } forall
        cellx 2 div 17celly fsize 0.4 mul sub moveto (oct) center
        cellx 0 rmoveto
        [(00x) (02x) (04x) (06x) (10x) (12x) (14x) (16x) (20x) (22x) (24x)
 	 (26x) (30x) (32x) (34x) (36x)] { center cellx 0 rmoveto } forall
        cellx 2 div 17celly fsize 0.8 mul sub moveto (dec) center
	cellx 0 rmoveto
        0 1 15 { 16 mul rope cvs center cellx 0 rmoveto } for
        doheader
      grestore
      notdef {
        gsave
          0 17celly 3 mm add moveto TR celly 0.33 mul scalefont setfont
          gsave cellx 0.3 mul 0 rlineto 0 celly 0.3 mul rlineto cellx -0.3 mul
          0 rlineto closepath
          gsave notdefgray setgray fill grestore 0 setlinewidth stroke grestore
          cellx 0.5 mul 0 rmoveto
          (boxes indicate entries not defined in encoding. ) show
        grestore
      } if
      extrapage dolist not or { gsave showpage grestore } if
    } if % dotable
    dolist { namesarray showlist showpage } if
  zeiv restore
} bind def

%%EndProlog

% syntax: font notestring dotable dolist unonlylist fonttable ->
% ISOLatin1 /Courier findfont rand reencode
% (ISO 88591/1) false true false fonttable

FLUFFSTOPPER
echo "/$font findfont"
case "$2"x in
  x) echo -n "";;
  *) echo "$2 exch /Q reencode";;
esac
echo "($3)";
case "${4}"y in
  y*|Y*|truey) echo -n "true ";;
  *) echo -n "false ";;
esac
case "${5}"y in
  y*|Y*|truey) echo -n "true ";;
  *) echo -n "false ";;
esac
case "${6}"y in
  y*|Y*|truey) echo -n "true ";;
  *) echo -n "false ";;
esac
echo "fonttable"
echo "%%Trailer"
exit 0