Subversion Repositories Scribus

Rev

Rev 6451 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
290 Franz 1
%
2
% psi.prolog
3
%
4
% Copyright (C) 1996-2000 by vhf computer GmbH + vhf interservice GmbH
5
% Author:   Georg Fleischmann
6
%
7
% created:  2000-09-09
8
% modified:
9
%
4717 avox 10
 
11
%%% this file also contains a section taken from GPL Ghostscript 8.50 "traceimg.ps", see below
12
 
290 Franz 13
% this PostScript code writes a file with the structure below.
14
% # # # # l		(x0 y0 x1 y1) line
15
% # # # # # # # #c	(x0 y0 x1 y1 x2 y2 x3 y3) curve
16
% # w			(width) width
17
% # # # # # co		(c m y k a) color
18
% n			new list
19
% f			list is a filled polygon
20
% s			list is a group
21
% cl			list is a clip list (clip with old clip list and use it)
22
% gs			save current clip list and width to top of stack
23
% gr			use last clip list (on top of stack) and width
24
% # # # # # # # # # #	(x y a b c d e f text font) text
25
%
26
% Adapted for Scribus by Franz Schmid 15.05.2004
27
% Also removed the hardcoded Output Filename
28
% and changed it in a way the -sOutputFile Option of Ghostscript can be used
29
% Speeded up the flattening of Text by removing unneeded calculations.
30
% Changed the Output slightly to ease parsing
31
% m                 moveto
32
% l # # # #         (x0 y0 x1 y1) line
33
% c # # # # # # # # (x0 y0 x1 y1 x2 y2 x3 y3) curve
34
% w #               (width) Linewidth
35
% co # # # # #      (c m y k a) color
36
% n                 new list
37
% f                 list is a filled polygon
38
% s                 list is a stroke path
39
% cp                close current subpath
40
% ci                list is a clip list (clip with old clip list and use it)
292 Franz 41
% sp                end of page
42
% lj #              linejoin
43
% lc #              linecap
44
% ld # # #n         linedash count offset d1, d2, dx
4717 avox 45
% im #              image <name>
4770 avox 46
% pat # #           makepattern params tmpfilename
47
% mask				imagemask, followed by b/w image
48
% fill-evenodd		set fill rule
49
% fill-winding		- " -
290 Franz 50
% 15.05.2004 Added the Glyphshow Operator.
51
% 17.05.2004 Made clipping working.
52
% 20.05.2004 kshow is working now.
4788 avox 53
% 22.02.2006 added image and colorimage ops -- av
54
% 02.03.2006 added code to divide reported coordinates by (device resolution/72) -- av
4983 avox 55
% 23.03.2006 added code to trace PDF commands
290 Franz 56
 
4983 avox 57
% some hacks to get access to PDF operators, needs -sDELAYBIND
58
 
4978 avox 59
currentglobal true setglobal
4983 avox 60
GS_PDF_ProcSet begin
61
currentdict /setshowstate
4978 avox 62
{
63
	dup WordSpacing 0 32 TextSpacing 0 6 -1 roll awidthshow
64
	//setshowstate exec
65
} .forceput
4983 avox 66
currentdict /endpage {
67
	(sp\n) print
68
	//endpage exec
69
} .forceput
5221 avox 70
currentdict /doimage known not {
71
	currentdict /doimage { } .forceput
72
} if
5184 avox 73
currentdict /doimage {
74
	currentdict i_image
75
	//doimage exec
76
} .forceput
4978 avox 77
end
78
setglobal
79
.bindnow
80
 
4740 avox 81
/cfile TraceFile (w) file def
290 Franz 82
/print { cfile exch writestring } bind def
83
 
4770 avox 84
 
85
/==write  % any ==write -
86
{
87
	dup type dup /arraytype eq exch /packedarraytype eq or
88
	{
89
		i_file ([) writestring
90
			{ ==write i_file ( ) writestring } forall
91
		i_file (]) writestring
92
	} {
93
	dup type /nametype eq
94
	{
95
		i_file (/) writestring i_file exch i_str cvs writestring
96
	} {
4779 avox 97
	dup type /stringtype eq
98
	{
4801 avox 99
		true 1 index { 32 ge and } forall
4779 avox 100
		{
101
			i_file (\() writestring i_file exch writestring i_file (\)) writestring
102
		}
103
		{
104
			i_file (<) writestring
105
			i_file /ASCIIHexEncode filter dup
106
			3 -1 roll
107
			writestring closefile % close filter
108
			i_file (\n) writestring
109
		} ifelse
110
	} {
4770 avox 111
	dup type /dicttype eq
112
	{
113
		i_file (<<) writestring
4779 avox 114
		{ ==write ( ) =write ==write (\n) =write } forall
4770 avox 115
		i_file (>>) writestring
116
	} {
4976 avox 117
		i_file exch i_str cvs
118
		dup dup length 1 sub get (-) 0 get eq { pop (null) } if
119
		writestring
4779 avox 120
	} ifelse } ifelse } ifelse } ifelse
4770 avox 121
} def
122
 
4779 avox 123
/=write  % any =write -
124
{
125
	dup type dup /arraytype eq exch /packedarraytype eq or
126
	{
127
			{ =write i_file ( ) writestring } forall
128
	} {
129
	dup type /nametype eq
130
	{
131
		i_file exch i_str cvs writestring
132
	} {
133
	dup type /stringtype eq
134
	{
135
		i_file exch writestring
136
	} {
137
	dup type /dicttype eq
138
	{
139
		i_file (<<) writestring
140
		{ =write ( ) =write =write (\n) =write } forall
141
		i_file (>>) writestring
142
	} {
143
		i_file exch i_str cvs writestring
144
	} ifelse } ifelse } ifelse } ifelse
145
} def
146
 
147
 
4770 avox 148
% flag to deactivate our substitutions
149
/i_shortcut false def
150
 
