Subversion Repositories Scribus

Rev

Rev 1488 | Rev 4167 | 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
%
10
% this PostScript code writes a file with the structure below.
11
% # # # # l		(x0 y0 x1 y1) line
12
% # # # # # # # #c	(x0 y0 x1 y1 x2 y2 x3 y3) curve
13
% # w			(width) width
14
% # # # # # co		(c m y k a) color
15
% n			new list
16
% f			list is a filled polygon
17
% s			list is a group
18
% cl			list is a clip list (clip with old clip list and use it)
19
% gs			save current clip list and width to top of stack
20
% gr			use last clip list (on top of stack) and width
21
% # # # # # # # # # #	(x y a b c d e f text font) text
22
%
23
% Adapted for Scribus by Franz Schmid 15.05.2004
24
% Also removed the hardcoded Output Filename
25
% and changed it in a way the -sOutputFile Option of Ghostscript can be used
26
% Speeded up the flattening of Text by removing unneeded calculations.
27
% Changed the Output slightly to ease parsing
28
% m                 moveto
29
% l # # # #         (x0 y0 x1 y1) line
30
% c # # # # # # # # (x0 y0 x1 y1 x2 y2 x3 y3) curve
31
% w #               (width) Linewidth
32
% co # # # # #      (c m y k a) color
33
% n                 new list
34
% f                 list is a filled polygon
35
% s                 list is a stroke path
36
% cp                close current subpath
37
% ci                list is a clip list (clip with old clip list and use it)
292 Franz 38
% sp                end of page
39
% lj #              linejoin
40
% lc #              linecap
41
% ld # # #n         linedash count offset d1, d2, dx
290 Franz 42
% 15.05.2004 Added the Glyphshow Operator.
43
% 17.05.2004 Made clipping working.
44
% 20.05.2004 kshow is working now.
45
 
46
/cfile OutputFile (w) file def
47
/print { cfile exch writestring } bind def
48
 
49
% whether we have to flatten the text
50
/flattenText 1 def
51
 
52
% is a Clipping there
53
/clipCnt 0 def
54
 
55
% remember the current point
56
/currentX 0 def
57
/currentY 0 def
58
 
59
% 1st point of path to close the path
60
/beginX 0 def
61
/beginY 0 def
62
 
63
% dummy for converting strings
64
/str 50 string def
65
 
66
% 0 = mirror at
67
/mirror 0 def
68
 
69
% mirror a at 0
70
/mir
71
{
72
	mirror 0 ne
73
	{	0 exch sub
74
	}if
75
} bind def
76
 
77
% scale
78
/m_a 1 def
79
/m_b 0 def
80
/m_c 0 def
81
/m_d 1 def
82
/m_x 0 def
83
/m_y 0 def
84
/matrix_x	% x y
85
{
86
	% ax + cy + tx
87
	m_c mul exch m_a mul add m_x add
88
} bind def
89
/matrix_y	% x y
90
{
91
	% bx + dy + ty
92
	m_d mul exch m_b mul add m_y add
93
} bind def
94
 
95
/writecurrentcolor
96
{
97
	currentcolorspace 0 get /CIEBasedABC eq
98
	{	currentcolor setrgbcolor
99
	} if
1488 fschmid 100
	currentcolorspace 0 get /DeviceRGB eq
101
	{
102
		currentrgbcolor	% -> r g b
103
		(corgb )print
104
		2 index str cvs print
105
		( ) print
106
		1 index str cvs print
107
		( ) print
108
		str cvs print
109
		( ) print
110
		pop pop
111
		.currentopacityalpha	% a
112
		str cvs print
113
		(\n) print
114
	}
115
	{
116
		currentcmykcolor	% -> c m y k
117
		(co )print
118
		3 index str cvs print
119
		( ) print
120
		2 index str cvs print
121
		( ) print
122
		1 index str cvs print
123
		( ) print
124
		str cvs print
125
		( ) print
126
		pop pop pop
127
		.currentopacityalpha	% a
128
		str cvs print
129
		(\n) print
130
	} ifelse
290 Franz 131
 
132
} bind def
133
 
292 Franz 134
/writecurrentlinecap
135
{
136
	(lc ) print
137
	currentlinecap str cvs print
138
	(\n) print
139
} bind def
140
 
