%! % $Header: /usr/jjc/dvitops/RCS/timessc.ps,v 1.1 89/02/01 09:24:29 jjc Rel $ % implements Times-SmallCaps /scdict 25 dict def scdict begin /buf 256 string def % c islower - bool /islower { %def dup 8#141 ge exch 8#172 le and } bind def % c toupper - c /toupper { %def dup islower { %if 8#40 sub } if } bind def % string proc mapstring - string /mapstring { cvx /proc exch def /s exch def 0 1 s length 1 sub { dup s exch get proc s 3 1 roll put } for s } bind def /name1 256 string def /name2 256 string def /concatname { %def name2 cvs /s2 exch def name1 cvs /s1 exch def buf 0 s1 length s2 length add getinterval dup 0 s1 putinterval dup s1 length s2 putinterval cvn } def end %scdict % oldname newname uniqueid MakeSmallCapsFont - /MakeSmallCapsFont { % def scdict begin /uid exch def /newname exch def findfont /olddict exch def /cs olddict /CharStrings get def % build enc and data from cs /enc 256 array def 0 1 255 { %for enc exch /.notdef put } for /i 1 def /data cs length dict def cs { % forall pop /c exch def c buf cvs dup dup 0 get toupper 0 exch put cvn /C exch def cs C known c C ne and { % ifelse (if) data c C put } { % ifelse (else) c buf cvs /toupper mapstring cvn /C exch def cs C known c C ne and { % ifelse (if) data c C put } { % ifelse (else) data c i put enc i c put /i i 1 add def } ifelse } ifelse } forall data /.notdef 0 put % reencode the base font /basename /$!# newname concatname def basename olddict maxlength dict begin olddict { % forall exch dup dup /FID ne exch /Encoding ne and { % ifelse (if) exch def } { % ifelse (else) pop pop } ifelse } forall /Encoding enc def /FontName basename def currentdict end definefont pop 20 dict begin /UniqueID uid def [/FontInfo /FontBBox /Encoding] { %forall dup olddict exch get def } forall /CharStrings data def /FontMatrix matrix def /FontName newname def /BaseFont basename findfont def /XScale .9 def gsave initgraphics % this is necessary; I don't understand why olddict setfont newpath 0 0 moveto (X) true charpath flattenpath pathbbox 4 1 roll pop pop pop dup 3 div newpath 0 0 moveto (x) true charpath flattenpath pathbbox 4 1 roll pop pop pop 2 mul 3 div add exch div /YScale exch def grestore /SmallBaseFont BaseFont [XScale 0 0 YScale 0 0] makefont def /OneCharString 1 string def /FontType 3 def /Widths 256 array def gsave initgraphics % this is necessary; I don't understand why BaseFont setfont 0 0 moveto 0 1 255 { % for dup OneCharString 0 3 -1 roll put OneCharString stringwidth pop Widths 3 1 roll put } for grestore /BuildChar { % def exch begin Encoding exch get CharStrings exch get dup type /integertype eq { % ifelse (if) dup Widths exch get 0 setcharwidth BaseFont setfont } { % ifelse (else) CharStrings exch get dup Widths exch get XScale mul 0 setcharwidth SmallBaseFont setfont } ifelse 0 0 moveto OneCharString 0 3 -1 roll put OneCharString show end } bind def currentdict end newname exch definefont pop end } bind def /Times-Roman /Times-SmallCaps 1573 MakeSmallCapsFont