summaryrefslogtreecommitdiff
path: root/dviware/dvitops/dvitops.pro
blob: fb1c5561c2491014973f97bf6a8d55c2bb785a51 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
%!
% $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