home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume15 / tpscript / part05 < prev    next >
Text File  |  1988-05-25  |  54KB  |  2,070 lines

  1. Subject:  v15i017:  Ditroff to PostScript translator, Part05/05
  2. Newsgroups: comp.sources.unix
  3. Sender: sources
  4. Approved: rsalz@uunet.UU.NET
  5.  
  6. Submitted-by: Axel Mahler <axel%coma.UUCP@TUB.BITNET>
  7. Posting-number: Volume 15, Issue 17
  8. Archive-name: tpscript/part05
  9.  
  10. #! /bin/sh
  11. # This is a shell archive.  Remove anything before this line, then unpack
  12. # it by saving it into a file and typing "sh file".  To overwrite existing
  13. # files, type "sh file -c".  You can also feed this as standard input via
  14. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  15. # will see the following message at the end:
  16. #        "End of archive 5 (of 5)."
  17. # Wrapped by rsalz@fig.bbn.com on Thu May 26 13:02:29 1988
  18. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  19. if test -f './pscript/genftable.ps' -a "${1}" != "-c" ; then 
  20.   echo shar: Will not clobber existing file \"'./pscript/genftable.ps'\"
  21. else
  22. echo shar: Extracting \"'./pscript/genftable.ps'\" \(12794 characters\)
  23. sed "s/^X//" >'./pscript/genftable.ps' <<'END_OF_FILE'
  24. X%!
  25. X% genftable - Postcript program to produce font tables for ditroff.
  26. X%          Tables are output on the standard output file - which
  27. X%          needs to be captured by the host computer.
  28. X%
  29. X%          Note the routine "commondefs" which outputs local
  30. X%          defined (hand built) characters.
  31. X%
  32. X% Michael Rourke, University of N.S.W., Australia
  33. X%
  34. X
  35. X/t 30 string def
  36. X
  37. X/ps
  38. X% string ->
  39. X{
  40. X    print
  41. X} def
  42. X
  43. X/pr
  44. X% any -->
  45. X{
  46. X    t cvs ps
  47. X} def
  48. X
  49. X/prsp
  50. X{
  51. X    (\t) ps
  52. X} def
  53. X
  54. X/prnl
  55. X{
  56. X    (\n) ps
  57. X} def
  58. X
  59. X/pro
  60. X% int -->
  61. X{
  62. X    dup 0 eq
  63. X    { pr }
  64. X    { dup 8 idiv pro 8 mod pr }
  65. X    ifelse
  66. X} def
  67. X
  68. X/charsize
  69. X% string --> bot top
  70. X{
  71. X    gsave
  72. X    newpath 0 0 moveto false charpath flattenpath pathbbox
  73. X    exch pop 3 -1 roll pop
  74. X    grestore
  75. X} def
  76. X
  77. X/strwidth
  78. X% string --> width
  79. X{
  80. X    stringwidth pop round cvi
  81. X} def
  82. X
  83. X/prsize
  84. X% string -->
  85. X{
  86. X    dup strwidth pr prsp
  87. X    dup charsize
  88. X    top gt { 2 } { 0 } ifelse
  89. X    exch bot lt { 1 or } if
  90. X    pr prsp
  91. X    0 get pro 
  92. X} def
  93. X
  94. X/fontinfo
  95. X% fontname troffinternal troffname
  96. X{
  97. X    (\ncat <<"!" > ) ps dup pr prnl
  98. X    (# ) ps 2 index pr prnl
  99. X    (name ) ps pr prnl
  100. X    (internalname ) ps pr prnl
  101. X    dup findfont 100 scalefont setfont
  102. X    /fixedwidth false def
  103. X    /Symbol eq
  104. X    {
  105. X        /actions symbol-encoding def
  106. X        (special\n) ps
  107. X    }
  108. X    {
  109. X        /actions standard-encoding def
  110. X        currentfont /FontInfo get /isFixedPitch get
  111. X        {
  112. X            (# fixed width\n) ps
  113. X            /fixedwidth true def
  114. X        }
  115. X        {
  116. X            (ligatures fi fl ff ffi ffl 0\n) ps
  117. X        }
  118. X        ifelse
  119. X    }
  120. X    ifelse
  121. X    % use "o" to get top and bottom on a normal char
  122. X    (o) charsize /top exch def /bot exch def
  123. X    % some non ascending chars slightly higher than "o"
  124. X    % and some lower so adjust slightly
  125. X    /top top 2 add def
  126. X    /bot bot 4 sub def
  127. X    /encoding currentfont /Encoding get def
  128. X    /s 1 string def
  129. X    0 1 255
  130. X    {
  131. X        s 0 2 index put
  132. X        encoding exch get dup /.notdef ne
  133. X        {
  134. X            s 1 index actions exch get
  135. X            % charname charstr
  136. X            exec
  137. X            flush
  138. X        }
  139. X        {
  140. X            pop
  141. X        }        
  142. X        ifelse
  143. X    } for
  144. X    actions standard-encoding eq { commondefs } if
  145. X    (!\n) ps flush
  146. X} def
  147. X
  148. X/commondefs
  149. X{
  150. X    /fracsize (0) strwidth (\244) strwidth add def        % \244 = '/'
  151. X    /Fisize (f) strwidth (\256) strwidth add 5 sub def    % \256 = 'fi'
  152. X    /ffsize (f) strwidth 2 mul 5 sub def
  153. X    /fl { flush } def
  154. X    fixedwidth not
  155. X    {
  156. X        (ff) ps prsp ffsize pr (\t2\t0100\tff ligature - faked\n) ps fl
  157. X        (Fi) ps prsp Fisize pr (\t2\t0100\tffi ligature - faked\n) ps fl
  158. X        (Fl) ps prsp Fisize pr (\t2\t0100\tffl ligature - faked\n) ps fl
  159. X    } if
  160. X    (12) ps prsp fracsize pr (\t2\t0100\t1/2 - faked\n) ps fl
  161. X    (13) ps prsp fracsize pr (\t2\t0100\t1/3 - faked\n) ps fl
  162. X    (14) ps prsp fracsize pr (\t2\t0100\t1/4 - faked\n) ps fl
  163. X    (18) ps prsp fracsize pr (\t2\t0100\t1/8 - faked\n) ps fl
  164. X    (23) ps prsp fracsize pr (\t2\t0100\t2/3 - faked\n) ps fl
  165. X    (34) ps prsp fracsize pr (\t2\t0100\t3/4 - faked\n) ps fl
  166. X    (38) ps prsp fracsize pr (\t2\t0100\t3/8 - faked\n) ps fl
  167. X    (58) ps prsp fracsize pr (\t2\t0100\t5/8 - faked\n) ps fl
  168. X    (78) ps prsp fracsize pr (\t2\t0100\t7/8 - faked\n) ps fl
  169. X    (sq\t100\t3\t0100\tsquare box - faked\n) ps fl
  170. X} def
  171. X
  172. X/space
  173. X% charname charstr -->
  174. X{
  175. X    (spacewidth ) ps
  176. X    strwidth pr pop prnl
  177. X    (charset\n) ps
  178. X} def
  179. X
  180. X/norm
  181. X% charname charstr -->
  182. X{
  183. X    dup pr prsp prsize pop prnl
  184. X} def
  185. X
  186. X/normdup
  187. X% charname charstr dupname -->
  188. X{
  189. X    3 1 roll norm
  190. X    pr prsp (") ps prnl
  191. X} def
  192. X
  193. X/gnorm
  194. X% charname charstr -->
  195. X{
  196. X    (*) ps norm
  197. X} def
  198. X
  199. X/map
  200. X% charname charstr mapname -->
  201. X{
  202. X    pr prsp prsize prsp pr prnl
  203. X} def
  204. X
  205. X/mapdup
  206. X% charname charstr mapname dupname -->
  207. X{
  208. X    4 1 roll map
  209. X    pr prsp (") ps prnl
  210. X} def
  211. X
  212. X/mapdupdup
  213. X% charname charstr mapname dupname dupname -->
  214. X{
  215. X    5 1 roll mapdup
  216. X    pr prsp (") ps prnl
  217. X} def
  218. X
  219. X/cmap
  220. X% charname charstr mapname -->
  221. X{
  222. X    fixedwidth { 3 { pop } repeat } { map } ifelse
  223. X} def
  224. X
  225. X/standard-encoding 149 dict def
  226. standard-encoding begin
  227. X    /space        { space }        def
  228. X    /exclam        { norm }        def
  229. X    /quotedbl    { norm }        def
  230. X    /numbersign    { norm }        def
  231. X    /dollar        { norm }        def
  232. X    /percent    { norm }        def
  233. X    /ampersand    { norm }        def
  234. X    /quoteright    { norm }        def
  235. X    /parenleft    { norm }        def
  236. X    /parenright    { norm }        def
  237. X    /asterisk    { norm }        def
  238. X    /plus        { norm }        def
  239. X    /comma        { norm }        def
  240. X    /hyphen        { (hy) normdup }    def
  241. X    /period        { norm }        def
  242. X    /slash        { (sl) dup }        def
  243. X    /zero        { norm }        def
  244. X    /one        { norm }        def
  245. X    /two        { norm }        def
  246. X    /three        { norm }        def
  247. X    /four        { norm }        def
  248. X    /five        { norm }        def
  249. X    /six        { norm }        def
  250. X    /seven        { norm }        def
  251. X    /eight        { norm }        def
  252. X    /nine        { norm }        def
  253. X    /colon        { norm }        def
  254. X    /semicolon    { norm }        def
  255. X    /less        { norm }        def
  256. X    /equal        { norm }        def
  257. X    /greater    { norm }        def
  258. X    /question    { norm }        def
  259. X    /at        { norm }        def
  260. X    /A        { norm }        def
  261. X    /B        { norm }        def
  262. X    /C        { norm }        def
  263. X    /D        { norm }        def
  264. X    /E        { norm }        def
  265. X    /F        { norm }        def
  266. X    /G        { norm }        def
  267. X    /H        { norm }        def
  268. X    /I        { norm }        def
  269. X    /J        { norm }        def
  270. X    /K        { norm }        def
  271. X    /L        { norm }        def
  272. X    /M        { norm }        def
  273. X    /N        { norm }        def
  274. X    /O        { norm }        def
  275. X    /P        { norm }        def
  276. X    /Q        { norm }        def
  277. X    /R        { norm }        def
  278. X    /S        { norm }        def
  279. X    /T        { norm }        def
  280. X    /U        { norm }        def
  281. X    /V        { norm }        def
  282. X    /W        { norm }        def
  283. X    /X        { norm }        def
  284. X    /Y        { norm }        def
  285. X    /Z        { norm }        def
  286. X    /bracketleft    { norm }        def
  287. X    /backslash    { norm }        def
  288. X    /bracketright    { norm }        def
  289. X    /asciicircum    { (a^) map }        def
  290. X    /underscore    { (ru) normdup }    def
  291. X    /quoteleft    { norm }        def
  292. X    /a        { norm }        def
  293. X    /b        { norm }        def
  294. X    /c        { norm }        def
  295. X    /d        { norm }        def
  296. X    /e        { norm }        def
  297. X    /f        { norm }        def
  298. X    /g        { norm }        def
  299. X    /h        { norm }        def
  300. X    /i        { norm }        def
  301. X    /j        { norm }        def
  302. X    /k        { norm }        def
  303. X    /l        { norm }        def
  304. X    /m        { norm }        def
  305. X    /n        { norm }        def
  306. X    /o        { norm }        def
  307. X    /p        { norm }        def
  308. X    /q        { norm }        def
  309. X    /r        { norm }        def
  310. X    /s        { norm }        def
  311. X    /t        { norm }        def
  312. X    /u        { norm }        def
  313. X    /v        { norm }        def
  314. X    /w        { norm }        def
  315. X    /x        { norm }        def
  316. X    /y        { norm }        def
  317. X    /z        { norm }        def
  318. X    /braceleft    { norm }        def
  319. X    /bar        { norm }        def
  320. X    /braceright    { norm }        def
  321. X    /asciitilde    { (a~) map }        def
  322. X    /exclamdown    { (I!) map }        def
  323. X    /cent        { (ct) map }        def
  324. X    /sterling    { (po) map }        def
  325. X    /fraction    { }            def
  326. X    /yen        { ($J) map }        def
  327. X    /florin        { }            def
  328. X    /section    { (sc) map }        def
  329. X    /currency    { }            def
  330. X    /quotesingle    { (fm) (n') mapdup }    def
  331. X    /quotedblleft    { (lq) map }        def
  332. X    /guillemotleft    { (d<) map }        def
  333. X    /guilsinglleft    { (l<) map }        def
  334. X    /guilsinglright    { (r>) map }        def
  335. X    /fi        { (fi) cmap }        def
  336. X    /fl        { (fl) cmap }        def
  337. X    /endash        { (\\-) map }        def
  338. X    /dagger        { (dg) map }        def
  339. X    /daggerdbl    { (dd) map }        def
  340. X    /periodcentered    { }            def
  341. X    /paragraph    { (pp) map }        def
  342. X    /bullet        { (bu) map }        def
  343. X    /quotesinglbase    { }             def
  344. X    /quotedblbase    { }            def
  345. X    /quotedblright    { (rq) map }        def
  346. X    /guillemotright    { (d>) map }        def
  347. X    /ellipsis    { }            def
  348. X    /perthousand    { (pm) cmap }        def
  349. X    /questiondown    { (I?) map }        def
  350. X    /grave        { (ga) (\\`) mapdup }    def
  351. X    /acute        { (aa) (\\') mapdup }    def
  352. X    /circumflex    { (^) map }        def
  353. X    /tilde        { (~) map }        def
  354. X    /macron        { (ma) map }        def
  355. X    /breve        { (be) map }        def
  356. X    /dotaccent    { (dt) map }        def
  357. X    /dieresis    { (..) (um) mapdup }    def
  358. X    /ring        { (ri) map }        def
  359. X    /cedilla    { (cd) map }        def
  360. X    /hungarumlaut    { ('') map }        def
  361. X    /ogonek        { (og) map }        def
  362. X    /caron        { (hc) map }        def
  363. X    /emdash        { (em) map }        def
  364. X    /AE        { (AE) cmap }        def
  365. X    /ordfeminine    { }            def
  366. X    /Lslash        { (PL) map }        def
  367. X    /Oslash        { (O/) map }        def
  368. X    /OE        { (OE) cmap }        def
  369. X    /ordmasculine    { }            def
  370. X    /ae        { (ae) cmap }        def
  371. X    /dotlessi    { (ui) map }        def
  372. X    /lslash        { (Pl) map }        def
  373. X    /oslash        { (o/) map }        def
  374. X    /oe        { (oe) cmap }        def
  375. X    /germandbls    { (ss) map }        def
  376. end
  377. X
  378. X/symbol-encoding 189 dict def
  379. symbol-encoding begin
  380. X    /space        { space }        def
  381. X    /exclam        { norm }        def
  382. X    /universal    { (fa) map }        def
  383. X    /numbersign    { norm }        def
  384. X    /existential    { (te) map }        def
  385. X    /percent    { norm }        def
  386. X    /ampersand    { norm }        def
  387. X    /suchthat    { (cm) map }        def
  388. X    /parenleft    { norm }        def
  389. X    /parenright    { norm }        def
  390. X    /asteriskmath    { (**) map }        def
  391. X    /plus        { (pl) map }        def
  392. X    /comma        { norm }        def
  393. X    /minus        { (mi) normdup }    def
  394. X    /period        { norm }        def
  395. X    /slash        { (sl) map }        def
  396. X    /zero        { norm }        def
  397. X    /one        { norm }        def
  398. X    /two        { norm }        def
  399. X    /three        { norm }        def
  400. X    /four        { norm }        def
  401. X    /five        { norm }        def
  402. X    /six        { norm }        def
  403. X    /seven        { norm }        def
  404. X    /eight        { norm }        def
  405. X    /nine        { norm }        def
  406. X    /colon        { norm }        def
  407. X    /semicolon    { norm }        def
  408. X    /less        { norm }        def
  409. X    /equal        { (eq) normdup }    def
  410. X    /greater    { norm }        def
  411. X    /question    { norm }        def
  412. X    /congruent    { (=~) map }        def
  413. X    /Alpha        { gnorm }        def
  414. X    /Beta        { gnorm }        def
  415. X    /Chi        { (*X) map }        def
  416. X    /Delta        { gnorm }        def
  417. X    /Epsilon    { gnorm }        def
  418. X    /Phi        { gnorm }        def
  419. X    /Gamma        { gnorm }        def
  420. X    /Eta        { (*Y) map }        def
  421. X    /Iota        { gnorm }        def
  422. X    /theta1        { }            def
  423. X    /Kappa        { gnorm }        def
  424. X    /Lambda        { gnorm }        def
  425. X    /Mu        { gnorm }        def
  426. X    /Nu        { gnorm }        def
  427. X    /Omicron    { gnorm }        def
  428. X    /Pi        { gnorm }        def
  429. X    /Theta        { (*H) map }        def
  430. X    /Rho        { gnorm }        def
  431. X    /Sigma        { gnorm }        def
  432. X    /Tau        { gnorm }        def
  433. X    /Upsilon    { gnorm }        def
  434. X    /sigma1        { (ts) map }        def
  435. X    /Omega        { (*W) map }        def
  436. X    /Xi        { (*C) map }        def
  437. X    /Psi        { (*Q) map }        def
  438. X    /Zeta        { gnorm }        def
  439. X    /bracketleft    { norm }        def
  440. X    /therefore    { (tf) map }        def
  441. X    /bracketright    { norm }        def
  442. X    /perpendicular    { (bt) map }        def
  443. X    /underscore    { (ul) map }        def
  444. X    /radicalex    { }            def
  445. X    /alpha        { gnorm }        def
  446. X    /beta        { gnorm }        def
  447. X    /chi        { (*x) map }        def
  448. X    /delta        { gnorm }        def
  449. X    /epsilon    { gnorm }        def
  450. X    /phi        { gnorm }        def
  451. X    /gamma        { gnorm }        def
  452. X    /eta        { (*y) map }        def
  453. X    /iota        { gnorm }        def
  454. X    /phi1        { }            def
  455. X    /kappa        { gnorm }        def
  456. X    /lambda        { gnorm }        def
  457. X    /mu        { gnorm }        def
  458. X    /nu        { gnorm }        def
  459. X    /omicron    { gnorm }        def
  460. X    /pi        { gnorm }        def
  461. X    /theta        { (*h) map }        def
  462. X    /rho        { gnorm }        def
  463. X    /sigma        { gnorm }        def
  464. X    /tau        { gnorm }        def
  465. X    /upsilon    { gnorm }        def
  466. X    /omega1        { }            def
  467. X    /omega        { (*w) map }        def
  468. X    /xi        { (*c) map }        def
  469. X    /psi        { (*q) map }        def
  470. X    /zeta        { gnorm }        def
  471. X    /braceleft    { norm }        def
  472. X    /bar        { (or) normdup }    def
  473. X    /braceright    { norm }        def
  474. X    /similar    { (ap) map }        def
  475. X    /Upsilon1    { }            def
  476. X    /minute        { (mt) map }        def
  477. X    /lessequal    { (<=) map }        def
  478. X    /fraction    { (/) map }        def
  479. X    /infinity    { (if) map }        def
  480. X    /florin        { }            def
  481. X    /club        { (Cc) map }        def
  482. X    /diamond    { (Cd) map }        def
  483. X    /heart        { (Ch) map }        def
  484. X    /spade        { (Cs) map }        def
  485. X    /arrowboth    { (<>) map }        def
  486. X    /arrowleft    { (<-) map }        def
  487. X    /arrowup    { (ua) map }        def
  488. X    /arrowright    { (->) map }        def
  489. X    /arrowdown    { (da) map }        def
  490. X    /degree        { (de) map }        def
  491. X    /plusminus    { (+-) map }        def
  492. X    /second        { (sd) map }        def
  493. X    /greaterequal    { (>=) map }        def
  494. X    /multiply    { (mu) map }        def
  495. X    /proportional    { (pt) map }        def
  496. X    /partialdiff    { (pd) map }        def
  497. X    /bullet        { }            def
  498. X    /divide        { (di) map }        def
  499. X    /notequal    { (!=) map }        def
  500. X    /equivalence    { (==) map }        def
  501. X    /approxequal    { (~=) map }        def
  502. X    /ellipsis    { }            def
  503. X    /arrowvertex    { }            def
  504. X    /arrowhorizex    { }            def
  505. X    /carriagereturn    { (cr) map }        def
  506. X    /aleph        { (al) map }        def
  507. X    /Ifraktur    { }            def
  508. X    /Rfraktur    { }            def
  509. X    /weierstrass    { }            def
  510. X    /circlemultiply    { (ax) map }        def
  511. X    /circleplus    { (a+) map }        def
  512. X    /emptyset    { (es) map }        def
  513. X    /intersection    { (ca) map }        def
  514. X    /union        { (cu) map }        def
  515. X    /propersuperset    { (sp) map }        def
  516. X    /reflexsuperset    { (ip) map }        def
  517. X    /notsubset    { (!s) map }        def
  518. X    /propersubset    { (sb) map }        def
  519. X    /reflexsubset    { (ib) map }        def
  520. X    /element    { (mo) map }        def
  521. X    /notelement    { (!m) (nm) mapdup }    def
  522. X    /angle        { (ag) map }        def
  523. X    /gradient    { (gr) map }        def
  524. X    /registerserif    { }            def
  525. X    /copyrightserif    { }            def
  526. X    /trademarkserif    { }            def
  527. X    /product    { }            def
  528. X    /radical    { (sr) map }        def
  529. X    /dotmath    { (m.) map }        def
  530. X    /logicalnot    { (no) map }        def
  531. X    /logicaland    { (an) (la) mapdup }    def
  532. X    /logicalor    { (lo) map }        def
  533. X    /arrowdblboth    { (io) map }        def
  534. X    /arrowdblleft    { (<:) (lh) mapdup }    def
  535. X    /arrowdblup    { (u=) map }        def
  536. X    /arrowdblright    { (:>) (rh) (im) mapdupdup } def
  537. X    /arrowdbldown    { (d=) map }        def
  538. X    /lozenge    { (dm) map }        def
  539. X    /angleleft    { (L<) map }        def
  540. X    /registersans    { (rg) map }        def
  541. X    /copyrightsans    { (co) map }        def
  542. X    /trademarksans    { (tm) map }        def
  543. X    /summation    { }            def
  544. X    /parenlefttp    { }            def
  545. X    /parenleftex    { }            def
  546. X    /parenleftbt    { }            def
  547. X    /bracketlefttp    { }            def
  548. X    /bracketleftex    { }            def
  549. X    /bracketleftbt    { }            def
  550. X    /bracelefttp    { }            def
  551. X    /braceleftmid    { }            def
  552. X    /braceleftbt    { }            def
  553. X    /braceex    { }            def
  554. X    /apple        { (AL) map }        def
  555. X    /angleright    { (R>) map }        def
  556. X    /integral    { (is) map }        def
  557. X    /integraltp    { }            def
  558. X    /integralex    { }            def
  559. X    /integralbt    { }            def
  560. X    /parenrighttp    { }            def
  561. X    /parenrightex    { }            def
  562. X    /parenrightbt    { }            def
  563. X    /bracketrighttp    { }            def
  564. X    /bracketrightex    { }            def
  565. X    /bracketrightbt    { }            def
  566. X    /bracerighttp    { }            def
  567. X    /bracerightmid    { }            def
  568. X    /bracerightbt    { }            def
  569. end
  570. X
  571. X/Times-Roman        /Roman        /R    fontinfo
  572. X/Helvetica        /Helvetica    /H    fontinfo
  573. X/Courier        /Courier    /C    fontinfo
  574. X/Symbol            /Symbol        /S    fontinfo
  575. X/Times-Italic        /Italic        /I    fontinfo
  576. X/Times-Bold        /Bold        /B    fontinfo
  577. X/Times-BoldItalic    /BoldI        /BI    fontinfo
  578. X/Helvetica-Bold        /HelveticaB    /HB    fontinfo
  579. X/Helvetica-Oblique    /HelveticaO    /HO    fontinfo
  580. X/Helvetica-BoldOblique    /HelveticaBO    /HX    fontinfo
  581. X/Courier-Bold        /CourierB    /CB    fontinfo
  582. X/Courier-Oblique    /CourierO    /CO    fontinfo
  583. X/Courier-BoldOblique    /CourierBO    /CX    fontinfo
  584. END_OF_FILE
  585. if test 12794 -ne `wc -c <'./pscript/genftable.ps'`; then
  586.     echo shar: \"'./pscript/genftable.ps'\" unpacked with wrong size!
  587. fi
  588. # end of './pscript/genftable.ps'
  589. fi
  590. if test -f './tpscript/tpscript.c' -a "${1}" != "-c" ; then 
  591.   echo shar: Will not clobber existing file \"'./tpscript/tpscript.c'\"
  592. else
  593. echo shar: Extracting \"'./tpscript/tpscript.c'\" \(36974 characters\)
  594. sed "s/^X//" >'./tpscript/tpscript.c' <<'END_OF_FILE'
  595. static char *RCSid = "$Header: tpscript.c,v 1.6 87/07/15 19:51:55 andy Exp $";
  596. X
  597. X/*
  598. X * $Log:    tpscript.c,v $
  599. X * Revision 1.6  87/07/15  19:51:55  andy
  600. X * The GEM related part of the PostScript prolog was enhanced.
  601. X * 
  602. X * Revision 1.5  87/04/27  17:35:44  andy
  603. X * in line 205 was a comma missing. 
  604. X * 
  605. X * Revision 1.4  87/04/24  03:01:16  andy
  606. X * *** empty log message ***
  607. X * 
  608. X * Revision 1.3  86/10/15  17:24:24  andy
  609. X * Added Escape-Mechanism which calls another PostScript generating
  610. X * Program as input filter.
  611. X * This change was made to introduce graphics generated by gemdraw
  612. X * in the tpscript output.
  613. X * Escape Character is E --- see #ifdef GEMPRINT
  614. X * 
  615. X */
  616. X
  617. X/*
  618. X *    tpscript.c
  619. X *    Troff post-processor for postscript devices
  620. X *
  621. X *    Original program by Stephen Frede (stephenf@elecvax.oz)
  622. X *        Dept. Comp. Sci., University of NSW, Sydney, Australia.
  623. X *                    ...!seismo!munnari!elecvax!stephenf
  624. X *
  625. X *    Extensive modifications by Cameron Davidson (probe@mm730.uq.oz)
  626. X *                University of Queensland, Brisbane, Australia
  627. X *
  628. X *    Other changes by Michael Rourke (michaelr@elecvax.oz) UNSW.
  629. X */
  630. X
  631. X/* NOTES:
  632. X *
  633. X * Originally, changes to a new font would not take effect until
  634. X * characters from that font were required to be printed, but this
  635. X * means that commands passed through to postscript directly (via \!!)
  636. X * may end up with the wrong font. So now font changes actually happen
  637. X * when requested (or needed in the case of the special font).
  638. X *
  639. X */
  640. X
  641. X/*    The language that is accepted by this program is produced by the new
  642. X *    device independent troff, and consists of the following statements,
  643. X *
  644. X *
  645. X *    sn        set the point size to n
  646. X *    fn        set the typesetter font to the one in position n
  647. X *    cx        output the ASCII character x 
  648. X *    Cxyz        output the code for the special character xyz. This
  649. X *            command is terminated by white space.
  650. X *    Hn        go to absolute horizontal position n
  651. X *    Vn        go to absolute vertical position n ( down is positive )
  652. X *    hn        go n units horizontally from current position
  653. X *    vn        go n units vertically from current position
  654. X *    nnc        move right nn units, then print the character c. This
  655. X *            command expects exactly two digits followed by the
  656. X *            character c.
  657. X *            ( this is an optimisation that shrinks output file
  658. X *            size by about 35% and run-time by about 15% while
  659. X *            preserving ascii-ness)
  660. X *    w        paddable word space - no action needed
  661. X *    nb a        end of line ( information only - no action needed )
  662. X *            b = space before line, a = space after line
  663. X *    pn        begin page n
  664. X *    in        stipple as no. from 1 to n (BERK).
  665. X *    P        spread ends -- output it (put in by rsort) (BERK).
  666. X *    # ...\n        comment - ignore.
  667. X *    ! ...\n        pass through uninterpreted (LOCAL MOD).
  668. X *    Dt ...\n    draw operation 't':
  669. X *
  670. X *        Dl dx dy        line from here to dx, dy
  671. X *        Dc d        circle of diameter d, left side here
  672. X *        De x y        ellipse of axes diameter x,y, left side here
  673. X *        Da dx1 dy1 dx2 dy2    arc counter-clockwise, start here,
  674. X *                    centre is dx1, dy1 (relative to start),
  675. X *                    end is dx2, dy2 (relative to centre).
  676. X *        D~ x y x y ...    wiggly line (spline) by x,y then x,y ...
  677. X *        Dt d        set line thickness to d pixels (BERK).
  678. X *        Ds d        set line style mask to d (BERK).
  679. X *        Dg x y x y ...    gremlin (BERK).
  680. X */
  681. X#ifdef GEMPRINT 
  682. X/*      E prg a1 a2 ... fork program "prg" with args a1 a2 ... .
  683. X *                      continue after execution.
  684. X */
  685. X#endif
  686. X/*    x ... \n    device control functions:
  687. X *
  688. X *        x i        initialize the typesetter
  689. X *        x T s        name of device is s
  690. X *        x r n h v    resolution is n units per inch. h is
  691. X *                min horizontal motion, v is min vert.
  692. X *                motion in machine units.
  693. X *        x p        pause - can restart the typesetter
  694. X *        x s        stop - done forever
  695. X *        x t        generate trailer
  696. X *        x f n s        load font position n with tables for 
  697. X *                font s. Referring to font n now means
  698. X *                font s.
  699. X *        x H n        set character height to n
  700. X *        x S n        set character slant to n
  701. X *
  702. X *        Subcommands like i are often spelled out as "init"
  703. X *
  704. X *    Commands marked "BERK" are berzerkeley extensions.
  705. X *
  706. X */
  707. X
  708. X#include    "tpscript.h"
  709. X
  710. X#define    FONTDIR    "/usr/lib/font"        /* where font directories live */
  711. X
  712. XFILE    *Debug = NULL;        /* debugging stream if non-null */
  713. char    *fontdir = FONTDIR;    /* where the fonts live */
  714. char    *ifile = 0;        /* current input file name */
  715. int    lineno,            /* line no. in current input file */
  716. X    npages = 0;            /* no. pages printed so far */
  717. char    device[100],        /* device name, eg "alw" */
  718. X    errbuf[100];        /* tmp buffer for error messages */
  719. int    hpos = 0,        /* current horizontal position */
  720. X    vpos = 0;        /* current vertical position (rel. TOP pg.) */
  721. int    res,            /* resolution in THINGS/inch */
  722. X    hor_res,        /* min horizontal movement (in THINGS) */
  723. X    vert_res,        /* min vertical movement (in THINGS) */
  724. X    respunits;
  725. float    rotation = 0;        /* page orientation (degrees) */
  726. int    currtfont = DEF_FONT,    /* current font number selected by troff */
  727. X    papertype =         /* paper type (different imageable regions) */
  728. X#ifdef    ALW
  729. X        PT_A4;
  730. X#else
  731. X        PT_DEFAULT;
  732. X#endif
  733. bool    manualfeed = FALSE;    /* normally auto-feed */
  734. X
  735. X/* due to an obscure bug in ditroff, sometimes no initial 'p' command
  736. X * is generated, so we have to remember if any output has happened
  737. X * to decide if a 'p' causes a page print or not.
  738. X */
  739. bool    firstpage = TRUE;    /* nothing yet printed anywhere */
  740. X
  741. X/* font parameters */
  742. struct    fontparam 
  743. X    tfp,        /* current troff font parameters */
  744. X    pfp;        /* current postscript font parameters */
  745. X
  746. X
  747. X/* table of font descriptions */
  748. struct fontdesc 
  749. X    *fontd = NOFONTDESC,
  750. X    *spcfnt1 = NOFONTDESC,    /* special font */
  751. X    *spcfnt2 = NOFONTDESC;    /* special font 2 */
  752. X
  753. X/* font mount table - array of pointers to font descriptions */
  754. struct fontdesc    **fontmount;
  755. X
  756. X/* mapping between troff font names and builtin font names
  757. X * This should go in the internal name part of the font description
  758. X * itself, but there is only 10 bytes allocated (see dev.h).
  759. X */
  760. X
  761. X#ifdef GERMAN
  762. struct fontmap  fontmap[] = {
  763. X     { "R", "Times-Roman-Germ" },
  764. X     { "I", "Times-Italic-Germ" },
  765. X     { "B", "Times-Bold-Germ" },
  766. X     { "BI", "Times-BoldItalic-Germ" },
  767. X     { "S", "Symbol" },
  768. X     { "S2", "BracketFont" },    /* locally defined special font */
  769. X     { "C", "Courier-Germ" },
  770. X     { "CW", "Courier" },        /* synonym: constant width */
  771. X     { "CB", "Courier-Bold-Germ" },
  772. X     { "CO", "Courier-Oblique-Germ" },
  773. X     { "CX", "Courier-BoldOblique-Germ" },
  774. X     { "H", "Helvetica-Germ" },
  775. X     { "HR", "Helvetica" },        /* two-char name for H */
  776. X     { "HB", "Helvetica-Bold-Germ" },
  777. X     { "HO", "Helvetica-Oblique-Germ" },
  778. X     { "HX", "Helvetica-BoldOblique-Germ" },
  779. X#ifdef XFONTS
  780. X     { "BR", "Bookman-Light-Germ" },
  781. X     { "BO", "Bookman-LightItalic-Germ" },
  782. X     { "BB", "Bookman-Demi-Germ" },
  783. X     { "BX", "Bookman-DemiItalic-Germ" },
  784. X#endif
  785. X     { (char *)0,    (char *)0 }
  786. X};
  787. X#else
  788. struct fontmap  fontmap[] = {
  789. X    { "R", "Times-Roman" },
  790. X    { "I", "Times-Italic" },
  791. X    { "B", "Times-Bold" },
  792. X    { "BI", "Times-BoldItalic" },
  793. X    { "S", "Symbol" },
  794. X    { "S2", "BracketFont" },    /* locally defined special font */
  795. X    { "C", "Courier" },
  796. X    { "CW", "Courier" },        /* synonym: constant width */
  797. X    { "CB", "Courier-Bold" },
  798. X    { "CO", "Courier-Oblique" },
  799. X    { "CX", "Courier-BoldOblique" },
  800. X    { "H", "Helvetica" },
  801. X    { "HR", "Helvetica" },        /* two-char name for H */
  802. X    { "HB", "Helvetica-Bold" },
  803. X    { "HO", "Helvetica-Oblique" },
  804. X    { "HX", "Helvetica-BoldOblique" },
  805. X#ifdef XFONTS
  806. X     { "BR", "Bookman-Light" },
  807. X     { "BO", "Bookman-LightItalic" },
  808. X     { "BB", "Bookman-Demi" },
  809. X     { "BX", "Bookman-DemiItalic" },
  810. X#endif
  811. X    { (char *)0,    (char *)0 }
  812. X};
  813. X#endif
  814. X
  815. struct dev    dev;
  816. X
  817. short    *chartab = NULL;    /* char's index in charname array */
  818. char    *charname = NULL;    /* special character names */
  819. int    ncharname;        /* no. special character names */
  820. int    nfonts = 0;        /* no. of fonts mounted */
  821. int    nfontmount;        /* no. of font mount positions */
  822. X
  823. X    /*
  824. X     * this is the width that the printer will have moved following
  825. X     * the last printed character, if troff then says to move a
  826. X     * different amount we will shift the difference
  827. X     */
  828. int    width_pending    = 0;
  829. X
  830. bool    word_started    = FALSE;    /* we are in middle of word string */
  831. X
  832. X
  833. int        strcmp();
  834. char        *emalloc();
  835. struct fontdesc *findfont();
  836. struct fontmap    *getfmap();
  837. X
  838. main(argc, argv)
  839. int        argc;
  840. register char    **argv;
  841. X{
  842. X    register FILE    *istr;
  843. X    int        status = 0;
  844. X    extern     double    atof();
  845. X#ifdef SPACING
  846. X    float        spacing;
  847. X#endif SPACING
  848. X
  849. X    strcpy(device, DEF_DEV); /* just in case we get a "Di" before a "DT" */
  850. X    argv++;
  851. X    while(*argv && **argv == '-')
  852. X    {
  853. X        char    c;
  854. X
  855. X        (*argv)++;    /* skip the '-' */
  856. X        c = **argv;
  857. X        (*argv)++;    /* skip the character */
  858. X        switch(c)
  859. X        {
  860. X            case 'D':    /* debug */
  861. X                Debug = stderr;
  862. X                break;
  863. X
  864. X#ifdef SPACING
  865. X            case 'h':
  866. X                spacing = atof(*argv);
  867. X                break;
  868. X#endif SPACING
  869. X            case 'r':    /* rotate */
  870. X                if(**argv == '\0')
  871. X                    rotation = 90.0;
  872. X                else
  873. X                    rotation = atof(*argv);
  874. X                break;
  875. X
  876. X            case 'S':    /* manual feed */
  877. X                manualfeed = TRUE;
  878. X                break;
  879. X
  880. X            case 'L':    /* legal paper type */
  881. X                papertype = PT_LEGAL;
  882. X                break;
  883. X
  884. X            case 't':
  885. X                postr = stdout;
  886. X                break;
  887. X
  888. X            default:
  889. X                break;
  890. X        }
  891. X        argv++;
  892. X    }
  893. X
  894. X    if (postr == NULL)
  895. X    {
  896. X#ifdef    GRIS
  897. X        postr = popen("exec sendfile -AC -aprinter -dbasser -ugris -e\"-R -qd\" -ntroff-alw", "w");
  898. X        if (postr == NULL)
  899. X            error(ERR_SNARK, "can't popen spooler");
  900. X#else    GRIS
  901. X        postr = stdout;
  902. X#endif    GRIS
  903. X    }
  904. X
  905. X    if(! *argv)
  906. X    {
  907. X        ifile = "stdin";
  908. X        process(stdin);
  909. X    }
  910. X    else while(*argv)
  911. X    {
  912. X        if((istr=fopen(*argv, "r")) == NULL)
  913. X        {
  914. X            perror(*argv);
  915. X            status++;
  916. X        }
  917. X        else
  918. X        {
  919. X            ifile = *argv;
  920. X            process(istr);
  921. X            fclose(istr);
  922. X        }
  923. X        argv++;
  924. X    }
  925. X    if (postr != stdout)
  926. X        status += pclose(postr);
  927. X    exit(status);
  928. X    /* NOTREACHED */
  929. X}
  930. X
  931. process(istr)
  932. XFILE    *istr;
  933. X{
  934. X    int    ch;
  935. X    char    str[50];
  936. X    int    n;
  937. X    register int    i;
  938. X
  939. X    lineno = 1;    /* start processing 1st input line */
  940. X
  941. X    while((ch=getc(istr)) != EOF)
  942. X    {
  943. X            /*
  944. X             * the first switch group can safely be scanned without
  945. X             * having to first ensure the horizontal position is
  946. X             * up to date.
  947. X             */
  948. X        switch(ch)
  949. X        {
  950. X            /* noise */
  951. X            case ' ':
  952. X            case '\0':
  953. X                continue;
  954. X
  955. X            case '\n':
  956. X                lineno++;
  957. X                continue;
  958. X
  959. X            case '0': case '1': case '2': case '3': case '4':
  960. X            case '5': case '6': case '7': case '8': case '9':
  961. X                ungetc(ch, istr);
  962. X                fscanf(istr, "%2d", &n);
  963. X
  964. X                width_pending -= n;
  965. X                hpos += n;
  966. X
  967. X                /* drop through to process the next char */
  968. X
  969. X            case 'c':    /* ascii character */
  970. X
  971. X                    /*
  972. X                     * if this char and preceeding were
  973. X                     * not simply successive chars in the
  974. X                     * same word then we need some
  975. X                     * horizontal motion to reset position
  976. X                     */
  977. X                if ( width_pending != 0 )
  978. X                    hgoto( );
  979. X
  980. X                ch = getc(istr);
  981. X
  982. X                width_pending += GETWIDTH( tfp.fp_font,
  983. X                    (i = tfp.fp_font->f_fitab[ch - NUNPRINT] ));
  984. X
  985. X                if(ch != ' ')
  986. X                    putch(tfp.fp_font->f_codetab[i] & BMASK);
  987. X                else
  988. X                    putch(' ');    /* no code for ' ' */
  989. X                continue;
  990. X
  991. X            case 'C':    /* troff character */
  992. X
  993. X                if ( width_pending != 0 )
  994. X                    hgoto( );
  995. X
  996. X                fscanf(istr, "%s", str);
  997. X                putspec(str);
  998. X                continue;
  999. X
  1000. X            case 'h':    /* relative horizontal movement */
  1001. X                fscanf(istr, "%d", &n);
  1002. X
  1003. X                /*
  1004. X                 * we continually accumulate horizontal
  1005. X                 * motions and all relative requests are
  1006. X                 * translated into absolute ones.
  1007. X                 * This avoids accumulation of character
  1008. X                 * width rounding errors
  1009. X                 * beyond a single word. (These errors arise
  1010. X                 * because troff requires widths to be
  1011. X                 * integral to the unit resolution whereas in
  1012. X                 * the printer they may be fractional).
  1013. X                 */
  1014. X
  1015. X                hpos += n;
  1016. X                if ( ( width_pending -= n ) != 0 )
  1017. X                    hgoto( );    /* most likely end of word */
  1018. X
  1019. X                continue;
  1020. X
  1021. X            case 'w':
  1022. X                firstpage = FALSE;
  1023. X                CLOSEWORD();
  1024. X                continue;
  1025. X
  1026. X            case 'n':    /* newline */
  1027. X                fscanf(istr, "%*f %*f");
  1028. X                width_pending = 0;    /* doesn't matter now */
  1029. X                continue;
  1030. X
  1031. X            case 'f':    /* select font no. */
  1032. X                fscanf(istr, "%d", &n);
  1033. X                if(n > nfonts || n < 0 || fontmount[n] == NULL)
  1034. X                {
  1035. X                    sprintf(errbuf, "ERROR: font %d not mounted",
  1036. X                        n);
  1037. X                    error(ERR_WARN, errbuf);
  1038. X                }
  1039. X                else
  1040. X                {
  1041. X                    tfp.fp_font = fontmount[n];
  1042. X                    currtfont = n;
  1043. X                }
  1044. X                continue;
  1045. X
  1046. X            case 's':    /* size in points */
  1047. X                fscanf(istr, "%d", &n);
  1048. X                if(n <= 0)
  1049. X                {
  1050. X                    sprintf(errbuf, "Illegal point size %d\n", n);
  1051. X                    error(ERR_WARN, errbuf);
  1052. X                }
  1053. X                else
  1054. X                {
  1055. X                    tfp.fp_size = n;
  1056. X                    tfp.fp_height = (float) n;
  1057. X                }
  1058. X                continue;
  1059. X
  1060. X            case 'H':    /* absolute horizontal position */
  1061. X
  1062. X                fscanf(istr, "%d", &hpos);
  1063. X                hgoto();
  1064. X                continue;
  1065. X
  1066. X            case 'V':    /* absolute vertical position */
  1067. X                fscanf(istr, "%d", &vpos);
  1068. X                vgoto();
  1069. X                continue;
  1070. X
  1071. X            case 'v':    /* relative vertical movement */
  1072. X                fscanf(istr, "%d", &n);
  1073. X                vmot(n);
  1074. X                continue;
  1075. X
  1076. X        }
  1077. X            /*
  1078. X             * If the input char is in the second group
  1079. X             * then we must make sure the printer is positioned
  1080. X             * where troff thinks it is
  1081. X             * and close any word currently being printed
  1082. X             */
  1083. X        if ( width_pending != 0 )
  1084. X            hgoto( );
  1085. X        else
  1086. X            CLOSEWORD();
  1087. X
  1088. X        switch(ch)
  1089. X        {
  1090. X            case 'x':    /* device control function */
  1091. X                devcntrl(istr);
  1092. X                break;
  1093. X
  1094. X            case 'D':    /* draw */
  1095. X                draw(istr);
  1096. X                break;
  1097. X#ifdef GEMPRINT
  1098. X            case 'E':    /* call program */
  1099. X                call(istr);          
  1100. X                break;
  1101. X#endif
  1102. X
  1103. X            case 'p':    /* new page */
  1104. X                fscanf(istr, "%d", &n);
  1105. X                page(n);
  1106. X                break;
  1107. X
  1108. X            case '#':    /* comment */
  1109. X                while((ch=getc(istr)) != '\n' && ch != EOF);
  1110. X                lineno++;
  1111. X                break;
  1112. X
  1113. X            case 't':    /* text */
  1114. X                text(istr);
  1115. X                break;
  1116. X
  1117. X# ifdef HASH
  1118. X            /*
  1119. X             * debug - to be manually inserted in input stream if needed
  1120. X             * if n >= 0 && n <= HASH_SIZE
  1121. X             *    then will print entire hash contents
  1122. X             * otherwise will dump just names in hash_tab[n] entry
  1123. X             */
  1124. X            case 'Z':
  1125. X                fscanf(istr, "%d", &n);
  1126. X                dumphash( n );
  1127. X                break;
  1128. X                
  1129. X# endif
  1130. X
  1131. X            case '!':    /* pass through uninterpreted */
  1132. X                setfont(FALSE);    /* ensure current font is set */
  1133. X                putc('\n', postr);
  1134. X                while((ch=getc(istr)) != '\n' && ch != EOF)
  1135. X                    putc(ch, postr);
  1136. X                break;
  1137. X
  1138. X            default:
  1139. X                sprintf(errbuf, "Unknown command '%c'", ch);
  1140. X                error(ERR_FATAL, errbuf);
  1141. X        }
  1142. X    }
  1143. X}
  1144. X
  1145. devcntrl(istr)
  1146. XFILE    *istr;
  1147. X{
  1148. X    char        str[50];
  1149. X    int        fontn,
  1150. X            ch;
  1151. X    float        f;
  1152. X
  1153. X    fscanf(istr, "%s", str);
  1154. X    switch(*str)
  1155. X    {
  1156. X        case 'i':    /* device initialisation */
  1157. X            initfonts(device);
  1158. X            devinit();
  1159. X            break;
  1160. X
  1161. X        case 'T':    /* we had better get this before an 'init' */
  1162. X            fscanf(istr, "%s", device);
  1163. X            break;
  1164. X
  1165. X        case 'r':    /* resolution */
  1166. X            fscanf(istr, "%d %d %d", &res, &hor_res, &vert_res);
  1167. X            respunits = res / PU_INCH;
  1168. X            break;
  1169. X
  1170. X        case 'f':    /* load font */
  1171. X            fscanf(istr, "%d %s", &fontn, str);
  1172. X            loadfont(str, fontn);
  1173. X            break;
  1174. X
  1175. X        case 's':    /* stop */
  1176. X            finish(0);
  1177. X            break;
  1178. X
  1179. X        case 'p':    /* pause */
  1180. X            break;
  1181. X
  1182. X        case 't':    /* trailer */
  1183. X            break;
  1184. X
  1185. X        case 'H':    /* character height (in points) */
  1186. X            fscanf(istr, "%f", &f);
  1187. X            if(f <= 0 || f > 1000)
  1188. X            {
  1189. X                sprintf(errbuf,
  1190. X                    "Illegal character height %.1f", f);
  1191. X                error(ERR_WARN, errbuf);
  1192. X            }
  1193. X            else
  1194. X                tfp.fp_height = f;
  1195. X            break;
  1196. X
  1197. X        case 'S':
  1198. X            fscanf(istr, "%f", &f);
  1199. X            if(f < -80 || f > 80)
  1200. X            {
  1201. X                sprintf(errbuf, "Illegal character slant %.1f degrees", f);
  1202. X                error(ERR_WARN, errbuf);
  1203. X            }
  1204. X            else
  1205. X                tfp.fp_slant = f;
  1206. X            break;
  1207. X
  1208. X        default:
  1209. X            sprintf(errbuf, "Unknown device control '%s'", str);
  1210. X            error(ERR_WARN, errbuf);
  1211. X            break;
  1212. X    }
  1213. X    while((ch=getc(istr)) != '\n' && ch != EOF);    /* skip rest of input line */
  1214. X    lineno++;
  1215. X}
  1216. X
  1217. error(errtype, errmsg)
  1218. int    errtype;
  1219. char    *errmsg;
  1220. X{
  1221. X    switch(errtype)
  1222. X    {
  1223. X        case ERR_WARN:
  1224. X            fprintf(stderr, "Warning");
  1225. X            break;
  1226. X
  1227. X        case ERR_FATAL:
  1228. X            fprintf(stderr, "Error");
  1229. X            break;
  1230. X
  1231. X        case ERR_SNARK:
  1232. X            fprintf(stderr, "Snark");
  1233. X            break;
  1234. X    }
  1235. X    fprintf(stderr, "\t%s pscript input, line %d of '%s'\n",
  1236. X        errtype == ERR_SNARK ? "at" : "in",
  1237. X        lineno, ifile);
  1238. X    if(errmsg && *errmsg)
  1239. X        fprintf(stderr, "\t%s\n", errmsg);
  1240. X    if(errtype != ERR_WARN)
  1241. X        finish(1);
  1242. X}
  1243. X
  1244. finish(status)
  1245. int    status;
  1246. X{
  1247. X    page(-1);
  1248. X    pcommfinish(npages, "");
  1249. X    if(status != 0)
  1250. X        fprintf(stderr, "\t... aborted processing\n");
  1251. X    exit(status);
  1252. X}
  1253. X
  1254. X/*
  1255. X *    Output the postscript "prologue" that is the start of each program
  1256. X *    generated. This sets up definitions, sets the scale to be troff
  1257. X *    units, etc.
  1258. X *    By convention, single character variables are procedure names,
  1259. X *    while multi-character variables are local to procedures.
  1260. X */
  1261. X
  1262. char    *inittab[] = {
  1263. X    /* initialise current path to non-null */
  1264. X    "0 0 moveto",
  1265. X    /* fix to make "joined" lines better */
  1266. X    "2 setlinecap",
  1267. X    /* routine for RELATIVE HORIZONTAL RIGHT */
  1268. X    /* need no more
  1269. X    "/x { 0 rmoveto } def",
  1270. X    /* routine for RELATIVE VERTICAL DOWN */
  1271. X    "/y { neg 0 exch rmoveto } def",
  1272. X    /* routine for ABSOLUTE HORIZONTAL (rel left edge page) */
  1273. X    "/X { currentpoint exch pop moveto } def",
  1274. X    /* routine for ABSOLUTE VERTICAL (rel top of page) */
  1275. X    "/Y { pgtop exch sub currentpoint pop exch moveto } def",
  1276. X#ifdef    SPACING
  1277. X    "/s { currentpoint spacing 0 5 -1 roll ashow moveto } def",
  1278. X#else
  1279. X    "/s { show } def",
  1280. X#endif    SPACING
  1281. X    "/l { neg rlineto currentpoint stroke moveto } def",
  1282. X/* The following definitions are needed for PIC drawings. They aren't
  1283. X * neccessary if graphics comes in metafile. (27-11-86 -- axel@coma.uucp)
  1284. X */
  1285. X#ifndef GEMPRINT 
  1286. X    /* circle - arg is diameter.
  1287. X     * Current point is left edge
  1288. X     */
  1289. X    "/c {",
  1290. X    /* save radius and current position */
  1291. X    "2 div /rad exch def currentpoint /y0 exch def /x0 exch def",
  1292. X    /* draw circle */
  1293. X    "newpath x0 rad add y0 rad 0 360 arc stroke",
  1294. X    /* move to right edge of circle */
  1295. X    "x0 rad add rad add y0 moveto",
  1296. X    " } def",
  1297. X    /* Arc anticlockwise, currentpoint is start;
  1298. X     * args are dx1, dy1 (centre relative to here)
  1299. X     * and dx2, dy2 (end relative to centre).
  1300. X     */
  1301. X    "/a {",
  1302. X    /* save all parameters */
  1303. X    "/y2 exch neg def /x2 exch def /y1 exch neg def /x1 exch def",
  1304. X    /* move to centre, push position for moveto after arc */
  1305. X    "x1 y1 rmoveto currentpoint",
  1306. X    /* push centre for args to arc */
  1307. X    "currentpoint",
  1308. X    /* calculate and push radius */
  1309. X    "x2 x2 mul y2 y2 mul add sqrt",
  1310. X    /* start angle */
  1311. X    "y1 neg x1 neg atan",
  1312. X    /* end angle */
  1313. X    "y2 x2 atan",
  1314. X    /* draw the arc, and move to end position */
  1315. X    "newpath arc stroke moveto x2 y2 rmoveto",
  1316. X    "} def",
  1317. X    /* ellipse - args are x diameter, y diameter;
  1318. X     * current position is left edge
  1319. X     */
  1320. X    "/e {",
  1321. X    /* save x and y radius */
  1322. X    "2 div /yrad exch def 2 div /xrad exch def",
  1323. X    /* save current position */
  1324. X    "currentpoint /y0 exch def /x0 exch def",
  1325. X    /* translate to centre of ellipse */
  1326. X    "x0 xrad add y0 translate",
  1327. X    /* scale coordinate system */
  1328. X    "xrad yrad scale",
  1329. X    /* draw the ellipse (unit circle in scaled system) */
  1330. X    "newpath 0 0 1 0 360 arc",
  1331. X    /* restore old scale + origin */
  1332. X    "savematrix setmatrix",
  1333. X    /* actually draw the ellipse (with unscaled linewidth) */
  1334. X    "stroke",
  1335. X    /* move to right of ellipse */
  1336. X    "x0 xrad add xrad add y0 moveto",
  1337. X    "} def",
  1338. X        /*
  1339. X         * common procedure for spline curves
  1340. X         */
  1341. X    "/spln {",
  1342. X        /* setup curve, remember where we are, fill in line,
  1343. X        ** and reset current point
  1344. X        */
  1345. X    "rcurveto currentpoint stroke moveto",
  1346. X    "} def",
  1347. X#else GEMPRINT
  1348. X"%%BeginProcSet: \"mfps-builtin-GEM-prologue\" \"(0.0)\" \"\"",
  1349. X"/Gem2PSdict 50 dict def",
  1350. X"Gem2PSdict begin",
  1351. X#ifdef GUMLAUT
  1352. X"/reencsmalldict 12 dict def",
  1353. X"/ReEncodeSmall",
  1354. X"{ reencsmalldict begin",
  1355. X"  /newcodesandnames exch def",
  1356. X"  /newfontname exch def",
  1357. X"  /basefontname exch def",
  1358. X"  /basefontdict basefontname findfont def",
  1359. X"  /newfont basefontdict maxlength dict def",
  1360. X"  basefontdict",
  1361. X"   { exch dup /FID ne",
  1362. X"    { dup /Encoding eq",
  1363. X"     { exch dup length array copy newfont 3 1 roll put }",
  1364. X"     { exch newfont 3 1 roll put }",
  1365. X"     ifelse",
  1366. X"    }",
  1367. X"    { pop pop }",
  1368. X"    ifelse",
  1369. X"   } forall",
  1370. X"  newfont /FontName newfontname put",
  1371. X"  newcodesandnames aload pop",
  1372. X"  newcodesandnames length 2 idiv",
  1373. X"   { newfont /Encoding get 3 1 roll put }",
  1374. X"   repeat",
  1375. X"  newfontname newfont definefont pop",
  1376. X"  end",
  1377. X"} def",
  1378. X"/germvec [",
  1379. X"8#204 /adieresis",
  1380. X"8#224 /odieresis",
  1381. X"8#201 /udieresis",
  1382. X"8#216 /Adieresis",
  1383. X"8#231 /Odieresis",
  1384. X"8#232 /Udieresis",
  1385. X"8#236 /germandbls",
  1386. X"] def",
  1387. X"/Times-Roman /Times-Roman-Germ germvec",
  1388. X"  ReEncodeSmall",
  1389. X"/Times-Italic /Times-Italic-Germ germvec",
  1390. X"  ReEncodeSmall",
  1391. X"/Times-Bold /Times-Bold-Germ germvec",
  1392. X"  ReEncodeSmall",
  1393. X"/Times-BoldItalic /Times-BoldItalic-Germ germvec",
  1394. X"  ReEncodeSmall",
  1395. X"/Helvetica /Helvetica-Germ germvec",
  1396. X"  ReEncodeSmall",
  1397. X"/Helvetica-Bold /Helvetica-Bold-Germ germvec",
  1398. X"  ReEncodeSmall",
  1399. X"/Helvetica-Oblique /Helvetica-Oblique-Germ germvec",
  1400. X"  ReEncodeSmall",
  1401. X"/Helvetica-BoldOblique /Helvetica-BoldOblique-Germ germvec",
  1402. X"  ReEncodeSmall",
  1403. X"/t { /Times-Roman-Germ findfont exch scalefont setfont } bind def",
  1404. X"/ti { /Times-Italic-Germ findfont exch scalefont setfont } bind def",
  1405. X"/tb { /Times-Bold-Germ findfont exch scalefont setfont } bind def",
  1406. X"/tx { /Times-BoldItalic-Germ findfont exch scalefont setfont } bind def",
  1407. X"/h { /Helvetica-Germ findfont exch scalefont setfont } bind def",
  1408. X"/hb { /Helvetica-Bold-Germ findfont exch scalefont setfont } bind def",
  1409. X"/ho { /Helvetica-Oblique-Germ findfont exch scalefont setfont } bind def",
  1410. X"/hbo { /Helvetica-BoldOblique-Germ findfont exch scalefont setfont }",
  1411. X" bind def",
  1412. X#else
  1413. X"/t { /Times-Roman findfont exch scalefont setfont } bind def",
  1414. X"/ti { /Times-Italic findfont exch scalefont setfont } bind def",
  1415. X"/tb { /Times-Bold findfont exch scalefont setfont } bind def",
  1416. X"/tx { /Times-BoldItalic findfont exch scalefont setfont } bind def",
  1417. X"/h { /Helvetica findfont exch scalefont setfont } bind def",
  1418. X"/hb { /Helvetica-Bold findfont exch scalefont setfont } bind def",
  1419. X"/ho { /Helvetica-Oblique findfont exch scalefont setfont } bind def",
  1420. X"/hbo { /Helvetica-BoldOblique findfont exch scalefont setfont } bind def",
  1421. X#endif GUMLAUT
  1422. X"/bitison",
  1423. X"{",
  1424. X"    /ybit exch def /xbit exch def",
  1425. X"    bstring ybit bwidth mul",
  1426. X"    xbit 8 idiv add get",
  1427. X"    1 7 xbit 8 mod sub bitshift",
  1428. X"    and 0 ne",
  1429. X"} bind def",
  1430. X"/setpattern",
  1431. X"{",
  1432. X"    /freq exch def",
  1433. X"    /bwidth exch def",
  1434. X"    /bpside exch def",
  1435. X"    /bstring exch def",
  1436. X"    /onbits 0 def /offbits 0 def",
  1437. X"    freq 0 {",
  1438. X"        /y exch def /x exch def",
  1439. X"        /xindex x 1 add 2 div bpside mul cvi def",
  1440. X"        /yindex y 1 add 2 div bpside mul cvi def",
  1441. X"        xindex yindex bitison",
  1442. X"        { /onbits onbits 1 add def 1 }",
  1443. X"        { /offbits offbits 1 add def 0 }",
  1444. X"        ifelse",
  1445. X"        } setscreen",
  1446. X"    {} settransfer",
  1447. X"    offbits offbits onbits add div setgray",
  1448. X"} bind def",
  1449. X"/mf {",
  1450. X"    statusdict begin /manualfeedtimeout 300 def ",
  1451. X"             /manualfeed true def ",
  1452. X"           end } bind def",
  1453. X"/af {",
  1454. X"    statusdict begin /waittimeout 5 def",
  1455. X"             /manualfeed false def",
  1456. X"           end } bind def",
  1457. X"/padj { transform round exch round exch itransform } bind def",
  1458. X"/ul { dup stringwidth pop 0 gsave 0.4 setlinewidth",
  1459. X"   currentpoint newpath moveto 0 -2 padj rmoveto padj rlineto",
  1460. X"   closepath stroke grestore } bind def",
  1461. X"/oshow { gsave currentpoint newpath moveto 0.2 setlinewidth false",
  1462. X"   charpath closepath stroke } bind def",
  1463. X"/wtext {",
  1464. X"  /str exch def /strwd exch def /nsp exch def /underl exch def",
  1465. X"  str stringwidth pop /pstrwd exch def",
  1466. X"  underl { gsave 0.4 setlinewidth currentpoint newpath",
  1467. X"  moveto 0 -2 padj rmoveto strwd 0 padj rlineto ",
  1468. X"  closepath stroke grestore } if",
  1469. X" nsp 0 ne",
  1470. X" { strwd pstrwd sub nsp div 0 8#040 str widthshow }",
  1471. X" { str show } ifelse",
  1472. X"} bind def",
  1473. X"/atext {",
  1474. X"  /str exch def /strwd exch def /underl exch def",
  1475. X"  str stringwidth pop /pstrwd exch def",
  1476. X"  underl { gsave 0.4 setlinewidth currentpoint newpath",
  1477. X"  moveto 0 -2 padj rmoveto strwd 0 padj rlineto",
  1478. X"  closepath stroke grestore } if",
  1479. X"  strwd pstrwd sub str length dup 1 gt { 1 sub } if div 0 str ashow",
  1480. X"} bind def",
  1481. X"/arrow {", 
  1482. X"        /leg exch def /taily exch def /tailx exch def",
  1483. X"        /tipy exch def /tipx exch def",
  1484. X"        gsave",
  1485. X"           1 setlinecap",
  1486. X"           newpath",
  1487. X"              tipx tipy translate",
  1488. X"              taily tipy sub /num exch def",
  1489. X"              tailx tipx sub /den exch def",
  1490. X"              num den eq den 0 eq and { /num 1 def } if",
  1491. X"              num den atan 16 sub rotate",
  1492. X"              leg 0 moveto 0 0 lineto",
  1493. X"              32 rotate",
  1494. X"              leg 0 lineto",
  1495. X"           closepath fill",
  1496. X"        grestore } bind def",
  1497. X"/pln { % xn yn xn-1 yn-1 .. x1 y1 n, draws a polyline with n-1 segments",
  1498. X"   /n exch def",
  1499. X"   /n n 1 sub def",
  1500. X"   padj moveto",
  1501. X"   1 1 n { pop padj lineto } for",
  1502. X"} bind def",
  1503. X"/pline {  % x1 y1 x2 y2, draws a line which is consistent with parallels",
  1504. X"   /y2 exch def /x2 exch def /y1 exch def /x1 exch def",
  1505. X"   x1 y1 padj moveto",
  1506. X"   x2 y2 padj rlineto",
  1507. X"} bind def",
  1508. X"/elip { % xscale yscale x y rad sang eang, draws an elliptical arc",
  1509. X"   /ea exch def /sa exch def /rad exch def",
  1510. X"   translate scale 0 0 rad sa ea arc",
  1511. X"   /sm 6 array def /im 6 array def /sm sm currentmatrix def",
  1512. X"   /im im defaultmatrix def sm 0 im 0 get put",
  1513. X"   sm 3 im 3 get put sm setmatrix",
  1514. X"} bind def",
  1515. X"/resetscale { /sm 6 array def /im 6 array def /sm sm currentmatrix def",
  1516. X"   /im im defaultmatrix def sm 0 im 0 get put",
  1517. X"   sm 3 im 3 get put sm setmatrix",
  1518. X"} bind def",
  1519. X#ifdef PSDEBUG
  1520. X/* Use: 'gsave ( labeltext ) X Y markpoint grestore' . Marks given point
  1521. X * with an 'x' and labels it with the supplied text. Intended for
  1522. X * Debugging 
  1523. X */
  1524. X"/markpoint { newpath moveto currentpoint 3 -1 roll",
  1525. X"   /Helvetica findfont 10 scalefont setfont dup stringwidth pop 2 add 0",
  1526. X"   rmoveto",
  1527. X"   show moveto 3 3 rmoveto -6 -6 rlineto 0 6 rmoveto 6 -6 rlineto",
  1528. X"   stroke } bind def",
  1529. X#endif
  1530. X"end",   /* end of Gem2PSdict initialization */
  1531. X"%%EndProcSet",
  1532. X#endif GEMPRINT
  1533. X#ifdef GERMAN
  1534. X     /* routine to modify fonts */
  1535. X     "/reencsmalldict 12 dict def",
  1536. X       "/ReEncodeSmall",
  1537. X         "{ reencsmalldict begin",
  1538. X         "  /newcodesandnames exch def",
  1539. X         "  /newfontname exch def",
  1540. X         "  /basefontname exch def",
  1541. X         "  /basefontdict basefontname findfont def",
  1542. X         "  /newfont basefontdict maxlength dict def",
  1543. X         "  basefontdict",
  1544. X         "   { exch dup /FID ne",
  1545. X         "    { dup /Encoding eq",
  1546. X         "     { exch dup length array copy newfont 3 1 roll put }",
  1547. X         "     { exch newfont 3 1 roll put }",
  1548. X         "     ifelse",
  1549. X         "    }",
  1550. X         "    { pop pop }",
  1551. X         "    ifelse",
  1552. X         "   } forall",
  1553. X         "  newfont /FontName newfontname put",
  1554. X         "  newcodesandnames aload pop",
  1555. X         "  newcodesandnames length 2 idiv",
  1556. X         "   { newfont /Encoding get 3 1 roll put }",
  1557. X         "   repeat",
  1558. X         "  newfontname newfont definefont pop",
  1559. X         "  end",
  1560. X         "} def",
  1561. X         /* Vector for additional german characters */
  1562. X         "/germvec [",
  1563. X         "8#321 /adieresis",
  1564. X         "8#322 /odieresis",
  1565. X         "8#323 /udieresis",
  1566. X         "8#324 /Adieresis",
  1567. X         "8#325 /Odieresis",
  1568. X        "8#326 /Udieresis",
  1569. X         "] def",
  1570. X     /* Define German fonts */
  1571. X     "/Times-Roman /Times-Roman-Germ germvec",
  1572. X     "  ReEncodeSmall",
  1573. X     "/Times-Italic /Times-Italic-Germ germvec",
  1574. X     "  ReEncodeSmall",
  1575. X     "/Times-Bold /Times-Bold-Germ germvec",
  1576. X     "  ReEncodeSmall",
  1577. X     "/Times-BoldItalic /Times-BoldItalic-Germ germvec",
  1578. X     "  ReEncodeSmall",
  1579. X     "/Helvetica /Helvetica-Germ germvec",
  1580. X     "  ReEncodeSmall",
  1581. X     "/Helvetica-Bold /Helvetica-Bold-Germ germvec",
  1582. X     "  ReEncodeSmall",
  1583. X     "/Helvetica-Oblique /Helvetica-Oblique-Germ germvec",
  1584. X     "  ReEncodeSmall",
  1585. X     "/Helvetica-BoldOblique /Helvetica-BoldOblique-Germ germvec",
  1586. X     "  ReEncodeSmall",
  1587. X     "/Courier /Courier-Germ germvec",
  1588. X     "  ReEncodeSmall",
  1589. X     "/Courier-Bold /Courier-Bold-Germ germvec",
  1590. X     "  ReEncodeSmall",
  1591. X     "/Courier-Oblique /Courier-Oblique-Germ germvec",
  1592. X     "  ReEncodeSmall",
  1593. X     "/Courier-BoldOblique /Courier-BoldOblique-Germ germvec",
  1594. X     "  ReEncodeSmall",
  1595. X#ifdef XFONTS
  1596. X     "/Bookman-Light /Bookman-Light-Germ germvec",
  1597. X     "  ReEncodeSmall",
  1598. X     "/Bookman-LightItalic /Bookman-LightItalic-Germ germvec",
  1599. X     "  ReEncodeSmall",
  1600. X     "/Bookman-Demi /Bookman-Demi-Germ germvec",
  1601. X     "  ReEncodeSmall",
  1602. X     "/Bookman-DemiItalic /Bookman-DemiItalic-Germ germvec",
  1603. X     "  ReEncodeSmall",
  1604. X#endif XFONTS
  1605. X#endif GERMAN
  1606. X    /* routine to select a font */
  1607. X    "/ft { /fonttype exch def /xsiz exch def /ysiz exch def /sl exch def",
  1608. X    " fonttype [ xsiz pt 0 sl sin sl cos div ysiz pt mul ysiz pt 0 0 ]",
  1609. X    " makefont setfont",
  1610. X#ifndef GEMPRINT
  1611. X    /* point size also affects linewidth (see Pic user manual, p. 17) */
  1612. X    " xsiz 1.7 div setlinewidth } def",
  1613. X#else
  1614. X    /* this seems to be of no use, if pictures are derived from a
  1615. X     * GEM-Metafile (axel@coma, 3-Nov-86) */
  1616. X    "} def",
  1617. X#endif
  1618. X    (char *) 0 };
  1619. X
  1620. X
  1621. devinit()
  1622. X{
  1623. X    register char    **ptab;
  1624. X    register int    i;
  1625. X
  1626. X    /* postscript basic units are "1/PU_INCH" inches.
  1627. X     * Normally PU_INCH=72, making postscript units points (1/72 inch)
  1628. X     * Scale postscript to accept whatever resolution we are given
  1629. X     * Typically res=300 for a 300 dot/inch laser printer
  1630. X     */
  1631. X    pcomminit(PU_INCH / (float) res, rotation, papertype, manualfeed, 0,
  1632. X        (char *)0, "troff->tpscript");
  1633. X    ptab = inittab;
  1634. X    while(*ptab)
  1635. X        fprintf(postr, "%s\n", *ptab++);
  1636. X    /* conversion back to points for font sizes etc. */
  1637. X    fprintf(postr, "/pt { %d mul } def\n", respunits);
  1638. X
  1639. X#if    defined(UQMINMET) && !defined(ALW)
  1640. X            /* to compensate for "setmargins" */
  1641. X    fprintf( postr, "\n-90 230 translate\n" );
  1642. X#endif
  1643. X    /* All graphics transformations have been done. Save the
  1644. X     * transformation matrix
  1645. X     */
  1646. X    fprintf(postr, "/savematrix matrix currentmatrix def\n");
  1647. X#ifdef SPACING
  1648. X    /* set increased character spacing (if any) */
  1649. X    fprintf(postr, "/spacing %.1f pt def\n", spacing);
  1650. X#endif SPACING
  1651. X
  1652. X    s2init();    /* initialise special font 2 */
  1653. X
  1654. X    /* set up font abbreviations */
  1655. X    for(i=1; i<nfonts+1; i++)
  1656. X        fprintf(postr, "/f.%s /%s findfont def\n",
  1657. X            fontd[i].f_extname, fontd[i].f_intname);
  1658. X    /* select default current font */
  1659. X    tfp.fp_size = DEF_SIZE;
  1660. X    tfp.fp_height = (float) DEF_SIZE;
  1661. X    tfp.fp_slant = 0;
  1662. X    tfp.fp_font = &fontd[DEF_FONT];
  1663. X    pfp.fp_font = (struct fontdesc *) NULL;
  1664. X    setfont(FALSE);
  1665. X
  1666. X    /* save state */
  1667. X    endinit();
  1668. X}
  1669. X
  1670. X
  1671. X/*
  1672. X *    Called when some use of characters or line-drawing
  1673. X *    is about to be made, to ensure that the correct font and
  1674. X *    line thickness is selected in postscript.
  1675. X */
  1676. setfont(force)
  1677. bool    force;
  1678. X{
  1679. X
  1680. X    if(tfp.fp_size == pfp.fp_size &&
  1681. X        tfp.fp_height == pfp.fp_height &&
  1682. X        tfp.fp_slant == pfp.fp_slant &&
  1683. X        tfp.fp_font == pfp.fp_font &&
  1684. X        ! force)
  1685. X        return;
  1686. X    CLOSEWORD();
  1687. X    fprintf(postr, "\n%.1f %.0f %d f.%s ft",
  1688. X        tfp.fp_slant,
  1689. X        tfp.fp_height, tfp.fp_size,
  1690. X        tfp.fp_font->f_extname);
  1691. X    pfp = tfp;
  1692. X}
  1693. X
  1694. draw(istr)
  1695. XFILE    *istr;
  1696. X{
  1697. X    int    ch;
  1698. X    int    x, y,
  1699. X        x1, y1,
  1700. X        d;
  1701. X
  1702. X    setfont( FALSE );    /* in case of size change affecting line thickness */
  1703. X
  1704. X    switch(ch=getc(istr))
  1705. X    {
  1706. X        case 'l':
  1707. X            fscanf(istr, "%d %d", &x, &y);
  1708. X            fprintf(postr, "\n%d %d l", x, y);
  1709. X            break;
  1710. X
  1711. X        case 'c':
  1712. X            fscanf(istr, "%d", &d);
  1713. X            fprintf(postr, "\n%d c", d);
  1714. X            break;
  1715. X
  1716. X        case 'e':
  1717. X            fscanf(istr, "%d %d", &x, &y);
  1718. X            fprintf(postr, "\n%d %d e", x, y);
  1719. X            break;
  1720. X
  1721. X        case 'a':
  1722. X            fscanf(istr, "%d %d %d %d", &x, &y, &x1, &y1);
  1723. X            fprintf(postr, "\n%d %d %d %d a", x, y, x1, y1);
  1724. X            break;
  1725. X
  1726. X        case '~':
  1727. X            draw_spline( istr );
  1728. X            break;
  1729. X
  1730. X        default:
  1731. X            sprintf(errbuf, "Illegal draw function '%c'", ch);
  1732. X            error(ERR_WARN, errbuf);
  1733. X            break;
  1734. X    }
  1735. X    while((ch=getc(istr)) != '\n' && ch != EOF);
  1736. X    lineno++;
  1737. X}
  1738. X
  1739. X
  1740. text(istr)
  1741. XFILE    *istr;
  1742. X{
  1743. X    register int    ch;
  1744. X
  1745. X    fprintf(postr, "\n(");
  1746. X    while((ch=getc(istr)) != '\n' && ch != EOF)
  1747. X        pch(ch);
  1748. X    fprintf(postr, ")s");
  1749. X}
  1750. X
  1751. page(n)
  1752. register int    n;
  1753. X{
  1754. X    hpos = 0; vpos = 0;
  1755. X    /* for each page except the first, print the previous one */
  1756. X    if(firstpage)
  1757. X        firstpage = FALSE;
  1758. X    else
  1759. X    {
  1760. X        fprintf(postr, "\npage");
  1761. X        setfont(TRUE);
  1762. X        resetspcl();        /* it forgets definitions on next page */
  1763. X    }
  1764. X    if(n >= 0)        /* beginning of a new page */
  1765. X        fprintf(postr, "\n%%%%Page: %d %d\n", n, ++npages);
  1766. X}
  1767. X
  1768. hgoto()
  1769. X{
  1770. X    CLOSEWORD();
  1771. X    width_pending = 0;    /* doesn't matter now */
  1772. X    fprintf(postr, "\n%d X", hpos);
  1773. X}
  1774. X
  1775. vgoto( )
  1776. X{
  1777. X    CLOSEWORD();
  1778. X    fprintf(postr, "\n%d Y", vpos);
  1779. X}
  1780. X
  1781. vmot(n)
  1782. int    n;    /* +'ve is DOWN */
  1783. X{
  1784. X    CLOSEWORD();
  1785. X    fprintf(postr, "\n%d y", n);
  1786. X    vpos += n;
  1787. X}
  1788. X
  1789. X/*
  1790. X *    Read the DESC file for the current device. This includes
  1791. X *    information about all the common fonts. The format is:
  1792. X *
  1793. X *        struct dev    (see dev.h)
  1794. X *        point size table    (dev.nsizes * sizeof(short))
  1795. X *        char index table    (chtab; dev.nchtab * sizeof(short))
  1796. X *        char name table        (chname; dev.lchname)
  1797. X *
  1798. X *    followed by dev.nfonts occurrences of    
  1799. X *        struct font    (see dev.h)
  1800. X *        width tables        (font.nwfont)
  1801. X *        kern tables        (font.nwfont)
  1802. X *        code tables        (font.nwfont)
  1803. X *        font index table    (dev.nchtab + NASCPRINT)
  1804. X */
  1805. X
  1806. initfonts(devname)
  1807. char    *devname;
  1808. X{
  1809. X    register int            i;
  1810. X    register struct fontdesc    *fd;
  1811. X    FILE                *fstr;
  1812. X    char                path[100];
  1813. X
  1814. X    sprintf(path, "%s/dev%s/DESC.out", fontdir, devname);
  1815. X    if((fstr=fopen(path, "r")) == NULL)
  1816. X    {
  1817. X        sprintf(errbuf, "Can't open '%s' (%s)",
  1818. X            path, sys_errlist[errno]);
  1819. X        error(ERR_FATAL, errbuf);
  1820. X    }
  1821. X    if(efread((char *)&dev, sizeof(dev), 1, fstr) != 1)
  1822. X    {
  1823. X        sprintf(errbuf, "%s: bad format (read dev failed)", path);
  1824. X        error(ERR_SNARK, errbuf);
  1825. X    }
  1826. X
  1827. X    nfonts = dev.nfonts;
  1828. X    /* nfontmount should be at least nfonts+2 */
  1829. X    nfontmount = nfonts + 20;
  1830. X    ncharname = dev.nchtab;
  1831. X    fontd = (struct fontdesc *)
  1832. X            emalloc((unsigned)(nfonts+2) * sizeof(struct fontdesc));
  1833. X    fontmount = (struct fontdesc **)
  1834. X            emalloc((unsigned)nfontmount * sizeof(struct fontdesc *));
  1835. X
  1836. X    /* skip point size table */
  1837. X    efseek(fstr, (int)((dev.nsizes + 1)*sizeof(short)));
  1838. X
  1839. X    chartab = (short *) emalloc((unsigned)ncharname * sizeof(short));
  1840. X    efread((char *)chartab, sizeof(* chartab), ncharname, fstr);
  1841. X
  1842. X    charname = emalloc((unsigned)dev.lchname);
  1843. X    efread(charname, sizeof(* charname), dev.lchname, fstr);
  1844. X
  1845. X    hash_init();
  1846. X
  1847. X    for(i=1; i <= nfonts; i++)
  1848. X    {
  1849. X        register int            nw;
  1850. X        struct font            f;
  1851. X        struct fontmap            *fm;
  1852. X
  1853. X        /* read struct font header */
  1854. X        efread((char *)&f, sizeof(f), 1, fstr);
  1855. X
  1856. X        nw = (int)(f.nwfont & BMASK);    /* NO sign extension */
  1857. X        fd = &fontd[i];
  1858. X        fd->f_nent = nw;
  1859. X
  1860. X        fd->f_widthtab = emalloc((unsigned)nw);
  1861. X        fd->f_codetab = emalloc((unsigned)nw);
  1862. X        fd->f_fitab = emalloc((unsigned)(ncharname+NASCPRINT));
  1863. X        /* remember if font is special */
  1864. X        if(f.specfont == 1)
  1865. X        {
  1866. X            if(spcfnt1 == NOFONTDESC )
  1867. X                spcfnt1 = fd;
  1868. X            else if ( spcfnt2 == NOFONTDESC )
  1869. X                spcfnt2 = fd;
  1870. X            else
  1871. X            {
  1872. X                sprintf( errbuf,
  1873. X                    "Too many special fonts, %s ignored",
  1874. X                    fd->f_extname );
  1875. X                error(ERR_WARN, errbuf );
  1876. X            }
  1877. X        }
  1878. X
  1879. X        fm = getfmap(f.namefont);
  1880. X        if(fm)
  1881. X        {
  1882. X            fd->f_intname = fm->fm_intname;
  1883. X            fd->f_extname = fm->fm_extname;
  1884. X            fd->f_mounted = TRUE;
  1885. X        }
  1886. X        else
  1887. X            fprintf(stderr, "font name '%s' not known\n",
  1888. X                f.namefont);
  1889. X
  1890. X        efread(fd->f_widthtab, sizeof(char), nw, fstr);
  1891. X        efseek(fstr, 1*nw);    /* skip kern tables */
  1892. X        efread(fd->f_codetab, sizeof(char), nw, fstr);
  1893. X        efread(fd->f_fitab, sizeof(char), ncharname+NASCPRINT, fstr);
  1894. X    }
  1895. X
  1896. X    fclose(fstr);
  1897. X
  1898. X    for(i=0; i < nfontmount; i++)
  1899. X        fontmount[i] = NOFONTDESC;
  1900. X
  1901. X    /* zeroth font desc entry reserved for "extra" fonts */
  1902. X    fd = &fontd[0];
  1903. X    fd->f_intname = "";    /* not NULL */
  1904. X    fd->f_extname = "";    /* not NULL */
  1905. X    fd->f_codetab = emalloc((unsigned)MAXCHARS);
  1906. X    fd->f_fitab = emalloc((unsigned)(ncharname+NASCPRINT));
  1907. X    fd->f_nent = MAXCHARS;
  1908. X
  1909. X    /* sentinel fontdesc entry */
  1910. X    fd = &fontd[nfonts+1];
  1911. X    fd->f_intname = (char *)NULL;
  1912. X    fd->f_extname = (char *)NULL;
  1913. X    fd->f_nent = 0;
  1914. X    fd->f_codetab = (char *)NULL;
  1915. X    fd->f_fitab = (char *)NULL;
  1916. X}
  1917. X
  1918. loadfont(extname, fpos)
  1919. char    *extname;    /* troff font name */
  1920. int    fpos;        /* font position */
  1921. X{
  1922. X    register struct fontdesc    *font;
  1923. X
  1924. X    if(fpos > nfontmount || fpos < 0)
  1925. X    {
  1926. X        sprintf(errbuf, "Illegal font mount position %d\n", fpos);
  1927. X        error(ERR_WARN, errbuf);
  1928. X        return;
  1929. X    }
  1930. X    if ( (font = findfont(extname)) == (struct fontdesc *) NULL )
  1931. X    {
  1932. X        sprintf(errbuf, "No such font '%s'\n", extname);
  1933. X        error(ERR_WARN, errbuf);
  1934. X        return;
  1935. X    }
  1936. X    fontmount[fpos] = font;
  1937. X}
  1938. X
  1939. struct fontmap *
  1940. getfmap(extname)
  1941. char    *extname;
  1942. X{
  1943. X    struct fontmap    *fm;
  1944. X
  1945. X    fm = fontmap;
  1946. X    while(fm->fm_intname && strcmp(fm->fm_extname, extname) != 0)
  1947. X        fm++;
  1948. X    if(fm->fm_intname)
  1949. X        return(fm);
  1950. X    else
  1951. X        return((struct fontmap *)NULL);
  1952. X}
  1953. X
  1954. X#ifndef    UQMINMET
  1955. X
  1956. struct fontdesc *
  1957. findfont(extname)
  1958. char    *extname;
  1959. X{
  1960. X    struct fontdesc    *fd;
  1961. X
  1962. X    fd = fontd;
  1963. X    while(fd->f_intname && strcmp(fd->f_extname, extname) != 0)
  1964. X        fd++;
  1965. X    if(fd->f_intname)
  1966. X        return(fd);
  1967. X    else
  1968. X        return((struct fontdesc *)NULL);
  1969. X}
  1970. X
  1971. X#else    UQMINMET
  1972. X        /*
  1973. X         * find font including from possible synonym
  1974. X         * - use internal name instead of troff name.
  1975. X         * troff names need not uniquely correspond to a given
  1976. X         * internal name
  1977. X         */
  1978. struct fontdesc *
  1979. findfont(extname)
  1980. char    *extname;
  1981. X{
  1982. X    struct fontmap    *fm;
  1983. X    struct fontdesc    *fd;
  1984. X
  1985. X    if ( (fm = getfmap( extname )) == (struct fontmap *)NULL )
  1986. X        return((struct fontdesc *)NULL);
  1987. X    fd = fontd;
  1988. X    while(fd->f_intname && strcmp(fd->f_intname, fm->fm_intname) != 0)
  1989. X        fd++;
  1990. X    if(fd->f_intname)
  1991. X        return(fd);
  1992. X    else
  1993. X        return((struct fontdesc *)NULL);
  1994. X}
  1995. X#endif UQMINMET
  1996. X
  1997. char *
  1998. emalloc(size)
  1999. unsigned size;
  2000. X{
  2001. X    char        *malloc();
  2002. X    register char    *s;
  2003. X
  2004. X    s = malloc(size);
  2005. X    if(s == NULL)
  2006. X    {
  2007. X        fprintf(stderr, "Ran out of memory allocating %u bytes\n",
  2008. X            size);
  2009. X        finish(1);
  2010. X    }
  2011. X    return(s);
  2012. X}
  2013. X
  2014. efread(buf, size, nel, istr)
  2015. char    *buf;
  2016. int    size,
  2017. X    nel;
  2018. XFILE    *istr;
  2019. X{
  2020. X    register int n;
  2021. X
  2022. X    if((n=fread(buf, size, nel, istr)) != nel)
  2023. X        fprintf(stderr, "Bad format font file\n");
  2024. X    return(n);
  2025. X}
  2026. X
  2027. efseek(istr, offset)
  2028. XFILE    *istr;
  2029. int    offset;
  2030. X{
  2031. X    if(fseek(istr, (long)offset, 1) != 0)
  2032. X        fprintf(stderr, "Snark: Bad seek on font file\n");
  2033. X}
  2034. X
  2035. X
  2036. putch(ch)
  2037. int    ch;
  2038. X{
  2039. X    setfont(FALSE);    /* ensure correct font */
  2040. X
  2041. X    if ( word_started == FALSE ) {
  2042. X        word_started = TRUE;
  2043. X        putc('(', postr);
  2044. X    }
  2045. X    pch(ch);
  2046. X}
  2047. END_OF_FILE
  2048. if test 36974 -ne `wc -c <'./tpscript/tpscript.c'`; then
  2049.     echo shar: \"'./tpscript/tpscript.c'\" unpacked with wrong size!
  2050. fi
  2051. # end of './tpscript/tpscript.c'
  2052. fi
  2053. echo shar: End of archive 5 \(of 5\).
  2054. cp /dev/null ark5isdone
  2055. MISSING=""
  2056. for I in 1 2 3 4 5 ; do
  2057.     if test ! -f ark${I}isdone ; then
  2058.     MISSING="${MISSING} ${I}"
  2059.     fi
  2060. done
  2061. if test "${MISSING}" = "" ; then
  2062.     echo You have unpacked all 5 archives.
  2063.     rm -f ark[1-9]isdone
  2064. else
  2065.     echo You still need to unpack the following archives:
  2066.     echo "        " ${MISSING}
  2067. fi
  2068. ##  End of shell archive.
  2069. exit 0
  2070.