% Copyright 1989, David Love, SERC Daresbury Laboratory under the same
% conditions as the Spider distribution

\def\title{PSWEB demonstration -- outline font}
\def\ps{{\sc PostScript}}

@*Introduction.
As a simple example of the use of \ps\ \.{WEB} we'll do a
literate re-write of {\sl Program 16 / Making an Outline Font} from the
Adobe blue {\sl Cookbook}, p~199. Most of the text will be directly lifted
from that example.
Compare this with the original!
The \ps\ convention of writing, for instance, |MakeOutlineFont| instead
of the form |make_outline_font| has been carried over from the original
example just this once, contrary to Knuthian lore and my preference.

@*2Purpose.
This program defines a general procedure to take one of the built-in
fonts and convert it to an outline font.
(This program will also work for downloadable fonts available from
Adobe Systems, Inc.).

@ We need to write out a suitable bounding box comment for \.{\\psfig}.
@u
@=%%BoundingBox: 18 18 577 824@>

@ Local storage for the procedure |MakeOutlineFont|.
@u
/makeoutlinedict 7 dict def

@*2Function definition and use.
|MakeOutlineFont| takes one of the built-in filled fonts and makes an outlined
font out of it.
It takes four arguments: the name of the font on which to base the outline
version, the new name for the outline font, a stroke width to use on the
outline  and a unique ID.
@u
/MakeOutlineFont  =>% base\_name new\_name stroke\_width ID
 { makeoutlinedict begin
  @<stash the arguments@>
  @<get dictionary of font on which outline version will be based@>
  @<determine how large new font dictionary should be@>
  @<make sure there is room for the unique ID field@>
  @<create dictionary to hold description for outline font@>
  @<copy entries in base font dictionary to outline dictionary, except
    for the FID@>
  @<miscellaneous inserts into the new dictionary@>
  @<make new font@>
  end
} def

@ Four arguments as described above.
@<stash...@>=
/uniqueid exch def
/strokewidth exch def
/newfontname exch def
/basefontname exch def

@ @<get dictionary...@>=
/basefontdict basefontname findfont def

@ @<determine how large...@>=
/numentries basefontdict maxlength 1 add def

@ (Not all fonts have unique ID fields initially.
In particlular, the built-in fonts in \ps\ version 23.0 don't.)

@<make sure there is room...@>=
basefontdict /UniqueID known not =>
 {/numentries numentries 1 add def} if

@ @<create dictionary...@>=
/outfontdict numentries dict def

@ @<copy entries...@>=
basefontdict =>
 { exch dup /FID ne
{exch outfontdict 3 1 roll put}
{pop pop}         % ignore the FID pair
ifelse
} forall

@ We need to 1) insert the new name into the dictionary
2) change the paint type to outline
3) insert the stroke width into the dictionary
4) insert the new unique ID

@<miscellaneous inserts...@>=
outfontdict /FontName newfontname put
outfontdict /PaintType 2 put
outfontdict /StrokeWidth strokewidth put
outfontdict /UniqueID uniqueid put

@ In making the outline dictionary into a \ps\ font we ignore the
modified dictionary returned on the stack by |definefont|.
@<make new font@>=
newfontname outfontdict definefont pop

@*Use of the procedure and determining new IDs.
We'll make a new font |Helvetica-Outline1| derived from |Helvetica-Bold|.
The results will appear below.

@u
/Helvetica-Bold @!/Helvetica-Outline1 @<define stroke width@>
@<determine unique ID@>
MakeOutlineFont

@ The stroke width is always specified in the character coordinate system
(1000 units).
The value specified here will yield a one point wide outline when the font is
scaled to 54 points in size.
Note that this outline width changes with different point sizes.
@^stroke width@>
@<define stroke width@>=
1000 54 div

@ To determine the unique id:
If the `base' font already contains a unique ID, add a unique constant to it,
otherwise pick a unique integer and leave that value on the operand stack.
@<determine unique ID@>=
/Helvetica-Bold findfont dup /UniqueID known =>
 {/UniqueID get 1 add}
{pop 1}
ifelse
@ So here are two sizes with this stroke width.
@u
/Helvetica-Outline1 findfont 36 scalefont setfont =>
72 504 moveto (outline) show <=
/Helvetica-Outline1 findfont 54 scalefont setfont =>
 (outline) show

@ Now we'll do one with a different stroke width.
The width of 1000/36 used now yields a one point wide outline when the font
is scaled to 36 point in size.
It yields a 1.5 point outline when the font is scaled to 54 points
in size ($54/36=1.5$).@^stroke width@>
@u
/Helvetica-Bold @!/Helvetica-Outline2 1000 36 div
@<determine unique ID@>
MakeOutlineFont

@ And use the different stroke width:
@u
/Helvetica-Outline2 findfont 36 scalefont setfont =>
72 444 moveto (outline) show <=
/Helvetica-Outline2 findfont 54 scalefont setfont =>
 (outline) show

@ Finish off the example:
@u
showpage

@*1Results of the examples.
The results of including the \.{TANGLE}d version of this \.{WEB} source
into the \.{WEAVE} output using the \.{\\psfig} macro and a suitable
\.{DVI} to \ps\ converter are given here.  The example has been shrunken
to get it on the page and may be faint on a write-white engine with the
stroke widths defined above.@^stroke width@>@^write-white@>
\input psfig.sty
\centerline{\psfig{figure=outline.ps1,height=6in}}

@*Index.