path: root/dviware/dvitops/dvitops.pro

%!
% $Header: /usr/jjc/dvitops/RCS/dvitops.pro,v 1.4 90/03/12 18:44:05 jjc Exp $

/dvitops 200 dict def dvitops begin

systemdict /setpacking known {
	/savepacking currentpacking def
	true setpacking
} if

% <h> <v> <string> Z
/Z {
	3 1 roll moveto show
} bind def

% <h> <string> X
/X {
	exch currentpoint exch pop moveto show
} bind def

% <rh> <string> W
/W {
	exch 0 rmoveto show
} bind def

/M /moveto load def

% When PostScript fills a path, it seems to blacken any pixel that
% wholly ***or partly*** lies within the path. Thus we can achieve
% results predictable down to the pixel level by ensuring that
% the corners of the rule do ***not*** lie on pixel boundaries.
% This procedure is made more complex by the fact that we do
% not know what the orientation of device space is---it cannot be
% assumed to be same as the default user coordinate system.
% This procedure assumes that the height and width are both > 0.
% height width x y R
/R {
	newpath
	% transform the coordinates of the bottom left hand corner
	% to device space and round them to the nearest pixel
	transform round exch round exch
	% compute and moveto the point half a pixel up from and half a pixel to the
	% right of this position
	.5 .5 idtransform abs neg exch abs exch dtransform
	3 -1 roll add 3 1 roll add exch itransform moveto
	% compute the height and width of the rule
	exch dtransform abs ceiling 1 sub exch abs ceiling 1 sub exch idtransform
	abs exch abs exch
	% draw the rule
	dup 0 exch neg rlineto exch 0 rlineto 0 exch rlineto fill
} bind def


/BP {
	/level0 save def
} bind def

/EP {
	level0 restore showpage
} bind def

/BO {
	/level1 save def
} bind def

/EO {
	level1 restore
} bind def


% <page width> landscape
% page width is in PostScript points

/landscape {
	/pw exch def
	[0 1 -1 0 pw 0] concat
} def


% <num> <den> <mag> <hoffset> <voffset> <page height> SC
% hoffset and voffset are in PostScript points
% page height is in PostScript points

/SC {
	/ph exch def
	/voffset exch def
	/hoffset exch def
	/mag exch def
	/den exch def
	/num exch def
	0 ph translate 1 -1 scale
	hoffset voffset translate
	num 254000 div 72 mul den div mag mul 1000 div dup scale
} bind def



/FF {
	findfont def
} bind def

/SF {
	/a exch def
	[a 0 0 a neg 0 0] makefont def
} bind def

/F /setfont load def

% newdictname newfontname newencoding basefontdict RE -
/RE {
	dup maxlength dict /f exch def
	{
		exch dup dup /FID ne exch /Encoding ne and {
			exch f 3 1 roll put
		} {
			pop pop
		} ifelse
	} forall
	f /Encoding 3 -1 roll put
	dup f /FontName 3 -1 roll put
	f definefont def
} bind def

%<string> <start index> makelong
/makelong {
	/i exch def
	/s exch def
	s i get 24 bitshift
	s i 1 add get 16 bitshift or
	s i 2 add get 8 bitshift or
	s i 3 add get or
} bind def

/BuildPK {
	/char exch def
	/fontdict exch def
	/charname
		fontdict /Encoding get char get
	def
	/charinfo
		fontdict /CharData get charname get
	def
	/flag 
		charinfo 0 get
	def
	flag 0 eq {
		/dm charinfo 1 get def
		/dn 0 def
		/cols charinfo 2 get def
		/rows charinfo 3 get def
		/hoff
			charinfo 4 get
			dup 127 gt {
				256 sub
			} if
		def
		/voff
			charinfo 5 get
			dup 127 gt {
				256 sub
			} if
		def
		/prelen 6 def
	} {
		flag 1 eq {
			/dm charinfo 1 get 256 mul charinfo 2 get add def
			/dn 0 def
			/cols charinfo 3 get 256 mul charinfo 4 get add def
			/rows charinfo 5 get 256 mul charinfo 6 get add def
			/hoff
				charinfo 7 get 256 mul charinfo 8 get add
				dup 32767 gt {
					65536 sub
				} if
			def
			/voff
				charinfo 9 get 256 mul charinfo 10 get add
				dup 32767 gt {
					65536 sub
				} if
			def
			/prelen 11 def
		} {
			/dm charinfo 1 makelong 65536 div def
			/dn charinfo 5 makelong 65536 div def
			/cols charinfo 9 makelong def
			/rows charinfo 13 makelong def
			/hoff charinfo 17 makelong def
			/voff charinfo 21 makelong def
			/prelen 25 def
		} ifelse
	} ifelse
	/llx hoff neg .5 sub def
	/lly voff 1 add rows sub .5 add def
	dm dn llx lly llx cols add lly rows add setcachedevice
	cols
	rows
	true
	fontdict /ImageMaskMatrix get dup 4 llx neg put	dup 5 rows lly add put
	{
		charinfo prelen charinfo length prelen sub getinterval
	}
	imagemask
} bind def


/EmptyEncoding 256 array def 0 1 255 {EmptyEncoding exch /.notdef put} for

% <name> <ds> <hppp> <vppp> <encoding> <CharData> <llx> <lly> <urx> <ury>
/DefinePKFont {
	4 array astore /bbox exch def
	/data exch def
	/encoding exch def
	/vppp exch def
	/hppp exch def
	/ds exch def

	9 dict dup begin
		/FontType 3 def
		/Encoding encoding def
		/BuildChar /BuildPK load def
		/ImageMaskMatrix [1 0 0 -1 0 0] def
		/FontMatrix [
			65536 ds 1048576 div hppp mul div
			0
			0
			65536 ds 1048576 div vppp mul div
			0
			0
		] def
		/FontBBox bbox def
		/CharData data def
		CharData /.notdef <000000000000> put
	end
	definefont pop
} def

% this comes from the Adobe Ilustrator manual

/Locate {
	8 dict begin
	[/newury /newurx /newlly /newllx /ury /urx /lly /llx]
	{
		exch def
	} forall
	newllx newlly translate
	newurx newllx sub urx llx sub div
	newury newlly sub ury lly sub div
	scale
	llx neg lly neg translate
	end
} bind def

% tpic stuff

/MT {
	transform round exch round exch itransform
	moveto
} bind def

/LT {
	transform round exch round exch itransform
	lineto
} bind def

/CT {
	transform round exch round exch itransform
	curveto
} bind def

/ST /stroke load def
/FI /fill load def
/CP /closepath load def
/SG /setgray load def
/LW /setlinewidth load def
/GR /grestore load def
/GS /gsave load def

% dash-len gap-len DH -

/DH {
	[ 3 1 roll ] 0 setdash
} bind def

/SO {
	[] 0 setdash
} bind def

/AR /arc load def

/TM matrix def

/EL {
	TM currentmatrix pop
	translate
	scale newpath 0 0 1 0 360 arc closepath
	TM setmatrix
} bind def

/TP {
	1 setlinecap 1 setlinejoin
} bind def

systemdict /setpacking known {
	savepacking setpacking
} if

end