% The following defines procedures assumed and used by program "dvips"
% and must be downloaded or sent as a header file for all TeX jobs.
% Originated by Neal Holtz, Carleton University, Ottawa, Canada
% <holtz@cascade.carleton.cdn>
% June, 1985
%
% Hacked by tgr, July 1987, stripped down to bare essentials,
% plus a few new commands for speed.
%
% Hacked by don, December 1989, to give characters top down and to
% remove other small nuisances; merged with tgr's compression scheme
%
% To convert this file into a downloaded file instead of a header
% file, uncomment all of the lines beginning with %-%
%
% To observe available VM, uncomment the following.
% (The first ten lines define a general 'printnumber' routine.)
%
% /VirginMtrx 6 array currentmatrix def
% /dummystring 20 string def
% /numberpos 36 def
% /printnumber { gsave VirginMtrx setmatrix
% /Helvetica findfont 10 scalefont setfont
% 36 numberpos moveto
% /numberpos numberpos 12 add def
% dummystring cvs show
% grestore
% } bind def
% /showVM { vmstatus exch sub exch pop printnumber } def
% /eop-aux { showVM } def
%
%-%0000000 % Server loop exit password
%-%serverdict begin exitserver
%-% systemdict /statusdict known
%-% {statusdict begin 9 0 3 setsccinteractive /waittimeout 300 def end}
%-% if
/TeXDict 300 dict def % define a working dictionary
TeXDict begin % start using it.
/N {def} def
/B {bind def} N
/S {exch} N
/X { S N } B
/TR {translate} N
% The output of dvips assumes pixel units, Resolution/inch, with
% increasing y coordinates corresponding to moving DOWNWARD.
% The PostScript default is big point units (bp), 72/inch, with
% increasing y coordinates corresponding to moving UP; the
% following routines handle conversion to dvips conventions.
% Let the PostScript origin be (xps,yps) in dvips coordinates.
/isls false N
/vsize 11 72 mul N
/hsize 8.5 72 mul N
/landplus90 { false } def % make this true to flip landscape
/@rigin % -xps -yps @rigin - establishes dvips conventions
{ isls { [ 0 landplus90 { 1 -1 } { -1 1 } ifelse 0 0 0 ] concat } if
72 Resolution div 72 VResolution div neg scale
isls { landplus90 { VResolution 72 div vsize mul 0 exch }
{ Resolution -72 div hsize mul 0 } ifelse TR } if
Resolution VResolution vsize -72 div 1 add mul TR
% As bad as setmatrix is, it is better than misalignment.
[ matrix currentmatrix
{ dup dup round sub abs 0.00001 lt {round} if } forall
round exch round exch
] setmatrix } N
/@landscape { /isls true N } B
/@manualfeed
{ statusdict /manualfeed true put
} B
% n @copies - set number of copies
/@copies
{ /#copies X
} B
% Bitmap fonts are called Fa, Fb, ..., Fz, F0, F1 . . . Ga . . .
% The calling sequence for downloading font foo is
% /foo df charde1 ... chardefn E
% where each chardef is
% <hexstring> wd ht xoff yoff dx charno D
% or <hexstring> wd ht xoff yoff dx I
% or <hexstring> charno D
% or <hexstring> I
/FMat [1 0 0 -1 0 0] N
/FBB [0 0 0 0] N
/nn 0 N /IE 0 N /ctr 0 N
/df-tail % id numcc maxcc df-tail -- initialize a new font dictionary
{
% dmystr 2 fontname cvx (@@@@) cvs putinterval % put name in template
/nn 8 dict N % allocate new font dictionary
nn begin
/FontType 3 N
/FontMatrix fntrx N
/FontBBox FBB N
string /base X
array /BitMaps X
/BuildChar {CharBuilder} N
/Encoding IE N
end
dup { /foo setfont } % dummy macro to be filled in
2 array copy cvx N % have to allocate a new one
load % now we change it
% 0 dmystr 6 string copy % get a copy of the font name
0 nn put
% cvn cvx put % and stick it in the dummy macro
/ctr 0 N % go, count, and etc.
[ % start next char definition
} B
/df {
/sf 1 N
/fntrx FMat N
df-tail
} B
/dfs { div /sf X
/fntrx [ sf 0 0 sf neg 0 0 ] N
df-tail
} B
/E { pop nn dup definefont setfont } B
% the following is the only character builder we need. it looks up the
% char data in the BitMaps array, and paints the character if possible.
% char data -- a bitmap descriptor -- is an array of length 6, of
% which the various slots are:
/ch-width {ch-data dup length 5 sub get} B % the number of pixels across
/ch-height {ch-data dup length 4 sub get} B % the number of pixels tall
/ch-xoff {128 ch-data dup length 3 sub get sub} B % num pixels right of origin
/ch-yoff {ch-data dup length 2 sub get 127 sub} B % number of pixels below origin
/ch-dx {ch-data dup length 1 sub get} B % number of pixels to next character
/ch-image {ch-data dup type /stringtype ne
{ ctr get /ctr ctr 1 add N } if
} B % the hex string image, or array of same
% /id ch-image N % image data
/id 0 N /rw 0 N /rc 0 N /gp 0 N /cp 0 N /G 0 N /sf 0 N
/CharBuilder % fontdict ch Charbuilder - -- image one character
{save 3 1 roll S dup /base get 2 index get S /BitMaps get S get
/ch-data X pop
/ctr 0 N
ch-dx 0 ch-xoff ch-yoff ch-height sub
ch-xoff ch-width add ch-yoff
setcachedevice
ch-width ch-height true
[1 0 0 -1 -.1 ch-xoff sub ch-yoff .1 sub]
% begin code for uncompressed fonts only
{ch-image} imagemask
restore
} B
% end code for uncompressed fonts only
% % here's the alternate code for unpacking compressed fonts
% /id ch-image N % image data
% /rw ch-width 7 add 8 idiv string N % row, initially zero
% /rc 0 N % repeat count
% /gp 0 N % image data pointer
% /cp 0 N % column pointer
% { rc 0 ne { rc 1 sub /rc X rw } { G } ifelse } imagemask
% restore
% } B
% /G { { id gp get /gp gp 1 add N
% dup 18 mod S 18 idiv pl S get exec } loop } B
% /adv { cp add /cp X } B
% /chg { rw cp id gp 4 index getinterval putinterval
% dup gp add /gp X adv } B
% /nd { /cp 0 N rw exit } B
% /lsh { rw cp 2 copy get dup 0 eq { pop 1 } { dup 255 eq { pop 254 }
% { dup dup add 255 and S 1 and or } ifelse } ifelse put 1 adv } B
% /rsh { rw cp 2 copy get dup 0 eq { pop 128 } { dup 255 eq { pop 127 }
% { dup 2 idiv S 128 and or } ifelse } ifelse put 1 adv } B
% /clr { rw cp 2 index string putinterval adv } B
% /set { rw cp fillstr 0 4 index getinterval putinterval adv } B
% /fillstr 18 string 0 1 17 { 2 copy 255 put pop } for N
% /pl [
% { adv 1 chg }
% { adv 1 chg nd }
% { 1 add chg }
% { 1 add chg nd }
% { adv lsh }
% { adv lsh nd }
% { adv rsh }
% { adv rsh nd }
% { 1 add adv }
% { /rc X nd }
% { 1 add set }
% { 1 add clr }
% { adv 2 chg }
% { adv 2 chg nd }
% { pop nd } ] dup { bind pop } forall N
% % end of code for unpacking compressed fonts
% in the following, the font-cacheing mechanism requires that
% a name unique in the particular font be generated
/D % char-data ch D - -- define character bitmap in current font
{ /cc X
dup type /stringtype ne {]} if
nn /base get cc ctr put
nn /BitMaps get S ctr S
sf 1 ne {
dup dup length 1 sub dup 2 index S get sf div put
} if
put
/ctr ctr 1 add N
} B
/I % a faster D for when the next char follows immediately
{ cc 1 add D } B
/bop % %t %d bop - -- begin a brand new page, %t=pageno %d=seqno
{
userdict /bop-hook known { bop-hook } if
/SI save N
@rigin
%
% Now we check the resolution. If it's correct, we use RV as V,
% otherwise we use QV.
%
0 0 moveto
/V matrix currentmatrix
dup 1 get dup mul exch 0 get dup mul add .99 lt
{/QV} {/RV} ifelse load def
pop pop
} N
/eop % - eop - -- end a page
{ % eop-aux % -- to observe VM usage
SI restore
userdict /eop-hook known { eop-hook } if
showpage
} N
/@start % hsz vsz mag dpi vdpi name @start - -- start everything
{
userdict /start-hook known { start-hook } if
pop % the job name string is used only by start-hook
/VResolution X
/Resolution X
1000 div /DVImag X
/IE 256 array N
2 string 0 1 255 { IE S dup 360 add 36 4 index cvrs cvn put } for pop
65781.76 div /vsize X
65781.76 div /hsize X
} N
/p {show} N % the main character setting routine
/RMat [ 1 0 0 -1 0 0 ] N % things we need for rules
/BDot 260 string N
/rulex 0 N /ruley 0 N
/v { % can't use ...fill; it makes rules too big
/ruley X /rulex X
V
} B
%
% What we need to do to get things to work here is tragic.
%
/V {} B /RV
%
% Which do we use? The first if we are talking to Display
% PostScript, the latter otherwise.
%
statusdict begin /product where
{ pop false [(Display) (NeXT) (LaserWriter 16/600)] {
dup length product length le {
dup length product exch 0 exch getinterval eq
{ pop true exit } if
} { pop } ifelse
} forall }
{ false } ifelse end
{ {
gsave
TR -.1 .1 TR 1 1 scale rulex ruley
false RMat { BDot } imagemask
grestore
} }
{ {
gsave
TR -.1 .1 TR rulex ruley scale 1 1
false RMat { BDot } imagemask
grestore
} } ifelse B
%
% We use this if the resolution doesn't match.
%
/QV {
gsave
newpath transform round exch round exch itransform moveto
rulex 0 rlineto 0 ruley neg rlineto
rulex neg 0 rlineto fill
grestore
} B
%
/a { moveto } B % absolute positioning
/delta 0 N % we need a variable to hold space moves
%
% The next ten macros allow us to make horizontal motions that
% are within 4 of the previous horizontal motion with a single
% character. These are typically used for spaces.
%
/tail { dup /delta X 0 rmoveto } B
/M { S p delta add tail } B
/b { S p tail } B % show and tail!
/c { -4 M } B
/d { -3 M } B
/e { -2 M } B
/f { -1 M } B
/g { 0 M } B
/h { 1 M } B
/i { 2 M } B
/j { 3 M } B
/k { 4 M } B
%
% These next allow us to make small motions (-4..4) cheaply.
% Typically used for kerns.
%
/w { 0 rmoveto } B
/l { p -4 w } B
/m { p -3 w } B
/n { p -2 w } B
/o { p -1 w } B
/q { p 1 w } B
/r { p 2 w } B
/s { p 3 w } B
/t { p 4 w } B
%
% x is good for small vertical positioning.
% And y is good for a print followed by a move.
%
/x { 0 S rmoveto } B
/y { 3 2 roll p a } B
%
% The bos and eos commands bracket sections of downloaded characters.
%
/bos { /SS save N } B
/eos { SS restore } B
end % revert to previous dictionary
|
