Subversion Repositories Scribus

Rev

Rev 4741 | Rev 4779 | Go to most recent revision | 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.
4717 avox 53
% 22.02.2006 added image and colorimage ops
290 Franz 54
 
4740 avox 55
/cfile TraceFile (w) file def
290 Franz 56
/print { cfile exch writestring } bind def
57
 
4770 avox 58
 
59
/==write  % any ==write -
60
{
61
	dup type dup /arraytype eq exch /packedarraytype eq or
62
	{
63
		i_file ([) writestring
64
			{ ==write i_file ( ) writestring } forall
65
		i_file (]) writestring
66
	} {
67
	dup type /nametype eq
68
	{
69
		i_file (/) writestring i_file exch i_str cvs writestring
70
	} {
71
	dup type /dicttype eq
72
	{
73
		i_file (<<) writestring
74
		{ ==write ( ) ==write ==write (\n) ==write } forall
75
		i_file (>>) writestring
76
	} {
77
		i_file exch i_str cvs writestring
78
	} ifelse } ifelse } ifelse
79
} def
80
 
81
% flag to deactivate our substitutions
82
/i_shortcut false def
83
 
84
% defines an overloaded function     name proc i_shortcutOverload -
85
% equvalent to /name { i_shortcut { //name } { proc } ifelse } bind def
86
/i_shortcutOverload
87
{
88
	[ /i_shortcut /load load [ 5 index load ] cvx 4 index /ifelse load ] cvx
89
	exch pop
90
	bind def
91
} def
92
 
290 Franz 93
% whether we have to flatten the text
94
/flattenText 1 def
95
 
96
% is a Clipping there
97
/clipCnt 0 def
98
 
99
% remember the current point
100
/currentX 0 def
101
/currentY 0 def
102
 
103
% 1st point of path to close the path
104
/beginX 0 def
105
/beginY 0 def
106
 
107
% dummy for converting strings
4725 avox 108
/i_str 50 string def
290 Franz 109
 
110
% 0 = mirror at
111
/mirror 0 def
112
 
113
% mirror a at 0
114
/mir
115
{
116
	mirror 0 ne
117
	{	0 exch sub
118
	}if
119
} bind def
120
 
121
% scale
122
/m_a 1 def
123
/m_b 0 def
124
/m_c 0 def
125
/m_d 1 def
126
/m_x 0 def
127
/m_y 0 def
128
/matrix_x	% x y
129
{
130
	% ax + cy + tx
131
	m_c mul exch m_a mul add m_x add
132
} bind def
133
/matrix_y	% x y
134
{
135
	% bx + dy + ty
136
	m_d mul exch m_b mul add m_y add
137
} bind def
138
 
4770 avox 139
 
140
/concatenate   % str1 str2 concatenate str12
141
{
142
	dup length 2 index length add string
143
	dup 3 index length 3 index putinterval
144
	dup 0 4 index putinterval
145
	exch pop exch pop
146
} bind def
147
 
148
 
149
% returns a unique filename for the given extension
150
/i_exportfilename   % string i_exportfilename string
151
{
152
	/ExportFiles where { /ExportFiles get (.) search { exch pop exch pop } if } { (imagefile) } ifelse
153
	    (-) concatenate dup /i_basename exch def i_filecount 9 string cvs concatenate
154
		{
155
			i_filecount 1 add /i_filecount exch store
156
			dup 2 index concatenate status not { exit } if
157
			pop pop pop pop pop
158
			i_basename i_filecount 9 string cvs concatenate
159
		} loop
160
	exch pop
161
} bind def
162
 
163
/makepattern { % dict matrix  makepattern patterndict
164
/makepattern =
165
	% we will do some real painting here:
166
	/i_shortcut true store
167
	% params:
168
	/i_m exch def
169
	/i_dict exch def
170
	% define export filename
171
	/i_basename (.png) i_exportfilename (.png) concatenate def
172
	i_dict /BBox get
173
		dup 0 get /i_x exch def
174
		dup 1 get /i_y exch def
175
		dup 2 get i_x sub /i_w exch def
176
		3 get i_y sub /i_h exch def
177
	% we want those in devspace:
178
		i_x i_y i_m itransform matrix currentmatrix transform
179
			/i_y exch def /i_x exch def
180
		i_w i_h i_m idtransform matrix currentmatrix dtransform
181
			/i_h exch def /i_w exch def
182
		% i_h < 0 ?
183
		i_h 0 le
184
		{
185
			/i_y i_h i_y add def
186
			/i_h i_h neg def
187
		} if
188
		% i_w < 0 ?
189
		i_w 0 le
190
		{
191
			/i_x i_w i_x add def
192
			/i_w i_w neg def
193
		} if
194
	% now we can use the current matrix as pattern matrix, but with (0,0) origin
195
	i_m ==
196
	i_x i_y matrix currentmatrix translate /i_m exch def
197
	i_m ==
198
	i_dict /BBox [ 0 0 i_w i_h ] put
199
	(w x h =) = i_w = i_h =
200
	% paint pattern to png file
201
	gsave
202
	currentcolor currentcolorspace
203
	<<
204
		/OutputFile i_basename
205
		/OutputDevice (pngalpha)
206
		/TextAlphaBits 4
207
		/GraphicsAlphaBits 4
208
		/BackgroundColor 16777215
209
		/PageUsesTransparency true
210
		/HWResolution [i_w i_h]
211
		/ProcessColorModel /DeviceRGB
212
		/PageSize [i_w i_h]
213
	/pngalpha finddevice putdeviceprops setdevice
214
	currentdevice getdeviceprops pstack cleartomark
215
	setcolorspace setcolor
216
	matrix currentmatrix ==
217
 
218
	1 1 transform exch = =
219
	1 0.5 0 setrgbcolor
220
 
221
 
222
	1 setlinewidth
223
	newpath
224
 
225
 
226
	i_w 0 lineto
227
	stroke
228
	i_dict i_w i_h matrix identmatrix scale //makepattern setpattern
229
 
230
	showpage
231
/MP1 =
232
	currentdevice getdeviceprops pstack cleartomark
233
	grestore
234
	% create pattern with our extensions:
235
	i_dict dup /ExportFile i_basename put
236
	dup /Origin [ 0 0 transform ] put
237
	i_m //makepattern
238
/MP2 =
239
	/i_shortcut false store
240
/makepatternE =
241
} i_shortcutOverload
242
 
243
/writecurrentpattern
244
{
245
/WP =
246
	currentcolor
247
	(pat ) print
248
	dup /Origin get
249
	dup 0 get i_str cvs print ( ) print
250
	    1 get i_str cvs print ( ) print
251
	/ExportFile get print
252
	(\n) print
253
/WPE =
254
} bind def
255
 
256
/writecurrentcmykcolor
257
{
258
	currentcmykcolor	% -> c m y k
259
	(co )print
260
	3 index i_str cvs print
261
	( ) print
262
	2 index i_str cvs print
263
	( ) print
264
	1 index i_str cvs print
265
	( ) print
266
	i_str cvs print
267
	( ) print
268
	pop pop pop
269
	.currentopacityalpha	% a
270
	i_str cvs print
271
	(\n) print
272
} bind def
273
 
274
 
275
/writecurrentrgbcolor
276
{
277
	currentrgbcolor	% -> r g b
278
	(corgb )print
279
	2 index i_str cvs print
280
	( ) print
281
	1 index i_str cvs print
282
	( ) print
283
	i_str cvs print
284
	( ) print
285
	pop pop
286
	.currentopacityalpha	% a
287
	i_str cvs print
288
	(\n) print
289
} bind def
290
 
291
 
290 Franz 292
/writecurrentcolor
293
{
4770 avox 294
	currentcolorspace 0 get
295
 
296
	% try to find a base colorspace first
297
	dup	/Indexed eq
298
	{
299
		pop
300
		currentcolorspace 1 get
301
		dup type /arraytype eq { 0 get } if
290 Franz 302
	} if
4770 avox 303
 
304
	dup dup /DeviceN eq exch /Separation eq or
1488 fschmid 305
	{
4770 avox 306
		pop
307
		currentcolorspace 2 get
308
		dup type /arraytype eq { 0 get } if
309
	} if
310
 
311
	% now write values
312
	dup /CIEBasedABC eq
313
	{ % this must be a hack....
314
		gsave
315
		currentcolor setrgbcolor
316
		writecurrentrgbcolor
317
		grestore
318
	} {
319
 	dup /DeviceRGB eq
1488 fschmid 320
	{
4770 avox 321
		writecurrentrgbcolor
322
	} {
323
	dup dup /DeviceCMYK eq exch /DeviceGray eq or
324
	{
325
		writecurrentcmykcolor
326
	} {
327
	dup /Pattern eq
328
	{
329
		writecurrentpattern
330
	} {
331
		% TODO: other CIE
332
		writecurrentrgbcolor % will always be 0
333
	}
334
	ifelse } ifelse } ifelse } ifelse
335
	pop
290 Franz 336
} bind def
337
 
292 Franz 338
/writecurrentlinecap
339
{
340
	(lc ) print
4725 avox 341
	currentlinecap i_str cvs print
292 Franz 342
	(\n) print
343
} bind def
344
 
345
/writecurrentlinejoin
346
{
347
	(lj ) print
4725 avox 348
	currentlinejoin i_str cvs print
292 Franz 349
	(\n) print
350
} bind def
351
 
352
/writecurrentdash
353
{
354
	(ld ) print
4725 avox 355
	currentdash 1 index length i_str cvs print ( ) print i_str cvs print ( ) print
292 Franz 356
 
357
	{
4725 avox 358
		1 index exch get i_str cvs print ( ) print
292 Franz 359
	} for
360
	pop
361
	(\n) print
362
} bind def
363
 
290 Franz 364
/writecurrentlinewidth
365
{
366
	userdict begin
367
	currentlinewidth	% w
368
	storeMatrix
369
 
370
	% (wb + wd + wa + wc) / 2
371
	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
372
	(w ) print
4725 avox 373
	i_str cvs print
290 Franz 374
	(\n) print
375
	end
376
} bind def
377
 
4770 avox 378
/i_move	% x y
290 Franz 379
{
380
	userdict begin
381
	(m\n) print
382
	/currentY exch def
383
	/currentX exch def
384
	/beginX currentX def
385
	/beginY currentY def
386
	end
387
} bind def
388
 
4770 avox 389
/i_line
290 Franz 390
{
391
	userdict begin
392
	/y1 exch def
393
	/x1 exch def
394
 
395
	% x x1 ne y y1 ne or
396
	currentX x1 sub abs 0.001 gt  currentY y1 sub abs 0.001 gt or
397
	{
398
		(l ) print
4725 avox 399
		currentX currentY matrix_x i_str cvs print
290 Franz 400
		( ) print
4725 avox 401
		currentX currentY matrix_y i_str cvs print
290 Franz 402
		( ) print
403
 
4725 avox 404
		x1 y1 matrix_x i_str cvs print
290 Franz 405
		( ) print
4725 avox 406
		x1 y1 matrix_y i_str cvs print
290 Franz 407
		(\n) print
408
		/currentX x1 def
409
		/currentY y1 def
410
	}if
411
	end
412
} bind def
413
 
4770 avox 414
/i_curve
290 Franz 415
{
416
	userdict begin
417
	% x1 y1 x2 y2 x3 y3
418
	(c ) print
4725 avox 419
	currentX currentY matrix_x i_str cvs print
290 Franz 420
	( ) print
4725 avox 421
	currentX currentY matrix_y i_str cvs print
290 Franz 422
	( ) print
4725 avox 423
	5 index 5 index matrix_x i_str cvs print
290 Franz 424
	( ) print
4725 avox 425
	5 index 5 index matrix_y i_str cvs print
290 Franz 426
	( ) print
4725 avox 427
	3 index 3 index matrix_x i_str cvs print
290 Franz 428
	( ) print
4725 avox 429
	3 index 3 index matrix_y i_str cvs print
290 Franz 430
	( ) print
431
 
432
	/currentY exch def
433
	/currentX exch def
434
 
4725 avox 435
	currentX currentY matrix_x i_str cvs print
290 Franz 436
	( ) print
4725 avox 437
	currentX currentY matrix_y i_str cvs print
290 Franz 438
	(\n)print
439
	pop pop pop pop
440
	end
441
} bind def
442
 
443
% modified: 18.10.96
4770 avox 444
/i_close
290 Franz 445
{
446
	(cp\n) print
4770 avox 447
	beginX beginY i_line
290 Franz 448
} bind def
449
 
450
/storeMatrix
451
{
452
	userdict begin
453
	matrix currentmatrix
454
 
455
	matrix currentmatrix
456
	1 get /m_b exch def
457
	matrix currentmatrix
458
	2 get /m_c exch def
459
	matrix currentmatrix
460
	3 get /m_d exch def
461
	matrix currentmatrix
462
	4 get /m_x exch def
463
	matrix currentmatrix
464
	5 get /m_y exch def
465
	end
466
} bind def
467
 
468
/rectfill
469
{
470
	userdict begin
471
	(n\n)print			% start polygon
472
	writecurrentcolor
473
	writecurrentlinewidth
292 Franz 474
	writecurrentlinecap
475
	writecurrentlinejoin
476
	writecurrentdash
290 Franz 477
	storeMatrix
478
 
479
	% x y width height
480
	dup type /arraytype ne
481
	{
482
		/hr exch def
483
		/wr exch def
484
		/yr exch def
485
		/xr exch def
4770 avox 486
		xr yr i_move
487
		xr wr add yr i_line
488
		xr wr add yr hr add i_line
489
		xr yr hr add i_line
490
		xr yr i_line
290 Franz 491
	}
492
	% numarray
493
	% numstring
494
	{
495
		/ar exch def
496
 
497
		{
498
			/n exch def
499
			ar n get /xr exch def
500
			ar n 1 add get /yr exch def
501
			ar n 2 add get /wr exch def
502
			ar n 3 add get /hr exch def
4770 avox 503
			xr yr i_move
504
			xr wr add yr i_line
505
			xr wr add yr hr add i_line
506
			xr yr hr add i_line
507
			xr yr i_line
290 Franz 508
		} for
509
	}ifelse
510
 
511
	(f\n)print			% close polygon
512
	end
4770 avox 513
} i_shortcutOverload
290 Franz 514
 
515
/rectstroke
516
{
517
	userdict begin
518
	(n\n)print			% start rect
519
	writecurrentcolor
520
	writecurrentlinewidth
292 Franz 521
	writecurrentlinecap
522
	writecurrentlinejoin
523
	writecurrentdash
290 Franz 524
	storeMatrix
525
 
526
	% x y width height
527
	dup type /arraytype ne
528
	{
529
		/hr exch def
530
		/wr exch def
531
		/yr exch def
532
		/xr exch def
4770 avox 533
		xr yr i_move
534
		xr wr add yr i_line
535
		xr wr add yr hr add i_line
536
		xr yr hr add i_line
537
		xr yr i_line
290 Franz 538
	}
539
	% numarray
540
	% numstring
541
	{
542
		/ar exch def
543
 
544
		{
545
			/n exch def
546
			ar n get /xr exch def
547
			ar n 1 add get /yr exch def
548
			ar n 2 add get /wr exch def
549
			ar n 3 add get /hr exch def
4770 avox 550
			xr yr i_move
551
			xr wr add yr i_line
552
			xr wr add yr hr add i_line
553
			xr yr hr add i_line
554
			xr yr i_line
290 Franz 555
		} for
556
	}ifelse
557
	(n\n)print			% stroke rect
558
	end
4770 avox 559
} i_shortcutOverload
290 Franz 560
 
561
/stroke
562
{
563
	(n\n) print
564
	writecurrentcolor
565
	writecurrentlinewidth
292 Franz 566
	writecurrentlinecap
567
	writecurrentlinejoin
568
	writecurrentdash
4642 avox 569
	clipCnt 1 eq
570
		{ clipsave clip newpath clippath cliprestore } if
290 Franz 571
	storeMatrix
4770 avox 572
	{i_move} {i_line} {i_curve} {i_close} pathforall
290 Franz 573
	(s\n)print			% stroke path
574
	newpath
4770 avox 575
} i_shortcutOverload
290 Franz 576
 
577
/eofill
578
{
579
	(n\n) print			% start polygon
580
	writecurrentcolor	% write color
581
	writecurrentlinewidth
292 Franz 582
	writecurrentlinecap
583
	writecurrentlinejoin
584
	writecurrentdash
4642 avox 585
	clipCnt 1 eq
586
		{ clipsave clip newpath clippath cliprestore } if
290 Franz 587
	storeMatrix			% take transformation, scaling, rotation from PostScript
4770 avox 588
	{i_move} {i_line} {i_curve} {i_close} pathforall
290 Franz 589
	(f\n)print			% close polygon
590
 
591
	newpath				% clear stack
4770 avox 592
} i_shortcutOverload
290 Franz 593
 
4770 avox 594
/fill
290 Franz 595
{
4770 avox 596
	(fill-winding\n) print
597
	eofill
598
	(fill-evenodd\n) print
599
} i_shortcutOverload
290 Franz 600
 
601
/clip
602
{
603
	userdict begin
604
	(n\n)print			% start clip polygon
605
 
606
	storeMatrix			% take transformation, scaling, rotation from PostScript
4770 avox 607
	{i_move} {i_line} {i_curve} {i_close} pathforall
290 Franz 608
 
609
	(ci\n)print			% close clip polygon begin path
610
						% we have to close the path!!
611
	clip
612
	/clipCnt 1 def
613
	newpath				% clear stack
614
	end
4770 avox 615
} i_shortcutOverload
290 Franz 616
 
617
% we don't clip
618
% because this doesn't work for flattening text (show, charpath) with NeXT PostScript Code
619
/rectclip
620
{
4717 avox 621
	% let Scribus decide what to do with rci: pop pop pop pop
622
	(rci ) print
4725 avox 623
	i_str cvs print ( ) print
624
	i_str cvs print ( ) print
625
	i_str cvs print ( ) print
626
	i_str cvs print (\n) print
4770 avox 627
} i_shortcutOverload
290 Franz 628
 
4717 avox 629
 
630
%    Copyright (C) 1994 Aladdin Enterprises.  All rights reserved.
631
%
632
% This software is provided AS-IS with no warranty, either express or
633
% implied.
634
%
635
% This software is distributed under license and may not be copied,
636
% modified or distributed except as expressly authorized under the terms
637
% of the license contained in the file LICENSE in this distribution.
638
%
639
% For more information about licensing, please refer to
640
% http://www.ghostscript.com/licensing/. For information on
641
% commercial licensing, go to http://www.artifex.com/licensing/ or
642
% contact Artifex Software, Inc., 101 Lucas Valley Road #110,
643
% San Rafael, CA  94903, U.S.A., +1(415)492-9861.
644
 
645
% $Id: import.prolog 4770 2006-03-01 01:48:43Z avox $
646
% traceimg.ps
647
% Trace the data supplied to the 'image' operator.
648
 
649
% This code currently handles only the (Level 2) dictionary form of image,
650
% with a single data source and 8-bit pixels.
651
 
652
% changed for Scribus image import by Andreas Vox, 2006-2-21
653
% added support for colorimage and other image variant
654
 
4725 avox 655
/i_image			% <dict> i_image -
4717 avox 656
{
4770 avox 657
/i_image =
4717 avox 658
	begin
659
		/i_left Width Height mul Decode length 2 idiv mul BitsPerComponent mul 8 idiv dup /i_size exch store store
660
		/i_dict currentdict store
661
		/i_nsources 1 store
662
		/i_source 0 store
663
		/i_datasource currentdict /DataSource get store
664
		currentdict /MultipleDataSources known not
665
			{ /MultipleDataSources false def } if
666
		MultipleDataSources
667
		{
668
			/i_nsources  DataSource length store
669
			/i_datasource DataSource 0 get store
670
		} if
671
	end
672
	storeMatrix
673
	i_dict /ImageMatrix get matrix invertmatrix matrix currentmatrix matrix concatmatrix /i_m exch def
674
	i_dict /Width get  0 i_m dtransform dup mul exch dup mul add sqrt /i_w exch def
675
 
676
 
4770 avox 677
 
678
	atan														% angleVert
679
	i_dict /Width get 0 i_m dtransform i_y sub exch i_x sub		% dy1 dx1
680
	atan sub													% angleVert-angleHor
681
	pop 0 % not working, TODO
682
	/i_angle exch def
683
	(.tif) i_exportfilename
4725 avox 684
		(im ) print												% im x y w h angle ...
685
		i_x i_str cvs print ( ) print
686
		i_y i_str cvs print ( ) print
687
		i_w i_str cvs print ( ) print
688
		i_h i_str cvs print ( ) print
689
		i_angle i_str cvs print ( ) print
690
		i_dict /Width get  i_str cvs print ( ) print			% ... hpix vpix ...
691
		i_dict /Height get i_str cvs print ( ) print
4717 avox 692
		currentcolorspace 0 get /DeviceRGB eq
693
			{ (tiff24nc ) print }
694
		{ currentcolorspace 0 get /DeviceCMYK eq
695
			{ (tiff32nc ) print }
696
		{ currentcolorspace 0 get /DeviceGray eq
697
			{ (tiffgray ) print }
698
			{ (tiff32nc ) print }
699
		ifelse } ifelse } ifelse
4770 avox 700
        dup  (.tif) concatenate print (\n) print flush			% ... dev filename
701
		(.dat) concatenate (w) file /i_file exch store			% temp file
4717 avox 702
	currentcolorspace ==write ( setcolorspace\n) ==write
703
	(<<\n) ==write
704
	i_dict { exch
705
		  dup /DataSource eq
706
			{ pop pop (/DataSource currentfile\n) ==write }
707
		  {
708
			dup /ImageMatrix eq
709
				{ pop pop (/ImageMatrix [1 0 0 -1 0 ) ==write i_dict /Height get ==write (]\n) ==write }
710
				{ ==write ( ) ==write ==write (\n) ==write }
711
			ifelse
712
		  } ifelse
713
		} forall
714
	(>>\nimage\n) ==write i_file flushfile
715
 
716
    { %loop
717
      i_left 0 le
718
      {
719
		i_source 1 add /i_source exch def
720
        i_source i_nsources ge { exit } if
721
        i_dict /DataSource get i_source get /i_datasource exch def
722
		/i_left i_size def
723
      } if
724
      /i_datasource load exec
725
      dup type /filetype eq
726
       { i_buf 0 i_left 32 .min getinterval readstring pop
727
       } if
728
      dup i_file exch writestring
729
      i_left exch length sub /i_left exch def
730
    } loop
731
    i_file flushfile
4770 avox 732
/i_imageE =
4717 avox 733
 } bind def
734
 
735
/colorimage
736
{
4770 avox 737
/colorimage =
738
	% width height bits/sample matrix datasource0..n-1 multi ncomp
739
	/tmpN exch def
740
	/tmpMulti exch def
741
	tmpMulti
742
	{
743
		/tmpN load array astore
744
	} if
745
	/tmpN load 6 add dict
746
	dup 7 -1 roll /Width exch put
747
	dup 6 -1 roll /Height exch put
748
	dup 5 -1 roll /BitsPerComponent exch put
749
	dup 4 -1 roll /ImageMatrix exch put
750
	dup 3 -1 roll /DataSource exch put
751
	tmpMulti
752
	{
753
		dup /MultipleDataSources true put
754
	} if
755
	dup /ImageType 1 put
756
	gsave
757
	/tmpN load
758
		dup 1 eq
759
		{
760
			1 index /Decode [0 1] /Decode put
4717 avox 761
            /DeviceGray setcolorspace
4770 avox 762
		} if
763
		dup 3 eq
764
		{
765
			1 index /Decode [0 1 0 1 0 1] put
766
			/DeviceRGB setcolorspace
767
		} if
768
		dup 4 eq
769
		{
770
			1 index /Decode [0 1 0 1 0 1 0 1]  put
771
			/DeviceCMYK setcolorspace
772
		} if
773
	pop
774
	i_image
775
	grestore
776
/colorimageE =
777
} i_shortcutOverload
4717 avox 778
 
779
/image {
4770 avox 780
/image =
781
	gsave
782
	dup type /dicttype ne
783
	{
784
		% width height bits/sample matrix datasource
785
		7 dict
786
		dup 7 -1 roll /Width exch put
787
		dup 6 -1 roll /Height exch put
788
		dup 5 -1 roll /BitsPerComponent  exch put
789
		dup 4 -1 roll /ImageMatrix exch put
790
		dup 3 -1 roll /DataSource exch put
791
		dup 1 /ImageType exch put
792
		dup [0 1] /Decode exch put
793
		/DeviceGray setcolorspace
794
	} if
795
	i_image
796
	grestore
797
/imageE =
798
} i_shortcutOverload
4717 avox 799
 
800
/imagemask
801
{
4770 avox 802
/imagemask =
803
	writecurrentcolor
804
	(mask\n) print
805
	gsave
4717 avox 806
	dup type /dicttype ne
807
	{
4770 avox 808
		% width height pol matrix datasource
809
		7 dict
810
		dup 7 -1 roll /Width exch put
811
		dup 6 -1 roll /Height exch put
812
		dup 5 -1 roll { [0 1] } { [1 0] } ifelse /Decode exch put
813
		dup 4 -1 roll /ImageMatrix exch put
814
		dup 3 -1 roll /DataSource exch put
4717 avox 815
	} if
4770 avox 816
	dup 1 /ImageType exch put
817
	dup 1 /BitsPerComponent exch put
4717 avox 818
	/DeviceGray setcolorspace
4725 avox 819
	i_image
4717 avox 820
	grestore
4770 avox 821
/imagemaskE =
822
} i_shortcutOverload
4717 avox 823
 
824
 
825
% declare some global vars
826
 
827
/i_left 0 def
828
/i_size 0 def
829
/i_dict null def
830
/i_buf 32 string def
831
/i_nsources 1 def
832
/i_source 0 def
4725 avox 833
/i_datasource { (x) } def
4717 avox 834
/i_file null def
835
/i_filecount 1 def
836
 
837
%%%% End of traceimage code
838
 
839
 
290 Franz 840
/stateArray 500 array def
841
/stateTop 0 def
842
/gsave
843
{
844
	userdict begin
4770 avox 845
%	(gs\n) print
290 Franz 846
	stateArray stateTop gstate currentgstate put
847
	/stateTop stateTop 1 add def
848
	end
4770 avox 849
} i_shortcutOverload
290 Franz 850
 
851
/grestore
852
{
853
	userdict begin
854
	stateTop 1 lt
855
	{
856
	}
857
	{
4770 avox 858
%		(gr\n) print
290 Franz 859
		stateArray stateTop 1 sub get setgstate
860
		/stateTop stateTop 1 sub def
861
		stateArray stateTop 0 put
862
	}ifelse
863
	end
4770 avox 864
} i_shortcutOverload
290 Franz 865
 
866
% a bind def of the show operator doesn't work,
867
% so this is our way to get a charpath entry for flattening text
868
/root_charpath
869
{
870
	charpath
871
} bind def
872
 
4740 avox 873
/i_kerningI
874
{
875
	exch 1 getinterval stringwidth
876
} bind def
877
 
878
% find kerning value
879
/i_kerningII		% index string   i_kerning   dx dy
880
{
881
	% stringwidth( [n..n+1] ) - stringwidth( [n+1] )
882
	/i_pstring exch def
883
	/i_pindex exch def
884
	i_pstring i_pindex 2 getinterval stringwidth exch	% y2 x2
885
	i_pstring i_pindex 1 add 1 getinterval stringwidth		% y2 x2 x1 y1
886
	4 1 roll sub											% y1 y2 (x2-x1)
887
	3 1 roll exch sub										% (x2-x1) (y2-y1)
888
} bind def
889
 
890
 
891
/i_kerningIII		% index string   i_kerning   dx dy
892
{
893
	% stringwidth( [n..n+1] ) - stringwidth( [n+1] )
894
	/i_pstring exch def
895
	/i_pindex exch def
896
	i_pstring i_pindex 2 getinterval (l) exch concatenate stringwidth exch	% y2 x2
897
	i_pstring i_pindex 1 add 1 getinterval (l) exch concatenate stringwidth		% y2 x2 x1 y1
898
	4 1 roll sub											% y1 y2 (x2-x1)
899
	3 1 roll exch sub										% (x2-x1) (y2-y1)
900
} bind def
901
 
4741 avox 902
/i_kerning /i_kerningII load def
4740 avox 903
 
4725 avox 904
/show % string show -
905
{
290 Franz 906
	userdict begin
907
	storeMatrix
908
	currentfont /FontName known
909
	% stack: string
910
	{
386 Franz 911
		currentpoint /ycur exch def /xcur exch def
290 Franz 912
		currentpoint	% x y
913
		newpath
914
		/clipCnt 0 def
915
		moveto
4725 avox 916
		/completeString exch def
290 Franz 917
		% we process each char separately to get smaller paths
4725 avox 918
 
290 Franz 919
		{
920
			(n\n)print			% start polygon
921
			writecurrentcolor	% write color
922
			storeMatrix
4725 avox 923
			dup completeString length 1 sub eq
4740 avox 924
			{ 0 0 } { dup completeString i_kerning } ifelse
925
			/curwidthy exch def /curwidthx exch def
4725 avox 926
			completeString exch 1 getinterval dup /curstr exch def
2798 fschmid 927
			false root_charpath
4770 avox 928
			{i_move} {i_line} {i_curve} {i_close} pathforall
290 Franz 929
			(f\n)print			% close polygon
386 Franz 930
			newpath
4725 avox 931
			curwidthx xcur add curwidthy ycur add moveto
386 Franz 932
			currentpoint /ycur exch def /xcur exch def
933
			newpath			% clear graphic stack
934
			xcur ycur moveto
290 Franz 935
		} for
936
		currentpoint	% x y
937
		newpath				% clear graphic stack (and current point)
938
		moveto
4725 avox 939
	} {
940
		pop		% string
941
	} ifelse
290 Franz 942
	end
4770 avox 943
} i_shortcutOverload
290 Franz 944
 
945
/ashow
946
{
947
	% ax ay string
385 Franz 948
	exch /ydist exch def
949
	exch /xdist exch def
950
	userdict begin
951
	storeMatrix
952
	currentfont /FontName known
953
	% stack: string
954
	{
386 Franz 955
		currentpoint /ycur exch def /xcur exch def
385 Franz 956
		currentpoint	% x y
957
		newpath
958
		/clipCnt 0 def
959
		moveto
4725 avox 960
		/completeString exch def
385 Franz 961
		% we process each char separately to get smaller paths
4725 avox 962
 
385 Franz 963
		{
964
			(n\n)print			% start polygon
965
			writecurrentcolor	% write color
966
			storeMatrix
4725 avox 967
			dup completeString length 1 sub eq
4740 avox 968
			{ 0 0 } { dup completeString i_kerning } ifelse
969
			/curwidthy exch def /curwidthx exch def
4725 avox 970
			completeString exch 1 getinterval dup /curstr exch def
971
			false root_charpath
4770 avox 972
			{i_move} {i_line} {i_curve} {i_close} pathforall
385 Franz 973
			(f\n)print			% close polygon
386 Franz 974
			newpath
4725 avox 975
			curwidthx xcur add curwidthy ycur add
386 Franz 976
			exch xdist add exch ydist add moveto
977
			currentpoint /ycur exch def /xcur exch def
978
			newpath			% clear graphic stack
979
			xcur ycur moveto
385 Franz 980
		} for
981
		currentpoint	% x y
982
		newpath				% clear graphic stack (and current point)
983
		moveto
4725 avox 984
	} {
985
		pop
986
	} ifelse
385 Franz 987
	end
4770 avox 988
} i_shortcutOverload
290 Franz 989
 
4642 avox 990
/awidthshow		% cx cy char ax ay string
290 Franz 991
{
4642 avox 992
	% ax ay string
993
	exch /ydist exch def
994
	exch /xdist exch def
995
	% cx cy char string
996
	exch /char exch def
997
	exch /cydist exch def
998
	exch /cxdist exch def
999
	userdict begin
1000
	storeMatrix
1001
	currentfont /FontName known
1002
	% stack: string
1003
	{
1004
		currentpoint /ycur exch def /xcur exch def
1005
		currentpoint	% x y
1006
		newpath
1007
		/clipCnt 0 def
1008
		moveto
4725 avox 1009
		/completeString exch def
4642 avox 1010
		% we process each char separately to get smaller paths
4725 avox 1011
 
4642 avox 1012
		{
1013
			(n\n)print			% start polygon
1014
			writecurrentcolor	% write color
1015
			storeMatrix
4725 avox 1016
			dup completeString length 1 sub eq
4740 avox 1017
			{ 0 0 } { dup completeString i_kerning } ifelse
1018
			/curwidthy exch def /curwidthx exch def
4725 avox 1019
			completeString exch 1 getinterval dup /curstr exch def
1020
			false root_charpath
4770 avox 1021
			{i_move} {i_line} {i_curve} {i_close} pathforall
4642 avox 1022
			(f\n)print			% close polygon
1023
			newpath
4725 avox 1024
			curwidthx xcur add curwidthy ycur add
4642 avox 1025
			exch xdist add exch ydist add moveto
1026
			curstr 0 get char eq
1027
			{
1028
				currentpoint exch cxdist add exch cydist add moveto
1029
			} if
1030
			currentpoint /ycur exch def /xcur exch def
1031
			newpath			% clear graphic stack
1032
			xcur ycur moveto
1033
		} for
1034
		currentpoint	% x y
1035
		newpath				% clear graphic stack (and current point)
1036
		moveto
4725 avox 1037
	} {
1038
		pop
1039
	} ifelse
4642 avox 1040
	end
4770 avox 1041
} i_shortcutOverload
290 Franz 1042
 
4642 avox 1043
/widthshow	% cx cy char string
290 Franz 1044
{
4642 avox 1045
 
1046
 
1047
	awidthshow
290 Franz 1048
} bind def
1049
 
1050
/cshow	% proc string
1051
{
1052
	exch pop
1053
	show
4770 avox 1054
} i_shortcutOverload
290 Franz 1055
 
1056
/kshow	% proc string
1057
{
1058
	dup length 1 sub
1059
	dup 0 ne
1060
	{
1061
		1 index 0 1 getinterval
1062
		show
1063
		1 sub
1064
		dup 0 ne
1065
		{
1066
			1 add
1067
			1 exch 1 exch
1068
			{
1069
				dup 1 sub
1070
				2 index exch get
1071
				2 index 2 index get
1072
				4 index exec
1073
				1 index exch 1 getinterval
1074
				show
1075
			} for
1076
		} if
1077
	}
1078
	{
1079
		pop dup show
1080
	} ifelse
1081
	pop pop
4770 avox 1082
} i_shortcutOverload
290 Franz 1083
 
1084
/xshow	% string array
1085
{
4770 avox 1086
	pop %FIXME
290 Franz 1087
	show
4770 avox 1088
} i_shortcutOverload
290 Franz 1089
 
1090
/xyshow	% string array
1091
{
4770 avox 1092
	pop %FIXME
290 Franz 1093
	show
4770 avox 1094
} i_shortcutOverload
290 Franz 1095
 
1096
/yshow	% string array
1097
{
4770 avox 1098
	pop %FIXME
290 Franz 1099
	show
4770 avox 1100
} i_shortcutOverload
290 Franz 1101
 
4770 avox 1102
/i_reencode % newfontname reencodevector origfontdict -> i_reencode -> newfontdict
290 Franz 1103
{
1104
	userdict begin
1105
 dup begin dup maxlength dict begin
1106
  { 1 index /FID ne {def} {pop pop} ifelse
1107
  } forall
1108
  /Encoding exch def
1109
  currentdict
1110
  end end
1111
  definefont
1112
	end
1113
} bind def
1114
 
1115
/glyphshow {
1116
    save % So can reclaim VM from reencoding
1117
    currentfont /Encoding get dup length array copy dup 0 5 -1 roll put
4770 avox 1118
    /GlyphShowTempFont exch currentfont i_reencode
290 Franz 1119
    setfont
1120
    (\000) show
1121
	restore
4770 avox 1122
} i_shortcutOverload
290 Franz 1123
 
292 Franz 1124
/showpage
1125
{
1126
	(sp\n) print
4770 avox 1127
} i_shortcutOverload
292 Franz 1128