🚀 go-pugleaf

In article <10987@dartvax.Dartmouth.EDU> iang@plasmoid.dartmouth.edu (Ian Gregory) writes:
>Here is one of my first postscript programs. It produces
>a 16*16 table of all 256 characters in a given postscript
>font. I have only tested it on an Apple LaserWriter. The
>last line of the program does the table for the Helvetica
>font. Try also looking at the Symbol font (/Symbol). I
>have used this procedure in a program which looks at the
>font directory, and automatically prints a table for every
>font installed on the printer.

Funny, i have just completed my program which does almost the same
thing! The difference is that the result of my program looks just
like the font-tables in the TeXbook. You can easily find the
corresponding character codes in hexadecimal or octal.

You can also incorporate all the unencoded characters in the font
and have them displayed. The unencoded characters are put in table
starting from octal code '000 - '033 (uppercase) and '200 - '233
(lowercase).

Enjoy...
------8<------- Cut Here ------ 8<------8<------8<------8<------8<------
%!
% ShowFont.ps : Show all characters in a font the same way as the TeXfonts
%               are presented TexBook pp. 430.
% Send this file to LaserWriter with LW Dwnload program to print listing.
%
% Copyright (c) 1988 Anders Ulfheden <ulfis@nada.kth.se>
%
% This program may be copied, modified and redistributed for non-commercial
% use only, provided that any and all copyright notices are preserved.
%
% Please report bugs, fixes, improvements and suggestions to:
%
% UUCP: ulfis@nada.kth.se
%
%
/fontsiz 12 def		% Used fontsize in grid
/fontlift 2.5 def	% Correction to align characters vertically
/minheight 10 def	% This means lower-y on the paper
/maxheight 750 def	%            upper-y
/minwidth 100 def	%	     lower-x
/maxwidth 450 def	%	     upper-x
/hno 32 def		% Number of characters vertically
/vno 8 def		%      -- "" --        horizontally

/hspace maxheight minheight sub hno div def	% Space in grid vertically
/vspace maxwidth minwidth sub vno div def	%   -- "" --    horizontally

%
% centertext -- Puts text centered horizontally at xcenter, ycenter.
%
/centertext	% xcenter yposition text centertext
{
  /currentstring exch def
  /yposition exch def
  /xcenter exch def
  xcenter currentstring stringwidth
  pop 2 div sub yposition moveto
  currentstring 
} def

%
% odd -- No comments... ;-)
%        Returns TRUE or FALSE
%
/odd { 2 mod 0 eq } def

%
% showfont -- Draws a grid and displays all characters in a font.
%
/showfont {   % fontname showfont
  /Displayfont exch def
  gsave
    /Helvetica findfont fontsiz 1.5 mul scalefont setfont
    maxwidth 1.15 mul maxheight 0.75 mul
    fontsiz 1.5 mul 2 div neg add translate
    90 rotate
    0 0 moveto
    Displayfont findfont /FontInfo get /FullName get 
    show
    /Helvetica findfont fontsiz 1.2 div scalefont setfont
    -400 0 moveto
    (From ulfis@nada.kth.se, 88-11-20) show
  grestore
  /Times-Italic findfont fontsiz scalefont setfont
  %
  % Horizontal lines
  %
  /localcount 0 def
  newpath 
    maxheight hspace neg minheight
    { dup minwidth hspace 2 mul neg add 2 1 roll moveto
          maxwidth 
	localcount odd
        { hspace 1.5 mul add }
        if
	/localcount localcount 1 add def
        2 1 roll lineto
    } for
  stroke
  %
  % Vertical lines
  %
  newpath 
    maxwidth vspace neg minwidth
    { dup minheight vspace 2 div neg add moveto
          maxheight vspace 2 div add lineto
    } for
  stroke
  %
  % Label axis
  %
  /nstr 4 string def
  /xpos minwidth hspace 3 mul neg 2 div add def
  0 1 hno 1 sub
  { dup dup
    1 add hspace mul neg hspace 2 div fontsiz fontlift div neg add add
    maxheight add xpos exch moveto
    nstr exch 8 mod 2 exch 48 add put
    nstr exch 8 idiv 1 exch 48 add put
    nstr 3 120 put % x
    nstr 0 39 put % '
    nstr show
  } for
  /nstr 2 string def
  /ypos maxheight vspace 4 div add fontsiz fontlift div neg add def
  0 1 vno 1 sub
  { dup 
    1 add vspace mul vspace 2 div neg add 
    minwidth add ypos 3 -1 roll
    nstr exch 1 exch 48 add put
    nstr 0 39 put % '
    nstr centertext show
  } for
  /Courier-Bold findfont fontsiz scalefont setfont
  /ypos minheight vspace 4 div neg add fontsiz fontlift div neg add def
  0 1 vno 1 sub
  { dup 
    1 add vspace mul vspace 2 div neg add 
    minwidth add ypos 3 -1 roll
    nstr exch 8 add 16 mod 1 exch dup 10 lt {48 add} {55 add} ifelse put
    nstr 0 34 put % "
    nstr centertext show
  } for
  /nstr 3 string def
  /xpos maxwidth hspace 4 div add def
  0 2 hno 1 sub 
  { dup
    1 add hspace mul neg fontsiz fontlift div neg add 
    maxheight add xpos exch moveto
    nstr exch 2 idiv 16 mod 1 exch dup 10 lt {48 add} {55 add} ifelse put
    nstr 2 120 put % x
    nstr 0 34 put % "
    nstr show
  } for
  %
  % Display characters
  %
  /nstr 1 string def
  /fontsiz fontsiz 1.2 mul def
  Displayfont findfont fontsiz scalefont setfont
  0 1 7
  {
    /xx exch def
    /xpos xx vspace mul vspace 2 div add minwidth add def
    0 1 31
    {
      /yy exch def
      /ypos yy hspace mul hspace 2 div add neg maxheight add 
          fontsiz fontlift div neg add def
      xx yy
      8 mul add
      nstr 0
      3 -1 roll
      put
      xpos ypos nstr centertext show
    }
    for
  }
  for
} def

