home *** CD-ROM | disk | FTP | other *** search
- Subject: v15i017: Ditroff to PostScript translator, Part05/05
- Newsgroups: comp.sources.unix
- Sender: sources
- Approved: rsalz@uunet.UU.NET
-
- 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
-