151
% defines an overloaded function     name proc i_shortcutOverload -
152
% equvalent to /name { i_shortcut { //name } { proc } ifelse } bind def
153
/i_shortcutOverload
154
{
155
	[ /i_shortcut /load load [ 5 index load ] cvx 4 index /ifelse load ] cvx
156
	exch pop
157
	bind def
158
} def
159
 
290 Franz 160
% whether we have to flatten the text
161
/flattenText 1 def
162
 
163
% is a Clipping there
164
/clipCnt 0 def
165
 
166
% remember the current point
167
/currentX 0 def
168
/currentY 0 def
169
 
170
% 1st point of path to close the path
171
/beginX 0 def
172
/beginY 0 def
173
 
174
% dummy for converting strings
4725 avox 175
/i_str 50 string def
290 Franz 176
 
177
% 0 = mirror at
178
/mirror 0 def
179
 
180
% mirror a at 0
181
/mir
182
{
183
	mirror 0 ne
184
	{	0 exch sub
185
	}if
186
} bind def
187
 
188
% scale
4788 avox 189
 
190
currentpagedevice /HWResolution get aload pop
191
72 div /i_vscale exch def
192
72 div /i_hscale exch def
193
 
290 Franz 194
/m_a 1 def
195
/m_b 0 def
196
/m_c 0 def
197
/m_d 1 def
198
/m_x 0 def
199
/m_y 0 def
200
/matrix_x	% x y
201
{
202
	% ax + cy + tx
4788 avox 203
	m_c mul exch m_a mul add m_x add i_hscale div
290 Franz 204
} bind def
205
/matrix_y	% x y
206
{
207
	% bx + dy + ty
4788 avox 208
	m_d mul exch m_b mul add m_y add i_vscale div
290 Franz 209
} bind def
210
 
4770 avox 211
 
212
/concatenate   % str1 str2 concatenate str12
213
{
214
	dup length 2 index length add string
215
	dup 3 index length 3 index putinterval
216
	dup 0 4 index putinterval
217
	exch pop exch pop
218
} bind def
219
 
4788 avox 220
% this is like search but returns the last match in string
221
/rsearch	% string seek  rsearch  post match pre true // string false
222
{
223
	2 copy search	% string seek post1 match1 pre1 true
224
	{
225
		2 index 4 index rsearch		% string seek post1 match1 pre1 post2 match2 pre2 true
226
		{
227
			6 -1 roll pop			% string seek match1 pre1 post2 match2 pre2
228
			% combine (pre1 match1 pre2) into one string
229
			5 -1 roll exch concatenate	% string seek pre1 post2 match2 (match1+pre2)
230
			4 -1 roll exch concatenate	% string seek post2 match2 (pre1+match1+pre2)
231
		} {		% string seek post1 match1 pre1 post1
232
			pop
233
		} ifelse
234
		% string seek post match pre
235
		5 -2 roll pop pop
236
		true
237
	} {		% string seek string
238
		pop pop false
239
	} ifelse
240
} bind def
4770 avox 241
 
4788 avox 242
 
4770 avox 243
% returns a unique filename for the given extension
244
/i_exportfilename   % string i_exportfilename string
245
{
4788 avox 246
	/ExportFiles where { /ExportFiles get (.) rsearch { exch pop exch pop } if } { (imagefile) } ifelse
4770 avox 247
	    (-) concatenate dup /i_basename exch def i_filecount 9 string cvs concatenate
248
		{
249
			i_filecount 1 add /i_filecount exch store
250
			dup 2 index concatenate status not { exit } if
251
			pop pop pop pop pop
252
			i_basename i_filecount 9 string cvs concatenate
253
		} loop
254
	exch pop
255
} bind def
256
 
257
/makepattern { % dict matrix  makepattern patterndict
4918 avox 258
%/makepattern =
4770 avox 259
	% we will do some real painting here:
260
	/i_shortcut true store
261
	% params:
262
	/i_m exch def
263
	/i_dict exch def
264
	% define export filename
265
	/i_basename (.png) i_exportfilename (.png) concatenate def
266
	i_dict /BBox get
267
		dup 0 get /i_x exch def
268
		dup 1 get /i_y exch def
269
		dup 2 get i_x sub /i_w exch def
270
		3 get i_y sub /i_h exch def
271
	% we want those in devspace:
272
		i_x i_y i_m itransform matrix currentmatrix transform
4976 avox 273
			i_vscale div /i_y exch def i_hscale div /i_x exch def
4770 avox 274
		i_w i_h i_m idtransform matrix currentmatrix dtransform
4976 avox 275
			i_vscale div /i_h exch def i_hscale div /i_w exch def
4770 avox 276
		% i_h < 0 ?
277
		i_h 0 le
278
		{
279
			/i_y i_h i_y add def
280
			/i_h i_h neg def
281
		} if
282
		% i_w < 0 ?
283
		i_w 0 le
284
		{
285
			/i_x i_w i_x add def
286
			/i_w i_w neg def
287
		} if
288
	% now we can use the current matrix as pattern matrix, but with (0,0) origin
4976 avox 289
	i_m ==
4770 avox 290
	i_x i_y matrix currentmatrix translate /i_m exch def
4976 avox 291
	i_m ==
4770 avox 292
	i_dict /BBox [ 0 0 i_w i_h ] put
4976 avox 293
	(w x h =) = i_w = i_h =
4770 avox 294
	% paint pattern to png file
295
	gsave
296
	currentcolor currentcolorspace
297
	<<
298
		/OutputFile i_basename
299
		/OutputDevice (pngalpha)
300
		/TextAlphaBits 4
301
		/GraphicsAlphaBits 4
4976 avox 302
%		/BackgroundColor 16777215
303
%		/BackgroundColor 0
4770 avox 304
		/PageUsesTransparency true
4976 avox 305
		/HWResolution [ 72 72 ]
4770 avox 306
		/ProcessColorModel /DeviceRGB
307
		/PageSize [i_w i_h]
308
	/pngalpha finddevice putdeviceprops setdevice
309
	setcolorspace setcolor
4918 avox 310
%	matrix currentmatrix ==
311
%	0 0 transform exch = =
312
%	1 1 transform exch = =
4976 avox 313
	i_dict i_w i_h matrix identmatrix scale
314
			%matrix identmatrix
315
			//makepattern setpattern
4918 avox 316
 
4770 avox 317
	showpage
318
	grestore
319
	% create pattern with our extensions:
320
	i_dict dup /ExportFile i_basename put
321
	dup /Origin [ 0 0 transform ] put
322
	i_m //makepattern
323
	/i_shortcut false store
4918 avox 324
%/makepatternE =
4770 avox 325
} i_shortcutOverload
326
 
327
/writecurrentpattern
328
{
329
	currentcolor
330
	(pat ) print
331
	dup /Origin get
4788 avox 332
	dup 0 get i_hscale div i_str cvs print ( ) print
333
	    1 get i_vscale div i_str cvs print ( ) print
4770 avox 334
	/ExportFile get print
335
	(\n) print
336
} bind def
337
 
338
/writecurrentcmykcolor
339
{
340
	currentcmykcolor	% -> c m y k
341
	(co )print
342
	3 index i_str cvs print
343
	( ) print
344
	2 index i_str cvs print
345
	( ) print
346
	1 index i_str cvs print
347
	( ) print
348
	i_str cvs print
349
	( ) print
350
	pop pop pop
351
	.currentopacityalpha	% a
352
	i_str cvs print
353
	(\n) print
354
} bind def
355
 
356
 
357
/writecurrentrgbcolor
358
{
359
	currentrgbcolor	% -> r g b
360
	(corgb )print
361
	2 index i_str cvs print
362
	( ) print
363
	1 index i_str cvs print
364
	( ) print
365
	i_str cvs print
366
	( ) print
367
	pop pop
368
	.currentopacityalpha	% a
369
	i_str cvs print
370
	(\n) print
371
} bind def
372
 
373
 
290 Franz 374
/writecurrentcolor
375
{
4770 avox 376
	currentcolorspace 0 get
377
 
378
	% try to find a base colorspace first
379
	dup	/Indexed eq
380
	{
381
		pop
382
		currentcolorspace 1 get
383
		dup type /arraytype eq { 0 get } if
290 Franz 384
	} if
4770 avox 385
 
386
	dup dup /DeviceN eq exch /Separation eq or
1488 fschmid 387
	{
4770 avox 388
		pop
389
		currentcolorspace 2 get
390
		dup type /arraytype eq { 0 get } if
391
	} if
392
 
393
	% now write values
394
	dup /CIEBasedABC eq
395
	{ % this must be a hack....
396
		gsave
397
		currentcolor setrgbcolor
398
		writecurrentrgbcolor
399
		grestore
400
	} {
401
 	dup /DeviceRGB eq
1488 fschmid 402
	{
4770 avox 403
		writecurrentrgbcolor
404
	} {
405
	dup dup /DeviceCMYK eq exch /DeviceGray eq or
406
	{
407
		writecurrentcmykcolor
408
	} {
409
	dup /Pattern eq
410
	{
411
		writecurrentpattern
412
	} {
413
		% TODO: other CIE
414
		writecurrentrgbcolor % will always be 0
415
	}
416
	ifelse } ifelse } ifelse } ifelse
417
	pop
290 Franz 418
} bind def
419
 
292 Franz 420
/writecurrentlinecap
421
{
422
	(lc ) print
4725 avox 423
	currentlinecap i_str cvs print
292 Franz 424
	(\n) print
425
} bind def
426
 
427
/writecurrentlinejoin
428
{
429
	(lj ) print
4725 avox 430
	currentlinejoin i_str cvs print
292 Franz 431
	(\n) print
432
} bind def
433
 
434
/writecurrentdash
435
{
436
	(ld ) print
4725 avox 437
	currentdash 1 index length i_str cvs print ( ) print i_str cvs print ( ) print
292 Franz 438
 
439
	{
7124 fschmid 440
		1 index exch get
441
		storeMatrix
442
		dup dup dup m_b abs mul exch m_d abs mul add  exch m_a abs mul add  exch m_c abs mul add  2 div  abs
443
		i_hscale div
444
		i_str cvs print ( ) print
292 Franz 445
	} for
446
	pop
447
	(\n) print
448
} bind def
449
 
290 Franz 450
/writecurrentlinewidth
451
{
452
	userdict begin
453
	currentlinewidth	% w
454
	storeMatrix
455
 
456
	% (wb + wd + wa + wc) / 2
4918 avox 457
%??
458
	dup dup dup m_b abs mul exch m_d abs mul add  exch m_a abs mul add  exch m_c abs mul add  2 div  abs
459
	i_hscale div
4788 avox 460
	% transform (w,w) and take length
4918 avox 461
%av-test:	dup dtransform i_vscale div dup mul exch i_hscale div dup mul add sqrt
290 Franz 462
	(w ) print
4725 avox 463
	i_str cvs print
290 Franz 464
	(\n) print
465
	end
466
} bind def
467
 
4770 avox 468
/i_move	% x y
290 Franz 469
{
470
	userdict begin
471
	(m\n) print
472
	/currentY exch def
473
	/currentX exch def
474
	/beginX currentX def
475
	/beginY currentY def
476
	end
477
} bind def
478
 
4770 avox 479
/i_line
290 Franz 480
{
481
	userdict begin
482
	/y1 exch def
483
	/x1 exch def
484
 
485
	% x x1 ne y y1 ne or
486
	currentX x1 sub abs 0.001 gt  currentY y1 sub abs 0.001 gt or
487
	{
488
		(l ) print
4725 avox 489
		currentX currentY matrix_x i_str cvs print
290 Franz 490
		( ) print
4725 avox 491
		currentX currentY matrix_y i_str cvs print
290 Franz 492
		( ) print
493
 
4725 avox 494
		x1 y1 matrix_x i_str cvs print
290 Franz 495
		( ) print
4725 avox 496
		x1 y1 matrix_y i_str cvs print
290 Franz 497
		(\n) print
498
		/currentX x1 def
499
		/currentY y1 def
500
	}if
501
	end
502
} bind def
503
 
4770 avox 504
/i_curve
290 Franz 505
{
506
	userdict begin
507
	% x1 y1 x2 y2 x3 y3
508
	(c ) print
4725 avox 509
	currentX currentY matrix_x i_str cvs print
290 Franz 510
	( ) print
4725 avox 511
	currentX currentY matrix_y i_str cvs print
290 Franz 512
	( ) print
4725 avox 513
	5 index 5 index matrix_x i_str cvs print
290 Franz 514
	( ) print
4725 avox 515
	5 index 5 index matrix_y i_str cvs print
290 Franz 516
	( ) print
4725 avox 517
	3 index 3 index matrix_x i_str cvs print
290 Franz 518
	( ) print
4725 avox 519
	3 index 3 index matrix_y i_str cvs print
290 Franz 520
	( ) print
521
 
522
	/currentY exch def
523
	/currentX exch def
524
 
4725 avox 525
	currentX currentY matrix_x i_str cvs print
290 Franz 526
	( ) print
4725 avox 527
	currentX currentY matrix_y i_str cvs print
290 Franz 528
	(\n)print
529
	pop pop pop pop
530
	end
531
} bind def
532
 
533
% modified: 18.10.96
4770 avox 534
/i_close
290 Franz 535
{
6451 fschmid 536
	beginX beginY i_line
290 Franz 537
	(cp\n) print
538
} bind def
539
 
540
/storeMatrix
541
{
542
	userdict begin
543
	matrix currentmatrix
4788 avox 544
	dup 0 get /m_a exch def
545
	dup 1 get /m_b exch def
546
	dup 2 get /m_c exch def
547
	dup 3 get /m_d exch def
548
	dup 4 get /m_x exch def
290 Franz 549
	5 get /m_y exch def
550
	end
551
} bind def
552
 
4918 avox 553
/pathClipAndClose % this is not nice: closes all open paths & flattens the path :-(
554
{
555
	clipsave
556
	clip				% combine clippath and path
557
	newpath clippath	% copy (closed) clippath to path
558
	cliprestore
559
} bind def
560
 
561
 
562
% find out if the point is within the clipping area
563
/i_in_clip					% x y  i_in_clip  bool
564
{
565
	gsave
566
	newpath clippath
567
	infill
568
	grestore
569
} bind def
570
 
571
 
572
% find out if two points are within the clipping area
573
/i_in_clip2					% x1 y1 x2 y2 i_in_clip  bool1 bool2
574
{
575
	gsave
576
	newpath clippath
577
	infill					% x1 y1 bool2
578
	3 1 roll				% bool2 x1 y1
579
	infill					% bool2 bool1
580
	exch
581
	grestore
582
} bind def
583
 
584
 
585
/i_clip_move
586
{
587
	/beginY exch store
588
	/beginX exch store
589
	/currentX beginX store
590
	/currentY beginY store
591
	% test if within cliparea
592
	currentX currentY i_in_clip
593
	{
594
		currentX currentY /moveto load
595
	} if
596
} bind def
597
 
598
 
599
% find intersection with line x1,y1 -> x2,y2 with clip path.
600
% x1,y2 is outside the clip area, x2, y2, x3, y3 inside
601
 
602
/i_find_clip_intersect		% x1 y1 x2 y2  i_find_clip_intersect  x3 y3
603
{
604
	3 index 2 index sub		% x1 y1 x2 y2 dx
605
	3 index 2 index sub		% x1 y1 x2 y2 dx dy
606
	gsave
607
	newpath clippath
608
	{
609
		2 div exch 2 div exch				% half interval
610
		2 copy abs 0.01 lt exch abs 0.01 lt and
611
			{ exit } if						% done
612
		2 copy 4 index add exch				% x1 y1 x2 y2 dx dy (y2+dy) dx
613
		       5 index add exch				% x1 y1 x2 y2 dx dy (x2+dx) (y2+dy)
614
%		/Intersect = 7 index = 6 index = 5 index = 4 index = 3 index = 2 index = 1 index = 0 index =
615
		2 copy infill
616
		{									% replace x2,y2
617
			6 -2 roll pop pop
618
			4 2 roll
619
		} {
620
			8 -2 roll pop pop				% replace x1,y1
621
			6 2 roll
622
		} ifelse
623
	} loop
624
	grestore
625
	6 -2 roll								% return x2,y2
626
	4 { pop } repeat
627
} bind def
628
 
629
/i_clip_line
630
{
631
	/endY exch store
632
	/endX exch store
633
	currentX currentY endX endY i_in_clip2
634
	{ % end in
635
		{
636
			% both in. just draw it. FIXME check if line leaves cliparea
637
			endX endY /lineto load
638
		} {
639
			% current not in
640
			% find new current point
641
			currentX currentY endX endY i_find_clip_intersect
642
			/moveto load
643
			endX endY /lineto load
644
		} ifelse
645
	} { % end not in
646
		{   % current in
647
			% find new endpoint
648
			endX endY currentX currentY i_find_clip_intersect
649
			/lineto load
650
		} {
651
			% both not in
652
			% try to find a point within cliparea
653
			currentX currentY endX endY i_find_clip_intersect
654
			2 copy i_in_clip
655
			{
656
				% yeah
657
				/moveto load
658
				% now find point from other end
659
				endX endY currentX currentY i_find_clip_intersect
660
				/lineto load
661
			} {
662
				pop pop
663
			} ifelse
664
		} ifelse
665
	} ifelse
666
	/currentX endX store
667
	/currentY endY store
668
} bind def
669
 
670
 
671
/pathClipForStroke
672
{
673
	% only lines
674
	flattenpath
675
	% create a userpath from currentpath
676
	userdict begin
677
	/beginX 0 def /beginY 0 def
678
	/currentX 0 def /currentY 0 def
679
	/endX 0 def /endY 0 def
680
	systemdict begin							% some EPS redefine moveto & Co :-(
681
	[
682
			{ i_clip_move }						% remember last move
683
			{ i_clip_line }						% clip lines individually
684
			{ 6 {pop} repeat /OOPS = }			% won't happen
685
			{ beginX beginY i_clip_line }		% close with line
686
		pathforall
687
	] cvx
688
%	dup ==
689
	newpath % uappend % userpaths SUCK!
690
	end end
691
	exec
692
} bind def
693
 
290 Franz 694
/rectfill
695
{
696
	userdict begin
697
	(n\n)print			% start polygon
698
	writecurrentcolor
699
	writecurrentlinewidth
292 Franz 700
	writecurrentlinecap
701
	writecurrentlinejoin
702
	writecurrentdash
290 Franz 703
	storeMatrix
704
 
705
	% x y width height
706
	dup type /arraytype ne
707
	{
708
		/hr exch def
709
		/wr exch def
710
		/yr exch def
711
		/xr exch def
4770 avox 712
		xr yr i_move
713
		xr wr add yr i_line
714
		xr wr add yr hr add i_line
715
		xr yr hr add i_line
716
		xr yr i_line
290 Franz 717
	}
718
	% numarray
719
	% numstring
720
	{
721
		/ar exch def
722
 
723
		{
724
			/n exch def
725
			ar n get /xr exch def
726
			ar n 1 add get /yr exch def
727
			ar n 2 add get /wr exch def
728
			ar n 3 add get /hr exch def
4770 avox 729
			xr yr i_move
730
			xr wr add yr i_line
731
			xr wr add yr hr add i_line
732
			xr yr hr add i_line
733
			xr yr i_line
290 Franz 734
		} for
735
	}ifelse
736
 
737
	(f\n)print			% close polygon
738
	end
4770 avox 739
} i_shortcutOverload
290 Franz 740
 
741
/rectstroke
742
{
743
	userdict begin
744
	(n\n)print			% start rect
745
	writecurrentcolor
746
	writecurrentlinewidth
292 Franz 747
	writecurrentlinecap
748
	writecurrentlinejoin
749
	writecurrentdash
290 Franz 750
	storeMatrix
751
 
752
	% x y width height
4788 avox 753
	dup type dup /arraytype ne exch /stringtype ne and
290 Franz 754
	{
755
		/hr exch def
756
		/wr exch def
757
		/yr exch def
758
		/xr exch def
4770 avox 759
		xr yr i_move
760
		xr wr add yr i_line
761
		xr wr add yr hr add i_line
762
		xr yr hr add i_line
763
		xr yr i_line
290 Franz 764
	}
765
	% numarray
766
	% numstring
767
	{
768
		/ar exch def
769
 
770
		{
771
			/n exch def
772
			ar n get /xr exch def
773
			ar n 1 add get /yr exch def
774
			ar n 2 add get /wr exch def
775
			ar n 3 add get /hr exch def
4770 avox 776
			xr yr i_move
777
			xr wr add yr i_line
778
			xr wr add yr hr add i_line
779
			xr yr hr add i_line
780
			xr yr i_line
290 Franz 781
		} for
782
	}ifelse
783
	(n\n)print			% stroke rect
784
	end
4770 avox 785
} i_shortcutOverload
290 Franz 786
 
787
/stroke
788
{
789
	(n\n) print
790
	writecurrentcolor
791
	writecurrentlinewidth
292 Franz 792
	writecurrentlinecap
793
	writecurrentlinejoin
794
	writecurrentdash
6451 fschmid 795
%	clipCnt 1 eq
796
%		{ pathClipForStroke } if
290 Franz 797
	storeMatrix
4918 avox 798
 
4770 avox 799
	{i_move} {i_line} {i_curve} {i_close} pathforall
290 Franz 800
	(s\n)print			% stroke path
801
	newpath
4770 avox 802
} i_shortcutOverload
290 Franz 803
 
804
/eofill
805
{
806
	(n\n) print			% start polygon
807
	writecurrentcolor	% write color
808
	writecurrentlinewidth
292 Franz 809
	writecurrentlinecap
810
	writecurrentlinejoin
811
	writecurrentdash
6451 fschmid 812
%	clipCnt 1 eq
813
%		{ pathClipAndClose } if
290 Franz 814
	storeMatrix			% take transformation, scaling, rotation from PostScript
4770 avox 815
	{i_move} {i_line} {i_curve} {i_close} pathforall
290 Franz 816
	(f\n)print			% close polygon
817
 
818
	newpath				% clear stack
4770 avox 819
} i_shortcutOverload
290 Franz 820
 
4770 avox 821
/fill
290 Franz 822
{
4770 avox 823
	(fill-winding\n) print
824
	eofill
825
	(fill-evenodd\n) print
826
} i_shortcutOverload
290 Franz 827
 
828
/clip
829
{
830
	userdict begin
831
	(n\n)print			% start clip polygon
832
 
4918 avox 833
% FIXME: pathClipAndClose first?
834
 
290 Franz 835
	storeMatrix			% take transformation, scaling, rotation from PostScript
4770 avox 836
	{i_move} {i_line} {i_curve} {i_close} pathforall
290 Franz 837
 
838
	(ci\n)print			% close clip polygon begin path
839
						% we have to close the path!!
6451 fschmid 840
%	clip
841
%	/clipCnt 1 def
290 Franz 842
	newpath				% clear stack
843
	end
4770 avox 844
} i_shortcutOverload
290 Franz 845
 
6451 fschmid 846
/eoclip
847
{
848
	userdict begin
849
	(n\n)print			% start clip polygon
850
 
851
% FIXME: pathClipAndClose first?
852
 
853
	storeMatrix			% take transformation, scaling, rotation from PostScript
854
	{i_move} {i_line} {i_curve} {i_close} pathforall
855
 
856
	(ci\n)print			% close clip polygon begin path
857
						% we have to close the path!!
858
%	clip
859
%	/clipCnt 1 def
860
	newpath				% clear stack
861
	end
862
} i_shortcutOverload
863
 
290 Franz 864
% we don't clip
865
% because this doesn't work for flattening text (show, charpath) with NeXT PostScript Code
866
/rectclip
867
{
4788 avox 868
	% let Scribus decide what to do with ci; was: pop pop pop pop
869
	userdict begin
870
	(n\n)print			% start clip polygon
871
 
872
	storeMatrix			% take transformation, scaling, rotation from PostScript
873
	dup type dup /arraytype ne exch /stringtype ne and
874
	{
875
		4 copy
876
		/i_h exch def
877
		/i_w exch def
878
		/i_y exch def
879
		/i_x exch def
880
		i_x i_y i_move
881
		i_x i_w add i_y i_line
882
		i_x i_w add i_y i_h add i_line
883
		i_x i_y i_h add i_line
884
	} {
885
		% array or string
886
 
887
		{
888
			1 index 1 index get /i_x exch def
889
			1 add
890
			1 index 1 index get /i_y exch def
891
			1 add
892
			1 index 1 index get /i_w exch def
893
			1 add
894
			1 index 1 index get /i_y exch def
895
			i_x i_y i_move
896
			i_x i_w add i_y i_line
897
			i_x i_w add i_y i_h add i_line
898
			i_x i_y i_h add i_line
899
		} for
900
	} ifelse
901
 
902
	(ci\n)print			% close clip polygon begin path
903
						% we have to close the path!!
6451 fschmid 904
%	rectclip
905
%	/clipCnt 1 def
4788 avox 906
	newpath				% clear stack
907
	end
4770 avox 908
} i_shortcutOverload
290 Franz 909
 
4717 avox 910
 
911
%    Copyright (C) 1994 Aladdin Enterprises.  All rights reserved.
912
%
913
% This software is provided AS-IS with no warranty, either express or
914
% implied.
915
%
916
% This software is distributed under license and may not be copied,
917
% modified or distributed except as expressly authorized under the terms
918
% of the license contained in the file LICENSE in this distribution.
919
%
920
% For more information about licensing, please refer to
921
% http://www.ghostscript.com/licensing/. For information on
922
% commercial licensing, go to http://www.artifex.com/licensing/ or
923
% contact Artifex Software, Inc., 101 Lucas Valley Road #110,
924
% San Rafael, CA  94903, U.S.A., +1(415)492-9861.
925
 
926
% $Id: import.prolog 7124 2006-11-23 14:07:24Z fschmid $
927
% traceimg.ps
928
% Trace the data supplied to the 'image' operator.
929
 
930
% This code currently handles only the (Level 2) dictionary form of image,
931
% with a single data source and 8-bit pixels.
932
 
933
% changed for Scribus image import by Andreas Vox, 2006-2-21
934
% added support for colorimage and other image variant
935
 
4725 avox 936
/i_image			% <dict> i_image -
4717 avox 937
{
4770 avox 938
/i_image =
4717 avox 939
	begin
940
		/i_left Width Height mul Decode length 2 idiv mul BitsPerComponent mul 8 idiv dup /i_size exch store store
941
		/i_dict currentdict store
942
		/i_nsources 1 store
943
		/i_source 0 store
944
		/i_datasource currentdict /DataSource get store
945
		currentdict /MultipleDataSources known not
946
			{ /MultipleDataSources false def } if
947
		MultipleDataSources
948
		{
949
			/i_nsources  DataSource length store
950
			/i_datasource DataSource 0 get store
951
		} if
952
	end
953
	storeMatrix
954
	i_dict /ImageMatrix get matrix invertmatrix matrix currentmatrix matrix concatmatrix /i_m exch def
955
	i_dict /Width get  0 i_m dtransform dup mul exch dup mul add sqrt /i_w exch def
956
 
957
 
4976 avox 958
	i_dict /Width get i_dict /Height get i_m transform
959
	/i_hflip -1 def /i_vflip 1 def
960
	dup i_y le { /i_y exch def } { pop /i_vflip -1 def } ifelse
961
	dup i_x le { /i_x exch def } { pop /i_hflip  1 def } ifelse
962
 
4770 avox 963
	/i_angle exch def
4801 avox 964
	(.dat) i_exportfilename
4725 avox 965
		(im ) print												% im x y w h angle ...
4788 avox 966
		i_x i_hscale div i_str cvs print ( ) print
967
		i_y i_vscale div i_str cvs print ( ) print
968
		i_w i_hscale div i_str cvs print ( ) print
969
		i_h i_vscale div i_str cvs print ( ) print
4725 avox 970
		i_angle i_str cvs print ( ) print
971
		i_dict /Width get  i_str cvs print ( ) print			% ... hpix vpix ...
972
		i_dict /Height get i_str cvs print ( ) print
4717 avox 973
		currentcolorspace 0 get /DeviceRGB eq
974
			{ (tiff24nc ) print }
975
		{ currentcolorspace 0 get /DeviceCMYK eq
4999 avox 976
			{ (psdcmyk ) print }
4717 avox 977
		{ currentcolorspace 0 get /DeviceGray eq
978
			{ (tiffgray ) print }
979
			{ (tiff32nc ) print }
980
		ifelse } ifelse } ifelse
4770 avox 981
        dup  (.tif) concatenate print (\n) print flush			% ... dev filename
982
		(.dat) concatenate (w) file /i_file exch store			% temp file
4779 avox 983
	currentcolorspace ==write ( setcolorspace\n) =write
984
	(<<\n) =write
4717 avox 985
	i_dict { exch
986
		  dup /DataSource eq
4779 avox 987
			{ pop pop (/DataSource currentfile\n) =write }
4717 avox 988
		  {
989
			dup /ImageMatrix eq
4976 avox 990
				{ pop pop (/ImageMatrix [) =write
991
					i_hflip ==write ( 0 0 ) =write i_vflip ==write
992
					( ) =write
993
					i_hflip 0 lt { i_dict /Width get } { 0 } ifelse ==write
994
					( ) =write
995
					i_vflip 0 lt { i_dict /Height get} { 0 } ifelse ==write
996
					(]\n) =write }
4779 avox 997
				{ ==write ( ) =write ==write (\n) =write }
4717 avox 998
			ifelse
999
		  } ifelse
1000
		} forall
4779 avox 1001
	(>>\nimage\n) =write i_file flushfile
4717 avox 1002
 
1003
    { %loop
1004
      i_left 0 le
1005
      {
1006
		i_source 1 add /i_source exch def
1007
        i_source i_nsources ge { exit } if
1008
        i_dict /DataSource get i_source get /i_datasource exch def
1009
		/i_left i_size def
1010
      } if
1011
      /i_datasource load exec
1012
      dup type /filetype eq
1013
       { i_buf 0 i_left 32 .min getinterval readstring pop
1014
       } if
1015
      dup i_file exch writestring
1016
      i_left exch length sub /i_left exch def
1017
    } loop
1018
    i_file flushfile
4770 avox 1019
/i_imageE =
4717 avox 1020
 } bind def
1021
 
1022
/colorimage
1023
{
4770 avox 1024
/colorimage =
1025
	% width height bits/sample matrix datasource0..n-1 multi ncomp
1026
	/tmpN exch def
1027
	/tmpMulti exch def
1028
	tmpMulti
1029
	{
1030
		/tmpN load array astore
1031
	} if
1032
	/tmpN load 6 add dict
1033
	dup 7 -1 roll /Width exch put
1034
	dup 6 -1 roll /Height exch put
1035
	dup 5 -1 roll /BitsPerComponent exch put
1036
	dup 4 -1 roll /ImageMatrix exch put
1037
	dup 3 -1 roll /DataSource exch put
1038
	tmpMulti
1039
	{
1040
		dup /MultipleDataSources true put
1041
	} if
1042
	dup /ImageType 1 put
1043
	gsave
1044
	/tmpN load
1045
		dup 1 eq
1046
		{
1047
			1 index /Decode [0 1] /Decode put
4717 avox 1048
            /DeviceGray setcolorspace
4770 avox 1049
		} if
1050
		dup 3 eq
1051
		{
1052
			1 index /Decode [0 1 0 1 0 1] put
1053
			/DeviceRGB setcolorspace
1054
		} if
1055
		dup 4 eq
1056
		{
1057
			1 index /Decode [0 1 0 1 0 1 0 1]  put
1058
			/DeviceCMYK setcolorspace
1059
		} if
1060
	pop
1061
	i_image
1062
	grestore
1063
/colorimageE =
1064
} i_shortcutOverload
4717 avox 1065
 
1066
/image {
4770 avox 1067
/image =
1068
	gsave
1069
	dup type /dicttype ne
1070
	{
1071
		% width height bits/sample matrix datasource
1072
		7 dict
1073
		dup 7 -1 roll /Width exch put
1074
		dup 6 -1 roll /Height exch put
1075
		dup 5 -1 roll /BitsPerComponent  exch put
1076
		dup 4 -1 roll /ImageMatrix exch put
1077
		dup 3 -1 roll /DataSource exch put
1078
		dup 1 /ImageType exch put
1079
		dup [0 1] /Decode exch put
1080
		/DeviceGray setcolorspace
1081
	} if
1082
	i_image
1083
	grestore
1084
/imageE =
1085
} i_shortcutOverload
4717 avox 1086
 
1087
/imagemask
1088
{
4770 avox 1089
/imagemask =
1090
	writecurrentcolor
1091
	(mask\n) print
1092
	gsave
4717 avox 1093
	dup type /dicttype ne
1094
	{
4770 avox 1095
		% width height pol matrix datasource
1096
		7 dict
1097
		dup 7 -1 roll /Width exch put
1098
		dup 6 -1 roll /Height exch put
1099
		dup 5 -1 roll { [0 1] } { [1 0] } ifelse /Decode exch put
1100
		dup 4 -1 roll /ImageMatrix exch put
1101
		dup 3 -1 roll /DataSource exch put
4717 avox 1102
	} if
4770 avox 1103
	dup 1 /ImageType exch put
1104
	dup 1 /BitsPerComponent exch put
4717 avox 1105
	/DeviceGray setcolorspace
4725 avox 1106
	i_image
4717 avox 1107
	grestore
4770 avox 1108
/imagemaskE =
1109
} i_shortcutOverload
4717 avox 1110
 
1111
 
1112
% declare some global vars
1113
 
1114
/i_left 0 def
1115
/i_size 0 def
1116
/i_dict null def
1117
/i_buf 32 string def
1118
/i_nsources 1 def
1119
/i_source 0 def
4725 avox 1120
/i_datasource { (x) } def
4717 avox 1121
/i_file null def
1122
/i_filecount 1 def
1123
 
1124
%%%% End of traceimage code
1125
 
1126
 
290 Franz 1127
/stateArray 500 array def
1128
/stateTop 0 def
1129
/gsave
1130
{
6451 fschmid 1131
	(gs\n) print
290 Franz 1132
	userdict begin
4770 avox 1133
%	(gs\n) print
290 Franz 1134
	stateArray stateTop gstate currentgstate put
1135
	/stateTop stateTop 1 add def
1136
	end
4770 avox 1137
} i_shortcutOverload
290 Franz 1138
 
1139
/grestore
1140
{
6451 fschmid 1141
	(gr\n) print
290 Franz 1142
	userdict begin
1143
	stateTop 1 lt
1144
	{
1145
	}
1146
	{
4770 avox 1147
%		(gr\n) print
290 Franz 1148
		stateArray stateTop 1 sub get setgstate
1149
		/stateTop stateTop 1 sub def
1150
		stateArray stateTop 0 put
1151
	}ifelse
1152
	end
4770 avox 1153
} i_shortcutOverload
290 Franz 1154
 
1155
% a bind def of the show operator doesn't work,
1156
% so this is our way to get a charpath entry for flattening text
1157
/root_charpath
1158
{
1159
	charpath
1160
} bind def
1161
 
4740 avox 1162
/i_kerningI
1163
{
1164
	exch 1 getinterval stringwidth
1165
} bind def
1166
 
1167
% find kerning value
1168
/i_kerningII		% index string   i_kerning   dx dy
1169
{
1170
	% stringwidth( [n..n+1] ) - stringwidth( [n+1] )
1171
	/i_pstring exch def
1172
	/i_pindex exch def
1173
	i_pstring i_pindex 2 getinterval stringwidth exch	% y2 x2
1174
	i_pstring i_pindex 1 add 1 getinterval stringwidth		% y2 x2 x1 y1
1175
	4 1 roll sub											% y1 y2 (x2-x1)
1176
	3 1 roll exch sub										% (x2-x1) (y2-y1)
1177
} bind def
1178
 
1179
 
1180
/i_kerningIII		% index string   i_kerning   dx dy
1181
{
1182
	% stringwidth( [n..n+1] ) - stringwidth( [n+1] )
1183
	/i_pstring exch def
1184
	/i_pindex exch def
1185
	i_pstring i_pindex 2 getinterval (l) exch concatenate stringwidth exch	% y2 x2
1186
	i_pstring i_pindex 1 add 1 getinterval (l) exch concatenate stringwidth		% y2 x2 x1 y1
1187
	4 1 roll sub											% y1 y2 (x2-x1)
1188
	3 1 roll exch sub										% (x2-x1) (y2-y1)
1189
} bind def
1190
 
4741 avox 1191
/i_kerning /i_kerningII load def
4740 avox 1192
 
4725 avox 1193
/show % string show -
1194
{
290 Franz 1195
	userdict begin
1196
	storeMatrix
1197
	currentfont /FontName known
1198
	% stack: string
1199
	{
386 Franz 1200
		currentpoint /ycur exch def /xcur exch def
290 Franz 1201
		currentpoint	% x y
1202
		newpath
1203
		/clipCnt 0 def
1204
		moveto
4725 avox 1205
		/completeString exch def
290 Franz 1206
		% we process each char separately to get smaller paths
4725 avox 1207
 
290 Franz 1208
		{
1209
			(n\n)print			% start polygon
1210
			writecurrentcolor	% write color
1211
			storeMatrix
4725 avox 1212
			dup completeString length 1 sub eq
4779 avox 1213
			{ dup completeString exch 1 getinterval stringwidth }
1214
			{ dup completeString i_kerning } ifelse
4740 avox 1215
			/curwidthy exch def /curwidthx exch def
4725 avox 1216
			completeString exch 1 getinterval dup /curstr exch def
2798 fschmid 1217
			false root_charpath
4770 avox 1218
			{i_move} {i_line} {i_curve} {i_close} pathforall
290 Franz 1219
			(f\n)print			% close polygon
386 Franz 1220
			newpath
4725 avox 1221
			curwidthx xcur add curwidthy ycur add moveto
386 Franz 1222
			currentpoint /ycur exch def /xcur exch def
1223
			newpath			% clear graphic stack
1224
			xcur ycur moveto
290 Franz 1225
		} for
1226
		currentpoint	% x y
1227
		newpath				% clear graphic stack (and current point)
1228
		moveto
4725 avox 1229
	} {
1230
		pop		% string
1231
	} ifelse
290 Franz 1232
	end
4770 avox 1233
} i_shortcutOverload
290 Franz 1234
 
1235
/ashow
1236
{
1237
	% ax ay string
385 Franz 1238
	exch /ydist exch def
1239
	exch /xdist exch def
1240
	userdict begin
1241
	storeMatrix
1242
	currentfont /FontName known
1243
	% stack: string
1244
	{
386 Franz 1245
		currentpoint /ycur exch def /xcur exch def
385 Franz 1246
		currentpoint	% x y
1247
		newpath
1248
		/clipCnt 0 def
1249
		moveto
4725 avox 1250
		/completeString exch def
385 Franz 1251
		% we process each char separately to get smaller paths
4725 avox 1252
 
385 Franz 1253
		{
1254
			(n\n)print			% start polygon
1255
			writecurrentcolor	% write color
1256
			storeMatrix
4725 avox 1257
			dup completeString length 1 sub eq
4779 avox 1258
			{ dup completeString exch 1 getinterval stringwidth }
1259
			{ dup completeString i_kerning } ifelse
4740 avox 1260
			/curwidthy exch def /curwidthx exch def
4725 avox 1261
			completeString exch 1 getinterval dup /curstr exch def
1262
			false root_charpath
4770 avox 1263
			{i_move} {i_line} {i_curve} {i_close} pathforall
385 Franz 1264
			(f\n)print			% close polygon
386 Franz 1265
			newpath
4725 avox 1266
			curwidthx xcur add curwidthy ycur add
386 Franz 1267
			exch xdist add exch ydist add moveto
1268
			currentpoint /ycur exch def /xcur exch def
1269
			newpath			% clear graphic stack
1270
			xcur ycur moveto
385 Franz 1271
		} for
1272
		currentpoint	% x y
1273
		newpath				% clear graphic stack (and current point)
1274
		moveto
4725 avox 1275
	} {
1276
		pop
1277
	} ifelse
385 Franz 1278
	end
4770 avox 1279
} i_shortcutOverload
290 Franz 1280
 
4642 avox 1281
/awidthshow		% cx cy char ax ay string
290 Franz 1282
{
4642 avox 1283
	% ax ay string
1284
	exch /ydist exch def
1285
	exch /xdist exch def
1286
	% cx cy char string
1287
	exch /char exch def
1288
	exch /cydist exch def
1289
	exch /cxdist exch def
1290
	userdict begin
1291
	storeMatrix
1292
	currentfont /FontName known
1293
	% stack: string
1294
	{
1295
		currentpoint /ycur exch def /xcur exch def
1296
		currentpoint	% x y
1297
		newpath
1298
		/clipCnt 0 def
1299
		moveto
4725 avox 1300
		/completeString exch def
4642 avox 1301
		% we process each char separately to get smaller paths
4725 avox 1302
 
4642 avox 1303
		{
1304
			(n\n)print			% start polygon
1305
			writecurrentcolor	% write color
1306
			storeMatrix
4725 avox 1307
			dup completeString length 1 sub eq
4779 avox 1308
			{ dup completeString exch 1 getinterval stringwidth }
1309
			{ dup completeString i_kerning } ifelse
4740 avox 1310
			/curwidthy exch def /curwidthx exch def
4725 avox 1311
			completeString exch 1 getinterval dup /curstr exch def
1312
			false root_charpath
4770 avox 1313
			{i_move} {i_line} {i_curve} {i_close} pathforall
4642 avox 1314
			(f\n)print			% close polygon
1315
			newpath
4725 avox 1316
			curwidthx xcur add curwidthy ycur add
4642 avox 1317
			exch xdist add exch ydist add moveto
1318
			curstr 0 get char eq
1319
			{
1320
				currentpoint exch cxdist add exch cydist add moveto
1321
			} if
1322
			currentpoint /ycur exch def /xcur exch def
1323
			newpath			% clear graphic stack
1324
			xcur ycur moveto
1325
		} for
1326
		currentpoint	% x y
1327
		newpath				% clear graphic stack (and current point)
1328
		moveto
4725 avox 1329
	} {
1330
		pop
1331
	} ifelse
4642 avox 1332
	end
4770 avox 1333
} i_shortcutOverload
290 Franz 1334
 
4642 avox 1335
/widthshow	% cx cy char string
290 Franz 1336
{
4642 avox 1337
 
1338
 
1339
	awidthshow
290 Franz 1340
} bind def
1341
 
1342
/cshow	% proc string
1343
{
1344
	exch pop
1345
	show
4770 avox 1346
} i_shortcutOverload
290 Franz 1347
 
1348
/kshow	% proc string
1349
{
1350
	dup length 1 sub
1351
	dup 0 ne
1352
	{
1353
		1 index 0 1 getinterval
1354
		show
1355
		1 sub
1356
		dup 0 ne
1357
		{
1358
			1 add
1359
			1 exch 1 exch
1360
			{
1361
				dup 1 sub
1362
				2 index exch get
1363
				2 index 2 index get
1364
				4 index exec
1365
				1 index exch 1 getinterval
1366
				show
1367
			} for
1368
		} if
1369
	}
1370
	{
1371
		pop dup show
1372
	} ifelse
1373
	pop pop
4770 avox 1374
} i_shortcutOverload
290 Franz 1375
 
1376
/xshow	% string array
1377
{
4770 avox 1378
	pop %FIXME
290 Franz 1379
	show
4770 avox 1380
} i_shortcutOverload
290 Franz 1381
 
1382
/xyshow	% string array
1383
{
4770 avox 1384
	pop %FIXME
290 Franz 1385
	show
4770 avox 1386
} i_shortcutOverload
290 Franz 1387
 
1388
/yshow	% string array
1389
{
4770 avox 1390
	pop %FIXME
290 Franz 1391
	show
4770 avox 1392
} i_shortcutOverload
290 Franz 1393
 
4770 avox 1394
/i_reencode % newfontname reencodevector origfontdict -> i_reencode -> newfontdict
290 Franz 1395
{
1396
	userdict begin
1397
 dup begin dup maxlength dict begin
1398
  { 1 index /FID ne {def} {pop pop} ifelse
1399
  } forall
1400
  /Encoding exch def
1401
  currentdict
1402
  end end
1403
  definefont
1404
	end
1405
} bind def
1406
 
1407
/glyphshow {
1408
    save % So can reclaim VM from reencoding
1409
    currentfont /Encoding get dup length array copy dup 0 5 -1 roll put
4770 avox 1410
    /GlyphShowTempFont exch currentfont i_reencode
290 Franz 1411
    setfont
1412
    (\000) show
5317 avox 1413
	currentpoint 3 -1 roll % curx cury -save-
290 Franz 1414
	restore
5317 avox 1415
	newpath
1416
	moveto
4770 avox 1417
} i_shortcutOverload
290 Franz 1418
 
292 Franz 1419
/showpage
1420
{
1421
	(sp\n) print
4770 avox 1422
} i_shortcutOverload
292 Franz 1423