%
% ReEncode -- Put unencoded text characters into a new font.
%             Returns the updated font.
%
/ReEncode {  % Font ReEncode -> New TemporaryFont
  /ReEncodeDict 12 dict def
  ReEncodeDict begin
   /basefontname exch def
   /basefontdict basefontname findfont def
   /newfont basefontdict maxlength dict def

    basefontdict
    { exch dup /FID ne
      { dup /Encoding eq
        { exch dup length array copy
          newfont 3 1 roll put }
        { exch newfont 3 1 roll put }
        ifelse
      }
      { pop pop }
      ifelse
    } forall

    newfont /FontName /TemporaryFont put
    auxvector aload pop
    auxvector length 2 idiv
    { newfont /Encoding get 3 1 roll put }
    repeat
    /TemporaryFont newfont definefont pop
  end
  /TemporaryFont
} def

%
% auxvector -- Contains character codes and corresponding unencoded characters.
%
/auxvector [        % Unencoded Text Characters
8#200 /aacute
8#201 /acircumflex
8#202 /adieresis
8#203 /agrave
8#204 /aring
8#205 /atilde
8#206 /ccedilla
8#207 /eacute
8#210 /ecircumflex
8#211 /edieresis
8#212 /egrave
8#213 /iacute
8#214 /icircumflex
8#215 /idieresis
8#216 /igrave
8#217 /ntilde
8#220 /oacute
8#221 /ocircumflex
8#222 /odieresis
8#223 /ograve
8#224 /otilde
8#225 /scaron
8#226 /uacute
8#227 /ucircumflex
8#230 /udieresis
8#231 /ugrave
8#232 /ydieresis
8#233 /zcaron
8#000 /Aacute
8#001 /Acircumflex
8#002 /Adieresis
8#003 /Agrave
8#004 /Aring
8#005 /Atilde
8#006 /Ccedilla
8#007 /Eacute
8#010 /Ecircumflex
8#011 /Edieresis
8#012 /Egrave
8#013 /Iacute
8#014 /Icircumflex
8#015 /Idieresis
8#016 /Igrave
8#017 /Ntilde
8#020 /Oacute
8#021 /Ocircumflex
8#022 /Odieresis
8#023 /Ograve
8#024 /Otilde
8#025 /Scaron
8#026 /Uacute
8#027 /Ucircumflex
8#030 /Udieresis
8#031 /Ugrave
8#032 /Ydieresis
8#033 /Zcaron
] def

40 40 translate

/Times-Bold showfont		% Shows /Times-Bold

%/Times-Bold ReEncode showfont	% Shows extended /Times-Bold

showpage

+------------------------------------------------------------------------------
|  Anders Ulfheden
|  USENET:  ulfis@nada.kth.se
|  Royal Institute of Technology
|  Stockholm, Sweden