home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 2007 November
/
CPNL0711.ISO
/
beeld
/
teken
/
scribus-1.3.3.9-win32-install.exe
/
libs
/
import.prolog
next >
Wrap
Text File
|
2006-11-23
|
32KB
|
1,394 lines
%
% psi.prolog
%
% Copyright (C) 1996-2000 by vhf computer GmbH + vhf interservice GmbH
% Author: Georg Fleischmann
%
% created: 2000-09-09
% modified:
%
%%% this file also contains a section taken from GPL Ghostscript 8.50 "traceimg.ps", see below
% this PostScript code writes a file with the structure below.
% # # # # l (x0 y0 x1 y1) line
% # # # # # # # #c (x0 y0 x1 y1 x2 y2 x3 y3) curve
% # w (width) width
% # # # # # co (c m y k a) color
% n new list
% f list is a filled polygon
% s list is a group
% cl list is a clip list (clip with old clip list and use it)
% gs save current clip list and width to top of stack
% gr use last clip list (on top of stack) and width
% # # # # # # # # # # (x y a b c d e f text font) text
%
% Adapted for Scribus by Franz Schmid 15.05.2004
% Also removed the hardcoded Output Filename
% and changed it in a way the -sOutputFile Option of Ghostscript can be used
% Speeded up the flattening of Text by removing unneeded calculations.
% Changed the Output slightly to ease parsing
% m moveto
% l # # # # (x0 y0 x1 y1) line
% c # # # # # # # # (x0 y0 x1 y1 x2 y2 x3 y3) curve
% w # (width) Linewidth
% co # # # # # (c m y k a) color
% n new list
% f list is a filled polygon
% s list is a stroke path
% cp close current subpath
% ci list is a clip list (clip with old clip list and use it)
% sp end of page
% lj # linejoin
% lc # linecap
% ld # # #n linedash count offset d1, d2, dx
% im # image <name>
% pat # # makepattern params tmpfilename
% mask imagemask, followed by b/w image
% fill-evenodd set fill rule
% fill-winding - " -
% 15.05.2004 Added the Glyphshow Operator.
% 17.05.2004 Made clipping working.
% 20.05.2004 kshow is working now.
% 22.02.2006 added image and colorimage ops -- av
% 02.03.2006 added code to divide reported coordinates by (device resolution/72) -- av
% 23.03.2006 added code to trace PDF commands
% some hacks to get access to PDF operators, needs -sDELAYBIND
currentglobal true setglobal
GS_PDF_ProcSet begin
currentdict /setshowstate
{
dup WordSpacing 0 32 TextSpacing 0 6 -1 roll awidthshow
//setshowstate exec
} .forceput
currentdict /endpage {
(sp\n) print
//endpage exec
} .forceput
end
setglobal
.bindnow
/cfile TraceFile (w) file def
/print { cfile exch writestring } bind def
/==write % any ==write -
{
dup type dup /arraytype eq exch /packedarraytype eq or
{
i_file ([) writestring
{ ==write i_file ( ) writestring } forall
i_file (]) writestring
} {
dup type /nametype eq
{
i_file (/) writestring i_file exch i_str cvs writestring
} {
dup type /stringtype eq
{
true 1 index { 32 ge and } forall
{
i_file (\() writestring i_file exch writestring i_file (\)) writestring
}
{
i_file (<) writestring
i_file /ASCIIHexEncode filter dup
3 -1 roll
writestring closefile % close filter
i_file (\n) writestring
} ifelse
} {
dup type /dicttype eq
{
i_file (<<) writestring
{ ==write ( ) =write ==write (\n) =write } forall
i_file (>>) writestring
} {
i_file exch i_str cvs
dup dup length 1 sub get (-) 0 get eq { pop (null) } if
writestring
} ifelse } ifelse } ifelse } ifelse
} def
/=write % any =write -
{
dup type dup /arraytype eq exch /packedarraytype eq or
{
{ =write i_file ( ) writestring } forall
} {
dup type /nametype eq
{
i_file exch i_str cvs writestring
} {
dup type /stringtype eq
{
i_file exch writestring
} {
dup type /dicttype eq
{
i_file (<<) writestring
{ =write ( ) =write =write (\n) =write } forall
i_file (>>) writestring
} {
i_file exch i_str cvs writestring
} ifelse } ifelse } ifelse } ifelse
} def
% flag to deactivate our substitutions
/i_shortcut false def
% defines an overloaded function name proc i_shortcutOverload -
% equvalent to /name { i_shortcut { //name } { proc } ifelse } bind def
/i_shortcutOverload
{
[ /i_shortcut /load load [ 5 index load ] cvx 4 index /ifelse load ] cvx
exch pop
bind def
} def
% whether we have to flatten the text
/flattenText 1 def
% is a Clipping there
/clipCnt 0 def
% remember the current point
/currentX 0 def
/currentY 0 def
% 1st point of path to close the path
/beginX 0 def
/beginY 0 def
% dummy for converting strings
/i_str 50 string def
% 0 = mirror at
/mirror 0 def
% mirror a at 0
/mir
{
mirror 0 ne
{ 0 exch sub
}if
} bind def
% scale
currentpagedevice /HWResolution get aload pop
72 div /i_vscale exch def
72 div /i_hscale exch def
/m_a 1 def
/m_b 0 def
/m_c 0 def
/m_d 1 def
/m_x 0 def
/m_y 0 def
/matrix_x % x y
{
% ax + cy + tx
m_c mul exch m_a mul add m_x add i_hscale div
} bind def
/matrix_y % x y
{
% bx + dy + ty
m_d mul exch m_b mul add m_y add i_vscale div
} bind def
/concatenate % str1 str2 concatenate str12
{
dup length 2 index length add string
dup 3 index length 3 index putinterval
dup 0 4 index putinterval
exch pop exch pop
} bind def
% this is like search but returns the last match in string
/rsearch % string seek rsearch post match pre true // string false
{
2 copy search % string seek post1 match1 pre1 true
{
2 index 4 index rsearch % string seek post1 match1 pre1 post2 match2 pre2 true
{
6 -1 roll pop % string seek match1 pre1 post2 match2 pre2
% combine (pre1 match1 pre2) into one string
5 -1 roll exch concatenate % string seek pre1 post2 match2 (match1+pre2)
4 -1 roll exch concatenate % string seek post2 match2 (pre1+match1+pre2)
} { % string seek post1 match1 pre1 post1
pop
} ifelse
% string seek post match pre
5 -2 roll pop pop
true
} { % string seek string
pop pop false
} ifelse
} bind def
% returns a unique filename for the given extension
/i_exportfilename % string i_exportfilename string
{
/ExportFiles where { /ExportFiles get (.) rsearch { exch pop exch pop } if } { (imagefile) } ifelse
(-) concatenate dup /i_basename exch def i_filecount 9 string cvs concatenate
{
i_filecount 1 add /i_filecount exch store
dup 2 index concatenate status not { exit } if
pop pop pop pop pop
i_basename i_filecount 9 string cvs concatenate
} loop
exch pop
} bind def
/makepattern { % dict matrix makepattern patterndict
%/makepattern =
% we will do some real painting here:
/i_shortcut true store
% params:
/i_m exch def
/i_dict exch def
% define export filename
/i_basename (.png) i_exportfilename (.png) concatenate def
i_dict /BBox get
dup 0 get /i_x exch def
dup 1 get /i_y exch def
dup 2 get i_x sub /i_w exch def
3 get i_y sub /i_h exch def
% we want those in devspace:
i_x i_y i_m itransform matrix currentmatrix transform
i_vscale div /i_y exch def i_hscale div /i_x exch def
i_w i_h i_m idtransform matrix currentmatrix dtransform
i_vscale div /i_h exch def i_hscale div /i_w exch def
% i_h < 0 ?
i_h 0 le
{
/i_y i_h i_y add def
/i_h i_h neg def
} if
% i_w < 0 ?
i_w 0 le
{
/i_x i_w i_x add def
/i_w i_w neg def
} if
% now we can use the current matrix as pattern matrix, but with (0,0) origin
i_m ==
i_x i_y matrix currentmatrix translate /i_m exch def
i_m ==
i_dict /BBox [ 0 0 i_w i_h ] put
(w x h =) = i_w = i_h =
% paint pattern to png file
gsave
currentcolor currentcolorspace
<<
/OutputFile i_basename
/OutputDevice (pngalpha)
/TextAlphaBits 4
/GraphicsAlphaBits 4
% /BackgroundColor 16777215
% /BackgroundColor 0
/PageUsesTransparency true
/HWResolution [ 72 72 ]
/ProcessColorModel /DeviceRGB
/PageSize [i_w i_h]
/pngalpha finddevice putdeviceprops setdevice
setcolorspace setcolor
% matrix currentmatrix ==
% 0 0 transform exch = =
% 1 1 transform exch = =
i_dict i_w i_h matrix identmatrix scale
%matrix identmatrix
//makepattern setpattern
0 0 i_w i_h rectfill
showpage
grestore
% create pattern with our extensions:
i_dict dup /ExportFile i_basename put
dup /Origin [ 0 0 transform ] put
i_m //makepattern
/i_shortcut false store
%/makepatternE =
} i_shortcutOverload
/writecurrentpattern
{
currentcolor
(pat ) print
dup /Origin get
dup 0 get i_hscale div i_str cvs print ( ) print
1 get i_vscale div i_str cvs print ( ) print
/ExportFile get print
(\n) print
} bind def
/writecurrentcmykcolor
{
currentcmykcolor % -> c m y k
(co )print
3 index i_str cvs print
( ) print
2 index i_str cvs print
( ) print
1 index i_str cvs print
( ) print
i_str cvs print
( ) print
pop pop pop
.currentopacityalpha % a
i_str cvs print
(\n) print
} bind def
/writecurrentrgbcolor
{
currentrgbcolor % -> r g b
(corgb )print
2 index i_str cvs print
( ) print
1 index i_str cvs print
( ) print
i_str cvs print
( ) print
pop pop
.currentopacityalpha % a
i_str cvs print
(\n) print
} bind def
/writecurrentcolor
{
currentcolorspace 0 get
% try to find a base colorspace first
dup /Indexed eq
{
pop
currentcolorspace 1 get
dup type /arraytype eq { 0 get } if
} if
dup dup /DeviceN eq exch /Separation eq or
{
pop
currentcolorspace 2 get
dup type /arraytype eq { 0 get } if
} if
% now write values
dup /CIEBasedABC eq
{ % this must be a hack....
gsave
currentcolor setrgbcolor
writecurrentrgbcolor
grestore
} {
dup /DeviceRGB eq
{
writecurrentrgbcolor
} {
dup dup /DeviceCMYK eq exch /DeviceGray eq or
{
writecurrentcmykcolor
} {
dup /Pattern eq
{
writecurrentpattern
} {
% TODO: other CIE
writecurrentrgbcolor % will always be 0
}
ifelse } ifelse } ifelse } ifelse
pop
} bind def
/writecurrentlinecap
{
(lc ) print
currentlinecap i_str cvs print
(\n) print
} bind def
/writecurrentlinejoin
{
(lj ) print
currentlinejoin i_str cvs print
(\n) print
} bind def
/writecurrentdash
{
(ld ) print
currentdash 1 index length i_str cvs print ( ) print i_str cvs print ( ) print
0 1 2 index length 1 sub
{
1 index exch get
storeMatrix
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
i_hscale div
i_str cvs print ( ) print
} for
pop
(\n) print
} bind def
/writecurrentlinewidth
{
userdict begin
currentlinewidth % w
storeMatrix
% (wb + wd + wa + wc) / 2
%??
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
i_hscale div
% transform (w,w) and take length
%av-test: dup dtransform i_vscale div dup mul exch i_hscale div dup mul add sqrt
(w ) print
i_str cvs print
(\n) print
end
} bind def
/i_move % x y
{
userdict begin
(m\n) print
/currentY exch def
/currentX exch def
/beginX currentX def
/beginY currentY def
end
} bind def
/i_line
{
userdict begin
/y1 exch def
/x1 exch def
% x x1 ne y y1 ne or
currentX x1 sub abs 0.001 gt currentY y1 sub abs 0.001 gt or
{
(l ) print
currentX currentY matrix_x i_str cvs print
( ) print
currentX currentY matrix_y i_str cvs print
( ) print
x1 y1 matrix_x i_str cvs print
( ) print
x1 y1 matrix_y i_str cvs print
(\n) print
/currentX x1 def
/currentY y1 def
}if
end
} bind def
/i_curve
{
userdict begin
% x1 y1 x2 y2 x3 y3
(c ) print
currentX currentY matrix_x i_str cvs print
( ) print
currentX currentY matrix_y i_str cvs print
( ) print
5 index 5 index matrix_x i_str cvs print
( ) print
5 index 5 index matrix_y i_str cvs print
( ) print
3 index 3 index matrix_x i_str cvs print
( ) print
3 index 3 index matrix_y i_str cvs print
( ) print
/currentY exch def
/currentX exch def
currentX currentY matrix_x i_str cvs print
( ) print
currentX currentY matrix_y i_str cvs print
(\n)print
pop pop pop pop
end
} bind def
% modified: 18.10.96
/i_close
{
(cp\n) print
beginX beginY i_line
} bind def
/storeMatrix
{
userdict begin
matrix currentmatrix
dup 0 get /m_a exch def
dup 1 get /m_b exch def
dup 2 get /m_c exch def
dup 3 get /m_d exch def
dup 4 get /m_x exch def
5 get /m_y exch def
end
} bind def
/pathClipAndClose % this is not nice: closes all open paths & flattens the path :-(
{
clipsave
clip % combine clippath and path
newpath clippath % copy (closed) clippath to path
cliprestore
} bind def
% find out if the point is within the clipping area
/i_in_clip % x y i_in_clip bool
{
gsave
newpath clippath
infill
grestore
} bind def
% find out if two points are within the clipping area
/i_in_clip2 % x1 y1 x2 y2 i_in_clip bool1 bool2
{
gsave
newpath clippath
infill % x1 y1 bool2
3 1 roll % bool2 x1 y1
infill % bool2 bool1
exch
grestore
} bind def
/i_clip_move
{
/beginY exch store
/beginX exch store
/currentX beginX store
/currentY beginY store
% test if within cliparea
currentX currentY i_in_clip
{
currentX currentY /moveto load
} if
} bind def
% find intersection with line x1,y1 -> x2,y2 with clip path.
% x1,y2 is outside the clip area, x2, y2, x3, y3 inside
/i_find_clip_intersect % x1 y1 x2 y2 i_find_clip_intersect x3 y3
{
3 index 2 index sub % x1 y1 x2 y2 dx
3 index 2 index sub % x1 y1 x2 y2 dx dy
gsave
newpath clippath
{
2 div exch 2 div exch % half interval
2 copy abs 0.01 lt exch abs 0.01 lt and
{ exit } if % done
2 copy 4 index add exch % x1 y1 x2 y2 dx dy (y2+dy) dx
5 index add exch % x1 y1 x2 y2 dx dy (x2+dx) (y2+dy)
% /Intersect = 7 index = 6 index = 5 index = 4 index = 3 index = 2 index = 1 index = 0 index =
2 copy infill
{ % replace x2,y2
6 -2 roll pop pop
4 2 roll
} {
8 -2 roll pop pop % replace x1,y1
6 2 roll
} ifelse
} loop
grestore
6 -2 roll % return x2,y2
4 { pop } repeat
} bind def
/i_clip_line
{
/endY exch store
/endX exch store
currentX currentY endX endY i_in_clip2
{ % end in
{
% both in. just draw it. FIXME check if line leaves cliparea
endX endY /lineto load
} {
% current not in
% find new current point
currentX currentY endX endY i_find_clip_intersect
/moveto load
endX endY /lineto load
} ifelse
} { % end not in
{ % current in
% find new endpoint
endX endY currentX currentY i_find_clip_intersect
/lineto load
} {
% both not in
% try to find a point within cliparea
currentX currentY endX endY i_find_clip_intersect
2 copy i_in_clip
{
% yeah
/moveto load
% now find point from other end
endX endY currentX currentY i_find_clip_intersect
/lineto load
} {
pop pop
} ifelse
} ifelse
} ifelse
/currentX endX store
/currentY endY store
} bind def
/pathClipForStroke
{
% only lines
flattenpath
% create a userpath from currentpath
userdict begin
/beginX 0 def /beginY 0 def
/currentX 0 def /currentY 0 def
/endX 0 def /endY 0 def
systemdict begin % some EPS redefine moveto & Co :-(
[
{ i_clip_move } % remember last move
{ i_clip_line } % clip lines individually
{ 6 {pop} repeat /OOPS = } % won't happen
{ beginX beginY i_clip_line } % close with line
pathforall
] cvx
% dup ==
newpath % uappend % userpaths SUCK!
end end
exec
} bind def
/rectfill
{
userdict begin
(n\n)print % start polygon
writecurrentcolor
writecurrentlinewidth
writecurrentlinecap
writecurrentlinejoin
writecurrentdash
storeMatrix
% x y width height
dup type /arraytype ne
{
/hr exch def
/wr exch def
/yr exch def
/xr exch def
xr yr i_move
xr wr add yr i_line
xr wr add yr hr add i_line
xr yr hr add i_line
xr yr i_line
}
% numarray
% numstring
{
/ar exch def
0 4 ar length 1 sub
{
/n exch def
ar n get /xr exch def
ar n 1 add get /yr exch def
ar n 2 add get /wr exch def
ar n 3 add get /hr exch def
xr yr i_move
xr wr add yr i_line
xr wr add yr hr add i_line
xr yr hr add i_line
xr yr i_line
} for
}ifelse
(f\n)print % close polygon
end
} i_shortcutOverload
/rectstroke
{
userdict begin
(n\n)print % start rect
writecurrentcolor
writecurrentlinewidth
writecurrentlinecap
writecurrentlinejoin
writecurrentdash
storeMatrix
% x y width height
dup type dup /arraytype ne exch /stringtype ne and
{
/hr exch def
/wr exch def
/yr exch def
/xr exch def
xr yr i_move
xr wr add yr i_line
xr wr add yr hr add i_line
xr yr hr add i_line
xr yr i_line
}
% numarray
% numstring
{
/ar exch def
0 4 ar length 1 sub
{
/n exch def
ar n get /xr exch def
ar n 1 add get /yr exch def
ar n 2 add get /wr exch def
ar n 3 add get /hr exch def
xr yr i_move
xr wr add yr i_line
xr wr add yr hr add i_line
xr yr hr add i_line
xr yr i_line
} for
}ifelse
(n\n)print % stroke rect
end
} i_shortcutOverload
/stroke
{
(n\n) print
writecurrentcolor
writecurrentlinewidth
writecurrentlinecap
writecurrentlinejoin
writecurrentdash
clipCnt 1 eq
{ pathClipForStroke } if
storeMatrix
{i_move} {i_line} {i_curve} {i_close} pathforall
(s\n)print % stroke path
newpath
} i_shortcutOverload
/eofill
{
(n\n) print % start polygon
writecurrentcolor % write color
writecurrentlinewidth
writecurrentlinecap
writecurrentlinejoin
writecurrentdash
clipCnt 1 eq
{ pathClipAndClose } if
storeMatrix % take transformation, scaling, rotation from PostScript
{i_move} {i_line} {i_curve} {i_close} pathforall
(f\n)print % close polygon
newpath % clear stack
} i_shortcutOverload
/fill
{
(fill-winding\n) print
eofill
(fill-evenodd\n) print
} i_shortcutOverload
/clip
{
userdict begin
(n\n)print % start clip polygon
% FIXME: pathClipAndClose first?
storeMatrix % take transformation, scaling, rotation from PostScript
{i_move} {i_line} {i_curve} {i_close} pathforall
(ci\n)print % close clip polygon begin path
% we have to close the path!!
clip
/clipCnt 1 def
newpath % clear stack
end
} i_shortcutOverload
% we don't clip
% because this doesn't work for flattening text (show, charpath) with NeXT PostScript Code
/rectclip
{
% let Scribus decide what to do with ci; was: pop pop pop pop
userdict begin
(n\n)print % start clip polygon
storeMatrix % take transformation, scaling, rotation from PostScript
dup type dup /arraytype ne exch /stringtype ne and
{
4 copy
/i_h exch def
/i_w exch def
/i_y exch def
/i_x exch def
i_x i_y i_move
i_x i_w add i_y i_line
i_x i_w add i_y i_h add i_line
i_x i_y i_h add i_line
} {
% array or string
0 4 dup length 1 sub
{
1 index 1 index get /i_x exch def
1 add
1 index 1 index get /i_y exch def
1 add
1 index 1 index get /i_w exch def
1 add
1 index 1 index get /i_y exch def
i_x i_y i_move
i_x i_w add i_y i_line
i_x i_w add i_y i_h add i_line
i_x i_y i_h add i_line
} for
} ifelse
(ci\n)print % close clip polygon begin path
% we have to close the path!!
rectclip
/clipCnt 1 def
newpath % clear stack
end
} i_shortcutOverload
% Copyright (C) 1994 Aladdin Enterprises. All rights reserved.
%
% This software is provided AS-IS with no warranty, either express or
% implied.
%
% This software is distributed under license and may not be copied,
% modified or distributed except as expressly authorized under the terms
% of the license contained in the file LICENSE in this distribution.
%
% For more information about licensing, please refer to
% http://www.ghostscript.com/licensing/. For information on
% commercial licensing, go to http://www.artifex.com/licensing/ or
% contact Artifex Software, Inc., 101 Lucas Valley Road #110,
% San Rafael, CA 94903, U.S.A., +1(415)492-9861.
% $Id: import.prolog,v 1.4.2.18.2.1 2006/11/23 13:45:38 fschmid Exp $
% traceimg.ps
% Trace the data supplied to the 'image' operator.
% This code currently handles only the (Level 2) dictionary form of image,
% with a single data source and 8-bit pixels.
% changed for Scribus image import by Andreas Vox, 2006-2-21
% added support for colorimage and other image variant
/i_image % <dict> i_image -
{
/i_image =
begin
/i_left Width Height mul Decode length 2 idiv mul BitsPerComponent mul 8 idiv dup /i_size exch store store
/i_dict currentdict store
/i_nsources 1 store
/i_source 0 store
/i_datasource currentdict /DataSource get store
currentdict /MultipleDataSources known not
{ /MultipleDataSources false def } if
MultipleDataSources
{
/i_nsources DataSource length store
/i_datasource DataSource 0 get store
} if
end
storeMatrix
i_dict /ImageMatrix get matrix invertmatrix matrix currentmatrix matrix concatmatrix /i_m exch def
i_dict /Width get 0 i_m dtransform dup mul exch dup mul add sqrt /i_w exch def
0 i_dict /Height get i_m dtransform dup mul exch dup mul add sqrt /i_h exch def
0 0 i_m transform /i_y exch def /i_x exch def
i_dict /Width get i_dict /Height get i_m transform
/i_hflip -1 def /i_vflip 1 def
dup i_y le { /i_y exch def } { pop /i_vflip -1 def } ifelse
dup i_x le { /i_x exch def } { pop /i_hflip 1 def } ifelse
0 i_dict /Height get i_m dtransform atan
/i_angle exch def
(.dat) i_exportfilename
(im ) print % im x y w h angle ...
i_x i_hscale div i_str cvs print ( ) print
i_y i_vscale div i_str cvs print ( ) print
i_w i_hscale div i_str cvs print ( ) print
i_h i_vscale div i_str cvs print ( ) print
i_angle i_str cvs print ( ) print
i_dict /Width get i_str cvs print ( ) print % ... hpix vpix ...
i_dict /Height get i_str cvs print ( ) print
currentcolorspace 0 get /DeviceRGB eq
{ (tiff24nc ) print }
{ currentcolorspace 0 get /DeviceCMYK eq
{ (psdcmyk ) print }
{ currentcolorspace 0 get /DeviceGray eq
{ (tiffgray ) print }
{ (tiff32nc ) print }
ifelse } ifelse } ifelse
dup (.tif) concatenate print (\n) print flush % ... dev filename
(.dat) concatenate (w) file /i_file exch store % temp file
currentcolorspace ==write ( setcolorspace\n) =write
(<<\n) =write
i_dict { exch
dup /DataSource eq
{ pop pop (/DataSource currentfile\n) =write }
{
dup /ImageMatrix eq
{ pop pop (/ImageMatrix [) =write
i_hflip ==write ( 0 0 ) =write i_vflip ==write
( ) =write
i_hflip 0 lt { i_dict /Width get } { 0 } ifelse ==write
( ) =write
i_vflip 0 lt { i_dict /Height get} { 0 } ifelse ==write
(]\n) =write }
{ ==write ( ) =write ==write (\n) =write }
ifelse
} ifelse
} forall
(>>\nimage\n) =write i_file flushfile
{ %loop
i_left 0 le
{
i_source 1 add /i_source exch def
i_source i_nsources ge { exit } if
i_dict /DataSource get i_source get /i_datasource exch def
/i_left i_size def
} if
/i_datasource load exec
dup type /filetype eq
{ i_buf 0 i_left 32 .min getinterval readstring pop
} if
dup i_file exch writestring
i_left exch length sub /i_left exch def
} loop
i_file flushfile
/i_imageE =
} bind def
/colorimage
{
/colorimage =
% width height bits/sample matrix datasource0..n-1 multi ncomp
/tmpN exch def
/tmpMulti exch def
tmpMulti
{
/tmpN load array astore
} if
/tmpN load 6 add dict
dup 7 -1 roll /Width exch put
dup 6 -1 roll /Height exch put
dup 5 -1 roll /BitsPerComponent exch put
dup 4 -1 roll /ImageMatrix exch put
dup 3 -1 roll /DataSource exch put
tmpMulti
{
dup /MultipleDataSources true put
} if
dup /ImageType 1 put
gsave
/tmpN load
dup 1 eq
{
1 index /Decode [0 1] /Decode put
/DeviceGray setcolorspace
} if
dup 3 eq
{
1 index /Decode [0 1 0 1 0 1] put
/DeviceRGB setcolorspace
} if
dup 4 eq
{
1 index /Decode [0 1 0 1 0 1 0 1] put
/DeviceCMYK setcolorspace
} if
pop
i_image
grestore
/colorimageE =
} i_shortcutOverload
/image {
/image =
gsave
dup type /dicttype ne
{
% width height bits/sample matrix datasource
7 dict
dup 7 -1 roll /Width exch put
dup 6 -1 roll /Height exch put
dup 5 -1 roll /BitsPerComponent exch put
dup 4 -1 roll /ImageMatrix exch put
dup 3 -1 roll /DataSource exch put
dup 1 /ImageType exch put
dup [0 1] /Decode exch put
/DeviceGray setcolorspace
} if
i_image
grestore
/imageE =
} i_shortcutOverload
/imagemask
{
/imagemask =
writecurrentcolor
(mask\n) print
gsave
dup type /dicttype ne
{
% width height pol matrix datasource
7 dict
dup 7 -1 roll /Width exch put
dup 6 -1 roll /Height exch put
dup 5 -1 roll { [0 1] } { [1 0] } ifelse /Decode exch put
dup 4 -1 roll /ImageMatrix exch put
dup 3 -1 roll /DataSource exch put
} if
dup 1 /ImageType exch put
dup 1 /BitsPerComponent exch put
/DeviceGray setcolorspace
i_image
grestore
/imagemaskE =
} i_shortcutOverload
% declare some global vars
/i_left 0 def
/i_size 0 def
/i_dict null def
/i_buf 32 string def
/i_nsources 1 def
/i_source 0 def
/i_datasource { (x) } def
/i_file null def
/i_filecount 1 def
%%%% End of traceimage code
/stateArray 500 array def
/stateTop 0 def
/gsave
{
userdict begin
% (gs\n) print
stateArray stateTop gstate currentgstate put
/stateTop stateTop 1 add def
end
} i_shortcutOverload
/grestore
{
userdict begin
stateTop 1 lt
{
}
{
% (gr\n) print
stateArray stateTop 1 sub get setgstate
/stateTop stateTop 1 sub def
stateArray stateTop 0 put
}ifelse
end
} i_shortcutOverload
% a bind def of the show operator doesn't work,
% so this is our way to get a charpath entry for flattening text
/root_charpath
{
charpath
} bind def
/i_kerningI
{
exch 1 getinterval stringwidth
} bind def
% find kerning value
/i_kerningII % index string i_kerning dx dy
{
% stringwidth( [n..n+1] ) - stringwidth( [n+1] )
/i_pstring exch def
/i_pindex exch def
i_pstring i_pindex 2 getinterval stringwidth exch % y2 x2
i_pstring i_pindex 1 add 1 getinterval stringwidth % y2 x2 x1 y1
4 1 roll sub % y1 y2 (x2-x1)
3 1 roll exch sub % (x2-x1) (y2-y1)
} bind def
/i_kerningIII % index string i_kerning dx dy
{
% stringwidth( [n..n+1] ) - stringwidth( [n+1] )
/i_pstring exch def
/i_pindex exch def
i_pstring i_pindex 2 getinterval (l) exch concatenate stringwidth exch % y2 x2
i_pstring i_pindex 1 add 1 getinterval (l) exch concatenate stringwidth % y2 x2 x1 y1
4 1 roll sub % y1 y2 (x2-x1)
3 1 roll exch sub % (x2-x1) (y2-y1)
} bind def
/i_kerning /i_kerningII load def
/show % string show -
{
userdict begin
storeMatrix
currentfont /FontName known
% stack: string
{
currentpoint /ycur exch def /xcur exch def
currentpoint % x y
newpath
/clipCnt 0 def
moveto
/completeString exch def
% we process each char separately to get smaller paths
0 1 completeString length 1 sub
{
(n\n)print % start polygon
writecurrentcolor % write color
storeMatrix
dup completeString length 1 sub eq
{ dup completeString exch 1 getinterval stringwidth }
{ dup completeString i_kerning } ifelse
/curwidthy exch def /curwidthx exch def
completeString exch 1 getinterval dup /curstr exch def
false root_charpath
{i_move} {i_line} {i_curve} {i_close} pathforall
(f\n)print % close polygon
newpath
curwidthx xcur add curwidthy ycur add moveto
currentpoint /ycur exch def /xcur exch def
newpath % clear graphic stack
xcur ycur moveto
} for
currentpoint % x y
newpath % clear graphic stack (and current point)
moveto
} {
pop % string
} ifelse
end
} i_shortcutOverload
/ashow
{
% ax ay string
exch /ydist exch def
exch /xdist exch def
userdict begin
storeMatrix
currentfont /FontName known
% stack: string
{
currentpoint /ycur exch def /xcur exch def
currentpoint % x y
newpath
/clipCnt 0 def
moveto
/completeString exch def
% we process each char separately to get smaller paths
0 1 completeString length 1 sub
{
(n\n)print % start polygon
writecurrentcolor % write color
storeMatrix
dup completeString length 1 sub eq
{ dup completeString exch 1 getinterval stringwidth }
{ dup completeString i_kerning } ifelse
/curwidthy exch def /curwidthx exch def
completeString exch 1 getinterval dup /curstr exch def
false root_charpath
{i_move} {i_line} {i_curve} {i_close} pathforall
(f\n)print % close polygon
newpath
curwidthx xcur add curwidthy ycur add
exch xdist add exch ydist add moveto
currentpoint /ycur exch def /xcur exch def
newpath % clear graphic stack
xcur ycur moveto
} for
currentpoint % x y
newpath % clear graphic stack (and current point)
moveto
} {
pop
} ifelse
end
} i_shortcutOverload
/awidthshow % cx cy char ax ay string
{
% ax ay string
exch /ydist exch def
exch /xdist exch def
% cx cy char string
exch /char exch def
exch /cydist exch def
exch /cxdist exch def
userdict begin
storeMatrix
currentfont /FontName known
% stack: string
{
currentpoint /ycur exch def /xcur exch def
currentpoint % x y
newpath
/clipCnt 0 def
moveto
/completeString exch def
% we process each char separately to get smaller paths
0 1 completeString length 1 sub
{
(n\n)print % start polygon
writecurrentcolor % write color
storeMatrix
dup completeString length 1 sub eq
{ dup completeString exch 1 getinterval stringwidth }
{ dup completeString i_kerning } ifelse
/curwidthy exch def /curwidthx exch def
completeString exch 1 getinterval dup /curstr exch def
false root_charpath
{i_move} {i_line} {i_curve} {i_close} pathforall
(f\n)print % close polygon
newpath
curwidthx xcur add curwidthy ycur add
exch xdist add exch ydist add moveto
curstr 0 get char eq
{
currentpoint exch cxdist add exch cydist add moveto
} if
currentpoint /ycur exch def /xcur exch def
newpath % clear graphic stack
xcur ycur moveto
} for
currentpoint % x y
newpath % clear graphic stack (and current point)
moveto
} {
pop
} ifelse
end
} i_shortcutOverload
/widthshow % cx cy char string
{
0 exch
0 exch
awidthshow
} bind def
/cshow % proc string
{
exch pop
show
} i_shortcutOverload
/kshow % proc string
{
dup length 1 sub
dup 0 ne
{
1 index 0 1 getinterval
show
1 sub
dup 0 ne
{
1 add
1 exch 1 exch
{
dup 1 sub
2 index exch get
2 index 2 index get
4 index exec
1 index exch 1 getinterval
show
} for
} if
}
{
pop dup show
} ifelse
pop pop
} i_shortcutOverload
/xshow % string array
{
pop %FIXME
show
} i_shortcutOverload
/xyshow % string array
{
pop %FIXME
show
} i_shortcutOverload
/yshow % string array
{
pop %FIXME
show
} i_shortcutOverload
/i_reencode % newfontname reencodevector origfontdict -> i_reencode -> newfontdict
{
userdict begin
dup begin dup maxlength dict begin
{ 1 index /FID ne {def} {pop pop} ifelse
} forall
/Encoding exch def
currentdict
end end
definefont
end
} bind def
/glyphshow {
save % So can reclaim VM from reencoding
currentfont /Encoding get dup length array copy dup 0 5 -1 roll put
/GlyphShowTempFont exch currentfont i_reencode
setfont
(\000) show
restore
} i_shortcutOverload
/showpage
{
(sp\n) print
} i_shortcutOverload