Subversion Repositories Scribus

Rev

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