rsalz@uunet.uu.net (Rich Salz) (05/27/88)
Submitted-by: Axel Mahler <axel%coma.UUCP@TUB.BITNET>
Posting-number: Volume 15, Issue 17
Archive-name: tpscript/part05
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 5 (of 5)."
# Wrapped by rsalz@fig.bbn.com on Thu May 26 13:02:29 1988
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f './pscript/genftable.ps' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./pscript/genftable.ps'\"
else
echo shar: Extracting \"'./pscript/genftable.ps'\" \(12794 characters\)
sed "s/^X//" >'./pscript/genftable.ps' <<'END_OF_FILE'
X%!
X% genftable - Postcript program to produce font tables for ditroff.
X% Tables are output on the standard output file - which
X% needs to be captured by the host computer.
X%
X% Note the routine "commondefs" which outputs local
X% defined (hand built) characters.
X%
X% Michael Rourke, University of N.S.W., Australia
X%
X
X/t 30 string def
X
X/ps
X% string ->
X{
X print
X} def
X
X/pr
X% any -->
X{
X t cvs ps
X} def
X
X/prsp
X{
X (\t) ps
X} def
X
X/prnl
X{
X (\n) ps
X} def
X
X/pro
X% int -->
X{
X dup 0 eq
X { pr }
X { dup 8 idiv pro 8 mod pr }
X ifelse
X} def
X
X/charsize
X% string --> bot top
X{
X gsave
X newpath 0 0 moveto false charpath flattenpath pathbbox
X exch pop 3 -1 roll pop
X grestore
X} def
X
X/strwidth
X% string --> width
X{
X stringwidth pop round cvi
X} def
X
X/prsize
X% string -->
X{
X dup strwidth pr prsp
X dup charsize
X top gt { 2 } { 0 } ifelse
X exch bot lt { 1 or } if
X pr prsp
X 0 get pro
X} def
X
X/fontinfo
X% fontname troffinternal troffname
X{
X (\ncat <<"!" > ) ps dup pr prnl
X (# ) ps 2 index pr prnl
X (name ) ps pr prnl
X (internalname ) ps pr prnl
X dup findfont 100 scalefont setfont
X /fixedwidth false def
X /Symbol eq
X {
X /actions symbol-encoding def
X (special\n) ps
X }
X {
X /actions standard-encoding def
X currentfont /FontInfo get /isFixedPitch get
X {
X (# fixed width\n) ps
X /fixedwidth true def
X }
X {
X (ligatures fi fl ff ffi ffl 0\n) ps
X }
X ifelse
X }
X ifelse
X % use "o" to get top and bottom on a normal char
X (o) charsize /top exch def /bot exch def
X % some non ascending chars slightly higher than "o"
X % and some lower so adjust slightly
X /top top 2 add def
X /bot bot 4 sub def
X /encoding currentfont /Encoding get def
X /s 1 string def
X 0 1 255
X {
X s 0 2 index put
X encoding exch get dup /.notdef ne
X {
X s 1 index actions exch get
X % charname charstr
X exec
X flush
X }
X {
X pop
X }
X ifelse
X } for
X actions standard-encoding eq { commondefs } if
X (!\n) ps flush
X} def
X
X/commondefs
X{
X /fracsize (0) strwidth (\244) strwidth add def % \244 = '/'
X /Fisize (f) strwidth (\256) strwidth add 5 sub def % \256 = 'fi'
X /ffsize (f) strwidth 2 mul 5 sub def
X /fl { flush } def
X fixedwidth not
X {
X (ff) ps prsp ffsize pr (\t2\t0100\tff ligature - faked\n) ps fl
X (Fi) ps prsp Fisize pr (\t2\t0100\tffi ligature - faked\n) ps fl
X (Fl) ps prsp Fisize pr (\t2\t0100\tffl ligature - faked\n) ps fl
X } if
X (12) ps prsp fracsize pr (\t2\t0100\t1/2 - faked\n) ps fl
X (13) ps prsp fracsize pr (\t2\t0100\t1/3 - faked\n) ps fl
X (14) ps prsp fracsize pr (\t2\t0100\t1/4 - faked\n) ps fl
X (18) ps prsp fracsize pr (\t2\t0100\t1/8 - faked\n) ps fl
X (23) ps prsp fracsize pr (\t2\t0100\t2/3 - faked\n) ps fl
X (34) ps prsp fracsize pr (\t2\t0100\t3/4 - faked\n) ps fl
X (38) ps prsp fracsize pr (\t2\t0100\t3/8 - faked\n) ps fl
X (58) ps prsp fracsize pr (\t2\t0100\t5/8 - faked\n) ps fl
X (78) ps prsp fracsize pr (\t2\t0100\t7/8 - faked\n) ps fl
X (sq\t100\t3\t0100\tsquare box - faked\n) ps fl
X} def
X
X/space
X% charname charstr -->
X{
X (spacewidth ) ps
X strwidth pr pop prnl
X (charset\n) ps
X} def
X
X/norm
X% charname charstr -->
X{
X dup pr prsp prsize pop prnl
X} def
X
X/normdup
X% charname charstr dupname -->
X{
X 3 1 roll norm
X pr prsp (") ps prnl
X} def
X
X/gnorm
X% charname charstr -->
X{
X (*) ps norm
X} def
X
X/map
X% charname charstr mapname -->
X{
X pr prsp prsize prsp pr prnl
X} def
X
X/mapdup
X% charname charstr mapname dupname -->
X{
X 4 1 roll map
X pr prsp (") ps prnl
X} def
X
X/mapdupdup
X% charname charstr mapname dupname dupname -->
X{
X 5 1 roll mapdup
X pr prsp (") ps prnl
X} def
X
X/cmap
X% charname charstr mapname -->
X{
X fixedwidth { 3 { pop } repeat } { map } ifelse
X} def
X
X/standard-encoding 149 dict def
standard-encoding begin
X /space { space } def
X /exclam { norm } def
X /quotedbl { norm } def
X /numbersign { norm } def
X /dollar { norm } def
X /percent { norm } def
X /ampersand { norm } def
X /quoteright { norm } def
X /parenleft { norm } def
X /parenright { norm } def
X /asterisk { norm } def
X /plus { norm } def
X /comma { norm } def
X /hyphen { (hy) normdup } def
X /period { norm } def
X /slash { (sl) dup } def
X /zero { norm } def
X /one { norm } def
X /two { norm } def
X /three { norm } def
X /four { norm } def
X /five { norm } def
X /six { norm } def
X /seven { norm } def
X /eight { norm } def
X /nine { norm } def
X /colon { norm } def
X /semicolon { norm } def
X /less { norm } def
X /equal { norm } def
X /greater { norm } def
X /question { norm } def
X /at { norm } def
X /A { norm } def
X /B { norm } def
X /C { norm } def
X /D { norm } def
X /E { norm } def
X /F { norm } def
X /G { norm } def
X /H { norm } def
X /I { norm } def
X /J { norm } def
X /K { norm } def
X /L { norm } def
X /M { norm } def
X /N { norm } def
X /O { norm } def
X /P { norm } def
X /Q { norm } def
X /R { norm } def
X /S { norm } def
X /T { norm } def
X /U { norm } def
X /V { norm } def
X /W { norm } def
X /X { norm } def
X /Y { norm } def
X /Z { norm } def
X /bracketleft { norm } def
X /backslash { norm } def
X /bracketright { norm } def
X /asciicircum { (a^) map } def
X /underscore { (ru) normdup } def
X /quoteleft { norm } def
X /a { norm } def
X /b { norm } def
X /c { norm } def
X /d { norm } def
X /e { norm } def
X /f { norm } def
X /g { norm } def
X /h { norm } def
X /i { norm } def
X /j { norm } def
X /k { norm } def
X /l { norm } def
X /m { norm } def
X /n { norm } def
X /o { norm } def
X /p { norm } def
X /q { norm } def
X /r { norm } def
X /s { norm } def
X /t { norm } def
X /u { norm } def
X /v { norm } def
X /w { norm } def
X /x { norm } def
X /y { norm } def
X /z { norm } def
X /braceleft { norm } def
X /bar { norm } def
X /braceright { norm } def
X /asciitilde { (a~) map } def
X /exclamdown { (I!) map } def
X /cent { (ct) map } def
X /sterling { (po) map } def
X /fraction { } def
X /yen { ($J) map } def
X /florin { } def
X /section { (sc) map } def
X /currency { } def
X /quotesingle { (fm) (n') mapdup } def
X /quotedblleft { (lq) map } def
X /guillemotleft { (d<) map } def
X /guilsinglleft { (l<) map } def
X /guilsinglright { (r>) map } def
X /fi { (fi) cmap } def
X /fl { (fl) cmap } def
X /endash { (\\-) map } def
X /dagger { (dg) map } def
X /daggerdbl { (dd) map } def
X /periodcentered { } def
X /paragraph { (pp) map } def
X /bullet { (bu) map } def
X /quotesinglbase { } def
X /quotedblbase { } def
X /quotedblright { (rq) map } def
X /guillemotright { (d>) map } def
X /ellipsis { } def
X /perthousand { (pm) cmap } def
X /questiondown { (I?) map } def
X /grave { (ga) (\\`) mapdup } def
X /acute { (aa) (\\') mapdup } def
X /circumflex { (^) map } def
X /tilde { (~) map } def
X /macron { (ma) map } def
X /breve { (be) map } def
X /dotaccent { (dt) map } def
X /dieresis { (..) (um) mapdup } def
X /ring { (ri) map } def
X /cedilla { (cd) map } def
X /hungarumlaut { ('') map } def
X /ogonek { (og) map } def
X /caron { (hc) map } def
X /emdash { (em) map } def
X /AE { (AE) cmap } def
X /ordfeminine { } def
X /Lslash { (PL) map } def
X /Oslash { (O/) map } def
X /OE { (OE) cmap } def
X /ordmasculine { } def
X /ae { (ae) cmap } def
X /dotlessi { (ui) map } def
X /lslash { (Pl) map } def
X /oslash { (o/) map } def
X /oe { (oe) cmap } def
X /germandbls { (ss) map } def
end
X
X/symbol-encoding 189 dict def
symbol-encoding begin
X /space { space } def
X /exclam { norm } def
X /universal { (fa) map } def
X /numbersign { norm } def
X /existential { (te) map } def
X /percent { norm } def
X /ampersand { norm } def
X /suchthat { (cm) map } def
X /parenleft { norm } def
X /parenright { norm } def
X /asteriskmath { (**) map } def
X /plus { (pl) map } def
X /comma { norm } def
X /minus { (mi) normdup } def
X /period { norm } def
X /slash { (sl) map } def
X /zero { norm } def
X /one { norm } def
X /two { norm } def
X /three { norm } def
X /four { norm } def
X /five { norm } def
X /six { norm } def
X /seven { norm } def
X /eight { norm } def
X /nine { norm } def
X /colon { norm } def
X /semicolon { norm } def
X /less { norm } def
X /equal { (eq) normdup } def
X /greater { norm } def
X /question { norm } def
X /congruent { (=~) map } def
X /Alpha { gnorm } def
X /Beta { gnorm } def
X /Chi { (*X) map } def
X /Delta { gnorm } def
X /Epsilon { gnorm } def
X /Phi { gnorm } def
X /Gamma { gnorm } def
X /Eta { (*Y) map } def
X /Iota { gnorm } def
X /theta1 { } def
X /Kappa { gnorm } def
X /Lambda { gnorm } def
X /Mu { gnorm } def
X /Nu { gnorm } def
X /Omicron { gnorm } def
X /Pi { gnorm } def
X /Theta { (*H) map } def
X /Rho { gnorm } def
X /Sigma { gnorm } def
X /Tau { gnorm } def
X /Upsilon { gnorm } def
X /sigma1 { (ts) map } def
X /Omega { (*W) map } def
X /Xi { (*C) map } def
X /Psi { (*Q) map } def
X /Zeta { gnorm } def
X /bracketleft { norm } def
X /therefore { (tf) map } def
X /bracketright { norm } def
X /perpendicular { (bt) map } def
X /underscore { (ul) map } def
X /radicalex { } def
X /alpha { gnorm } def
X /beta { gnorm } def
X /chi { (*x) map } def
X /delta { gnorm } def
X /epsilon { gnorm } def
X /phi { gnorm } def
X /gamma { gnorm } def
X /eta { (*y) map } def
X /iota { gnorm } def
X /phi1 { } def
X /kappa { gnorm } def
X /lambda { gnorm } def
X /mu { gnorm } def
X /nu { gnorm } def
X /omicron { gnorm } def
X /pi { gnorm } def
X /theta { (*h) map } def
X /rho { gnorm } def
X /sigma { gnorm } def
X /tau { gnorm } def
X /upsilon { gnorm } def
X /omega1 { } def
X /omega { (*w) map } def
X /xi { (*c) map } def
X /psi { (*q) map } def
X /zeta { gnorm } def
X /braceleft { norm } def
X /bar { (or) normdup } def
X /braceright { norm } def
X /similar { (ap) map } def
X /Upsilon1 { } def
X /minute { (mt) map } def
X /lessequal { (<=) map } def
X /fraction { (/) map } def
X /infinity { (if) map } def
X /florin { } def
X /club { (Cc) map } def
X /diamond { (Cd) map } def
X /heart { (Ch) map } def
X /spade { (Cs) map } def
X /arrowboth { (<>) map } def
X /arrowleft { (<-) map } def
X /arrowup { (ua) map } def
X /arrowright { (->) map } def
X /arrowdown { (da) map } def
X /degree { (de) map } def
X /plusminus { (+-) map } def
X /second { (sd) map } def
X /greaterequal { (>=) map } def
X /multiply { (mu) map } def
X /proportional { (pt) map } def
X /partialdiff { (pd) map } def
X /bullet { } def
X /divide { (di) map } def
X /notequal { (!=) map } def
X /equivalence { (==) map } def
X /approxequal { (~=) map } def
X /ellipsis { } def
X /arrowvertex { } def
X /arrowhorizex { } def
X /carriagereturn { (cr) map } def
X /aleph { (al) map } def
X /Ifraktur { } def
X /Rfraktur { } def
X /weierstrass { } def
X /circlemultiply { (ax) map } def
X /circleplus { (a+) map } def
X /emptyset { (es) map } def
X /intersection { (ca) map } def
X /union { (cu) map } def
X /propersuperset { (sp) map } def
X /reflexsuperset { (ip) map } def
X /notsubset { (!s) map } def
X /propersubset { (sb) map } def
X /reflexsubset { (ib) map } def
X /element { (mo) map } def
X /notelement { (!m) (nm) mapdup } def
X /angle { (ag) map } def
X /gradient { (gr) map } def
X /registerserif { } def
X /copyrightserif { } def
X /trademarkserif { } def
X /product { } def
X /radical { (sr) map } def
X /dotmath { (m.) map } def
X /logicalnot { (no) map } def
X /logicaland { (an) (la) mapdup } def
X /logicalor { (lo) map } def
X /arrowdblboth { (io) map } def
X /arrowdblleft { (<:) (lh) mapdup } def
X /arrowdblup { (u=) map } def
X /arrowdblright { (:>) (rh) (im) mapdupdup } def
X /arrowdbldown { (d=) map } def
X /lozenge { (dm) map } def
X /angleleft { (L<) map } def
X /registersans { (rg) map } def
X /copyrightsans { (co) map } def
X /trademarksans { (tm) map } def
X /summation { } def
X /parenlefttp { } def
X /parenleftex { } def
X /parenleftbt { } def
X /bracketlefttp { } def
X /bracketleftex { } def
X /bracketleftbt { } def
X /bracelefttp { } def
X /braceleftmid { } def
X /braceleftbt { } def
X /braceex { } def
X /apple { (AL) map } def
X /angleright { (R>) map } def
X /integral { (is) map } def
X /integraltp { } def
X /integralex { } def
X /integralbt { } def
X /parenrighttp { } def
X /parenrightex { } def
X /parenrightbt { } def
X /bracketrighttp { } def
X /bracketrightex { } def
X /bracketrightbt { } def
X /bracerighttp { } def
X /bracerightmid { } def
X /bracerightbt { } def
end
X
X/Times-Roman /Roman /R fontinfo
X/Helvetica /Helvetica /H fontinfo
X/Courier /Courier /C fontinfo
X/Symbol /Symbol /S fontinfo
X/Times-Italic /Italic /I fontinfo
X/Times-Bold /Bold /B fontinfo
X/Times-BoldItalic /BoldI /BI fontinfo
X/Helvetica-Bold /HelveticaB /HB fontinfo
X/Helvetica-Oblique /HelveticaO /HO fontinfo
X/Helvetica-BoldOblique /HelveticaBO /HX fontinfo
X/Courier-Bold /CourierB /CB fontinfo
X/Courier-Oblique /CourierO /CO fontinfo
X/Courier-BoldOblique /CourierBO /CX fontinfo
END_OF_FILE
if test 12794 -ne `wc -c <'./pscript/genftable.ps'`; then
echo shar: \"'./pscript/genftable.ps'\" unpacked with wrong size!
fi
# end of './pscript/genftable.ps'
fi
if test -f './tpscript/tpscript.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./tpscript/tpscript.c'\"
else
echo shar: Extracting \"'./tpscript/tpscript.c'\" \(36974 characters\)
sed "s/^X//" >'./tpscript/tpscript.c' <<'END_OF_FILE'
static char *RCSid = "$Header: tpscript.c,v 1.6 87/07/15 19:51:55 andy Exp $";
X
X/*
X * $Log: tpscript.c,v $
X * Revision 1.6 87/07/15 19:51:55 andy
X * The GEM related part of the PostScript prolog was enhanced.
X *
X * Revision 1.5 87/04/27 17:35:44 andy
X * in line 205 was a comma missing.
X *
X * Revision 1.4 87/04/24 03:01:16 andy
X * *** empty log message ***
X *
X * Revision 1.3 86/10/15 17:24:24 andy
X * Added Escape-Mechanism which calls another PostScript generating
X * Program as input filter.
X * This change was made to introduce graphics generated by gemdraw
X * in the tpscript output.
X * Escape Character is E --- see #ifdef GEMPRINT
X *
X */
X
X/*
X * tpscript.c
X * Troff post-processor for postscript devices
X *
X * Original program by Stephen Frede (stephenf@elecvax.oz)
X * Dept. Comp. Sci., University of NSW, Sydney, Australia.
X * ...!seismo!munnari!elecvax!stephenf
X *
X * Extensive modifications by Cameron Davidson (probe@mm730.uq.oz)
X * University of Queensland, Brisbane, Australia
X *
X * Other changes by Michael Rourke (michaelr@elecvax.oz) UNSW.
X */
X
X/* NOTES:
X *
X * Originally, changes to a new font would not take effect until
X * characters from that font were required to be printed, but this
X * means that commands passed through to postscript directly (via \!!)
X * may end up with the wrong font. So now font changes actually happen
X * when requested (or needed in the case of the special font).
X *
X */
X
X/* The language that is accepted by this program is produced by the new
X * device independent troff, and consists of the following statements,
X *
X *
X * sn set the point size to n
X * fn set the typesetter font to the one in position n
X * cx output the ASCII character x
X * Cxyz output the code for the special character xyz. This
X * command is terminated by white space.
X * Hn go to absolute horizontal position n
X * Vn go to absolute vertical position n ( down is positive )
X * hn go n units horizontally from current position
X * vn go n units vertically from current position
X * nnc move right nn units, then print the character c. This
X * command expects exactly two digits followed by the
X * character c.
X * ( this is an optimisation that shrinks output file
X * size by about 35% and run-time by about 15% while
X * preserving ascii-ness)
X * w paddable word space - no action needed
X * nb a end of line ( information only - no action needed )
X * b = space before line, a = space after line
X * pn begin page n
X * in stipple as no. from 1 to n (BERK).
X * P spread ends -- output it (put in by rsort) (BERK).
X * # ...\n comment - ignore.
X * ! ...\n pass through uninterpreted (LOCAL MOD).
X * Dt ...\n draw operation 't':
X *
X * Dl dx dy line from here to dx, dy
X * Dc d circle of diameter d, left side here
X * De x y ellipse of axes diameter x,y, left side here
X * Da dx1 dy1 dx2 dy2 arc counter-clockwise, start here,
X * centre is dx1, dy1 (relative to start),
X * end is dx2, dy2 (relative to centre).
X * D~ x y x y ... wiggly line (spline) by x,y then x,y ...
X * Dt d set line thickness to d pixels (BERK).
X * Ds d set line style mask to d (BERK).
X * Dg x y x y ... gremlin (BERK).
X */
X#ifdef GEMPRINT
X/* E prg a1 a2 ... fork program "prg" with args a1 a2 ... .
X * continue after execution.
X */
X#endif
X/* x ... \n device control functions:
X *
X * x i initialize the typesetter
X * x T s name of device is s
X * x r n h v resolution is n units per inch. h is
X * min horizontal motion, v is min vert.
X * motion in machine units.
X * x p pause - can restart the typesetter
X * x s stop - done forever
X * x t generate trailer
X * x f n s load font position n with tables for
X * font s. Referring to font n now means
X * font s.
X * x H n set character height to n
X * x S n set character slant to n
X *
X * Subcommands like i are often spelled out as "init"
X *
X * Commands marked "BERK" are berzerkeley extensions.
X *
X */
X
X#include "tpscript.h"
X
X#define FONTDIR "/usr/lib/font" /* where font directories live */
X
XFILE *Debug = NULL; /* debugging stream if non-null */
char *fontdir = FONTDIR; /* where the fonts live */
char *ifile = 0; /* current input file name */
int lineno, /* line no. in current input file */
X npages = 0; /* no. pages printed so far */
char device[100], /* device name, eg "alw" */
X errbuf[100]; /* tmp buffer for error messages */
int hpos = 0, /* current horizontal position */
X vpos = 0; /* current vertical position (rel. TOP pg.) */
int res, /* resolution in THINGS/inch */
X hor_res, /* min horizontal movement (in THINGS) */
X vert_res, /* min vertical movement (in THINGS) */
X respunits;
float rotation = 0; /* page orientation (degrees) */
int currtfont = DEF_FONT, /* current font number selected by troff */
X papertype = /* paper type (different imageable regions) */
X#ifdef ALW
X PT_A4;
X#else
X PT_DEFAULT;
X#endif
bool manualfeed = FALSE; /* normally auto-feed */
X
X/* due to an obscure bug in ditroff, sometimes no initial 'p' command
X * is generated, so we have to remember if any output has happened
X * to decide if a 'p' causes a page print or not.
X */
bool firstpage = TRUE; /* nothing yet printed anywhere */
X
X/* font parameters */
struct fontparam
X tfp, /* current troff font parameters */
X pfp; /* current postscript font parameters */
X
X
X/* table of font descriptions */
struct fontdesc
X *fontd = NOFONTDESC,
X *spcfnt1 = NOFONTDESC, /* special font */
X *spcfnt2 = NOFONTDESC; /* special font 2 */
X
X/* font mount table - array of pointers to font descriptions */
struct fontdesc **fontmount;
X
X/* mapping between troff font names and builtin font names
X * This should go in the internal name part of the font description
X * itself, but there is only 10 bytes allocated (see dev.h).
X */
X
X#ifdef GERMAN
struct fontmap fontmap[] = {
X { "R", "Times-Roman-Germ" },
X { "I", "Times-Italic-Germ" },
X { "B", "Times-Bold-Germ" },
X { "BI", "Times-BoldItalic-Germ" },
X { "S", "Symbol" },
X { "S2", "BracketFont" }, /* locally defined special font */
X { "C", "Courier-Germ" },
X { "CW", "Courier" }, /* synonym: constant width */
X { "CB", "Courier-Bold-Germ" },
X { "CO", "Courier-Oblique-Germ" },
X { "CX", "Courier-BoldOblique-Germ" },
X { "H", "Helvetica-Germ" },
X { "HR", "Helvetica" }, /* two-char name for H */
X { "HB", "Helvetica-Bold-Germ" },
X { "HO", "Helvetica-Oblique-Germ" },
X { "HX", "Helvetica-BoldOblique-Germ" },
X#ifdef XFONTS
X { "BR", "Bookman-Light-Germ" },
X { "BO", "Bookman-LightItalic-Germ" },
X { "BB", "Bookman-Demi-Germ" },
X { "BX", "Bookman-DemiItalic-Germ" },
X#endif
X { (char *)0, (char *)0 }
X};
X#else
struct fontmap fontmap[] = {
X { "R", "Times-Roman" },
X { "I", "Times-Italic" },
X { "B", "Times-Bold" },
X { "BI", "Times-BoldItalic" },
X { "S", "Symbol" },
X { "S2", "BracketFont" }, /* locally defined special font */
X { "C", "Courier" },
X { "CW", "Courier" }, /* synonym: constant width */
X { "CB", "Courier-Bold" },
X { "CO", "Courier-Oblique" },
X { "CX", "Courier-BoldOblique" },
X { "H", "Helvetica" },
X { "HR", "Helvetica" }, /* two-char name for H */
X { "HB", "Helvetica-Bold" },
X { "HO", "Helvetica-Oblique" },
X { "HX", "Helvetica-BoldOblique" },
X#ifdef XFONTS
X { "BR", "Bookman-Light" },
X { "BO", "Bookman-LightItalic" },
X { "BB", "Bookman-Demi" },
X { "BX", "Bookman-DemiItalic" },
X#endif
X { (char *)0, (char *)0 }
X};
X#endif
X
struct dev dev;
X
short *chartab = NULL; /* char's index in charname array */
char *charname = NULL; /* special character names */
int ncharname; /* no. special character names */
int nfonts = 0; /* no. of fonts mounted */
int nfontmount; /* no. of font mount positions */
X
X /*
X * this is the width that the printer will have moved following
X * the last printed character, if troff then says to move a
X * different amount we will shift the difference
X */
int width_pending = 0;
X
bool word_started = FALSE; /* we are in middle of word string */
X
X
int strcmp();
char *emalloc();
struct fontdesc *findfont();
struct fontmap *getfmap();
X
main(argc, argv)
int argc;
register char **argv;
X{
X register FILE *istr;
X int status = 0;
X extern double atof();
X#ifdef SPACING
X float spacing;
X#endif SPACING
X
X strcpy(device, DEF_DEV); /* just in case we get a "Di" before a "DT" */
X argv++;
X while(*argv && **argv == '-')
X {
X char c;
X
X (*argv)++; /* skip the '-' */
X c = **argv;
X (*argv)++; /* skip the character */
X switch(c)
X {
X case 'D': /* debug */
X Debug = stderr;
X break;
X
X#ifdef SPACING
X case 'h':
X spacing = atof(*argv);
X break;
X#endif SPACING
X case 'r': /* rotate */
X if(**argv == '\0')
X rotation = 90.0;
X else
X rotation = atof(*argv);
X break;
X
X case 'S': /* manual feed */
X manualfeed = TRUE;
X break;
X
X case 'L': /* legal paper type */
X papertype = PT_LEGAL;
X break;
X
X case 't':
X postr = stdout;
X break;
X
X default:
X break;
X }
X argv++;
X }
X
X if (postr == NULL)
X {
X#ifdef GRIS
X postr = popen("exec sendfile -AC -aprinter -dbasser -ugris -e\"-R -qd\" -ntroff-alw", "w");
X if (postr == NULL)
X error(ERR_SNARK, "can't popen spooler");
X#else GRIS
X postr = stdout;
X#endif GRIS
X }
X
X if(! *argv)
X {
X ifile = "stdin";
X process(stdin);
X }
X else while(*argv)
X {
X if((istr=fopen(*argv, "r")) == NULL)
X {
X perror(*argv);
X status++;
X }
X else
X {
X ifile = *argv;
X process(istr);
X fclose(istr);
X }
X argv++;
X }
X if (postr != stdout)
X status += pclose(postr);
X exit(status);
X /* NOTREACHED */
X}
X
process(istr)
XFILE *istr;
X{
X int ch;
X char str[50];
X int n;
X register int i;
X
X lineno = 1; /* start processing 1st input line */
X
X while((ch=getc(istr)) != EOF)
X {
X /*
X * the first switch group can safely be scanned without
X * having to first ensure the horizontal position is
X * up to date.
X */
X switch(ch)
X {
X /* noise */
X case ' ':
X case '\0':
X continue;
X
X case '\n':
X lineno++;
X continue;
X
X case '0': case '1': case '2': case '3': case '4':
X case '5': case '6': case '7': case '8': case '9':
X ungetc(ch, istr);
X fscanf(istr, "%2d", &n);
X
X width_pending -= n;
X hpos += n;
X
X /* drop through to process the next char */
X
X case 'c': /* ascii character */
X
X /*
X * if this char and preceeding were
X * not simply successive chars in the
X * same word then we need some
X * horizontal motion to reset position
X */
X if ( width_pending != 0 )
X hgoto( );
X
X ch = getc(istr);
X
X width_pending += GETWIDTH( tfp.fp_font,
X (i = tfp.fp_font->f_fitab[ch - NUNPRINT] ));
X
X if(ch != ' ')
X putch(tfp.fp_font->f_codetab[i] & BMASK);
X else
X putch(' '); /* no code for ' ' */
X continue;
X
X case 'C': /* troff character */
X
X if ( width_pending != 0 )
X hgoto( );
X
X fscanf(istr, "%s", str);
X putspec(str);
X continue;
X
X case 'h': /* relative horizontal movement */
X fscanf(istr, "%d", &n);
X
X /*
X * we continually accumulate horizontal
X * motions and all relative requests are
X * translated into absolute ones.
X * This avoids accumulation of character
X * width rounding errors
X * beyond a single word. (These errors arise
X * because troff requires widths to be
X * integral to the unit resolution whereas in
X * the printer they may be fractional).
X */
X
X hpos += n;
X if ( ( width_pending -= n ) != 0 )
X hgoto( ); /* most likely end of word */
X
X continue;
X
X case 'w':
X firstpage = FALSE;
X CLOSEWORD();
X continue;
X
X case 'n': /* newline */
X fscanf(istr, "%*f %*f");
X width_pending = 0; /* doesn't matter now */
X continue;
X
X case 'f': /* select font no. */
X fscanf(istr, "%d", &n);
X if(n > nfonts || n < 0 || fontmount[n] == NULL)
X {
X sprintf(errbuf, "ERROR: font %d not mounted",
X n);
X error(ERR_WARN, errbuf);
X }
X else
X {
X tfp.fp_font = fontmount[n];
X currtfont = n;
X }
X continue;
X
X case 's': /* size in points */
X fscanf(istr, "%d", &n);
X if(n <= 0)
X {
X sprintf(errbuf, "Illegal point size %d\n", n);
X error(ERR_WARN, errbuf);
X }
X else
X {
X tfp.fp_size = n;
X tfp.fp_height = (float) n;
X }
X continue;
X
X case 'H': /* absolute horizontal position */
X
X fscanf(istr, "%d", &hpos);
X hgoto();
X continue;
X
X case 'V': /* absolute vertical position */
X fscanf(istr, "%d", &vpos);
X vgoto();
X continue;
X
X case 'v': /* relative vertical movement */
X fscanf(istr, "%d", &n);
X vmot(n);
X continue;
X
X }
X /*
X * If the input char is in the second group
X * then we must make sure the printer is positioned
X * where troff thinks it is
X * and close any word currently being printed
X */
X if ( width_pending != 0 )
X hgoto( );
X else
X CLOSEWORD();
X
X switch(ch)
X {
X case 'x': /* device control function */
X devcntrl(istr);
X break;
X
X case 'D': /* draw */
X draw(istr);
X break;
X#ifdef GEMPRINT
X case 'E': /* call program */
X call(istr);
X break;
X#endif
X
X case 'p': /* new page */
X fscanf(istr, "%d", &n);
X page(n);
X break;
X
X case '#': /* comment */
X while((ch=getc(istr)) != '\n' && ch != EOF);
X lineno++;
X break;
X
X case 't': /* text */
X text(istr);
X break;
X
X# ifdef HASH
X /*
X * debug - to be manually inserted in input stream if needed
X * if n >= 0 && n <= HASH_SIZE
X * then will print entire hash contents
X * otherwise will dump just names in hash_tab[n] entry
X */
X case 'Z':
X fscanf(istr, "%d", &n);
X dumphash( n );
X break;
X
X# endif
X
X case '!': /* pass through uninterpreted */
X setfont(FALSE); /* ensure current font is set */
X putc('\n', postr);
X while((ch=getc(istr)) != '\n' && ch != EOF)
X putc(ch, postr);
X break;
X
X default:
X sprintf(errbuf, "Unknown command '%c'", ch);
X error(ERR_FATAL, errbuf);
X }
X }
X}
X
devcntrl(istr)
XFILE *istr;
X{
X char str[50];
X int fontn,
X ch;
X float f;
X
X fscanf(istr, "%s", str);
X switch(*str)
X {
X case 'i': /* device initialisation */
X initfonts(device);
X devinit();
X break;
X
X case 'T': /* we had better get this before an 'init' */
X fscanf(istr, "%s", device);
X break;
X
X case 'r': /* resolution */
X fscanf(istr, "%d %d %d", &res, &hor_res, &vert_res);
X respunits = res / PU_INCH;
X break;
X
X case 'f': /* load font */
X fscanf(istr, "%d %s", &fontn, str);
X loadfont(str, fontn);
X break;
X
X case 's': /* stop */
X finish(0);
X break;
X
X case 'p': /* pause */
X break;
X
X case 't': /* trailer */
X break;
X
X case 'H': /* character height (in points) */
X fscanf(istr, "%f", &f);
X if(f <= 0 || f > 1000)
X {
X sprintf(errbuf,
X "Illegal character height %.1f", f);
X error(ERR_WARN, errbuf);
X }
X else
X tfp.fp_height = f;
X break;
X
X case 'S':
X fscanf(istr, "%f", &f);
X if(f < -80 || f > 80)
X {
X sprintf(errbuf, "Illegal character slant %.1f degrees", f);
X error(ERR_WARN, errbuf);
X }
X else
X tfp.fp_slant = f;
X break;
X
X default:
X sprintf(errbuf, "Unknown device control '%s'", str);
X error(ERR_WARN, errbuf);
X break;
X }
X while((ch=getc(istr)) != '\n' && ch != EOF); /* skip rest of input line */
X lineno++;
X}
X
error(errtype, errmsg)
int errtype;
char *errmsg;
X{
X switch(errtype)
X {
X case ERR_WARN:
X fprintf(stderr, "Warning");
X break;
X
X case ERR_FATAL:
X fprintf(stderr, "Error");
X break;
X
X case ERR_SNARK:
X fprintf(stderr, "Snark");
X break;
X }
X fprintf(stderr, "\t%s pscript input, line %d of '%s'\n",
X errtype == ERR_SNARK ? "at" : "in",
X lineno, ifile);
X if(errmsg && *errmsg)
X fprintf(stderr, "\t%s\n", errmsg);
X if(errtype != ERR_WARN)
X finish(1);
X}
X
finish(status)
int status;
X{
X page(-1);
X pcommfinish(npages, "");
X if(status != 0)
X fprintf(stderr, "\t... aborted processing\n");
X exit(status);
X}
X
X/*
X * Output the postscript "prologue" that is the start of each program
X * generated. This sets up definitions, sets the scale to be troff
X * units, etc.
X * By convention, single character variables are procedure names,
X * while multi-character variables are local to procedures.
X */
X
char *inittab[] = {
X /* initialise current path to non-null */
X "0 0 moveto",
X /* fix to make "joined" lines better */
X "2 setlinecap",
X /* routine for RELATIVE HORIZONTAL RIGHT */
X /* need no more
X "/x { 0 rmoveto } def",
X /* routine for RELATIVE VERTICAL DOWN */
X "/y { neg 0 exch rmoveto } def",
X /* routine for ABSOLUTE HORIZONTAL (rel left edge page) */
X "/X { currentpoint exch pop moveto } def",
X /* routine for ABSOLUTE VERTICAL (rel top of page) */
X "/Y { pgtop exch sub currentpoint pop exch moveto } def",
X#ifdef SPACING
X "/s { currentpoint spacing 0 5 -1 roll ashow moveto } def",
X#else
X "/s { show } def",
X#endif SPACING
X "/l { neg rlineto currentpoint stroke moveto } def",
X/* The following definitions are needed for PIC drawings. They aren't
X * neccessary if graphics comes in metafile. (27-11-86 -- axel@coma.uucp)
X */
X#ifndef GEMPRINT
X /* circle - arg is diameter.
X * Current point is left edge
X */
X "/c {",
X /* save radius and current position */
X "2 div /rad exch def currentpoint /y0 exch def /x0 exch def",
X /* draw circle */
X "newpath x0 rad add y0 rad 0 360 arc stroke",
X /* move to right edge of circle */
X "x0 rad add rad add y0 moveto",
X " } def",
X /* Arc anticlockwise, currentpoint is start;
X * args are dx1, dy1 (centre relative to here)
X * and dx2, dy2 (end relative to centre).
X */
X "/a {",
X /* save all parameters */
X "/y2 exch neg def /x2 exch def /y1 exch neg def /x1 exch def",
X /* move to centre, push position for moveto after arc */
X "x1 y1 rmoveto currentpoint",
X /* push centre for args to arc */
X "currentpoint",
X /* calculate and push radius */
X "x2 x2 mul y2 y2 mul add sqrt",
X /* start angle */
X "y1 neg x1 neg atan",
X /* end angle */
X "y2 x2 atan",
X /* draw the arc, and move to end position */
X "newpath arc stroke moveto x2 y2 rmoveto",
X "} def",
X /* ellipse - args are x diameter, y diameter;
X * current position is left edge
X */
X "/e {",
X /* save x and y radius */
X "2 div /yrad exch def 2 div /xrad exch def",
X /* save current position */
X "currentpoint /y0 exch def /x0 exch def",
X /* translate to centre of ellipse */
X "x0 xrad add y0 translate",
X /* scale coordinate system */
X "xrad yrad scale",
X /* draw the ellipse (unit circle in scaled system) */
X "newpath 0 0 1 0 360 arc",
X /* restore old scale + origin */
X "savematrix setmatrix",
X /* actually draw the ellipse (with unscaled linewidth) */
X "stroke",
X /* move to right of ellipse */
X "x0 xrad add xrad add y0 moveto",
X "} def",
X /*
X * common procedure for spline curves
X */
X "/spln {",
X /* setup curve, remember where we are, fill in line,
X ** and reset current point
X */
X "rcurveto currentpoint stroke moveto",
X "} def",
X#else GEMPRINT
X"%%BeginProcSet: \"mfps-builtin-GEM-prologue\" \"(0.0)\" \"\"",
X"/Gem2PSdict 50 dict def",
X"Gem2PSdict begin",
X#ifdef GUMLAUT
X"/reencsmalldict 12 dict def",
X"/ReEncodeSmall",
X"{ reencsmalldict begin",
X" /newcodesandnames exch def",
X" /newfontname exch def",
X" /basefontname exch def",
X" /basefontdict basefontname findfont def",
X" /newfont basefontdict maxlength dict def",
X" basefontdict",
X" { exch dup /FID ne",
X" { dup /Encoding eq",
X" { exch dup length array copy newfont 3 1 roll put }",
X" { exch newfont 3 1 roll put }",
X" ifelse",
X" }",
X" { pop pop }",
X" ifelse",
X" } forall",
X" newfont /FontName newfontname put",
X" newcodesandnames aload pop",
X" newcodesandnames length 2 idiv",
X" { newfont /Encoding get 3 1 roll put }",
X" repeat",
X" newfontname newfont definefont pop",
X" end",
X"} def",
X"/germvec [",
X"8#204 /adieresis",
X"8#224 /odieresis",
X"8#201 /udieresis",
X"8#216 /Adieresis",
X"8#231 /Odieresis",
X"8#232 /Udieresis",
X"8#236 /germandbls",
X"] def",
X"/Times-Roman /Times-Roman-Germ germvec",
X" ReEncodeSmall",
X"/Times-Italic /Times-Italic-Germ germvec",
X" ReEncodeSmall",
X"/Times-Bold /Times-Bold-Germ germvec",
X" ReEncodeSmall",
X"/Times-BoldItalic /Times-BoldItalic-Germ germvec",
X" ReEncodeSmall",
X"/Helvetica /Helvetica-Germ germvec",
X" ReEncodeSmall",
X"/Helvetica-Bold /Helvetica-Bold-Germ germvec",
X" ReEncodeSmall",
X"/Helvetica-Oblique /Helvetica-Oblique-Germ germvec",
X" ReEncodeSmall",
X"/Helvetica-BoldOblique /Helvetica-BoldOblique-Germ germvec",
X" ReEncodeSmall",
X"/t { /Times-Roman-Germ findfont exch scalefont setfont } bind def",
X"/ti { /Times-Italic-Germ findfont exch scalefont setfont } bind def",
X"/tb { /Times-Bold-Germ findfont exch scalefont setfont } bind def",
X"/tx { /Times-BoldItalic-Germ findfont exch scalefont setfont } bind def",
X"/h { /Helvetica-Germ findfont exch scalefont setfont } bind def",
X"/hb { /Helvetica-Bold-Germ findfont exch scalefont setfont } bind def",
X"/ho { /Helvetica-Oblique-Germ findfont exch scalefont setfont } bind def",
X"/hbo { /Helvetica-BoldOblique-Germ findfont exch scalefont setfont }",
X" bind def",
X#else
X"/t { /Times-Roman findfont exch scalefont setfont } bind def",
X"/ti { /Times-Italic findfont exch scalefont setfont } bind def",
X"/tb { /Times-Bold findfont exch scalefont setfont } bind def",
X"/tx { /Times-BoldItalic findfont exch scalefont setfont } bind def",
X"/h { /Helvetica findfont exch scalefont setfont } bind def",
X"/hb { /Helvetica-Bold findfont exch scalefont setfont } bind def",
X"/ho { /Helvetica-Oblique findfont exch scalefont setfont } bind def",
X"/hbo { /Helvetica-BoldOblique findfont exch scalefont setfont } bind def",
X#endif GUMLAUT
X"/bitison",
X"{",
X" /ybit exch def /xbit exch def",
X" bstring ybit bwidth mul",
X" xbit 8 idiv add get",
X" 1 7 xbit 8 mod sub bitshift",
X" and 0 ne",
X"} bind def",
X"/setpattern",
X"{",
X" /freq exch def",
X" /bwidth exch def",
X" /bpside exch def",
X" /bstring exch def",
X" /onbits 0 def /offbits 0 def",
X" freq 0 {",
X" /y exch def /x exch def",
X" /xindex x 1 add 2 div bpside mul cvi def",
X" /yindex y 1 add 2 div bpside mul cvi def",
X" xindex yindex bitison",
X" { /onbits onbits 1 add def 1 }",
X" { /offbits offbits 1 add def 0 }",
X" ifelse",
X" } setscreen",
X" {} settransfer",
X" offbits offbits onbits add div setgray",
X"} bind def",
X"/mf {",
X" statusdict begin /manualfeedtimeout 300 def ",
X" /manualfeed true def ",
X" end } bind def",
X"/af {",
X" statusdict begin /waittimeout 5 def",
X" /manualfeed false def",
X" end } bind def",
X"/padj { transform round exch round exch itransform } bind def",
X"/ul { dup stringwidth pop 0 gsave 0.4 setlinewidth",
X" currentpoint newpath moveto 0 -2 padj rmoveto padj rlineto",
X" closepath stroke grestore } bind def",
X"/oshow { gsave currentpoint newpath moveto 0.2 setlinewidth false",
X" charpath closepath stroke } bind def",
X"/wtext {",
X" /str exch def /strwd exch def /nsp exch def /underl exch def",
X" str stringwidth pop /pstrwd exch def",
X" underl { gsave 0.4 setlinewidth currentpoint newpath",
X" moveto 0 -2 padj rmoveto strwd 0 padj rlineto ",
X" closepath stroke grestore } if",
X" nsp 0 ne",
X" { strwd pstrwd sub nsp div 0 8#040 str widthshow }",
X" { str show } ifelse",
X"} bind def",
X"/atext {",
X" /str exch def /strwd exch def /underl exch def",
X" str stringwidth pop /pstrwd exch def",
X" underl { gsave 0.4 setlinewidth currentpoint newpath",
X" moveto 0 -2 padj rmoveto strwd 0 padj rlineto",
X" closepath stroke grestore } if",
X" strwd pstrwd sub str length dup 1 gt { 1 sub } if div 0 str ashow",
X"} bind def",
X"/arrow {",
X" /leg exch def /taily exch def /tailx exch def",
X" /tipy exch def /tipx exch def",
X" gsave",
X" 1 setlinecap",
X" newpath",
X" tipx tipy translate",
X" taily tipy sub /num exch def",
X" tailx tipx sub /den exch def",
X" num den eq den 0 eq and { /num 1 def } if",
X" num den atan 16 sub rotate",
X" leg 0 moveto 0 0 lineto",
X" 32 rotate",
X" leg 0 lineto",
X" closepath fill",
X" grestore } bind def",
X"/pln { % xn yn xn-1 yn-1 .. x1 y1 n, draws a polyline with n-1 segments",
X" /n exch def",
X" /n n 1 sub def",
X" padj moveto",
X" 1 1 n { pop padj lineto } for",
X"} bind def",
X"/pline { % x1 y1 x2 y2, draws a line which is consistent with parallels",
X" /y2 exch def /x2 exch def /y1 exch def /x1 exch def",
X" x1 y1 padj moveto",
X" x2 y2 padj rlineto",
X"} bind def",
X"/elip { % xscale yscale x y rad sang eang, draws an elliptical arc",
X" /ea exch def /sa exch def /rad exch def",
X" translate scale 0 0 rad sa ea arc",
X" /sm 6 array def /im 6 array def /sm sm currentmatrix def",
X" /im im defaultmatrix def sm 0 im 0 get put",
X" sm 3 im 3 get put sm setmatrix",
X"} bind def",
X"/resetscale { /sm 6 array def /im 6 array def /sm sm currentmatrix def",
X" /im im defaultmatrix def sm 0 im 0 get put",
X" sm 3 im 3 get put sm setmatrix",
X"} bind def",
X#ifdef PSDEBUG
X/* Use: 'gsave ( labeltext ) X Y markpoint grestore' . Marks given point
X * with an 'x' and labels it with the supplied text. Intended for
X * Debugging
X */
X"/markpoint { newpath moveto currentpoint 3 -1 roll",
X" /Helvetica findfont 10 scalefont setfont dup stringwidth pop 2 add 0",
X" rmoveto",
X" show moveto 3 3 rmoveto -6 -6 rlineto 0 6 rmoveto 6 -6 rlineto",
X" stroke } bind def",
X#endif
X"end", /* end of Gem2PSdict initialization */
X"%%EndProcSet",
X#endif GEMPRINT
X#ifdef GERMAN
X /* routine to modify fonts */
X "/reencsmalldict 12 dict def",
X "/ReEncodeSmall",
X "{ reencsmalldict begin",
X " /newcodesandnames exch def",
X " /newfontname exch def",
X " /basefontname exch def",
X " /basefontdict basefontname findfont def",
X " /newfont basefontdict maxlength dict def",
X " basefontdict",
X " { exch dup /FID ne",
X " { dup /Encoding eq",
X " { exch dup length array copy newfont 3 1 roll put }",
X " { exch newfont 3 1 roll put }",
X " ifelse",
X " }",
X " { pop pop }",
X " ifelse",
X " } forall",
X " newfont /FontName newfontname put",
X " newcodesandnames aload pop",
X " newcodesandnames length 2 idiv",
X " { newfont /Encoding get 3 1 roll put }",
X " repeat",
X " newfontname newfont definefont pop",
X " end",
X "} def",
X /* Vector for additional german characters */
X "/germvec [",
X "8#321 /adieresis",
X "8#322 /odieresis",
X "8#323 /udieresis",
X "8#324 /Adieresis",
X "8#325 /Odieresis",
X "8#326 /Udieresis",
X "] def",
X /* Define German fonts */
X "/Times-Roman /Times-Roman-Germ germvec",
X " ReEncodeSmall",
X "/Times-Italic /Times-Italic-Germ germvec",
X " ReEncodeSmall",
X "/Times-Bold /Times-Bold-Germ germvec",
X " ReEncodeSmall",
X "/Times-BoldItalic /Times-BoldItalic-Germ germvec",
X " ReEncodeSmall",
X "/Helvetica /Helvetica-Germ germvec",
X " ReEncodeSmall",
X "/Helvetica-Bold /Helvetica-Bold-Germ germvec",
X " ReEncodeSmall",
X "/Helvetica-Oblique /Helvetica-Oblique-Germ germvec",
X " ReEncodeSmall",
X "/Helvetica-BoldOblique /Helvetica-BoldOblique-Germ germvec",
X " ReEncodeSmall",
X "/Courier /Courier-Germ germvec",
X " ReEncodeSmall",
X "/Courier-Bold /Courier-Bold-Germ germvec",
X " ReEncodeSmall",
X "/Courier-Oblique /Courier-Oblique-Germ germvec",
X " ReEncodeSmall",
X "/Courier-BoldOblique /Courier-BoldOblique-Germ germvec",
X " ReEncodeSmall",
X#ifdef XFONTS
X "/Bookman-Light /Bookman-Light-Germ germvec",
X " ReEncodeSmall",
X "/Bookman-LightItalic /Bookman-LightItalic-Germ germvec",
X " ReEncodeSmall",
X "/Bookman-Demi /Bookman-Demi-Germ germvec",
X " ReEncodeSmall",
X "/Bookman-DemiItalic /Bookman-DemiItalic-Germ germvec",
X " ReEncodeSmall",
X#endif XFONTS
X#endif GERMAN
X /* routine to select a font */
X "/ft { /fonttype exch def /xsiz exch def /ysiz exch def /sl exch def",
X " fonttype [ xsiz pt 0 sl sin sl cos div ysiz pt mul ysiz pt 0 0 ]",
X " makefont setfont",
X#ifndef GEMPRINT
X /* point size also affects linewidth (see Pic user manual, p. 17) */
X " xsiz 1.7 div setlinewidth } def",
X#else
X /* this seems to be of no use, if pictures are derived from a
X * GEM-Metafile (axel@coma, 3-Nov-86) */
X "} def",
X#endif
X (char *) 0 };
X
X
devinit()
X{
X register char **ptab;
X register int i;
X
X /* postscript basic units are "1/PU_INCH" inches.
X * Normally PU_INCH=72, making postscript units points (1/72 inch)
X * Scale postscript to accept whatever resolution we are given
X * Typically res=300 for a 300 dot/inch laser printer
X */
X pcomminit(PU_INCH / (float) res, rotation, papertype, manualfeed, 0,
X (char *)0, "troff->tpscript");
X ptab = inittab;
X while(*ptab)
X fprintf(postr, "%s\n", *ptab++);
X /* conversion back to points for font sizes etc. */
X fprintf(postr, "/pt { %d mul } def\n", respunits);
X
X#if defined(UQMINMET) && !defined(ALW)
X /* to compensate for "setmargins" */
X fprintf( postr, "\n-90 230 translate\n" );
X#endif
X /* All graphics transformations have been done. Save the
X * transformation matrix
X */
X fprintf(postr, "/savematrix matrix currentmatrix def\n");
X#ifdef SPACING
X /* set increased character spacing (if any) */
X fprintf(postr, "/spacing %.1f pt def\n", spacing);
X#endif SPACING
X
X s2init(); /* initialise special font 2 */
X
X /* set up font abbreviations */
X for(i=1; i<nfonts+1; i++)
X fprintf(postr, "/f.%s /%s findfont def\n",
X fontd[i].f_extname, fontd[i].f_intname);
X /* select default current font */
X tfp.fp_size = DEF_SIZE;
X tfp.fp_height = (float) DEF_SIZE;
X tfp.fp_slant = 0;
X tfp.fp_font = &fontd[DEF_FONT];
X pfp.fp_font = (struct fontdesc *) NULL;
X setfont(FALSE);
X
X /* save state */
X endinit();
X}
X
X
X/*
X * Called when some use of characters or line-drawing
X * is about to be made, to ensure that the correct font and
X * line thickness is selected in postscript.
X */
setfont(force)
bool force;
X{
X
X if(tfp.fp_size == pfp.fp_size &&
X tfp.fp_height == pfp.fp_height &&
X tfp.fp_slant == pfp.fp_slant &&
X tfp.fp_font == pfp.fp_font &&
X ! force)
X return;
X CLOSEWORD();
X fprintf(postr, "\n%.1f %.0f %d f.%s ft",
X tfp.fp_slant,
X tfp.fp_height, tfp.fp_size,
X tfp.fp_font->f_extname);
X pfp = tfp;
X}
X
draw(istr)
XFILE *istr;
X{
X int ch;
X int x, y,
X x1, y1,
X d;
X
X setfont( FALSE ); /* in case of size change affecting line thickness */
X
X switch(ch=getc(istr))
X {
X case 'l':
X fscanf(istr, "%d %d", &x, &y);
X fprintf(postr, "\n%d %d l", x, y);
X break;
X
X case 'c':
X fscanf(istr, "%d", &d);
X fprintf(postr, "\n%d c", d);
X break;
X
X case 'e':
X fscanf(istr, "%d %d", &x, &y);
X fprintf(postr, "\n%d %d e", x, y);
X break;
X
X case 'a':
X fscanf(istr, "%d %d %d %d", &x, &y, &x1, &y1);
X fprintf(postr, "\n%d %d %d %d a", x, y, x1, y1);
X break;
X
X case '~':
X draw_spline( istr );
X break;
X
X default:
X sprintf(errbuf, "Illegal draw function '%c'", ch);
X error(ERR_WARN, errbuf);
X break;
X }
X while((ch=getc(istr)) != '\n' && ch != EOF);
X lineno++;
X}
X
X
text(istr)
XFILE *istr;
X{
X register int ch;
X
X fprintf(postr, "\n(");
X while((ch=getc(istr)) != '\n' && ch != EOF)
X pch(ch);
X fprintf(postr, ")s");
X}
X
page(n)
register int n;
X{
X hpos = 0; vpos = 0;
X /* for each page except the first, print the previous one */
X if(firstpage)
X firstpage = FALSE;
X else
X {
X fprintf(postr, "\npage");
X setfont(TRUE);
X resetspcl(); /* it forgets definitions on next page */
X }
X if(n >= 0) /* beginning of a new page */
X fprintf(postr, "\n%%%%Page: %d %d\n", n, ++npages);
X}
X
hgoto()
X{
X CLOSEWORD();
X width_pending = 0; /* doesn't matter now */
X fprintf(postr, "\n%d X", hpos);
X}
X
vgoto( )
X{
X CLOSEWORD();
X fprintf(postr, "\n%d Y", vpos);
X}
X
vmot(n)
int n; /* +'ve is DOWN */
X{
X CLOSEWORD();
X fprintf(postr, "\n%d y", n);
X vpos += n;
X}
X
X/*
X * Read the DESC file for the current device. This includes
X * information about all the common fonts. The format is:
X *
X * struct dev (see dev.h)
X * point size table (dev.nsizes * sizeof(short))
X * char index table (chtab; dev.nchtab * sizeof(short))
X * char name table (chname; dev.lchname)
X *
X * followed by dev.nfonts occurrences of
X * struct font (see dev.h)
X * width tables (font.nwfont)
X * kern tables (font.nwfont)
X * code tables (font.nwfont)
X * font index table (dev.nchtab + NASCPRINT)
X */
X
initfonts(devname)
char *devname;
X{
X register int i;
X register struct fontdesc *fd;
X FILE *fstr;
X char path[100];
X
X sprintf(path, "%s/dev%s/DESC.out", fontdir, devname);
X if((fstr=fopen(path, "r")) == NULL)
X {
X sprintf(errbuf, "Can't open '%s' (%s)",
X path, sys_errlist[errno]);
X error(ERR_FATAL, errbuf);
X }
X if(efread((char *)&dev, sizeof(dev), 1, fstr) != 1)
X {
X sprintf(errbuf, "%s: bad format (read dev failed)", path);
X error(ERR_SNARK, errbuf);
X }
X
X nfonts = dev.nfonts;
X /* nfontmount should be at least nfonts+2 */
X nfontmount = nfonts + 20;
X ncharname = dev.nchtab;
X fontd = (struct fontdesc *)
X emalloc((unsigned)(nfonts+2) * sizeof(struct fontdesc));
X fontmount = (struct fontdesc **)
X emalloc((unsigned)nfontmount * sizeof(struct fontdesc *));
X
X /* skip point size table */
X efseek(fstr, (int)((dev.nsizes + 1)*sizeof(short)));
X
X chartab = (short *) emalloc((unsigned)ncharname * sizeof(short));
X efread((char *)chartab, sizeof(* chartab), ncharname, fstr);
X
X charname = emalloc((unsigned)dev.lchname);
X efread(charname, sizeof(* charname), dev.lchname, fstr);
X
X hash_init();
X
X for(i=1; i <= nfonts; i++)
X {
X register int nw;
X struct font f;
X struct fontmap *fm;
X
X /* read struct font header */
X efread((char *)&f, sizeof(f), 1, fstr);
X
X nw = (int)(f.nwfont & BMASK); /* NO sign extension */
X fd = &fontd[i];
X fd->f_nent = nw;
X
X fd->f_widthtab = emalloc((unsigned)nw);
X fd->f_codetab = emalloc((unsigned)nw);
X fd->f_fitab = emalloc((unsigned)(ncharname+NASCPRINT));
X /* remember if font is special */
X if(f.specfont == 1)
X {
X if(spcfnt1 == NOFONTDESC )
X spcfnt1 = fd;
X else if ( spcfnt2 == NOFONTDESC )
X spcfnt2 = fd;
X else
X {
X sprintf( errbuf,
X "Too many special fonts, %s ignored",
X fd->f_extname );
X error(ERR_WARN, errbuf );
X }
X }
X
X fm = getfmap(f.namefont);
X if(fm)
X {
X fd->f_intname = fm->fm_intname;
X fd->f_extname = fm->fm_extname;
X fd->f_mounted = TRUE;
X }
X else
X fprintf(stderr, "font name '%s' not known\n",
X f.namefont);
X
X efread(fd->f_widthtab, sizeof(char), nw, fstr);
X efseek(fstr, 1*nw); /* skip kern tables */
X efread(fd->f_codetab, sizeof(char), nw, fstr);
X efread(fd->f_fitab, sizeof(char), ncharname+NASCPRINT, fstr);
X }
X
X fclose(fstr);
X
X for(i=0; i < nfontmount; i++)
X fontmount[i] = NOFONTDESC;
X
X /* zeroth font desc entry reserved for "extra" fonts */
X fd = &fontd[0];
X fd->f_intname = ""; /* not NULL */
X fd->f_extname = ""; /* not NULL */
X fd->f_codetab = emalloc((unsigned)MAXCHARS);
X fd->f_fitab = emalloc((unsigned)(ncharname+NASCPRINT));
X fd->f_nent = MAXCHARS;
X
X /* sentinel fontdesc entry */
X fd = &fontd[nfonts+1];
X fd->f_intname = (char *)NULL;
X fd->f_extname = (char *)NULL;
X fd->f_nent = 0;
X fd->f_codetab = (char *)NULL;
X fd->f_fitab = (char *)NULL;
X}
X
loadfont(extname, fpos)
char *extname; /* troff font name */
int fpos; /* font position */
X{
X register struct fontdesc *font;
X
X if(fpos > nfontmount || fpos < 0)
X {
X sprintf(errbuf, "Illegal font mount position %d\n", fpos);
X error(ERR_WARN, errbuf);
X return;
X }
X if ( (font = findfont(extname)) == (struct fontdesc *) NULL )
X {
X sprintf(errbuf, "No such font '%s'\n", extname);
X error(ERR_WARN, errbuf);
X return;
X }
X fontmount[fpos] = font;
X}
X
struct fontmap *
getfmap(extname)
char *extname;
X{
X struct fontmap *fm;
X
X fm = fontmap;
X while(fm->fm_intname && strcmp(fm->fm_extname, extname) != 0)
X fm++;
X if(fm->fm_intname)
X return(fm);
X else
X return((struct fontmap *)NULL);
X}
X
X#ifndef UQMINMET
X
struct fontdesc *
findfont(extname)
char *extname;
X{
X struct fontdesc *fd;
X
X fd = fontd;
X while(fd->f_intname && strcmp(fd->f_extname, extname) != 0)
X fd++;
X if(fd->f_intname)
X return(fd);
X else
X return((struct fontdesc *)NULL);
X}
X
X#else UQMINMET
X /*
X * find font including from possible synonym
X * - use internal name instead of troff name.
X * troff names need not uniquely correspond to a given
X * internal name
X */
struct fontdesc *
findfont(extname)
char *extname;
X{
X struct fontmap *fm;
X struct fontdesc *fd;
X
X if ( (fm = getfmap( extname )) == (struct fontmap *)NULL )
X return((struct fontdesc *)NULL);
X fd = fontd;
X while(fd->f_intname && strcmp(fd->f_intname, fm->fm_intname) != 0)
X fd++;
X if(fd->f_intname)
X return(fd);
X else
X return((struct fontdesc *)NULL);
X}
X#endif UQMINMET
X
char *
emalloc(size)
unsigned size;
X{
X char *malloc();
X register char *s;
X
X s = malloc(size);
X if(s == NULL)
X {
X fprintf(stderr, "Ran out of memory allocating %u bytes\n",
X size);
X finish(1);
X }
X return(s);
X}
X
efread(buf, size, nel, istr)
char *buf;
int size,
X nel;
XFILE *istr;
X{
X register int n;
X
X if((n=fread(buf, size, nel, istr)) != nel)
X fprintf(stderr, "Bad format font file\n");
X return(n);
X}
X
efseek(istr, offset)
XFILE *istr;
int offset;
X{
X if(fseek(istr, (long)offset, 1) != 0)
X fprintf(stderr, "Snark: Bad seek on font file\n");
X}
X
X
putch(ch)
int ch;
X{
X setfont(FALSE); /* ensure correct font */
X
X if ( word_started == FALSE ) {
X word_started = TRUE;
X putc('(', postr);
X }
X pch(ch);
X}
END_OF_FILE
if test 36974 -ne `wc -c <'./tpscript/tpscript.c'`; then
echo shar: \"'./tpscript/tpscript.c'\" unpacked with wrong size!
fi
# end of './tpscript/tpscript.c'
fi
echo shar: End of archive 5 \(of 5\).
cp /dev/null ark5isdone
MISSING=""
for I in 1 2 3 4 5 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 5 archives.
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
--
Please send comp.sources.unix-related mail to rsalz@uunet.uu.net.