141
/writecurrentlinejoin
142
{
143
	(lj ) print
144
	currentlinejoin str cvs print
145
	(\n) print
146
} bind def
147
 
148
/writecurrentdash
149
{
150
	(ld ) print
151
	currentdash 1 index length str cvs print ( ) print str cvs print ( ) print
152
 
153
	{
154
		1 index exch get str cvs print ( ) print
155
	} for
156
	pop
157
	(\n) print
158
} bind def
159
 
290 Franz 160
/writecurrentlinewidth
161
{
162
	userdict begin
163
	currentlinewidth	% w
164
	storeMatrix
165
 
166
	% (wb + wd + wa + wc) / 2
167
	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
168
	(w ) print
169
	str cvs print
170
	(\n) print
171
	end
172
} bind def
173
 
174
/_move	% x y
175
{
176
	userdict begin
177
	(m\n) print
178
	/currentY exch def
179
	/currentX exch def
180
	/beginX currentX def
181
	/beginY currentY def
182
	end
183
} bind def
184
 
185
/_line
186
{
187
	userdict begin
188
	/y1 exch def
189
	/x1 exch def
190
 
191
	% x x1 ne y y1 ne or
192
	currentX x1 sub abs 0.001 gt  currentY y1 sub abs 0.001 gt or
193
	{
194
		(l ) print
195
		currentX currentY matrix_x str cvs print
196
		( ) print
197
		currentX currentY matrix_y str cvs print
198
		( ) print
199
 
200
		x1 y1 matrix_x str cvs print
201
		( ) print
202
		x1 y1 matrix_y str cvs print
203
		(\n) print
204
		/currentX x1 def
205
		/currentY y1 def
206
	}if
207
	end
208
} bind def
209
 
210
/_curve
211
{
212
	userdict begin
213
	% x1 y1 x2 y2 x3 y3
214
	(c ) print
215
	currentX currentY matrix_x str cvs print
216
	( ) print
217
	currentX currentY matrix_y str cvs print
218
	( ) print
219
	5 index 5 index matrix_x str cvs print
220
	( ) print
221
	5 index 5 index matrix_y str cvs print
222
	( ) print
223
	3 index 3 index matrix_x str cvs print
224
	( ) print
225
	3 index 3 index matrix_y str cvs print
226
	( ) print
227
 
228
	/currentY exch def
229
	/currentX exch def
230
 
231
	currentX currentY matrix_x str cvs print
232
	( ) print
233
	currentX currentY matrix_y str cvs print
234
	(\n)print
235
	pop pop pop pop
236
	end
237
} bind def
238
 
239
% modified: 18.10.96
240
/_close
241
{
242
	(cp\n) print
243
	beginX beginY _line
244
} bind def
245
 
246
/storeMatrix
247
{
248
	userdict begin
249
	matrix currentmatrix
250
 
251
	matrix currentmatrix
252
	1 get /m_b exch def
253
	matrix currentmatrix
254
	2 get /m_c exch def
255
	matrix currentmatrix
256
	3 get /m_d exch def
257
	matrix currentmatrix
258
	4 get /m_x exch def
259
	matrix currentmatrix
260
	5 get /m_y exch def
261
	end
262
} bind def
263
 
264
/rectfill
265
{
266
	userdict begin
267
	(n\n)print			% start polygon
268
	writecurrentcolor
269
	writecurrentlinewidth
292 Franz 270
	writecurrentlinecap
271
	writecurrentlinejoin
272
	writecurrentdash
290 Franz 273
	storeMatrix
274
 
275
	% x y width height
276
	dup type /arraytype ne
277
	{
278
		/hr exch def
279
		/wr exch def
280
		/yr exch def
281
		/xr exch def
282
		xr yr _move
283
		xr wr add yr _line
284
		xr wr add yr hr add _line
285
		xr yr hr add _line
286
		xr yr _line
287
	}
288
	% numarray
289
	% numstring
290
	{
291
		/ar exch def
292
 
293
		{
294
			/n exch def
295
			ar n get /xr exch def
296
			ar n 1 add get /yr exch def
297
			ar n 2 add get /wr exch def
298
			ar n 3 add get /hr exch def
299
			xr yr _move
300
			xr wr add yr _line
301
			xr wr add yr hr add _line
302
			xr yr hr add _line
303
			xr yr _line
304
		} for
305
	}ifelse
306
 
307
	(f\n)print			% close polygon
308
	end
309
} bind def
310
 
