home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume20 / psroff / part04 / lib.ps < prev    next >
Encoding:
Text File  |  1989-10-17  |  9.7 KB  |  389 lines
  1. %    Copyright 1985, 1986, 1987, 1988 Chris Lewis
  2. %        All Rights Reserved
  3. %
  4. %    Permission to copy and further distribute is freely given provided 
  5. %    this copyright notice remains intact and that this software is not 
  6. %    sold for profit.
  7. %
  8. %    Project:    Generic Troff drivers
  9. %    Module:        lib.ps
  10. %    Author:     Chris Lewis
  11. %    Specs:        Predefinitions for PostScript
  12. %ident  @(#)lib.ps: 1.16 Copyright 89/07/04 16:59:33 Chris Lewis"
  13.  
  14. /Y { 3 1 roll dup /CurY exch def moveto show } def
  15. /X { exch CurY moveto show } def
  16.  
  17. /Hits    10 string def
  18. Hits 0 0 1 string cvs putinterval
  19. /Misses    10 string def
  20. Misses 0 0 1 string cvs putinterval
  21.  
  22. /drawfraction {
  23.     /denominator exch def
  24.     /numerator exch def
  25.     /origY exch def
  26.     /origX exch def
  27.     origX curPoints 4 div add origY moveto
  28.     (/) show
  29.     curFont findfont curPoints .5 mul cvi scalefont setfont
  30.     origX origY curPoints 4 div add moveto
  31.     numerator show
  32.     origX curPoints 2 div add origY moveto
  33.     denominator show
  34.     curFont findfont curPoints scalefont setfont
  35.     origX origY moveto
  36. } def
  37.  
  38. /mySetLineWidth {
  39.     curPoints 3 72 div mul setlinewidth
  40. } def
  41.  
  42. /do12 {
  43.     (1) (2) drawfraction
  44. } def
  45.  
  46. /do14 {
  47.     (1) (4) drawfraction
  48. } def
  49.  
  50. /do34 {
  51.     (3) (4) drawfraction
  52. } def
  53.  
  54. /doff {
  55.     moveto
  56.     (f) show curPoints 20 div neg 0 rmoveto (f) show
  57. } def
  58.  
  59. /doFi {
  60.     moveto
  61.     (f) show curPoints 20 div neg 0 rmoveto (\256) show
  62. } def
  63.  
  64. /doFl {
  65.     moveto
  66.     (f) show curPoints 20 div neg 0 rmoveto (\257) show
  67. } def
  68.  
  69. %    This should be sort of a font-caching mechanism - eg:
  70. %    remember each font/point combination requested, and
  71. %    if the setting is not already known, *then* do the findfont/scalefont.
  72. %    Otherwise, simply retrieve it.
  73. %    However, even with simply recalculating the font each time, it
  74. %    isn't *that* slow.  Eg: 20 seconds or so for *very* "font-changy"
  75. %    pages.
  76. %
  77. %    Trial font cache - I can't think in Polish... ;-)
  78. /SetFont {
  79.     /curPoints exch def
  80.     /curFont exch def
  81.     %    Concatenate the curFont string with the curPoints to create
  82.     %    a new name and assign to cF
  83.  
  84.     /cF 50 string def 
  85.  
  86.     cF 0
  87.         cF curFont cF cvs        % cF 0 string "curFont"
  88.         length dup            % cF 0 "curFont\0\0..." N N
  89.         curPoints 10 string cvs    % cF 0 "curFont\0\0..." N N "points"
  90.         dup length            % cF 0 "curFont\0\0..." N N "points" M
  91.         3 -1 roll add        % cF 0 "curFont\0\0..." N "points" M+N
  92.         4 1 roll            % cF 0 M+N "curFont\0\0..." N "points"
  93.         putinterval            % cF 0 M+N    (cF <- "curFontpoints")
  94.     getinterval                % "curFontpoints"
  95.  
  96.     /cF exch def
  97.     cF
  98.     cvn                    % /curFontpoints
  99.  
  100.     where {
  101.     /hits hits 1 add def
  102.     pop 
  103.     } {
  104.     /misses misses 1 add def
  105.     cF curFont findfont curPoints scalefont def
  106.     } ifelse
  107.     cF load setfont
  108. } def
  109.  
  110. /docircle {
  111.     /origY exch def
  112.     /origX exch def
  113.     /radius curPoints 3 div def
  114.     newpath origX radius add origY radius add radius 0 360 arc 
  115.     mySetLineWidth
  116.     stroke
  117.     origX origY moveto
  118. } def
  119.  
  120. /doru {
  121.     moveto
  122.     0 curPoints 5 div rmoveto (_) show
  123. } def
  124.  
  125. /do34em {
  126.     /origY exch def
  127.     /origX exch def
  128.     /emheight curPoints .23 mul def
  129.     newpath
  130.     origX origY emheight add moveto
  131.     origX curPoints .75 mul add origY emheight add lineto
  132.     mySetLineWidth
  133.     stroke
  134.     origX origY moveto
  135. } def
  136.  
  137. /dosq {
  138.     /origY exch def
  139.     /origX exch def
  140.     /L (M) stringwidth pop 3 div def
  141.     newpath
  142.     origX origY moveto
  143.     origX origY L add lineto
  144.     origX L add origY L add lineto
  145.     origX L add origY lineto
  146.     closepath
  147.     mySetLineWidth
  148.     stroke
  149.     origX origY moveto
  150. } def
  151.  
  152. /dobox {
  153.     /origY exch def
  154.     /origX exch def
  155.     /L curPoints def
  156.     newpath
  157.     origX origY moveto
  158.     origX origY L add lineto
  159.     origX L add origY L add lineto
  160.     origX L add origY lineto
  161.     closepath
  162.     1 setlinewidth
  163.     stroke
  164.     origX origY moveto
  165. } def
  166.  
  167.  
  168. /fourpops {
  169.     4 {pop} repeat
  170. } def
  171.  
  172. %    These are macros so that they can be redefined.
  173. %    print current page.
  174. /ShowPage {
  175.     Misses dup cvi misses add 10 string cvs 0 exch putinterval
  176.     Hits dup cvi hits add 10 string cvs 0 exch putinterval
  177.     showpage
  178. } def
  179.  
  180. %    Emitted at beginning of page.
  181. /StartPage {
  182.     /hits 0 def
  183.     /misses 0 def
  184.     Form
  185. } def
  186.  
  187. %    If you want to define a Bell System Logo, go ahead.  This
  188. %    one draws an animal (ferret) face
  189. %    Object should be scaled off of curPoints, with origX,origY
  190. %    lower left coordinates.
  191. /BellSymbol {
  192.     /origY exch def
  193.     /origX exch def
  194.     /TEMPSAVE save def
  195.  
  196.     /Radius curPoints 2 div def    % Face Radius
  197.     /HRadius Radius 2 div def    % Half Face Radius
  198.     /NRadius Radius 6 div def    % Nose Radius
  199.     /ERadius Radius 8 div def    % Eye Radius
  200.     /EarRadius Radius 3 div def    % Ear Radius
  201.     /FaceType (Ferret) def
  202.  
  203.     /MRadius Radius 4 div def    % Mask corner radius
  204.     /TopMask Radius .7 mul def    % XCent & YCent max delta
  205.     /BotMask NRadius 1.1 mul def % YCent min delta
  206.  
  207.     /XCent origX Radius add def
  208.     /YCent origY Radius add def
  209.  
  210.     newpath
  211.     %    Main face
  212.     XCent YCent Radius 0 360 arc mySetLineWidth stroke
  213.     %    Nose
  214.     XCent YCent NRadius 0 360 arc fill
  215.     %    Left Ear
  216.     XCent Radius 45 sin mul sub 
  217.     YCent Radius 45 sin mul add EarRadius 20 250 arc mySetLineWidth stroke
  218.     %    Right Ear
  219.     XCent Radius 45 sin mul add 
  220.     YCent Radius 45 sin mul add EarRadius -70 160 arc mySetLineWidth stroke
  221.     %    Cleft
  222.     XCent YCent NRadius sub moveto
  223.     XCent YCent HRadius sub lineto 
  224.     mySetLineWidth stroke
  225.  
  226.     %    Mouth
  227.     XCent HRadius 45 sin mul sub YCent HRadius 45 sin mul sub moveto
  228.     XCent HRadius 30 sin mul sub YCent HRadius sub lineto
  229.     XCent HRadius 30 sin mul add YCent HRadius sub lineto
  230.     XCent HRadius 45 sin mul add YCent HRadius 45 sin mul sub lineto
  231.     mySetLineWidth stroke
  232.  
  233.     FaceType (Ferret) eq {
  234.     %    Mask
  235.     .6 setgray
  236.     XCent TopMask sub YCent BotMask add YCent TopMask add add 2 div moveto
  237.  
  238.     XCent TopMask sub YCent TopMask add 
  239.         XCent TopMask add YCent TopMask add
  240.         MRadius arcto fourpops
  241.     XCent TopMask add YCent TopMask add
  242.         XCent TopMask add YCent BotMask add
  243.         MRadius arcto fourpops
  244.     XCent TopMask add YCent BotMask add
  245.         XCent TopMask sub YCent BotMask add
  246.         MRadius arcto fourpops
  247.     XCent TopMask sub YCent BotMask add
  248.         XCent TopMask sub YCent TopMask add 
  249.         MRadius arcto fourpops
  250.     fill
  251.  
  252.     0 setgray
  253.     } if
  254.     
  255.     %    Eyes
  256.     XCent HRadius add YCent HRadius add ERadius 0 360 arc fill
  257.     XCent HRadius sub YCent HRadius add ERadius 0 360 arc fill
  258.     TEMPSAVE restore
  259.     origX origY moveto
  260. } def
  261.  
  262. %    bracket building font
  263. %!
  264. %
  265. % Michael Rourke, University of N.S.W., Australia
  266. %
  267. /BracketFontDict 9 dict def /$workingdict 10 dict def
  268. BracketFontDict begin
  269. /FontType 3 def
  270. /FontName (Bracket) cvn def
  271. /FontMatrix [ 0.001 0 0 0.001 0 0] def
  272. /FontBBox [ -50 -250 1000 1000 ] def
  273. /Encoding 256 array def 0 1 255 { Encoding exch /.notdef put } for
  274. Encoding
  275. dup 65 /Cbv put    %A
  276. dup 66 /Clt put    %B
  277. dup 67 /Clk put    %C
  278. dup 68 /Clb put    %D
  279. dup 69 /Crt put    %E
  280. dup 70 /Crk put    %F
  281. dup 71 /Crb put    %G
  282. dup 72 /Clc put    %H
  283. dup 73 /Clf put    %I
  284. dup 74 /Crc put    %J
  285. dup 75 /Crf put    %K
  286. dup 76 /Cbr put    %L
  287. dup 77 /Crn put    %M
  288. dup 78 /Cci put    %N
  289. dup 79 /Cru put    %O
  290. pop
  291. /CharProcs 24 dict dup begin
  292. /setC { 0 -50 -250 500 1000 setcachedevice} def
  293. /C.bv {220 -250 moveto 0 1000 rlineto
  294. 60 0 rlineto 0 -1000 rlineto fill } def
  295. /C.barc { 750 moveto 180 0 rlineto 0 -60 rlineto -180 0 rlineto fill } def
  296. /C.barf { -250 moveto 180 0 rlineto 0 60 rlineto -180 0 rlineto fill } def
  297. /C.brk.end { 1 setlinewidth moveto rlineto rcurveto
  298. reversepath 60 0 rlineto rlineto rcurveto fill } def
  299. /C.setl {dup dtransform exch round exch idtransform pop setlinewidth } def
  300. /Cbv {
  301. 300 setC
  302. C.bv
  303. } def
  304. /Clt {
  305. 300 setC
  306.   0 150 50 210 140 250   0 730  0 150 50 250 200 250   0 750   220 -250   C.brk.end
  307. } def
  308. /Clk {
  309. 300 setC
  310.   1 setlinewidth  220 -250 moveto  0 400 rlineto  0 50 -50 100 -100 100 rcurveto  50 0 100 50 100 100 rcurveto  0 400 rlineto  60 0 rlineto  0 -400 rlineto  0 -50 -50 -100 -100 -100 rcurveto  50 0 100 -50 100 -100 rcurveto  0 -400 rlineto  closepath fill
  311. } def
  312. /Clb {
  313. 300 setC
  314.   0 -150 50 -210 140 -250   0 -730  0 -150 50 -250 200 -250   0 -750   220 750   C.brk.end
  315. } def
  316. /Crt {
  317. 300 setC
  318.   0 150 -50 250 -200 250   0 750   0 150 -50 210 -140 250   0 730  220 -250   C.brk.end
  319. } def
  320. /Crk {
  321. 300 setC
  322.   1 setlinewidth  220 -250 moveto  0 400 rlineto  0 50 50 100 100 100 rcurveto  -50 0 -100 50 -100 100 rcurveto  0 400 rlineto  60 0 rlineto  0 -400 rlineto  0 -50 50 -100 100 -100 rcurveto  -50 0 -100 -50 -100 -100 rcurveto  0 -400 rlineto  fill
  323. } def
  324. /Crb {
  325. 300 setC
  326.   0 -150 -50 -250 -200 -250   0 -750   0 -150 -50 -210 -140 -250   0 -730  220 750   C.brk.end
  327. } def
  328. /Clc {
  329. 300 setC
  330.   C.bv   280   C.barc
  331. } def
  332. /Clf {
  333. 300 setC
  334.   C.bv 280 C.barf
  335. } def
  336. /Crc {
  337. 300 setC
  338.   C.bv 40 C.barc
  339. } def
  340. /Crf {
  341. 300 setC
  342.   C.bv 40 C.barf
  343. } def
  344. /Cbr {
  345. 0 0 -50 -250 0 1000 setcachedevice
  346.   40 C.setl  0 -250 moveto  0 1000 rlineto  stroke
  347. } def
  348. /Cru {
  349. 0 0 -50 -250 1000 0 setcachedevice
  350.   40 C.setl  0 -250 moveto 500 0 rlineto stroke
  351. } def
  352. /Crn {
  353. 300 setC
  354.   40 C.setl  0 895 moveto  500 0 rlineto  stroke
  355. } def
  356. /Cci {
  357. 600 0 -50 -250 700 1000 setcachedevice
  358.   40 C.setl  400 250   300   0 360 arc   stroke
  359. } def
  360. end def
  361. /BuildChar
  362. {
  363.     $workingdict begin
  364.     /charcode exch def
  365.     /fontdict exch def
  366.     fontdict /CharProcs get begin
  367.     fontdict /Encoding get
  368.     charcode get load
  369.     gsave
  370.     0 setlinecap 0 setgray newpath
  371.     exec
  372.     grestore
  373.     end end
  374. } def end
  375. /BracketFont BracketFontDict definefont pop
  376.  
  377. %    This macro is invoked by ShowPage to display the current form.
  378. %    Usually redefined to point at a form loaded by an include
  379. %    directive.  Redefinition triggered by .sR O<formname> troff
  380. %    directive.
  381. %    Global default form (usually redefined top of each page anyways)
  382. /Form {} def
  383. %    This is a convenient place for putting your extra inclusions.
  384. %    Eg: this would load conf.ps (from current directory or LIBDIR)
  385. %    and insert it into the end of the prolog.
  386. %   This loads the confidential form.
  387. %%%include confid
  388. %%%include lethead
  389.