Subversion Repositories Scribus

Rev

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