reid@Glacier.ARPA (Brian Reid) (06/07/85)
I store this file as /usr/stanford/lib/ps/mac.ps on my machines.
This version works only for standalone pages--the entire sheet of paper
generated by the Mac. I am working on one that will let you use the Mac to
make figures and diagrams that can be included in documents formatted by
other programs.
------ cut here -------
%!
% Macintosh LaserWriter header file.
%
% This is a file of PostScript definitions that can be affixed to the
% front of the PostScript files generated by Macintosh applications in order
% that they can be printed on a LaserWriter that has not been initialized
% with the "LaserPrep" package. This situation will arise if you are
% trying to share a LaserWriter between Macintosh users and non-Macintosh
% users.
%
% Macintosh applications do not normally generate straight PostScript.
% They generate a file in PostScript format, but the contents of the file
% is a series of calls on functions that are not part of the PostScript
% language. This file defines those functions.
%
% This is not the official Apple header file. It is neither endorsed nor
% condemned by Apple. I suspect that it probably started out its life
% as a bootleg copy of a version of the Apple header file. It has been
% slightly modified by me and perhaps heavily modified by various other
% people. I have substantially augmented the comments so that they explain
% what I think the code is doing.
%
% Brian Reid Reid@SU-Glacier.ARPA
% Stanford {decwrl,hplabs,bellcore}!glacier!reid
%
% WARNING: There is no guarantee that Apple will stick to this particular
% set of definitions. This header file works with the application software
% that came with my LaserWriter; I make no promises that it will work with
% the software on anybody else's LaserWriter.
%
% To convert this file back into a downloaded file instead of a header
% file, uncomment all of the lines beginning with %-%
%-%0000000 % Server loop exit password
%-%serverdict begin exitserver
%-% systemdict /statusdict known
%-% {statusdict begin 9 0 3 setsccinteractive /waittimeout 300 def end}
%-% if
/md 200 dict def % define a working dictionary
md begin % start using it
/av 13 def % define apple version
/mtx matrix currentmatrix def % save current transformation
/s30 30 string def
/s1 ( ) def
/pys 1 def
/pxs 1 def
/pyt 760 def
/pxt 29.52 def
/por true def
/xl {translate} def
/fp {pnsh 0 ne pnsv 0 ne and} def
% Define QuickDraw operators as an array of procedures.
% They are {frame, paint, erase, invert, fill}
% For some reason "invert" is a no-op.
/vrb [
{fp
{gsave 1 setlinewidth pnsh pnsv scale stroke grestore}
if newpath}
{eofill}
{eofill}
{newpath}
{eofill}
{initclip eoclip newpath}
{}
{}
{}
{}
] def
% convenience function for backwards def
/xdf {exch def} def
% get current halftone screen parameters
currentscreen
/spf xdf % spot function
/rot xdf % rotation
/freq xdf % spatial frequency
% "apply" function to execute appropriate numbered operator from /vrb.
/doop {vrb exch get exec} def
% compute page position from portrait/landscape flag, translation, scale,
% and resolution.
% call: P/L-flag xtransl ytransl scale*100 xbits/inch ybits/inch psu
% typical call: F 580 760 100 72 72 psu for life-size screen-resolution
% image.
%
/psu
{2 index .72 mul exch div /pys xdf % pixel y scale
div .72 mul /pxs xdf % pixel x scale
/pyt xdf % pixel y translation
/pxt xdf % pixel x translation
/por xdf % portrait flag (T=portrait)
} def
% argument is page y size; use this to determine legal, letter, or note
% and to set up appropriate scale factors and translation/reflection
% for portrait or landscape.
/txpose{
dup 1680 eq
userdict /note known
{{legal}{note}ifelse}
{pop}
ifelse
dup 1212 eq {54 32.4 xl} if
1321 eq {8.64 -.6 xl} if
pxs pys scale pxt pyt xl por not
{270 rotate} if
1 -1 scale
} def
% Compute oblique shear value for font if flag true
/obl {{0.212557 mul}{pop 0} ifelse} def
% set font from dictionary: make a font, set it to current, leave on stack
% call: "found-font size oblique-flag dictionary sfd"
/sfd {
[ps 0 ps 6 -1 roll obl ps neg 0 0] makefont
dup setfont
} def
/fnt {findfont sfd} def
% bit test-- "number mask-word bt" returns boolean and unchanged number
% thus, "4095 512 bt" returns "true 4095" -- the argument is a mask
% and not a bit number.
/bt {1 index and 0 ne exch} def
% load style array with unpacked true/false flags from style word
% flags are Bold, Italic, Underline, Outline, Shadow (I don't know
% what the 6th one is supposed to be).
/sa 6 array def
/fs {
1 bt 2 bt 4 bt 8 bt 16 bt
sa astore pop
} def
/matrix1 matrix def
/matrix2 matrix def
/gf{
currentfont
} def
% set translation center from 2 double-precision integers giving x,y
/tc{
32768 div add % compute y location
3 1 roll
32768 div add % compute x location
2t astore pop % save 'em
} def
/3a [0 0 0] def
/2t 2 array def
% store transformation params: "justify flip rotation tp"
% (left/center/right/full, none/yflip,xflip, degrees)
/tp{
3a astore pop
} def
/ee {} def
% move PostScript current position to QuickDraw current position,
% and get scaling and rotation right (this is in preparation for
% outputting text
/tt {
gsave
currentpoint 2 copy
2t aload pop qa 2 copy xl
3a aload pop exch dup 0 eq
{pop}
{1 eq {-1 1}
{1 -1}ifelse scale}
ifelse
rotate
pop neg exch neg exch xl
moveto
} def
/te { % text-end: undo effects of prior "tt"
currentpoint currentfont
grestore setfont moveto % but leave font and currentpoint set
} def
/tb {
/tg currentgray def
3 -1 roll 3 eq
{1 setgray} if
/ml 0 def /al 0 def
} def
/am {
ml add /ml xdf
} def
/aa {
[currentgray /setgray cvx] cvx
exch dup wi pop dup al add /al xdf exch
} def
% scale by rational value (quotient) in x and y. Set "scaleflag" to
% record that we have done this.
/th {
3 -1 roll div
3 1 roll exch div
% not sure of "transform" in next line (BKR)
2 copy matrix1 transform scale
pop scale
/scaleflag true def
} def
% undo a "th" scaling and return to default coordinate system
/tu {
1 1 matrix1 itransform scale
/scaleflag false def
} def
/ts {
1 1 matrix1 transform scale
/scaleflag true def
} def
% record point size (of fonts)
/fz{/ps xdf} def
% execute a procedure but leave it on the stack
/fx{dup exec} def
/st{show pop pop} def
% text munger. This does the dirty work for the edit string procedure
% (following) by iterating over a polymorphic array and doing the right
% thing with what it finds there.
/tm {
{dup type dup /integertype eq exch /realtype eq or
{dup ml mul}
{dup type /stringtype eq
{rs}
{dup type /dicttype eq
{setfont}
{dup type /arraytype eq
{exec}
{pop}
ifelse
} ifelse
} ifelse
} ifelse
} forall
} def
% edit string. Takes a font, a text mode, a justification mode, and an
% array of text and font changes for that text, and does it.
/es {
3 -1 roll dup sa 5 get dup type /nulltype eq
{pop4 pop}
{sa 1 get
{/ml ml .2 ps mul sub def} if
ne {fs}
{pop}
ifelse exch
dup 1 eq % justification mode 1 is left-justify
{pop
al ml gt
{/tv {ll} /ml ml al dup 0 ne
{div}{pop} ifelse
def}
{/tv {st} /ml 1 def}
ifelse def tm
}
{dup 3 eq % justification mode 3 is right-justify
{pop
al ml gt
{/tv {ll} /ml ml al dup 0 ne
{div}{pop} ifelse
def}
{ml al sub 0 rmoveto
/tv {st} /ml 1 def}
ifelse def
tm}
{2 eq % justification mode 3 is centered
{al ml gt
{ /tv {ll} /ml ml al dup
0 ne
{div}{pop}
ifelse def}
{ml al sub 2 div 0 rmoveto
/tv {st} /ml 1 def}
ifelse def
tm}
{ % otherwise it is just "justified"
/tv {ll} def
/ml ml al dup 0 ne
{div}{pop}
ifelse def
tm}
ifelse}
ifelse}
ifelse}
ifelse
tg setgray
}def
/pop4 {pop pop pop pop} def
% --------------------------------------------------------------------
% QuickDraw Procedures
%
% moveto. If a scale factor is in effect, then honor it.
/gm {
scaleflag {matrix1 itransform} if
moveto
} def
%local y move
% call: "x y localy ly"
/ly {
exch pop
currentpoint exch pop
sub 0 exch rmoveto
} def
% print n copies of page (ensures full speed for multiple copies)
/page {
1 add /#copies xdf showpage
} def
/sk {
systemdict /statusdict known
} def
% set job name
/jn {
sk {statusdict /jobname 3 -1 roll put}
{pop}
ifelse
} def
% set pen size: h v pen
/pen {
/pnsv xdf
/pnsh xdf
pnsh setlinewidth
} def
% draw line
% (uses current pen location, pen size and graylevel)
% This emulates the ugly QuickDraw pen on the LaserWriter but
% preserves the same endpoint and linewidth anomalies that some applications
% rely on. (Bletch).
/dlin {
currentpoint newpath moveto
lineto currentpoint stroke
grestore moveto
} def
/lin {
currentpoint /pnlv xdf /pnlh xdf
gsave newpath /@y xdf /@x xdf fp
{pnlh @x lt
{pnlv @y ge
{pnlh pnlv moveto @x @y lineto
pnsh 0 rlineto
0 pnsv rlineto
pnlh pnsh add pnlv pnsv add lineto
pnsh neg 0 rlineto}
{pnlh pnlv moveto
pnsh 0 rlineto
@x pnsh add @y lineto
0 pnsv rlineto
pnsh neg 0 rlineto
pnlh pnlv pnsv add lineto}
ifelse}
{pnlv @y gt
{@x @y moveto pnsh 0 rlineto
pnlh pnsh add pnlv lineto
0 pnsv rlineto
pnsh neg 0 rlineto
@x @y pnsv add lineto}
{pnlh pnlv moveto pnsh 0 rlineto
0 pnsv rlineto
@x pnsh add @y pnsv add lineto
pnsh neg 0 rlineto
0 pnsv neg rlineto}
ifelse}
ifelse
closepath fill}
if @x @y grestore moveto
} def
/dl {
gsave
0 setlinewidth 0 setgray
} def
% Arc: top left bottom right startangle stopangle verb flag
% flag true means to exclude the center of curvature in the arc
/barc {
/@f xdf /@op xdf /@e xdf /@s xdf
/@r xdf /@b xdf /@l xdf /@t xdf
gsave
@r @l add 2 div @b @t add 2 div xl 0 0 moveto
@r @l sub @b @t sub mtx currentmatrix pop scale
@f {newpath} if
0 0 0.5 @s @e arc
mtx setmatrix @op doop
grestore
} def
/doarc {dup 0 eq barc} def
% oval: top left bottom right verb
/doval {0 exch 360 exch true barc} def
% rectangle: top left bottom right verb
/dorect {
/@op xdf currentpoint 6 2 roll
newpath 4 copy
4 2 roll exch moveto
6 -1 roll lineto
lineto lineto closepath
@op doop moveto
} def
/mup {dup pnsh 2 div le exch pnsv 2 div le or} def
% roundrect: top left bottom right ovalwidth ovalheight operation
% Warning: ovalwidth is assumed equal to ovalheight.
/dorrect {
/@op xdf 2. div /@h xdf 2. div /@w xdf
/@r xdf /@b xdf /@l xdf /@t xdf
@t @b eq @l @r eq @w mup or or
{@t @l @b @r @op dorect}
{@r @l sub 2. div dup @w lt
{/@w xdf}{pop}
ifelse
@b @t sub 2. div dup @w lt
{/@w xdf}{pop}
ifelse
@op 0 eq
{/@w @w pnsh 2 div sub def}
if %this helps solve overlap gap for wide line widths
currentpoint
newpath
@r @l add 2. div @t moveto
@r @t @r @b @w arcto pop4
@r @b @l @b @w arcto pop4
@l @b @l @t @w arcto pop4
@l @t @r @t @w arcto pop4
closepath @op doop
moveto
}ifelse
} def
% Polygon utility procedures
/pr {
gsave newpath /pl
{moveto
/pl {lineto} def
}def
} def
/pl {lineto} def
/ep {
dup 0 eq
{
{moveto}{lin}{}{}
pathforall %nothing but movetos and linetos should be called
pop grestore
}
{
doop grestore
}
ifelse
} def
/bs 8 string def
/bd {/bs xdf} def
% These following procedures are used in defining QuickDraw patterns.
% (Pattern definition goes into halftone screen of PostScript)
% procedure to find black bits in QuickDraw pattern (pattern in hex string bs)
/bit {bs exch get exch 7 sub bitshift 1 and} def
/bix {1 add 4 mul cvi} def
/pp{exch bix exch bix bit}def
/grlevel {64. div setgray} def
% procedure to set a pattern: ratio hexstring
% ratio is the total number of white bits in the QuickDraw pattern represented in hexstring
/setpat {
/bs xdf
9.375 0 {pp} setscreen
grlevel
} def
/setgry {
freq rot {spf} setscreen
grlevel
} def
% standard copybits routine:
% arguments: xscale yscale xloc yloc rowbytes xwidth ywidth fsmooth bitmode
% This procedure is the basis for all QuickDraw bit operations.
% xscale and yscale tell how much to scale the bit image in 72nds of an inch
% xloc and yloc are the location of the top left corner of the bitmap
% rowbytes is the total number of bytes in each scanline of hex data in the
% image.
% Note that rowbytes must be even.
% xwidth and ywidth are the actual number of bits in the x and y coordinates
% of the image. fsmooth is a flag to tell whether or not to use bit
% smoothing. Bit smoothing is a
% proprietary algorithm that provides smoothing of the data around a 5 by 5
% local area of each data pixel.
% bitmode can be any of the QuickDraw source transfer modes excluding srcXor
% and notSrcXor.
% Note that this is the only QuickDraw procedure that can implement
% more than the simple srcCopy transfer mode.
/x4 {2 bitshift} def
/d4 {-2 bitshift} def
/xf {.96 mul exch 2 sub .96 mul exch} def
/dobits
{
/bmode xdf
save 9 1 roll
% 2 sub fixes dxsrc offset number required for bitsmoothing, but applies
% to both
%Bit Smooth mode
{
x4 /@dy xdf 2 sub x4 /@dx xdf /@idx xdf
.96 mul exch 3 index 2 sub @dx div 7.68 mul dup 6 1 roll sub exch xl 0 0 moveto xf
0 4 -1 roll 2 index 4 index 1.759 add 10 dorect clip newpath 0 0 moveto scale
bmode 0 eq bmode 4 eq or{1 setgray 1 @dy div 1 @dx div 1 1 2 dorect}if
bmode 3 eq bmode 7 eq or{1}{0}ifelse setgray
@idx 5 bitshift @dy bmode 0 eq bmode 1 eq bmode 3 eq or or [@dx 0 0 @dy 0 0]
{(%stdin)(r) file @dy d4 4 add @idx mul string readhexstring pop
dup length @idx x4 sub 4 bitshift string
dup 3 1 roll @dx 8 add d4 smooth} imagemask
}
%Non Bit Smooth mode
{
/@dy xdf 2 sub /@dx xdf /@idx xdf
/@xs @idx string def
/@f (%stdin)(r) file def
/@p{@f @xs readhexstring pop}def
.96 mul xl 0 0 moveto xf scale
0 0 1 1 10 dorect clip newpath 0 0 moveto
bmode 0 eq bmode 4 eq or{1 setgray .25 @dy div .25 @dx div 1 1 2 dorect}if
bmode 3 eq bmode 7 eq or{1}{0}ifelse setgray
@p @p
@idx 3 bitshift @dy bmode 0 eq bmode 1 eq bmode 3 eq or or [@dx 0 0 @dy 0 0]
{@p} imagemask
@p @p pop4
}ifelse
restore
} def
% Making Mac compatible Fonts
/mfont 14 dict def
/wd 14 dict def
/mdef {mfont wcheck not{/mfont 14 dict def}if mfont begin xdf end} def
/dc {transform round .5 sub exch round .5 sub exch itransform} def
% Copy a font dictionary: fontdictionary
% copies a font dictionary into tmp so it may be used to define a new font
% tmp must be set before cf is called
/cf{{1 index /FID ne {tmp 3 1 roll put}{pop pop}ifelse}forall}def
% Procedures used in defining a bit map font
/mv{tmp /Encoding macvec put}def
/bf{
mfont begin
/FontType 3 def
/FontMatrix [1 0 0 1 0 0] def
/FontBBox [0 0 1 1] def
/Encoding macvec def
/BuildChar
{
wd begin
/cr xdf
/fd xdf
fd /low get cr get 2 get -1 ne
{
fd begin
low cr get aload pop
sd
low cr 1 add get 0 get
sh
sw
end
/sw xdf
/sh xdf
sw div /clocn xdf
dup 0 ne {0 exch sh div neg dc xl}{pop}ifelse
exch sw div /coff xdf
exch sw div /cloc xdf
/bitw clocn cloc sub def
sw sh div 1 scale
sw div 0 coff 0 bitw coff add 1 setcachedevice
coff cloc sub 0 dc xl
cloc .5 sw div add 0 dc newpath moveto
bitw 0 ne
{0 1 rlineto bitw .5 sw div sub 0 rlineto 0 -1 rlineto
closepath clip
sw sh false [sw 0 0 sh neg 0 sh]{fd /hm get}imagemask}if
} if
end
} def
end
mfont definefont pop
} def
% stringwidth procedure which does not allow a show to occur: (string)
/wi{save exch /show{pop}def
stringwidth 3 -1 roll restore}def
/aps {0 get 124 eq}def
/apn {s30 cvs aps} def
%set style in a PostScript name: AppleFontName
% e.g.
% /|----name sos /|---Oname
% /|----name sis /|-I--name
/xc{s30 cvs dup}def
/xp{put cvn}def
/scs{xc 3 67 put dup 0 95 xp}def
/sos{xc 3 79 xp}def
/sbs{xc 1 66 xp}def
/sis{xc 2 73 xp}def
/sob{xc 2 79 xp}def
/sss{xc 4 83 xp}def
/dd{exch 1 index add 3 1 roll add exch} def
/smc{moveto dup show} def
/kwn{dup FontDirectory exch known{findfont exch pop}}def
/fb{/ps ps 1 add def}def
/mb
{dup sbs kwn
{
exch{pop}{bbc}{} mm
}ifelse
sfd
}def
/mo
{dup sos kwn
{
exch{pop}{boc}{} mm
}ifelse
sfd
}def
/ms
{dup sss kwn
{
exch{pop}{bsc}{} mm
}ifelse
sfd
}def
/ao
{dup sos kwn
{
exch dup ac pop
{scs findfont /df2 xdf}{aoc}{} mm
}ifelse
sfd
}def
/as
{dup sss kwn
{
exch dup ac pop
{scs findfont /df2 xdf}{asc}{} mm
}ifelse
sfd
}def
/ac
{
dup scs kwn
{exch /ofd exch findfont def
/tmp ofd maxlength 1 add dict def
ofd cf mv
tmp /PaintType 1 put
tmp definefont}ifelse
}def
/mm{
/mfont 10 dict def
mfont begin
/FontMatrix [1 0 0 1 0 0] def
/FontType 3 def
/Encoding macvec def
/df 4 index findfont def
/FontBBox [0 0 1 1] def
/xda xdf
/mbc xdf
/BuildChar { wd begin
/cr xdf
/fd xdf
/cs s1 dup 0 cr put def
fd /mbc get exec
end
} def
exec
end
mfont definefont} def
/bbc
{
/da .03 def
fd /df get setfont
gsave
cs wi exch da add exchd
grestore
setcharwidth
cs 0 0 smc
da 0 smc
da da smc
0 da moveto show
} def
/boc
{
/da 1 ps div def
fd /df get setfont
gsave
cs wi
exch da add exch
grestore
setcharwidth
cs 0 0 smc
da 0 smc
da da smc
0 da smc
1 setgray
da 2. div dup moveto show
} def
/bsc
{
/da 1 ps div def
/ds .05 def %da dup .03 lt {pop .03}if def
/da2 da 2. div def
fd /df get setfont
gsave
cs wi
exch ds add da2 add exch
grestore
setcharwidth
cs ds da2 add .01 add 0 smc
0 ds da2 sub xl
0 0 smc
da 0 smc
da da smc
0 da smc
1 setgray
da 2. div dup moveto show
} def
/aoc
{
fd /df get setfont
gsave
cs wi
grestore
setcharwidth
1 setgray
cs 0 0 smc
fd /df2 get setfont
0 setgray
0 0 moveto show
}def
/asc
{
/da .05 def
fd /df get setfont
gsave
cs wi
exch da add exch
grestore
setcharwidth
cs da .01 add 0 smc
0 da xl
1 setgray
0 0 smc
0 setgray
fd /df2 get setfont
0 0 moveto show
}def
/T true def
/F false def
% More Polygon stuff used in polygon comment
/6a 6 array def
/2a 2 array def
/5a 5 array def
%subtract points, first from second (reverse order): pt0 pt1 qs newpt
/qs{3 -1 roll sub exch 3 -1 roll sub exch}def
/qa{3 -1 roll add exch 3 -1 roll add exch}def
%multiply point: pt factor qm newpt
/qm{3 -1 roll 1 index mul 3 1 roll mul}def
/qn{6a exch get mul}def
/qA .166667 def /qB .833333 def /qC .5 def
/qx{
6a astore pop
qA 0 qn qB 2 qn add qA 1 qn qB 3 qn add
qB 2 qn qA 4 qn add qB 3 qn qA 5 qn add
qC 2 qn qC 4 qn add qC 3 qn qC 5 qn add
}def
/qp{6 copy 12 -2 roll pop pop}def
/qc{qp qx curveto}def
/qi{{4 copy 2a astore aload pop qa .5 qm newpath moveto}{2 copy 6 -2 roll 2 qm qs 4 2 roll}ifelse}def
/qq{{qc 2a aload pop qx curveto}{4 copy qs qa qx curveto}ifelse}def
%start polygon comment
/pt{gsave currentpoint newpath moveto}def
%fill smoothed poly
/qf{gsave eofill grestore}def
/tr{currentgray currentscreen bs 5a astore pop /fillflag 1 def}def
/bc{/fillflag 0 def}def
%polyverb ec
/ec{currentpoint 3 -1 roll
1 and 0 ne
{currentgray currentscreen bs 5a aload pop bd setscreen setgray 0 doop bd setscreen setgray}
{newpath}ifelse
moveto
}def
/bp {
currentpoint newpath 2 copy moveto
currentgray currentscreen bs 5a astore pop
} def
/eu{
fillflag 0 ne
{
gsave currentgray currentscreen bs
5a aload pop bd setscreen setgray
4 ep
bd setscreen setgray
}if
fp{0 ep}{grestore newpath}ifelse
}def
% Line Layout stuff used by string merging algorithm
% counts spaces in string: (...) sm (...) n
% returns string and number of spaces in string
/sm
{
dup 0 exch
{32 eq{1 add}if}forall
}
def
% layout a string to length specified by desiredlength: printerlength desiredlength (...) ll
% printerlength is length of string in printer space
/ll
{
3 1 roll exch dup .0001 lt 1 index -.0001 gt and
{pop pop pop}
{sub dup 0 eq
{
pop show
}
{
1 index sm dup 0 eq 3 index 0 le or
{
pop length div
0 3 -1 roll ashow
}
{
% This piece does 10 percent stretching in characters and 90 percent in spaces
10 mul exch length add div
dup 10 mul 0 32 4 -1 roll 0 6 -1 roll awidthshow
% This piece does straight stretching in spaces only
% exch pop div
% 0 32 4 -1 roll widthshow
}ifelse
}ifelse
}ifelse
}def
%set font to symbol and show the string: (...) ss
/ss
{ /pft currentfont def sa aload pop pop /|----2Symbol 4 1 roll
{pop{as}}
{{{ao}}{{fnt}}ifelse}ifelse
exch pop exec exch pop
}def
/pf{pft dup setfont}def
% regular show does underline if ulf is true:
% arguments: printerlength desiredlength string rs
/rs
{
sa 2 get
{
gsave
1 index 0
currentfont
dup /FontInfo known
{
/FontInfo get
dup /UnderlinePosition known
{
dup /UnderlinePosition get 1000 div ps mul
}
{
ps 10 div neg %15 makes line closer to text
}ifelse
exch
dup /UnderlineThickness known
{
/UnderlineThickness get 1000 div ps mul
}
{
pop
ps 15 div %20 makes slightly narrower line
}ifelse
}
{
pop
ps 10 div neg %15 makes line closer to text
ps 15 div %20 makes slightly narrower line
}ifelse
setlinewidth
0 setgray
currentpoint 3 -1 roll sub moveto
sa 4 get{gsave currentlinewidth 2. div dup rmoveto currentpoint xl 2 copy rlineto
stroke grestore}if
sa 3 get sa 4 get or 3 1 roll 2 index{gsave 1 setgray 2 copy rlineto stroke grestore}if
rlineto{strokepath 0 setlinewidth}if stroke
grestore
}if
tv
}
def
% More Font building stuff, specifically the Apple Encoding Vector
% Font encoding vector for PostScript fonts to match Mac
/macvec 256 array def
macvec 0
/Times-Roman findfont /Encoding get
0 128 getinterval putinterval macvec 39 /quotesingle put
/dotlessi /grave /circumflex /tilde /cedilla /registerserif
/copyrightserif /trademarkserif
macvec 0 8 getinterval astore pop
/Adieresis /Aring /Ccedilla /Eacute /Ntilde /Odieresis /Udieresis /aacute
/agrave /acircumflex /adieresis /atilde /aring /ccedilla /eacute /egrave
/ecircumflex /edieresis /iacute /igrave /icircumflex /idieresis /ntilde
/oacute /ograve /ocircumflex /odieresis /otilde /uacute /ugrave
/ucircumflex /udieresis
/dagger /ring /cent /sterling /section /bullet /paragraph /germandbls
/registersans /copyrightsans /trademarksans /acute /dieresis /notequal
/AE /Oslash
/infinity /plusminus /lessequal /greaterequal /yen /mu /partialdiff
/summation
/product /pi /integral /ordfeminine /ordmasculine /Omega /ae /oslash
/questiondown /exclamdown /logicalnot /radical /florin /approxequal /Delta
/guillemotleft /guillemotright /ellipsis /space /Agrave /Atilde /Otilde
/OE /oe /endash /emdash /quotedblleft /quotedblright /quoteleft
/quoteright /divide /lozenge /ydieresis /Ydieresis /fraction /currency
/guilsinglleft /guilsinglright /fi /fl /daggerdbl /periodcentered
/quotesinglbase /quotedblbase /perthousand /Acircumflex /Ecircumflex /Aacute
/Edieresis /Egrave /Iacute /Icircumflex /Idieresis /Igrave /Oacute
/Ocircumflex /apple /Ograve /Uacute /Ucircumflex /Ugrave /dotlessi
/asciicircum /asciitilde /macron /breve /dotaccent /ring /cedilla
/hungarumlaut /ogonek /caron
macvec 128 128 getinterval astore pop
% now redefine all fonts using the MAC Encoding (except in Symbol) to make
% them be Apple compatible.
FontDirectory
{exch dup s30 cvs /@s xdf @s aps
{pop pop}
{exch dup length dict /tmp xdf
cf
/Symbol ne {mv} if
/@i false def /@o false def /@b false def
mark @s (Italic) search {/@i true def} if (Oblique) search {/@o true def} if
(Bold) search {/@b true def} if (Roman) search pop (-) search pop /@s xdf cleartomark
@s cvn dup /Symbol eq{pop 50}{/Courier eq{51}{49}ifelse}ifelse
s30 0 @s length 6 add getinterval dup 6 @s putinterval dup 0 (|-----) putinterval
@b {dup 1 66 put} if @i @o or {dup 2 73 put} if % @o {dup 2 79 put} if
dup 5 4 -1 roll put
cvn tmp definefont pop
}ifelse
}forall
%Make any other special fonts here, i.e. Seattle
/_--C-2Symbol /Symbol findfont /tmp 1 index maxlength 1 add dict def cf tmp /PaintType 1 put tmp definefont
/|----4Seattle /Helvetica findfont dup length 1 add dict /tmp xdf cf mv
/mxv [/zero /one /two /three /four /five /six /seven /eight /nine /comma /period /dollar /numbersign
/percent /plus /hyphen /E /parenleft /parenright /space] def
tmp /Metrics 21 dict dup begin mxv{600 def}forall end put
tmp begin /FontBBox FontBBox [0 0 0 0] astore def end
tmp definefont pop
% open document, open page and close page procedures
% close document doesn't do anything currently
% txpose takes the vertical page size as a parameter
/od{txpose 10 fz 0 fs F /|----3Courier fnt pop}def
/op{/scaleflag false def /pm save def}def
/cp{pm restore}def
end
--
Brian Reid decwrl!glacier!reid
Stanford reid@SU-Glacier.ARPA