311
/rectstroke
312
{
313
	userdict begin
314
	(n\n)print			% start rect
315
	writecurrentcolor
316
	writecurrentlinewidth
292 Franz 317
	writecurrentlinecap
318
	writecurrentlinejoin
319
	writecurrentdash
290 Franz 320
	storeMatrix
321
 
322
	% x y width height
323
	dup type /arraytype ne
324
	{
325
		/hr exch def
326
		/wr exch def
327
		/yr exch def
328
		/xr exch def
329
		xr yr _move
330
		xr wr add yr _line
331
		xr wr add yr hr add _line
332
		xr yr hr add _line
333
		xr yr _line
334
	}
335
	% numarray
336
	% numstring
337
	{
338
		/ar exch def
339
 
340
		{
341
			/n exch def
342
			ar n get /xr exch def
343
			ar n 1 add get /yr exch def
344
			ar n 2 add get /wr exch def
345
			ar n 3 add get /hr exch def
346
			xr yr _move
347
			xr wr add yr _line
348
			xr wr add yr hr add _line
349
			xr yr hr add _line
350
			xr yr _line
351
		} for
352
	}ifelse
353
	(n\n)print			% stroke rect
354
	end
355
} bind def
356
 
357
/stroke
358
{
359
	(n\n) print
360
	writecurrentcolor
361
	writecurrentlinewidth
292 Franz 362
	writecurrentlinecap
363
	writecurrentlinejoin
364
	writecurrentdash
290 Franz 365
	clipCnt 1 eq
366
		{ clipsave clip newpath clippath cliprestore } if
367
	storeMatrix
368
	{_move} {_line} {_curve} {_close} pathforall
369
	(s\n)print			% stroke path
370
	newpath
371
} bind def
372
 
373
/eofill
374
{
375
	(n\n) print			% start polygon
376
	writecurrentcolor	% write color
377
	writecurrentlinewidth
292 Franz 378
	writecurrentlinecap
379
	writecurrentlinejoin
380
	writecurrentdash
290 Franz 381
	clipCnt 1 eq
382
		{ clipsave clip newpath clippath cliprestore } if
383
	storeMatrix			% take transformation, scaling, rotation from PostScript
384
	{_move} {_line} {_curve} {_close} pathforall
385
	(f\n)print			% close polygon
386
 
387
	newpath				% clear stack
388
} bind def
389
 
390
/fill
391
{
392
	eofill
393
} bind def
394
 
395
/clip
396
{
397
	userdict begin
398
	(n\n)print			% start clip polygon
399
 
400
	storeMatrix			% take transformation, scaling, rotation from PostScript
401
	{_move} {_line} {_curve} {_close} pathforall
402
 
403
	(ci\n)print			% close clip polygon begin path
404
						% we have to close the path!!
405
	clip
406
	/clipCnt 1 def
407
	newpath				% clear stack
408
	end
409
} bind def
410
 
411
% we don't clip
412
% because this doesn't work for flattening text (show, charpath) with NeXT PostScript Code
413
/rectclip
414
{
415
	pop pop pop pop
416
} bind def
417
 
418
/stateArray 500 array def
419
/stateTop 0 def
420
/gsave
421
{
422
	userdict begin
423
%	(gs\n) print
424
	stateArray stateTop gstate currentgstate put
425
	/stateTop stateTop 1 add def
426
	end
427
} bind def
428
 
429
/grestore
430
{
431
	userdict begin
432
	stateTop 1 lt
433
	{
434
	}
435
	{
436
%		(gr\n) print
437
		stateArray stateTop 1 sub get setgstate
438
		/stateTop stateTop 1 sub def
439
		stateArray stateTop 0 put
440
	}ifelse
441
	end
442
} bind def
443
 
444
% a bind def of the show operator doesn't work,
445
% so this is our way to get a charpath entry for flattening text
446
/root_charpath
447
{
448
	charpath
449
} bind def
450
 
