home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Usenet 1994 October
/
usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso
/
unix
/
volume20
/
psroff
/
part04
/
lib.ps
< prev
next >
Wrap
Text File
|
1989-10-17
|
10KB
|
389 lines
% Copyright 1985, 1986, 1987, 1988 Chris Lewis
% All Rights Reserved
%
% Permission to copy and further distribute is freely given provided
% this copyright notice remains intact and that this software is not
% sold for profit.
%
% Project: Generic Troff drivers
% Module: lib.ps
% Author: Chris Lewis
% Specs: Predefinitions for PostScript
%ident @(#)lib.ps: 1.16 Copyright 89/07/04 16:59:33 Chris Lewis"
/Y { 3 1 roll dup /CurY exch def moveto show } def
/X { exch CurY moveto show } def
/Hits 10 string def
Hits 0 0 1 string cvs putinterval
/Misses 10 string def
Misses 0 0 1 string cvs putinterval
/drawfraction {
/denominator exch def
/numerator exch def
/origY exch def
/origX exch def
origX curPoints 4 div add origY moveto
(/) show
curFont findfont curPoints .5 mul cvi scalefont setfont
origX origY curPoints 4 div add moveto
numerator show
origX curPoints 2 div add origY moveto
denominator show
curFont findfont curPoints scalefont setfont
origX origY moveto
} def
/mySetLineWidth {
curPoints 3 72 div mul setlinewidth
} def
/do12 {
(1) (2) drawfraction
} def
/do14 {
(1) (4) drawfraction
} def
/do34 {
(3) (4) drawfraction
} def
/doff {
moveto
(f) show curPoints 20 div neg 0 rmoveto (f) show
} def
/doFi {
moveto
(f) show curPoints 20 div neg 0 rmoveto (\256) show
} def
/doFl {
moveto
(f) show curPoints 20 div neg 0 rmoveto (\257) show
} def
% This should be sort of a font-caching mechanism - eg:
% remember each font/point combination requested, and
% if the setting is not already known, *then* do the findfont/scalefont.
% Otherwise, simply retrieve it.
% However, even with simply recalculating the font each time, it
% isn't *that* slow. Eg: 20 seconds or so for *very* "font-changy"
% pages.
%
% Trial font cache - I can't think in Polish... ;-)
/SetFont {
/curPoints exch def
/curFont exch def
% Concatenate the curFont string with the curPoints to create
% a new name and assign to cF
/cF 50 string def
cF 0
cF curFont cF cvs % cF 0 string "curFont"
length dup % cF 0 "curFont\0\0..." N N
curPoints 10 string cvs % cF 0 "curFont\0\0..." N N "points"
dup length % cF 0 "curFont\0\0..." N N "points" M
3 -1 roll add % cF 0 "curFont\0\0..." N "points" M+N
4 1 roll % cF 0 M+N "curFont\0\0..." N "points"
putinterval % cF 0 M+N (cF <- "curFontpoints")
getinterval % "curFontpoints"
/cF exch def
cF
cvn % /curFontpoints
where {
/hits hits 1 add def
pop
} {
/misses misses 1 add def
cF curFont findfont curPoints scalefont def
} ifelse
cF load setfont
} def
/docircle {
/origY exch def
/origX exch def
/radius curPoints 3 div def
newpath origX radius add origY radius add radius 0 360 arc
mySetLineWidth
stroke
origX origY moveto
} def
/doru {
moveto
0 curPoints 5 div rmoveto (_) show
} def
/do34em {
/origY exch def
/origX exch def
/emheight curPoints .23 mul def
newpath
origX origY emheight add moveto
origX curPoints .75 mul add origY emheight add lineto
mySetLineWidth
stroke
origX origY moveto
} def
/dosq {
/origY exch def
/origX exch def
/L (M) stringwidth pop 3 div def
newpath
origX origY moveto
origX origY L add lineto
origX L add origY L add lineto
origX L add origY lineto
closepath
mySetLineWidth
stroke
origX origY moveto
} def
/dobox {
/origY exch def
/origX exch def
/L curPoints def
newpath
origX origY moveto
origX origY L add lineto
origX L add origY L add lineto
origX L add origY lineto
closepath
1 setlinewidth
stroke
origX origY moveto
} def
/fourpops {
4 {pop} repeat
} def
% These are macros so that they can be redefined.
% print current page.
/ShowPage {
Misses dup cvi misses add 10 string cvs 0 exch putinterval
Hits dup cvi hits add 10 string cvs 0 exch putinterval
showpage
} def
% Emitted at beginning of page.
/StartPage {
/hits 0 def
/misses 0 def
Form
} def
% If you want to define a Bell System Logo, go ahead. This
% one draws an animal (ferret) face
% Object should be scaled off of curPoints, with origX,origY
% lower left coordinates.
/BellSymbol {
/origY exch def
/origX exch def
/TEMPSAVE save def
/Radius curPoints 2 div def % Face Radius
/HRadius Radius 2 div def % Half Face Radius
/NRadius Radius 6 div def % Nose Radius
/ERadius Radius 8 div def % Eye Radius
/EarRadius Radius 3 div def % Ear Radius
/FaceType (Ferret) def
/MRadius Radius 4 div def % Mask corner radius
/TopMask Radius .7 mul def % XCent & YCent max delta
/BotMask NRadius 1.1 mul def % YCent min delta
/XCent origX Radius add def
/YCent origY Radius add def
newpath
% Main face
XCent YCent Radius 0 360 arc mySetLineWidth stroke
% Nose
XCent YCent NRadius 0 360 arc fill
% Left Ear
XCent Radius 45 sin mul sub
YCent Radius 45 sin mul add EarRadius 20 250 arc mySetLineWidth stroke
% Right Ear
XCent Radius 45 sin mul add
YCent Radius 45 sin mul add EarRadius -70 160 arc mySetLineWidth stroke
% Cleft
XCent YCent NRadius sub moveto
XCent YCent HRadius sub lineto
mySetLineWidth stroke
% Mouth
XCent HRadius 45 sin mul sub YCent HRadius 45 sin mul sub moveto
XCent HRadius 30 sin mul sub YCent HRadius sub lineto
XCent HRadius 30 sin mul add YCent HRadius sub lineto
XCent HRadius 45 sin mul add YCent HRadius 45 sin mul sub lineto
mySetLineWidth stroke
FaceType (Ferret) eq {
% Mask
.6 setgray
XCent TopMask sub YCent BotMask add YCent TopMask add add 2 div moveto
XCent TopMask sub YCent TopMask add
XCent TopMask add YCent TopMask add
MRadius arcto fourpops
XCent TopMask add YCent TopMask add
XCent TopMask add YCent BotMask add
MRadius arcto fourpops
XCent TopMask add YCent BotMask add
XCent TopMask sub YCent BotMask add
MRadius arcto fourpops
XCent TopMask sub YCent BotMask add
XCent TopMask sub YCent TopMask add
MRadius arcto fourpops
fill
0 setgray
} if
% Eyes
XCent HRadius add YCent HRadius add ERadius 0 360 arc fill
XCent HRadius sub YCent HRadius add ERadius 0 360 arc fill
TEMPSAVE restore
origX origY moveto
} def
% bracket building font
%!
%
% Michael Rourke, University of N.S.W., Australia
%
/BracketFontDict 9 dict def /$workingdict 10 dict def
BracketFontDict begin
/FontType 3 def
/FontName (Bracket) cvn def
/FontMatrix [ 0.001 0 0 0.001 0 0] def
/FontBBox [ -50 -250 1000 1000 ] def
/Encoding 256 array def 0 1 255 { Encoding exch /.notdef put } for
Encoding
dup 65 /Cbv put %A
dup 66 /Clt put %B
dup 67 /Clk put %C
dup 68 /Clb put %D
dup 69 /Crt put %E
dup 70 /Crk put %F
dup 71 /Crb put %G
dup 72 /Clc put %H
dup 73 /Clf put %I
dup 74 /Crc put %J
dup 75 /Crf put %K
dup 76 /Cbr put %L
dup 77 /Crn put %M
dup 78 /Cci put %N
dup 79 /Cru put %O
pop
/CharProcs 24 dict dup begin
/setC { 0 -50 -250 500 1000 setcachedevice} def
/C.bv {220 -250 moveto 0 1000 rlineto
60 0 rlineto 0 -1000 rlineto fill } def
/C.barc { 750 moveto 180 0 rlineto 0 -60 rlineto -180 0 rlineto fill } def
/C.barf { -250 moveto 180 0 rlineto 0 60 rlineto -180 0 rlineto fill } def
/C.brk.end { 1 setlinewidth moveto rlineto rcurveto
reversepath 60 0 rlineto rlineto rcurveto fill } def
/C.setl {dup dtransform exch round exch idtransform pop setlinewidth } def
/Cbv {
300 setC
C.bv
} def
/Clt {
300 setC
0 150 50 210 140 250 0 730 0 150 50 250 200 250 0 750 220 -250 C.brk.end
} def
/Clk {
300 setC
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
} def
/Clb {
300 setC
0 -150 50 -210 140 -250 0 -730 0 -150 50 -250 200 -250 0 -750 220 750 C.brk.end
} def
/Crt {
300 setC
0 150 -50 250 -200 250 0 750 0 150 -50 210 -140 250 0 730 220 -250 C.brk.end
} def
/Crk {
300 setC
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
} def
/Crb {
300 setC
0 -150 -50 -250 -200 -250 0 -750 0 -150 -50 -210 -140 -250 0 -730 220 750 C.brk.end
} def
/Clc {
300 setC
C.bv 280 C.barc
} def
/Clf {
300 setC
C.bv 280 C.barf
} def
/Crc {
300 setC
C.bv 40 C.barc
} def
/Crf {
300 setC
C.bv 40 C.barf
} def
/Cbr {
0 0 -50 -250 0 1000 setcachedevice
40 C.setl 0 -250 moveto 0 1000 rlineto stroke
} def
/Cru {
0 0 -50 -250 1000 0 setcachedevice
40 C.setl 0 -250 moveto 500 0 rlineto stroke
} def
/Crn {
300 setC
40 C.setl 0 895 moveto 500 0 rlineto stroke
} def
/Cci {
600 0 -50 -250 700 1000 setcachedevice
40 C.setl 400 250 300 0 360 arc stroke
} def
end def
/BuildChar
{
$workingdict begin
/charcode exch def
/fontdict exch def
fontdict /CharProcs get begin
fontdict /Encoding get
charcode get load
gsave
0 setlinecap 0 setgray newpath
exec
grestore
end end
} def end
/BracketFont BracketFontDict definefont pop
% This macro is invoked by ShowPage to display the current form.
% Usually redefined to point at a form loaded by an include
% directive. Redefinition triggered by .sR O<formname> troff
% directive.
% Global default form (usually redefined top of each page anyways)
/Form {} def
% This is a convenient place for putting your extra inclusions.
% Eg: this would load conf.ps (from current directory or LIBDIR)
% and insert it into the end of the prolog.
% This loads the confidential form.
%%%include confid
%%%include lethead