451
/show
452
{
453
	userdict begin
454
	storeMatrix
455
	currentfont /FontName known
456
	% stack: string
457
	{
386 Franz 458
		currentpoint /ycur exch def /xcur exch def
290 Franz 459
		currentpoint	% x y
460
		newpath
461
		/clipCnt 0 def
462
		moveto
463
		% we process each char separately to get smaller paths
464
 
465
		{
466
			(n\n)print			% start polygon
467
			writecurrentcolor	% write color
468
			storeMatrix
2798 fschmid 469
			1 index exch 1 getinterval dup /curstr exch def
470
			false root_charpath
290 Franz 471
			{_move} {_line} {_curve} {_close} pathforall
472
			(f\n)print			% close polygon
386 Franz 473
			newpath
474
			curstr stringwidth exch xcur add exch ycur add moveto
475
			currentpoint /ycur exch def /xcur exch def
476
			newpath			% clear graphic stack
477
			xcur ycur moveto
290 Franz 478
		} for
479
		currentpoint	% x y
480
		newpath				% clear graphic stack (and current point)
481
		moveto
482
	} if
483
	pop
484
	end
485
} def
486
 
487
/ashow
488
{
489
	% ax ay string
385 Franz 490
	exch /ydist exch def
491
	exch /xdist exch def
492
	userdict begin
493
	storeMatrix
494
	currentfont /FontName known
495
	% stack: string
496
	{
386 Franz 497
		currentpoint /ycur exch def /xcur exch def
385 Franz 498
		currentpoint	% x y
499
		newpath
500
		/clipCnt 0 def
501
		moveto
502
		% we process each char separately to get smaller paths
503
 
504
		{
505
			(n\n)print			% start polygon
506
			writecurrentcolor	% write color
507
			storeMatrix
386 Franz 508
			1 index exch 1 getinterval dup /curstr exch def false root_charpath
385 Franz 509
			{_move} {_line} {_curve} {_close} pathforall
510
			(f\n)print			% close polygon
386 Franz 511
			newpath
512
			curstr stringwidth exch xcur add exch ycur add
513
			exch xdist add exch ydist add moveto
514
			currentpoint /ycur exch def /xcur exch def
515
			newpath			% clear graphic stack
516
			xcur ycur moveto
385 Franz 517
		} for
518
		currentpoint	% x y
519
		newpath				% clear graphic stack (and current point)
520
		moveto
521
	} if
522
	pop
523
	end
290 Franz 524
} bind def
525
 
526
/widthshow	% cx cy char string
527
{
528
	exch pop
529
	exch pop
530
	exch pop
531
	show
532
} bind def
533
 
534
/awidthshow		% cx cy char ax ay string
535
{
536
	exch pop
537
	exch pop
538
	exch pop
539
	exch pop
540
	exch pop
541
	show
542
} bind def
543
 
544
/cshow	% proc string
545
{
546
	exch pop
547
	show
548
} bind def
549
 
550
/kshow	% proc string
551
{
552
	dup length 1 sub
553
	dup 0 ne
554
	{
555
		1 index 0 1 getinterval
556
		show
557
		1 sub
558
		dup 0 ne
559
		{
560
			1 add
561
			1 exch 1 exch
562
			{
563
				dup 1 sub
564
				2 index exch get
565
				2 index 2 index get
566
				4 index exec
567
				1 index exch 1 getinterval
568
				show
569
			} for
570
		} if
571
	}
572
	{
573
		pop dup show
574
	} ifelse
575
	pop pop
576
} bind def
577
 
578
/xshow	% string array
579
{
580
	pop
581
	show
582
} bind def
583
 
584
/xyshow	% string array
585
{
586
	pop
587
	show
588
} bind def
589
 
590
/yshow	% string array
591
{
592
	pop
593
	show
594
} bind def
595
 
596
/ReEnc % newfontname reencodevector origfontdict -> ReEncode -> newfontdict
597
{
598
	userdict begin
599
 dup begin dup maxlength dict begin
600
  { 1 index /FID ne {def} {pop pop} ifelse
601
  } forall
602
  /Encoding exch def
603
  currentdict
604
  end end
605
  definefont
606
	end
607
} bind def
608
 
609
/glyphshow {
610
    save % So can reclaim VM from reencoding
611
    currentfont /Encoding get dup length array copy dup 0 5 -1 roll put
612
    /GlyphShowTempFont exch currentfont ReEnc
613
    setfont
614
    (\000) show
615
	restore
616
} bind def
617
 
292 Franz 618
/showpage
619
{
620
	(sp\n) print
621
} bind def
622