Nothing
R/PostScript2RGML.R
In grImport: Importing Vector Graphics
Defines functions
PostScriptTrace
postProcess
processNUL
PScaptureHead
Documented in
PostScriptTrace
# Function to extract outlines from PostScript paths
PScaptureText <- c()
PScaptureChars <- c()
PScaptureHead <- function(file, charpath, charpos, setflat, encoding,
scaleEPS) {
c("%!PS-Adobe-2.0 EPSF-1.2",
"%%BeginProcSet:convertToR 0 0",
# XML file header info
sprintf("(<?xml version='1.0' encoding='%s' ?>\n\n) print",
encoding),
paste("(<picture version='3' xmlns:rgml='http://r-project.org/RGML'",
" source='", file, "'",
" date='", as.character(Sys.time()), "'",
" creator='R (", R.Version()$major, ".", R.Version()$minor, ")'",
" >\n\n) print", sep=""),
# useful definitions
# Define my counters GLOBALLY so the postscript
# file I run cannot reset my counters with a restore!
"true setglobal",
"/convertToR dup 100 dict def load begin",
"/id 1 def",
# Do these need to be even "larger"?
"/xmax -99999 def",
"/xmin 99999 def",
"/ymax -99999 def",
"/ymin 99999 def",
# Start with x, y and end with dw
"/transwidth {",
" transform",
" 0 0 transform",
" 2 index exch sub", # dy
" 3 index 2 index sub", # dx
" 2 exp exch 2 exp add sqrt",
" 3 1 roll pop pop pop",
" } def",
# bounding box processing
"/boxinit {",
" convertToR /bxmax -99999 put",
" convertToR /bxmin 99999 put",
" convertToR /bymax -99999 put",
" convertToR /bymin 99999 put",
" } def",
"/boxmove {",
" transform",
" dup",
" convertToR exch /cury exch put",
" dup",
" convertToR /bymin get lt {convertToR /bymin cury put} if",
" convertToR /bymax get gt {convertToR /bymax cury put} if",
" dup",
" convertToR exch /curx exch put",
" dup",
" convertToR /bxmin get lt {convertToR /bxmin curx put} if",
" convertToR /bxmax get gt {convertToR /bxmax curx put} if",
" } def",
"/boxline {",
" transform",
" dup",
" convertToR exch /cury exch put",
" dup",
" convertToR /bymin get lt {convertToR /bymin cury put} if",
" convertToR /bymax get gt {convertToR /bymax cury put} if",
" dup",
" convertToR exch /curx exch put",
" dup",
" convertToR /bxmin get lt {convertToR /bxmin curx put} if",
" convertToR /bxmax get gt {convertToR /bxmax curx put} if",
" } def",
"/boxcurve {",
" } def",
"/boxclose {",
" } def",
# Update global bbox from bbox
"/boxupdate {",
" convertToR /bymin get convertToR /ymin get lt {convertToR /ymin convertToR /bymin get put} if",
" convertToR /bymax get convertToR /ymax get gt {convertToR /ymax convertToR /bymax get put} if",
" convertToR /bxmin get convertToR /xmin get lt {convertToR /xmin convertToR /bxmin get put} if",
" convertToR /bxmax get convertToR /xmax get gt {convertToR /xmax convertToR /bxmax get put} if",
" } def",
# Font height calculation (for *current* font)
"/fontsize {",
# DO NOT just 'get' the third element of FontMatrix
# because the font may, e.g., rotate the font outlines
" currentfont /FontMatrix get",
# For Type 1 fonts, scale the matrix by 1000
# (see PLRM.pdf version 3 page 324; comment on FontMatrix)
# For Type 42 (TrueType), no multiplier necessary
# (http://www.adobe.com/devnet/font/pdfs/5012.Type42_Spec.pdf)
# For other font types, not sure what the initial font matrix is
# COPY the FontMatrix to avoid 'invalidaccess'
" currentfont /FontType get 1 eq { 1000 1000 matrix scale matrix concatmatrix } if",
# Transform (0, 1) using this matrix, then transform to user coords
" dup 0 exch 1 exch transform transform",
# Do the same to (0, 0)
" 2 index 0 exch 0 exch transform transform",
# dy
" 2 index exch sub",
# dx
" 3 index 2 index sub",
" 2 exp exch 2 exp add sqrt",
# clean up
" 5 1 roll pop pop pop pop",
" } def",
# path processing
"/mymove {",
" 1 dict begin",
" /str 50 string def",
" (\t<move) print",
" transform",
" dup",
" convertToR exch /ystart exch put",
" dup",
" convertToR exch /cury exch put",
" dup",
" convertToR /ymin get lt {convertToR /ymin cury put} if",
" dup",
" convertToR /ymax get gt {convertToR /ymax cury put} if",
" ( y=') print str cvs print (') print",
" dup",
" convertToR exch /xstart exch put",
" dup",
" convertToR exch /curx exch put",
" dup",
" convertToR /xmin get lt {convertToR /xmin curx put} if",
" dup",
" convertToR /xmax get gt {convertToR /xmax curx put} if",
" ( x=') print str cvs print (') print",
" (/>\n) print",
" end",
"} def",
"/myline {",
" 1 dict begin",
" /str 50 string def",
" (\t<line) print",
" transform",
" dup",
" convertToR exch /cury exch put",
" dup",
" convertToR /ymin get lt {convertToR /ymin cury put} if",
" dup",
" convertToR /ymax get gt {convertToR /ymax cury put} if",
" ( y=') print str cvs print (') print",
" dup",
" convertToR exch /curx exch put",
" dup",
" convertToR /xmin get lt {convertToR /xmin curx put} if",
" dup",
" convertToR /xmax get gt {convertToR /xmax curx put} if",
" ( x=') print str cvs print (') print",
" (/>\n) print",
" end",
" } def",
"/mycurve {",
" } def",
"/myclose {",
" 1 dict begin",
" /str 50 string def",
# Convert 'closepath' to 'lineto'
# " (\t<close/>\n) print",
" (\t<line) print",
" ( y=') print convertToR /ystart get str cvs print (') print",
" ( x=') print convertToR /xstart get str cvs print (') print",
" (/>\n) print",
" end",
" } def",
# echoing graphics state
"/printcol {",
# What colorspace are we in?
# Return colorspace array and extract
# first element which is colorspace name
" currentcolorspace 0 get",
# If it's DeviceRGB or DeviceGray or DeviceCMYK we're ok
# Separation and Pattern are special cases that are currently handled
# by just specifying "grey" as the colour
# Otherwise we "hail mary" and hope that currencolor throws back 3 values
# that can be interpreted as RGB (e.g., R's sRGB!)
" dup dup (Separation) eq exch (Pattern) eq or {pop 0.5 0.5 0.5} {dup (DeviceGray) eq exch dup (DeviceRGB) eq exch (DeviceCMYK) eq or or {currentrgbcolor} {currentcolor} ifelse} ifelse",
" (\t\t<rgb) print",
# make sure the colour is RGB not BGR
" ( r=') print 2 index str cvs print (') print",
" ( g=') print 1 index str cvs print (') print",
" ( b=') print str cvs print (') print",
" (/>\n) print",
" pop pop",
" } def",
"/printlwd {",
# lwd is in user coords so transform
# This will need transforming to a grDevices "lwd" in R
" currentlinewidth 0 transform",
" 0 0 transform",
" 3 index 2 index sub", # dx
" 3 index 2 index sub", # dy
" 2 exp exch 2 exp add sqrt",
# clean up
" 5 1 roll pop pop pop pop",
" ( lwd=') print str cvs print (') print",
"} def",
"/printlineend {",
" ( lineend=') print currentlinecap str cvs print (') print",
"} def",
"/printlinejoin {",
" ( linejoin=') print currentlinejoin str cvs print (') print",
"} def",
"/printlinemiter {",
" ( linemitre=') print currentmiterlimit str cvs print (') print",
"} def",
"/printdash {",
" currentdash",
# Like lwd, transform user coords
# Ignore offset
" ( lty=') print pop {0 transform pop 0 0 transform pop sub str cvs print ( ) print} forall (') print",
"} def",
"/printstyle {",
" (\t\t<style) print",
" printlwd",
" printdash",
" printlineend",
" printlinemiter",
" printlinejoin",
" (/>\n) print",
"} def",
# print out "closestroke" marker plus graphics state info
"/mystroke {",
" 1 dict begin",
" /str 50 string def",
" (<path type='stroke') print",
" ( id=') print convertToR /id get str cvs print ('>\n) print",
" (\t<context>\n) print",
" printcol ",
" printstyle",
" (\t</context>\n\n) print",
" pathforall",
" convertToR /id get 1 add convertToR exch /id exch put",
" (</path>\n\n) print",
" end",
"} def",
"/myfill {",
" 1 dict begin",
" /str 50 string def",
" (<path type='fill') print",
" ( id=') print convertToR /id get str cvs print ('>\n) print",
" (\t<context>\n) print",
" printcol",
" printstyle",
" (\t</context>\n\n) print",
" pathforall",
" convertToR /id get 1 add convertToR exch /id exch put",
" (</path>\n\n) print",
" end",
"} def",
"/myeofill {",
" 1 dict begin",
" /str 50 string def",
" (<path type='eofill') print",
" ( id=') print convertToR /id get str cvs print ('>\n) print",
" (\t<context>\n) print",
" printcol",
" printstyle",
" (\t</context>\n\n) print",
" pathforall",
" convertToR /id get 1 add convertToR exch /id exch put",
" (</path>\n\n) print",
" end",
"} def",
"/mytext {",
" 1 dict begin",
" /str 50 string def",
" (<text ) print",
" ( id=') print convertToR /id get str cvs print (') print",
" convertToR /id get 1 add convertToR exch /id exch put",
# Insert MARKS here so that postProcess() can easily locate strings
" ( string='###TEXT) print dup print (###TEXT') print",
# Type of text element
if (charpath) {
" ( type='charpath') print"
} else if (charpos) {
" ( type='char') print"
} else {
" ( type='text') print"
},
# Calculate any width adjustments
" convertToR /widthadjfun get cvx exec",
# (x, y) location of text
" currentpoint",
" transform",
" dup",
" convertToR exch /cury exch put",
" dup",
" convertToR /ymin get lt {convertToR /ymin cury put} if",
" dup",
" convertToR /ymax get gt {convertToR /ymax cury put} if",
" ( y=') print str cvs print (') print",
" dup",
" convertToR exch /curx exch put",
" dup",
" convertToR /xmin get lt {convertToR /xmin curx put} if",
" dup",
" convertToR /xmax get gt {convertToR /xmax curx put} if",
" ( x=') print str cvs print (') print",
# width of text
" dup stringwidth",
# stringwidth has put wx and wy on stack
# If wy is non-zero, text is at an angle
" dup 0 ne { 1 index 1 index exch atan } { 0 } ifelse",
# Save this angle
" convertToR exch /curangle exch put",
# Calculate user-space width from wx and wy
" 2 exp exch 2 exp add sqrt",
# Transform user-space width to device
" 0 transform",
# Subtract (0, 0)[x]
" exch 0 0 transform pop sub",
# Subtract (0, 0)[y]
" exch 0 0 transform exch pop sub",
# If transformed y is non-zero then text is at an angle
" dup 0 ne { 1 index 1 index exch atan } { 0 } ifelse",
# Save user-space angle plus angle
" convertToR /curangle get add convertToR exch /curangle exch put",
# Record user-space angle plus angle
" ( angle=') print",
" convertToR /curangle get str cvs print (') print",
# Calculate device width
" 2 exp exch 2 exp add sqrt",
# Make any adjustments
" convertToR /curadj get add",
# Print width
" ( width=') print",
" str cvs print (') print",
# Height of text (size of current font)
# Print height
" ( height=') print",
" fontsize str cvs print (') print",
# Calculate text bb
" convertToR /bboxfun get cvx exec",
# Record bbox
" ( bbox=') print",
" convertToR /bxmin get str cvs print ( ) print",
" convertToR /bymin get str cvs print ( ) print",
" convertToR /bxmax get str cvs print ( ) print",
" convertToR /bymax get str cvs print (') print",
# Record font (if available)
" currentfont /FontName known",
" { ( fontName=') print currentfont /FontName get str cvs print (') print} if",
" currentfont /FontInfo known",
" { currentfont /FontInfo get /FamilyName known",
" { ( fontFamilyName=') print currentfont /FontInfo get /FamilyName get print (') print } if } if",
" currentfont /FontInfo known",
" { currentfont /FontInfo get /FullName known",
" { ( fontFullName=') print currentfont /FontInfo get /FullName get print (') print } if } if",
" (>\n) print",
# Graphics context
" (\t<context>\n) print",
" printcol",
" printstyle",
" (\t</context>\n\n) print",
# If charpath or charloc, need to nest additional elements
if (charpath) {
"convertToR /charpathfun get cvx exec"
} else if (charpos) {
"convertToR /charfun get cvx exec"
},
" (</text>\n\n) print",
" end",
"} def",
"/mychar {",
" 1 dict begin",
" /str 50 string def",
" (<path type='char') print",
" ( id=') print convertToR /id get str cvs print (') print",
# Insert MARKS here so that postProcess() can easily locate strings
" ( char='###TEXT) print 4 index print (###TEXT' >\n) print",
" pathforall",
" (\t<context>\n) print",
" printcol",
" printstyle",
" (\t</context>\n\n) print",
" convertToR /id get 1 add convertToR exch /id exch put",
" (</path>\n\n) print",
" end",
"} def",
"/checkskew {",
## load individual elements of CTM onto stack (and name them)
## https://stackoverflow.com/questions/11777305/postscript-discover-rotate-scale-value
" matrix currentmatrix aload pop",
## calculate xscale and yscale
## https://stackoverflow.com/questions/20422392/given-a-2d-transformation-matrix-how-to-calculate-the-scalings-skews-rotation
## a, b, c, d, tx, ty
" pop pop",
## a, b, c, d
" dup mul exch dup mul add sqrt",
## a, b, sqrt(c*c + d*d)
" 3 1 roll",
## sqrt(c*c + d*d), a, b
" dup mul exch dup mul add sqrt",
## sqrt(c*c + d*d), sqrt(a*a + b*b)
## if they are not equal use strokepath to convert to path we can fill
## (because R does not have the concept of a transformed pen for stroking)
## " (<!-- ) print dup str cvs print (, ) print exch dup str cvs print ( -->) print sub abs (<!-- diff=) print dup str cvs print ( -->) print .01 ge",
paste0(" sub abs ", scaleEPS, " ge"),
"} def",
"/fillstroke {",
## convert stroke to path we can fill
" strokepath",
## fill instead of stroke
" flattenpath {mymove} {myline} {mycurve} {myclose}",
" myfill",
"} def",
"/strokestroke {",
" flattenpath {mymove} {myline} {mycurve} {myclose}",
" mystroke",
"} def",
# override paint operators
"/stroke {",
" checkskew {fillstroke} {strokestroke} ifelse",
" newpath",
"} def",
"/fill {",
" flattenpath {mymove} {myline} {mycurve} {myclose}",
" myfill",
" newpath",
"} def",
"/eofill {",
" flattenpath {mymove} {myline} {mycurve} {myclose}",
" myeofill",
" newpath",
"} def",
# Turn rectangles into paths
"/rectfill {",
" 4 dict begin",
" /rheight exch def",
" /rwidth exch def",
" /rx exch def",
" /ry exch def",
" rx ry moveto",
" rwidth 0 rlineto",
" 0 rheight rlineto",
" rwidth neg 0 rlineto",
" end",
" closepath",
" fill",
"} def",
"/rectstroke {",
" 4 dict begin",
" /rheight exch def",
" /rwidth exch def",
" /rx exch def",
" /ry exch def",
" rx ry moveto",
" rwidth 0 rlineto",
" 0 rheight rlineto",
" rwidth neg 0 rlineto",
" end",
" closepath",
" stroke",
"} def",
# text is split into individual characters
"/nullchar {} def",
"/showchar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" convertToR /charfun (nullchar) put",
" convertToR /bboxfun (showbbox) put",
" mytext",
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original char)
" true charpath",
" currentpoint newpath moveto",
"} def",
"/xshowchar {",
# Save copy of 'i'
" dup",
# Get copy of 'str' out front
" 2 index",
" exch",
" 1 getinterval",
# Save current location (starting position for THIS char)
" currentpoint 3 -1 roll",
" convertToR /charfun (nullchar) put",
" convertToR /bboxfun (showbbox) put",
" mytext",
# Pop char
" pop",
# Return to start point for THIS char and use 'numarray'
# to find location for NEXT char
" moveto 2 index exch get 0 rmoveto",
# Save current location (starting position for next char),
# start new path for next char,
# move to save location
" currentpoint newpath moveto",
"} def",
"/yshowchar {",
# Save copy of 'i'
" dup",
# Get copy of 'str' out front
" 2 index",
" exch",
" 1 getinterval",
# Save current location (starting position for THIS char)
" currentpoint 3 -1 roll",
" convertToR /charfun (nullchar) put",
" convertToR /bboxfun (showbbox) put",
" mytext",
# Pop char
" pop",
# Return to start point for THIS char and use 'numarray'
# to find location for NEXT char
" moveto 2 index exch get 0 exch rmoveto",
# Save current location (starting position for next char),
# start new path for next char,
# move to save location
" currentpoint newpath moveto",
"} def",
"/xyshowchar {",
# Save copy of 'i'
" dup",
# Get copy of 'str' out front
" 2 index",
" exch",
" 1 getinterval",
# Save current location (starting position for THIS char)
" currentpoint 3 -1 roll",
" convertToR /charfun (nullchar) put",
" convertToR /bboxfun (showbbox) put",
" mytext",
# Pop char
" pop",
# Return to start point for THIS char and use 'numarray'
# to find location for NEXT char
" moveto 2 index exch 2 mul 2 getinterval dup 0 get exch 1 get rmoveto",
# Save current location (starting position for next char),
# start new path for next char,
# move to save location
" currentpoint newpath moveto",
"} def",
"/widthshowchar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" convertToR /charfun (nullchar) put",
# Just get bbox of char
" convertToR /bboxfun (showbbox) put",
" mytext",
" dup 0 get 3 index eq {4 index 4 index rmoveto} if",
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original char)
" true charpath",
" currentpoint newpath moveto",
"} def",
"/ashowchar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" convertToR /charfun (nullchar) put",
# Just get bbox of char
" convertToR /bboxfun (showbbox) put",
" mytext",
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original char)
" true charpath",
# Do adjustment on every char
" 2 index 2 index rmoveto",
" currentpoint newpath moveto",
"} def",
"/awidthshowchar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" convertToR /charfun (nullchar) put",
# Just get bbox of char
" convertToR /bboxfun (showbbox) put",
" mytext",
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original char)
# Check for special char adjustment
" dup 0 get 5 index eq {6 index 6 index rmoveto} if",
" true charpath",
" 2 index 2 index rmoveto",
" currentpoint newpath moveto",
"} def",
# text is split into individual characters,
# each character is converted to a path, flattened
# and then stroked
"/strokechar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" dup", # copy of char for "char="
" true charpath flattenpath",
" {mymove} {myline} {mycurve} {myclose}",
" mychar",
" pop", # copy of char for "char="
# Save current location (starting position for next char),
# start new path for next char,
# move to save location
" currentpoint newpath moveto",
"} def",
"/xstrokechar {",
# Save copy of 'i'
" dup",
# Get copy of 'str' out front
" 2 index",
" exch",
" 1 getinterval",
# Save current location (starting position for THIS char)
" currentpoint 3 -1 roll",
" dup", # copy of char for "char="
" true charpath flattenpath",
" {mymove} {myline} {mycurve} {myclose}",
" mychar",
" pop", # copy of char for "char="
# Return to start point for THIS char and use 'numarray'
# to find location for NEXT char
" moveto 2 index exch get 0 rmoveto",
# Save current location (starting position for next char),
# start new path for next char,
# move to save location
" currentpoint newpath moveto",
"} def",
"/ystrokechar {",
# Save copy of 'i'
" dup",
# Get copy of 'str' out front
" 2 index",
" exch",
" 1 getinterval",
# Save current location (starting position for THIS char)
" currentpoint 3 -1 roll",
" dup", # copy of char for "char="
" true charpath flattenpath",
" {mymove} {myline} {mycurve} {myclose}",
" mychar",
" pop", # copy of char for "char="
# Return to start point for THIS char and use 'numarray'
# to find location for NEXT char
" moveto 2 index exch get 0 exch rmoveto",
# Save current location (starting position for next char),
# start new path for next char,
# move to save location
" currentpoint newpath moveto",
"} def",
"/xystrokechar {",
# Save copy of 'i'
" dup",
# Get copy of 'str' out front
" 2 index",
" exch",
" 1 getinterval",
# Save current location (starting position for THIS char)
" currentpoint 3 -1 roll",
" dup", # copy of char for "char="
" true charpath flattenpath",
" {mymove} {myline} {mycurve} {myclose}",
" mychar",
" pop", # copy of char for "char="
# Return to start point for THIS char and use 'numarray'
# to find location for NEXT char
" moveto 2 index exch 2 mul 2 getinterval dup 0 get exch 1 get rmoveto",
# Save current location (starting position for next char),
# start new path for next char,
# move to save location
" currentpoint newpath moveto",
"} def",
"/widthstrokechar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" dup",
" true charpath flattenpath",
" {mymove} {myline} {mycurve} {myclose}",
" mychar",
# Check for special char adjustment
# (the get converts char to int)
" 0 get 2 index eq {3 index 3 index rmoveto} if",
" currentpoint newpath moveto",
"} def",
"/astrokechar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" dup", # copy of char for "char="
" true charpath flattenpath",
" {mymove} {myline} {mycurve} {myclose}",
" mychar",
" pop", # copy of char for "char="
" 2 index 2 index rmoveto",
" currentpoint newpath moveto",
"} def",
"/awidthstrokechar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" dup",
" true charpath flattenpath",
" {mymove} {myline} {mycurve} {myclose}",
" mychar",
# Do adjustment on every char
" 3 index 3 index rmoveto",
# Check for special char adjustment
" 0 get 4 index eq {5 index 5 index rmoveto} if",
" currentpoint newpath moveto",
"} def",
"/showchars {",
" dup length -1 add 0 exch 1 exch {showchar} for",
"} def",
"/xshowchars {",
" dup length -1 add 0 exch 1 exch {xshowchar} for",
"} def",
"/yshowchars {",
" dup length -1 add 0 exch 1 exch {yshowchar} for",
"} def",
"/xyshowchars {",
" dup length -1 add 0 exch 1 exch {xyshowchar} for",
"} def",
"/widthshowchars {",
" dup length -1 add 0 exch 1 exch {widthshowchar} for",
"} def",
"/ashowchars {",
" dup length -1 add 0 exch 1 exch {ashowchar} for",
"} def",
"/awidthshowchars {",
" dup length -1 add 0 exch 1 exch {awidthshowchar} for",
"} def",
"/showpaths {",
" dup length -1 add 0 exch 1 exch {strokechar} for",
"} def",
"/xshowpaths {",
" dup length -1 add 0 exch 1 exch {xstrokechar} for",
"} def",
"/yshowpaths {",
" dup length -1 add 0 exch 1 exch {ystrokechar} for",
"} def",
"/xyshowpaths {",
" dup length -1 add 0 exch 1 exch {xystrokechar} for",
"} def",
"/widthshowpaths {",
" dup length -1 add 0 exch 1 exch {widthstrokechar} for",
"} def",
"/ashowpaths {",
" dup length -1 add 0 exch 1 exch {astrokechar} for",
"} def",
"/awidthshowpaths {",
" dup length -1 add 0 exch 1 exch {awidthstrokechar} for",
"} def",
"/showbbox {",
" gsave",
" currentpoint newpath moveto dup true charpath flattenpath",
" boxinit",
" {boxmove} {boxline} {boxcurve} {boxclose} pathforall",
# Update global picture xmin/xmax/ymin/ymax
" boxupdate",
" grestore",
"} def",
"/xshowbbox {",
" gsave",
" currentpoint newpath moveto",
# For each char, save currentpoint, flatten charpath,
# move back to start point and shift across using 'numarray'
" dup length -1 add 0 exch 1 exch { dup 2 index exch 1 getinterval currentpoint 3 -1 roll true charpath flattenpath moveto 2 index exch get 0 rmoveto } for",
" boxinit",
" {boxmove} {boxline} {boxcurve} {boxclose} pathforall",
# Update global picture xmin/xmax/ymin/ymax
" boxupdate",
" grestore",
"} def",
"/yshowbbox {",
" gsave",
" currentpoint newpath moveto",
# For each char, save currentpoint, flatten charpath,
# move back to start point and shift across using 'numarray'
" dup length -1 add 0 exch 1 exch { dup 2 index exch 1 getinterval currentpoint 3 -1 roll true charpath flattenpath moveto 2 index exch get 0 exch rmoveto } for",
" boxinit",
" {boxmove} {boxline} {boxcurve} {boxclose} pathforall",
# Update global picture xmin/xmax/ymin/ymax
" boxupdate",
" grestore",
"} def",
"/xyshowbbox {",
" gsave",
" currentpoint newpath moveto",
# For each char, save currentpoint, flatten charpath,
# move back to start point and shift across using 'numarray'
" dup length -1 add 0 exch 1 exch { dup 2 index exch 1 getinterval currentpoint 3 -1 roll true charpath flattenpath moveto 2 index exch 2 mul 2 getinterval dup 0 get exch 1 get rmoveto } for",
" boxinit",
" {boxmove} {boxline} {boxcurve} {boxclose} pathforall",
# Update global picture xmin/xmax/ymin/ymax
" boxupdate",
" grestore",
"} def",
"/widthshowbbox {",
" gsave",
" currentpoint newpath moveto",
" dup length -1 add 0 exch 1 exch { 1 index exch 1 getinterval dup true charpath flattenpath 0 get 2 index eq { 3 index 3 index rmoveto } if } for",
" boxinit",
" {boxmove} {boxline} {boxcurve} {boxclose} pathforall",
# Update global picture xmin/xmax/ymin/ymax
" boxupdate",
" grestore",
"} def",
"/ashowbbox {",
" gsave",
" currentpoint newpath moveto",
" dup length -1 add 0 exch 1 exch { 1 index exch 1 getinterval true charpath flattenpath 2 index 2 index rmoveto } for",
" boxinit",
" {boxmove} {boxline} {boxcurve} {boxclose} pathforall",
# Update global picture xmin/xmax/ymin/ymax
" boxupdate",
" grestore",
"} def",
"/awidthshowbbox {",
" gsave",
" currentpoint newpath moveto",
" dup length -1 add 0 exch 1 exch { 1 index exch 1 getinterval dup true charpath flattenpath 3 index 3 index rmoveto 0 get 4 index eq { 5 index 5 index rmoveto } if } for",
" boxinit",
" {boxmove} {boxline} {boxcurve} {boxclose} pathforall",
# Update global picture xmin/xmax/ymin/ymax
" boxupdate",
" grestore",
"} def",
"/showwidthadj {",
" convertToR /curadj 0 put",
"} def",
"/widthshowwidthadj {",
" convertToR /curadj 0 put",
# Determine width adj in device coords
" 3 index 0 transwidth",
# Check each char, if special, add
" 1 index { 3 index eq { convertToR /curadj get 1 index add convertToR /curadj 3 -1 roll put } if } forall",
# Clean up
" pop",
"} def",
"/ashowwidthadj {",
# How many chars
" dup length",
# Determine width adj in device coords
" 3 index 0 transwidth",
" mul convertToR /curadj 3 -1 roll put",
"} def",
"/awidthshowwidthadj {",
# How many chars
" dup length",
# Determine width adj in device coords
" 3 index 0 transwidth",
" mul convertToR /curadj 3 -1 roll put",
# Determine width adj in device coords
" 5 index 0 transwidth",
# Check each char, if special, add
" 1 index { 5 index eq { convertToR /curadj get 1 index add convertToR /curadj 3 -1 roll put } if } forall",
# Clean up
" pop",
"} def",
"/show {",
" convertToR /charpathfun (showpaths) put",
" convertToR /charfun (showchars) put",
" convertToR /widthadjfun (showwidthadj) put",
" convertToR /bboxfun (showbbox) put",
" mytext",
if (!(charpath || charpos)) {
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original text)
" true charpath"
} else {
"pop"
},
" currentpoint newpath moveto",
"} def",
"/xshow {",
" convertToR /charpathfun (xshowpaths) put",
" convertToR /charfun (xshowchars) put",
" convertToR /widthadjfun (showwidthadj) put",
" convertToR /bboxfun (xshowbbox) put",
# Switch 'string' and 'numarray' so common code
# for show operators can see 'string' on top of stack
" exch",
" mytext",
if (!(charpath || charpos)) {
# Perform the x-shifts from 'numarray'
" exch { 0 rmoveto } forall"
} else {
# remove 'numarray'
" exch pop"
},
# Remove 'string'
" pop",
" currentpoint newpath moveto",
"} def",
"/yshow {",
" convertToR /charpathfun (yshowpaths) put",
" convertToR /charfun (yshowchars) put",
" convertToR /widthadjfun (showwidthadj) put",
" convertToR /bboxfun (yshowbbox) put",
# Switch 'string' and 'numarray' so common code
# for show operators can see 'string' on top of stack
" exch",
" mytext",
if (!(charpath || charpos)) {
# Perform the y-shifts from 'numarray'
" exch { 0 exch rmoveto } forall"
} else {
# remove 'numarray'
" exch pop"
},
# Remove 'string'
" pop",
" currentpoint newpath moveto",
"} def",
"/xyshow {",
" convertToR /charpathfun (xyshowpaths) put",
" convertToR /charfun (xyshowchars) put",
" convertToR /widthadjfun (showwidthadj) put",
" convertToR /bboxfun (xyshowbbox) put",
# Switch 'string' and 'numarray' so common code
# for show operators can see 'string' on top of stack
" exch",
" mytext",
if (!(charpath || charpos)) {
# Perform the x/y-shifts from 'numarray' and pop 'numarray'
" exch dup length 2 idiv -1 add 0 exch 1 exch { 1 index exch 2 mul 2 getinterval dup 0 get exch 1 get rmoveto } for pop"
} else {
# remove 'numarray'
" exch pop"
},
# Remove 'string'
" pop",
" currentpoint newpath moveto",
"} def",
"/widthshow {",
" convertToR /charpathfun (widthshowpaths) put",
" convertToR /charfun (widthshowchars) put",
" convertToR /widthadjfun (widthshowwidthadj) put",
" convertToR /bboxfun (widthshowbbox) put",
" mytext",
if (!(charpath || charpos)) {
# Check for any char adjustments
c(" dup dup { 2 index eq {3 index 3 index rmoveto} if } forall",
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original text)
" true charpath")
} else {
"pop"
},
# Remove the cx and cy and char from the /widthshow
" pop pop pop",
" currentpoint newpath moveto",
"} def",
"/ashow {",
" convertToR /charpathfun (ashowpaths) put",
" convertToR /charfun (ashowchars) put",
" convertToR /widthadjfun (ashowwidthadj) put",
" convertToR /bboxfun (ashowbbox) put",
" mytext",
if (!(charpath || charpos)) {
# Do per-char adjustment
c(" dup length dup 4 index mul exch 3 index mul rmoveto",
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original text)
" true charpath")
} else {
"pop"
},
# Remove ax and ay
" pop pop",
" currentpoint newpath moveto",
"} def",
"/awidthshow {",
" convertToR /charpathfun (awidthshowpaths) put",
" convertToR /charfun (awidthshowchars) put",
" convertToR /widthadjfun (awidthshowwidthadj) put",
" convertToR /bboxfun (awidthshowbbox) put",
" mytext",
if (!(charpath || charpos)) {
# Do per-char adjustment
c(" dup length -1 add dup 4 index mul exch 3 index mul rmoveto",
# Check for any char adjustments
" dup { 4 index eq {5 index 5 index rmoveto} if } forall",
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original text)
" true charpath")
} else {
"pop"
},
# Remove ax,ay,char,cx,cy
" pop pop pop pop pop",
" currentpoint newpath moveto",
"} def",
"end",
# end global settings
"false setglobal",
"%%EndProcSet",
"%% EndProlog",
"",
# Put converToR on the dictionary stack
"convertToR begin",
# Put userdict on top of dictionary stack for the file that is
# about to run
"userdict begin",
if (!is.null(setflat)) {
paste(setflat, "setflat")
},
"")
}
PScaptureFoot <-
c(
# Restore convertToR dict to dictionary stack in case the file
# that we just ran does something nasty like clearing the dict stack!
"convertToR begin",
# XML file footer info
"1 dict begin",
"/str 50 string def",
"(<summary count=') print convertToR /id get 1 sub str cvs print (') print",
"( ymax=') print convertToR /ymax get str cvs print (') print",
"( ymin=') print convertToR /ymin get str cvs print (') print",
"( xmax=') print convertToR /xmax get str cvs print (') print",
"( xmin=') print convertToR /xmin get str cvs print (') print",
"(/>\n\n) print",
"(</picture>\n) print",
"end",
# EOF
"%% EOF\n"
)
# Handle a "stringLine" that contains a NUL character
# ONE LINE ONLY at a time
processNUL <- function(filename, linenum) {
if (length(linenum) != 1)
stop("Bad computer!")
# Read in each piece of the element
bits <- scan(filename, skip=linenum - 1, nlines=1, quote=NULL,
sep=" ", quiet=TRUE, what="character")
# The
# string='###TEXT blah blah ###TEXT'
# part will be incomplete (terminated by the NUL char in blah blah)
# Replace
# string='###TEXT whatever
# with
# string=''
bits[grep("string='###TEXT", bits)] <-
paste(bits[grep("string='###TEXT", bits)], "###TEXT'", sep="")
# OR could be
# char='###TEXT^@###TEXT'
bits[grep("char='###TEXT", bits)] <- "char='###TEXT###TEXT'"
# Check for ###TEXT' too
bits[grep("###TEXT' $", bits)] <- " "
# Put it all back together
paste(bits, collapse=" ")
}
# Perform some post-processing of the XML file that is generated by the
# above PostScript code.
# (e.g., do some character escaping that would be more painful to do
# in PostScript code)
postProcess <- function(outfilename, enc, defaultcol) {
processStringLine <- function(stringLine) {
paste(stringLine[1],
gsub("<", "<",
gsub(">", ">",
gsub("'", "'",
gsub("&", "&",
stringLine[2])))),
stringLine[3],
sep="")
}
# The XML file has been created by ghostscript in ISO-8859-1
infile <- file(outfilename, "r", encoding="ISO-8859-1")
lines <- readLines(infile)
close(infile)
# All string values have been marked
stringLines <- grep("###TEXT", lines)
if (length(stringLines) > 0) {
# Check first for NUL-terminated text
# Test is no tag terminator, ">", at end of line
nulTerminated <- !grepl(">$", lines[stringLines])
if (any(nulTerminated)) {
for (i in stringLines[nulTerminated]) {
lines[i] <- processNUL(outfilename, i)
}
}
stringLinesBits <- strsplit(lines[stringLines], "###TEXT")
stringLinesMod <- sapply(stringLinesBits, processStringLine)
lines[stringLines] <- stringLinesMod
}
# Write the file using 'enc' encoding
outfile <- file(outfilename, "w", encoding=enc)
writeLines(lines, outfile)
close(outfile)
}
# Generate RGML file from PostScript file
PostScriptTrace <- function(file, outfilename,
charpath=TRUE, charpos=FALSE,
setflat=NULL, defaultcol="black",
encoding="ISO-8859-1", scaleEPS=.01) {
# Create temporary PostScript file which loads
# dictionary redefining stroke and fill operators
# and then runs target PostScript file
psfilename <- tempfile(fileext = ".ps")
psfile <- file(psfilename, "w")
writeLines(PScaptureHead(file, charpath, charpos,
setflat, encoding, scaleEPS),
psfile)
# Reconstitute file name here to handle Windows-style paths
# in the file name
writeLines(paste("(", file.path(dirname(file), basename(file)),
") run", sep=""), psfile)
writeLines(PScaptureFoot, psfile)
close(psfile)
if (missing(outfilename)) {
outfilename <- paste(basename(file), ".xml", sep="")
}
# Run temp file using ghostscript
# Determination of ghostscript command syntax derived from dev2bitmap()
gsexe <- Sys.getenv("R_GSCMD")
if (.Platform$OS.type == "windows") {
if(!nzchar(gsexe)) gsexe <- Sys.getenv("GSC")
if(is.null(gsexe) || !nzchar(gsexe)) {
poss <- Sys.which(c("gswin64c.exe", "gswin32c.exe"))
poss <- poss[nzchar(poss)]
gsexe <- if(length(poss)) poss[1] else "gswin32c.exe"
} else if(grepl(" ", gsexe, fixed = TRUE))
gsexe <- utils::shortPathName(gsexe)
outfile <- tempfile()
} else {
if (is.null(gsexe) || !nzchar(gsexe)) {
gsexe <- "gs"
rc <- system(paste(shQuote(gsexe), "-help > /dev/null"))
if (rc != 0)
stop("sorry, 'gs' cannot be found")
}
outfile <- "/dev/null"
}
cmd <- paste(shQuote(gsexe),
" -q -dBATCH -dNOPAUSE -dNOSAFER",
" -sDEVICE=ps2write -sOutputFile=",
outfile, " -sstdout=",
outfilename, " ",
psfilename, sep="")
ret <- switch(.Platform$OS.type,
unix = system(cmd),
windows = system(cmd, invisible = TRUE))
if(ret != 0) {
stop(gettextf("status %d in running command '%s'", ret, cmd),
domain = NA)
} else {
postProcess(outfilename, encoding, defaultcol)
}
invisible(cmd)
}
Try the grImport package in your browser
Any scripts or data that you put into this service are public.
grImport documentation built on March 31, 2023, 6:57 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions PostScriptTrace postProcess processNUL PScaptureHead
Documented in PostScriptTrace
# Function to extract outlines from PostScript paths
PScaptureText <- c()
PScaptureChars <- c()
PScaptureHead <- function(file, charpath, charpos, setflat, encoding,
scaleEPS) {
c("%!PS-Adobe-2.0 EPSF-1.2",
"%%BeginProcSet:convertToR 0 0",
# XML file header info
sprintf("(<?xml version='1.0' encoding='%s' ?>\n\n) print",
encoding),
paste("(<picture version='3' xmlns:rgml='http://r-project.org/RGML'",
" source='", file, "'",
" date='", as.character(Sys.time()), "'",
" creator='R (", R.Version()$major, ".", R.Version()$minor, ")'",
" >\n\n) print", sep=""),
# useful definitions
# Define my counters GLOBALLY so the postscript
# file I run cannot reset my counters with a restore!
"true setglobal",
"/convertToR dup 100 dict def load begin",
"/id 1 def",
# Do these need to be even "larger"?
"/xmax -99999 def",
"/xmin 99999 def",
"/ymax -99999 def",
"/ymin 99999 def",
# Start with x, y and end with dw
"/transwidth {",
" transform",
" 0 0 transform",
" 2 index exch sub", # dy
" 3 index 2 index sub", # dx
" 2 exp exch 2 exp add sqrt",
" 3 1 roll pop pop pop",
" } def",
# bounding box processing
"/boxinit {",
" convertToR /bxmax -99999 put",
" convertToR /bxmin 99999 put",
" convertToR /bymax -99999 put",
" convertToR /bymin 99999 put",
" } def",
"/boxmove {",
" transform",
" dup",
" convertToR exch /cury exch put",
" dup",
" convertToR /bymin get lt {convertToR /bymin cury put} if",
" convertToR /bymax get gt {convertToR /bymax cury put} if",
" dup",
" convertToR exch /curx exch put",
" dup",
" convertToR /bxmin get lt {convertToR /bxmin curx put} if",
" convertToR /bxmax get gt {convertToR /bxmax curx put} if",
" } def",
"/boxline {",
" transform",
" dup",
" convertToR exch /cury exch put",
" dup",
" convertToR /bymin get lt {convertToR /bymin cury put} if",
" convertToR /bymax get gt {convertToR /bymax cury put} if",
" dup",
" convertToR exch /curx exch put",
" dup",
" convertToR /bxmin get lt {convertToR /bxmin curx put} if",
" convertToR /bxmax get gt {convertToR /bxmax curx put} if",
" } def",
"/boxcurve {",
" } def",
"/boxclose {",
" } def",
# Update global bbox from bbox
"/boxupdate {",
" convertToR /bymin get convertToR /ymin get lt {convertToR /ymin convertToR /bymin get put} if",
" convertToR /bymax get convertToR /ymax get gt {convertToR /ymax convertToR /bymax get put} if",
" convertToR /bxmin get convertToR /xmin get lt {convertToR /xmin convertToR /bxmin get put} if",
" convertToR /bxmax get convertToR /xmax get gt {convertToR /xmax convertToR /bxmax get put} if",
" } def",
# Font height calculation (for *current* font)
"/fontsize {",
# DO NOT just 'get' the third element of FontMatrix
# because the font may, e.g., rotate the font outlines
" currentfont /FontMatrix get",
# For Type 1 fonts, scale the matrix by 1000
# (see PLRM.pdf version 3 page 324; comment on FontMatrix)
# For Type 42 (TrueType), no multiplier necessary
# (http://www.adobe.com/devnet/font/pdfs/5012.Type42_Spec.pdf)
# For other font types, not sure what the initial font matrix is
# COPY the FontMatrix to avoid 'invalidaccess'
" currentfont /FontType get 1 eq { 1000 1000 matrix scale matrix concatmatrix } if",
# Transform (0, 1) using this matrix, then transform to user coords
" dup 0 exch 1 exch transform transform",
# Do the same to (0, 0)
" 2 index 0 exch 0 exch transform transform",
# dy
" 2 index exch sub",
# dx
" 3 index 2 index sub",
" 2 exp exch 2 exp add sqrt",
# clean up
" 5 1 roll pop pop pop pop",
" } def",
# path processing
"/mymove {",
" 1 dict begin",
" /str 50 string def",
" (\t<move) print",
" transform",
" dup",
" convertToR exch /ystart exch put",
" dup",
" convertToR exch /cury exch put",
" dup",
" convertToR /ymin get lt {convertToR /ymin cury put} if",
" dup",
" convertToR /ymax get gt {convertToR /ymax cury put} if",
" ( y=') print str cvs print (') print",
" dup",
" convertToR exch /xstart exch put",
" dup",
" convertToR exch /curx exch put",
" dup",
" convertToR /xmin get lt {convertToR /xmin curx put} if",
" dup",
" convertToR /xmax get gt {convertToR /xmax curx put} if",
" ( x=') print str cvs print (') print",
" (/>\n) print",
" end",
"} def",
"/myline {",
" 1 dict begin",
" /str 50 string def",
" (\t<line) print",
" transform",
" dup",
" convertToR exch /cury exch put",
" dup",
" convertToR /ymin get lt {convertToR /ymin cury put} if",
" dup",
" convertToR /ymax get gt {convertToR /ymax cury put} if",
" ( y=') print str cvs print (') print",
" dup",
" convertToR exch /curx exch put",
" dup",
" convertToR /xmin get lt {convertToR /xmin curx put} if",
" dup",
" convertToR /xmax get gt {convertToR /xmax curx put} if",
" ( x=') print str cvs print (') print",
" (/>\n) print",
" end",
" } def",
"/mycurve {",
" } def",
"/myclose {",
" 1 dict begin",
" /str 50 string def",
# Convert 'closepath' to 'lineto'
# " (\t<close/>\n) print",
" (\t<line) print",
" ( y=') print convertToR /ystart get str cvs print (') print",
" ( x=') print convertToR /xstart get str cvs print (') print",
" (/>\n) print",
" end",
" } def",
# echoing graphics state
"/printcol {",
# What colorspace are we in?
# Return colorspace array and extract
# first element which is colorspace name
" currentcolorspace 0 get",
# If it's DeviceRGB or DeviceGray or DeviceCMYK we're ok
# Separation and Pattern are special cases that are currently handled
# by just specifying "grey" as the colour
# Otherwise we "hail mary" and hope that currencolor throws back 3 values
# that can be interpreted as RGB (e.g., R's sRGB!)
" dup dup (Separation) eq exch (Pattern) eq or {pop 0.5 0.5 0.5} {dup (DeviceGray) eq exch dup (DeviceRGB) eq exch (DeviceCMYK) eq or or {currentrgbcolor} {currentcolor} ifelse} ifelse",
" (\t\t<rgb) print",
# make sure the colour is RGB not BGR
" ( r=') print 2 index str cvs print (') print",
" ( g=') print 1 index str cvs print (') print",
" ( b=') print str cvs print (') print",
" (/>\n) print",
" pop pop",
" } def",
"/printlwd {",
# lwd is in user coords so transform
# This will need transforming to a grDevices "lwd" in R
" currentlinewidth 0 transform",
" 0 0 transform",
" 3 index 2 index sub", # dx
" 3 index 2 index sub", # dy
" 2 exp exch 2 exp add sqrt",
# clean up
" 5 1 roll pop pop pop pop",
" ( lwd=') print str cvs print (') print",
"} def",
"/printlineend {",
" ( lineend=') print currentlinecap str cvs print (') print",
"} def",
"/printlinejoin {",
" ( linejoin=') print currentlinejoin str cvs print (') print",
"} def",
"/printlinemiter {",
" ( linemitre=') print currentmiterlimit str cvs print (') print",
"} def",
"/printdash {",
" currentdash",
# Like lwd, transform user coords
# Ignore offset
" ( lty=') print pop {0 transform pop 0 0 transform pop sub str cvs print ( ) print} forall (') print",
"} def",
"/printstyle {",
" (\t\t<style) print",
" printlwd",
" printdash",
" printlineend",
" printlinemiter",
" printlinejoin",
" (/>\n) print",
"} def",
# print out "closestroke" marker plus graphics state info
"/mystroke {",
" 1 dict begin",
" /str 50 string def",
" (<path type='stroke') print",
" ( id=') print convertToR /id get str cvs print ('>\n) print",
" (\t<context>\n) print",
" printcol ",
" printstyle",
" (\t</context>\n\n) print",
" pathforall",
" convertToR /id get 1 add convertToR exch /id exch put",
" (</path>\n\n) print",
" end",
"} def",
"/myfill {",
" 1 dict begin",
" /str 50 string def",
" (<path type='fill') print",
" ( id=') print convertToR /id get str cvs print ('>\n) print",
" (\t<context>\n) print",
" printcol",
" printstyle",
" (\t</context>\n\n) print",
" pathforall",
" convertToR /id get 1 add convertToR exch /id exch put",
" (</path>\n\n) print",
" end",
"} def",
"/myeofill {",
" 1 dict begin",
" /str 50 string def",
" (<path type='eofill') print",
" ( id=') print convertToR /id get str cvs print ('>\n) print",
" (\t<context>\n) print",
" printcol",
" printstyle",
" (\t</context>\n\n) print",
" pathforall",
" convertToR /id get 1 add convertToR exch /id exch put",
" (</path>\n\n) print",
" end",
"} def",
"/mytext {",
" 1 dict begin",
" /str 50 string def",
" (<text ) print",
" ( id=') print convertToR /id get str cvs print (') print",
" convertToR /id get 1 add convertToR exch /id exch put",
# Insert MARKS here so that postProcess() can easily locate strings
" ( string='###TEXT) print dup print (###TEXT') print",
# Type of text element
if (charpath) {
" ( type='charpath') print"
} else if (charpos) {
" ( type='char') print"
} else {
" ( type='text') print"
},
# Calculate any width adjustments
" convertToR /widthadjfun get cvx exec",
# (x, y) location of text
" currentpoint",
" transform",
" dup",
" convertToR exch /cury exch put",
" dup",
" convertToR /ymin get lt {convertToR /ymin cury put} if",
" dup",
" convertToR /ymax get gt {convertToR /ymax cury put} if",
" ( y=') print str cvs print (') print",
" dup",
" convertToR exch /curx exch put",
" dup",
" convertToR /xmin get lt {convertToR /xmin curx put} if",
" dup",
" convertToR /xmax get gt {convertToR /xmax curx put} if",
" ( x=') print str cvs print (') print",
# width of text
" dup stringwidth",
# stringwidth has put wx and wy on stack
# If wy is non-zero, text is at an angle
" dup 0 ne { 1 index 1 index exch atan } { 0 } ifelse",
# Save this angle
" convertToR exch /curangle exch put",
# Calculate user-space width from wx and wy
" 2 exp exch 2 exp add sqrt",
# Transform user-space width to device
" 0 transform",
# Subtract (0, 0)[x]
" exch 0 0 transform pop sub",
# Subtract (0, 0)[y]
" exch 0 0 transform exch pop sub",
# If transformed y is non-zero then text is at an angle
" dup 0 ne { 1 index 1 index exch atan } { 0 } ifelse",
# Save user-space angle plus angle
" convertToR /curangle get add convertToR exch /curangle exch put",
# Record user-space angle plus angle
" ( angle=') print",
" convertToR /curangle get str cvs print (') print",
# Calculate device width
" 2 exp exch 2 exp add sqrt",
# Make any adjustments
" convertToR /curadj get add",
# Print width
" ( width=') print",
" str cvs print (') print",
# Height of text (size of current font)
# Print height
" ( height=') print",
" fontsize str cvs print (') print",
# Calculate text bb
" convertToR /bboxfun get cvx exec",
# Record bbox
" ( bbox=') print",
" convertToR /bxmin get str cvs print ( ) print",
" convertToR /bymin get str cvs print ( ) print",
" convertToR /bxmax get str cvs print ( ) print",
" convertToR /bymax get str cvs print (') print",
# Record font (if available)
" currentfont /FontName known",
" { ( fontName=') print currentfont /FontName get str cvs print (') print} if",
" currentfont /FontInfo known",
" { currentfont /FontInfo get /FamilyName known",
" { ( fontFamilyName=') print currentfont /FontInfo get /FamilyName get print (') print } if } if",
" currentfont /FontInfo known",
" { currentfont /FontInfo get /FullName known",
" { ( fontFullName=') print currentfont /FontInfo get /FullName get print (') print } if } if",
" (>\n) print",
# Graphics context
" (\t<context>\n) print",
" printcol",
" printstyle",
" (\t</context>\n\n) print",
# If charpath or charloc, need to nest additional elements
if (charpath) {
"convertToR /charpathfun get cvx exec"
} else if (charpos) {
"convertToR /charfun get cvx exec"
},
" (</text>\n\n) print",
" end",
"} def",
"/mychar {",
" 1 dict begin",
" /str 50 string def",
" (<path type='char') print",
" ( id=') print convertToR /id get str cvs print (') print",
# Insert MARKS here so that postProcess() can easily locate strings
" ( char='###TEXT) print 4 index print (###TEXT' >\n) print",
" pathforall",
" (\t<context>\n) print",
" printcol",
" printstyle",
" (\t</context>\n\n) print",
" convertToR /id get 1 add convertToR exch /id exch put",
" (</path>\n\n) print",
" end",
"} def",
"/checkskew {",
## load individual elements of CTM onto stack (and name them)
## https://stackoverflow.com/questions/11777305/postscript-discover-rotate-scale-value
" matrix currentmatrix aload pop",
## calculate xscale and yscale
## https://stackoverflow.com/questions/20422392/given-a-2d-transformation-matrix-how-to-calculate-the-scalings-skews-rotation
## a, b, c, d, tx, ty
" pop pop",
## a, b, c, d
" dup mul exch dup mul add sqrt",
## a, b, sqrt(c*c + d*d)
" 3 1 roll",
## sqrt(c*c + d*d), a, b
" dup mul exch dup mul add sqrt",
## sqrt(c*c + d*d), sqrt(a*a + b*b)
## if they are not equal use strokepath to convert to path we can fill
## (because R does not have the concept of a transformed pen for stroking)
## " (<!-- ) print dup str cvs print (, ) print exch dup str cvs print ( -->) print sub abs (<!-- diff=) print dup str cvs print ( -->) print .01 ge",
paste0(" sub abs ", scaleEPS, " ge"),
"} def",
"/fillstroke {",
## convert stroke to path we can fill
" strokepath",
## fill instead of stroke
" flattenpath {mymove} {myline} {mycurve} {myclose}",
" myfill",
"} def",
"/strokestroke {",
" flattenpath {mymove} {myline} {mycurve} {myclose}",
" mystroke",
"} def",
# override paint operators
"/stroke {",
" checkskew {fillstroke} {strokestroke} ifelse",
" newpath",
"} def",
"/fill {",
" flattenpath {mymove} {myline} {mycurve} {myclose}",
" myfill",
" newpath",
"} def",
"/eofill {",
" flattenpath {mymove} {myline} {mycurve} {myclose}",
" myeofill",
" newpath",
"} def",
# Turn rectangles into paths
"/rectfill {",
" 4 dict begin",
" /rheight exch def",
" /rwidth exch def",
" /rx exch def",
" /ry exch def",
" rx ry moveto",
" rwidth 0 rlineto",
" 0 rheight rlineto",
" rwidth neg 0 rlineto",
" end",
" closepath",
" fill",
"} def",
"/rectstroke {",
" 4 dict begin",
" /rheight exch def",
" /rwidth exch def",
" /rx exch def",
" /ry exch def",
" rx ry moveto",
" rwidth 0 rlineto",
" 0 rheight rlineto",
" rwidth neg 0 rlineto",
" end",
" closepath",
" stroke",
"} def",
# text is split into individual characters
"/nullchar {} def",
"/showchar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" convertToR /charfun (nullchar) put",
" convertToR /bboxfun (showbbox) put",
" mytext",
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original char)
" true charpath",
" currentpoint newpath moveto",
"} def",
"/xshowchar {",
# Save copy of 'i'
" dup",
# Get copy of 'str' out front
" 2 index",
" exch",
" 1 getinterval",
# Save current location (starting position for THIS char)
" currentpoint 3 -1 roll",
" convertToR /charfun (nullchar) put",
" convertToR /bboxfun (showbbox) put",
" mytext",
# Pop char
" pop",
# Return to start point for THIS char and use 'numarray'
# to find location for NEXT char
" moveto 2 index exch get 0 rmoveto",
# Save current location (starting position for next char),
# start new path for next char,
# move to save location
" currentpoint newpath moveto",
"} def",
"/yshowchar {",
# Save copy of 'i'
" dup",
# Get copy of 'str' out front
" 2 index",
" exch",
" 1 getinterval",
# Save current location (starting position for THIS char)
" currentpoint 3 -1 roll",
" convertToR /charfun (nullchar) put",
" convertToR /bboxfun (showbbox) put",
" mytext",
# Pop char
" pop",
# Return to start point for THIS char and use 'numarray'
# to find location for NEXT char
" moveto 2 index exch get 0 exch rmoveto",
# Save current location (starting position for next char),
# start new path for next char,
# move to save location
" currentpoint newpath moveto",
"} def",
"/xyshowchar {",
# Save copy of 'i'
" dup",
# Get copy of 'str' out front
" 2 index",
" exch",
" 1 getinterval",
# Save current location (starting position for THIS char)
" currentpoint 3 -1 roll",
" convertToR /charfun (nullchar) put",
" convertToR /bboxfun (showbbox) put",
" mytext",
# Pop char
" pop",
# Return to start point for THIS char and use 'numarray'
# to find location for NEXT char
" moveto 2 index exch 2 mul 2 getinterval dup 0 get exch 1 get rmoveto",
# Save current location (starting position for next char),
# start new path for next char,
# move to save location
" currentpoint newpath moveto",
"} def",
"/widthshowchar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" convertToR /charfun (nullchar) put",
# Just get bbox of char
" convertToR /bboxfun (showbbox) put",
" mytext",
" dup 0 get 3 index eq {4 index 4 index rmoveto} if",
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original char)
" true charpath",
" currentpoint newpath moveto",
"} def",
"/ashowchar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" convertToR /charfun (nullchar) put",
# Just get bbox of char
" convertToR /bboxfun (showbbox) put",
" mytext",
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original char)
" true charpath",
# Do adjustment on every char
" 2 index 2 index rmoveto",
" currentpoint newpath moveto",
"} def",
"/awidthshowchar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" convertToR /charfun (nullchar) put",
# Just get bbox of char
" convertToR /bboxfun (showbbox) put",
" mytext",
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original char)
# Check for special char adjustment
" dup 0 get 5 index eq {6 index 6 index rmoveto} if",
" true charpath",
" 2 index 2 index rmoveto",
" currentpoint newpath moveto",
"} def",
# text is split into individual characters,
# each character is converted to a path, flattened
# and then stroked
"/strokechar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" dup", # copy of char for "char="
" true charpath flattenpath",
" {mymove} {myline} {mycurve} {myclose}",
" mychar",
" pop", # copy of char for "char="
# Save current location (starting position for next char),
# start new path for next char,
# move to save location
" currentpoint newpath moveto",
"} def",
"/xstrokechar {",
# Save copy of 'i'
" dup",
# Get copy of 'str' out front
" 2 index",
" exch",
" 1 getinterval",
# Save current location (starting position for THIS char)
" currentpoint 3 -1 roll",
" dup", # copy of char for "char="
" true charpath flattenpath",
" {mymove} {myline} {mycurve} {myclose}",
" mychar",
" pop", # copy of char for "char="
# Return to start point for THIS char and use 'numarray'
# to find location for NEXT char
" moveto 2 index exch get 0 rmoveto",
# Save current location (starting position for next char),
# start new path for next char,
# move to save location
" currentpoint newpath moveto",
"} def",
"/ystrokechar {",
# Save copy of 'i'
" dup",
# Get copy of 'str' out front
" 2 index",
" exch",
" 1 getinterval",
# Save current location (starting position for THIS char)
" currentpoint 3 -1 roll",
" dup", # copy of char for "char="
" true charpath flattenpath",
" {mymove} {myline} {mycurve} {myclose}",
" mychar",
" pop", # copy of char for "char="
# Return to start point for THIS char and use 'numarray'
# to find location for NEXT char
" moveto 2 index exch get 0 exch rmoveto",
# Save current location (starting position for next char),
# start new path for next char,
# move to save location
" currentpoint newpath moveto",
"} def",
"/xystrokechar {",
# Save copy of 'i'
" dup",
# Get copy of 'str' out front
" 2 index",
" exch",
" 1 getinterval",
# Save current location (starting position for THIS char)
" currentpoint 3 -1 roll",
" dup", # copy of char for "char="
" true charpath flattenpath",
" {mymove} {myline} {mycurve} {myclose}",
" mychar",
" pop", # copy of char for "char="
# Return to start point for THIS char and use 'numarray'
# to find location for NEXT char
" moveto 2 index exch 2 mul 2 getinterval dup 0 get exch 1 get rmoveto",
# Save current location (starting position for next char),
# start new path for next char,
# move to save location
" currentpoint newpath moveto",
"} def",
"/widthstrokechar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" dup",
" true charpath flattenpath",
" {mymove} {myline} {mycurve} {myclose}",
" mychar",
# Check for special char adjustment
# (the get converts char to int)
" 0 get 2 index eq {3 index 3 index rmoveto} if",
" currentpoint newpath moveto",
"} def",
"/astrokechar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" dup", # copy of char for "char="
" true charpath flattenpath",
" {mymove} {myline} {mycurve} {myclose}",
" mychar",
" pop", # copy of char for "char="
" 2 index 2 index rmoveto",
" currentpoint newpath moveto",
"} def",
"/awidthstrokechar {",
" exch dup 3 -1 roll",
" 1 getinterval",
" dup",
" true charpath flattenpath",
" {mymove} {myline} {mycurve} {myclose}",
" mychar",
# Do adjustment on every char
" 3 index 3 index rmoveto",
# Check for special char adjustment
" 0 get 4 index eq {5 index 5 index rmoveto} if",
" currentpoint newpath moveto",
"} def",
"/showchars {",
" dup length -1 add 0 exch 1 exch {showchar} for",
"} def",
"/xshowchars {",
" dup length -1 add 0 exch 1 exch {xshowchar} for",
"} def",
"/yshowchars {",
" dup length -1 add 0 exch 1 exch {yshowchar} for",
"} def",
"/xyshowchars {",
" dup length -1 add 0 exch 1 exch {xyshowchar} for",
"} def",
"/widthshowchars {",
" dup length -1 add 0 exch 1 exch {widthshowchar} for",
"} def",
"/ashowchars {",
" dup length -1 add 0 exch 1 exch {ashowchar} for",
"} def",
"/awidthshowchars {",
" dup length -1 add 0 exch 1 exch {awidthshowchar} for",
"} def",
"/showpaths {",
" dup length -1 add 0 exch 1 exch {strokechar} for",
"} def",
"/xshowpaths {",
" dup length -1 add 0 exch 1 exch {xstrokechar} for",
"} def",
"/yshowpaths {",
" dup length -1 add 0 exch 1 exch {ystrokechar} for",
"} def",
"/xyshowpaths {",
" dup length -1 add 0 exch 1 exch {xystrokechar} for",
"} def",
"/widthshowpaths {",
" dup length -1 add 0 exch 1 exch {widthstrokechar} for",
"} def",
"/ashowpaths {",
" dup length -1 add 0 exch 1 exch {astrokechar} for",
"} def",
"/awidthshowpaths {",
" dup length -1 add 0 exch 1 exch {awidthstrokechar} for",
"} def",
"/showbbox {",
" gsave",
" currentpoint newpath moveto dup true charpath flattenpath",
" boxinit",
" {boxmove} {boxline} {boxcurve} {boxclose} pathforall",
# Update global picture xmin/xmax/ymin/ymax
" boxupdate",
" grestore",
"} def",
"/xshowbbox {",
" gsave",
" currentpoint newpath moveto",
# For each char, save currentpoint, flatten charpath,
# move back to start point and shift across using 'numarray'
" dup length -1 add 0 exch 1 exch { dup 2 index exch 1 getinterval currentpoint 3 -1 roll true charpath flattenpath moveto 2 index exch get 0 rmoveto } for",
" boxinit",
" {boxmove} {boxline} {boxcurve} {boxclose} pathforall",
# Update global picture xmin/xmax/ymin/ymax
" boxupdate",
" grestore",
"} def",
"/yshowbbox {",
" gsave",
" currentpoint newpath moveto",
# For each char, save currentpoint, flatten charpath,
# move back to start point and shift across using 'numarray'
" dup length -1 add 0 exch 1 exch { dup 2 index exch 1 getinterval currentpoint 3 -1 roll true charpath flattenpath moveto 2 index exch get 0 exch rmoveto } for",
" boxinit",
" {boxmove} {boxline} {boxcurve} {boxclose} pathforall",
# Update global picture xmin/xmax/ymin/ymax
" boxupdate",
" grestore",
"} def",
"/xyshowbbox {",
" gsave",
" currentpoint newpath moveto",
# For each char, save currentpoint, flatten charpath,
# move back to start point and shift across using 'numarray'
" dup length -1 add 0 exch 1 exch { dup 2 index exch 1 getinterval currentpoint 3 -1 roll true charpath flattenpath moveto 2 index exch 2 mul 2 getinterval dup 0 get exch 1 get rmoveto } for",
" boxinit",
" {boxmove} {boxline} {boxcurve} {boxclose} pathforall",
# Update global picture xmin/xmax/ymin/ymax
" boxupdate",
" grestore",
"} def",
"/widthshowbbox {",
" gsave",
" currentpoint newpath moveto",
" dup length -1 add 0 exch 1 exch { 1 index exch 1 getinterval dup true charpath flattenpath 0 get 2 index eq { 3 index 3 index rmoveto } if } for",
" boxinit",
" {boxmove} {boxline} {boxcurve} {boxclose} pathforall",
# Update global picture xmin/xmax/ymin/ymax
" boxupdate",
" grestore",
"} def",
"/ashowbbox {",
" gsave",
" currentpoint newpath moveto",
" dup length -1 add 0 exch 1 exch { 1 index exch 1 getinterval true charpath flattenpath 2 index 2 index rmoveto } for",
" boxinit",
" {boxmove} {boxline} {boxcurve} {boxclose} pathforall",
# Update global picture xmin/xmax/ymin/ymax
" boxupdate",
" grestore",
"} def",
"/awidthshowbbox {",
" gsave",
" currentpoint newpath moveto",
" dup length -1 add 0 exch 1 exch { 1 index exch 1 getinterval dup true charpath flattenpath 3 index 3 index rmoveto 0 get 4 index eq { 5 index 5 index rmoveto } if } for",
" boxinit",
" {boxmove} {boxline} {boxcurve} {boxclose} pathforall",
# Update global picture xmin/xmax/ymin/ymax
" boxupdate",
" grestore",
"} def",
"/showwidthadj {",
" convertToR /curadj 0 put",
"} def",
"/widthshowwidthadj {",
" convertToR /curadj 0 put",
# Determine width adj in device coords
" 3 index 0 transwidth",
# Check each char, if special, add
" 1 index { 3 index eq { convertToR /curadj get 1 index add convertToR /curadj 3 -1 roll put } if } forall",
# Clean up
" pop",
"} def",
"/ashowwidthadj {",
# How many chars
" dup length",
# Determine width adj in device coords
" 3 index 0 transwidth",
" mul convertToR /curadj 3 -1 roll put",
"} def",
"/awidthshowwidthadj {",
# How many chars
" dup length",
# Determine width adj in device coords
" 3 index 0 transwidth",
" mul convertToR /curadj 3 -1 roll put",
# Determine width adj in device coords
" 5 index 0 transwidth",
# Check each char, if special, add
" 1 index { 5 index eq { convertToR /curadj get 1 index add convertToR /curadj 3 -1 roll put } if } forall",
# Clean up
" pop",
"} def",
"/show {",
" convertToR /charpathfun (showpaths) put",
" convertToR /charfun (showchars) put",
" convertToR /widthadjfun (showwidthadj) put",
" convertToR /bboxfun (showbbox) put",
" mytext",
if (!(charpath || charpos)) {
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original text)
" true charpath"
} else {
"pop"
},
" currentpoint newpath moveto",
"} def",
"/xshow {",
" convertToR /charpathfun (xshowpaths) put",
" convertToR /charfun (xshowchars) put",
" convertToR /widthadjfun (showwidthadj) put",
" convertToR /bboxfun (xshowbbox) put",
# Switch 'string' and 'numarray' so common code
# for show operators can see 'string' on top of stack
" exch",
" mytext",
if (!(charpath || charpos)) {
# Perform the x-shifts from 'numarray'
" exch { 0 rmoveto } forall"
} else {
# remove 'numarray'
" exch pop"
},
# Remove 'string'
" pop",
" currentpoint newpath moveto",
"} def",
"/yshow {",
" convertToR /charpathfun (yshowpaths) put",
" convertToR /charfun (yshowchars) put",
" convertToR /widthadjfun (showwidthadj) put",
" convertToR /bboxfun (yshowbbox) put",
# Switch 'string' and 'numarray' so common code
# for show operators can see 'string' on top of stack
" exch",
" mytext",
if (!(charpath || charpos)) {
# Perform the y-shifts from 'numarray'
" exch { 0 exch rmoveto } forall"
} else {
# remove 'numarray'
" exch pop"
},
# Remove 'string'
" pop",
" currentpoint newpath moveto",
"} def",
"/xyshow {",
" convertToR /charpathfun (xyshowpaths) put",
" convertToR /charfun (xyshowchars) put",
" convertToR /widthadjfun (showwidthadj) put",
" convertToR /bboxfun (xyshowbbox) put",
# Switch 'string' and 'numarray' so common code
# for show operators can see 'string' on top of stack
" exch",
" mytext",
if (!(charpath || charpos)) {
# Perform the x/y-shifts from 'numarray' and pop 'numarray'
" exch dup length 2 idiv -1 add 0 exch 1 exch { 1 index exch 2 mul 2 getinterval dup 0 get exch 1 get rmoveto } for pop"
} else {
# remove 'numarray'
" exch pop"
},
# Remove 'string'
" pop",
" currentpoint newpath moveto",
"} def",
"/widthshow {",
" convertToR /charpathfun (widthshowpaths) put",
" convertToR /charfun (widthshowchars) put",
" convertToR /widthadjfun (widthshowwidthadj) put",
" convertToR /bboxfun (widthshowbbox) put",
" mytext",
if (!(charpath || charpos)) {
# Check for any char adjustments
c(" dup dup { 2 index eq {3 index 3 index rmoveto} if } forall",
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original text)
" true charpath")
} else {
"pop"
},
# Remove the cx and cy and char from the /widthshow
" pop pop pop",
" currentpoint newpath moveto",
"} def",
"/ashow {",
" convertToR /charpathfun (ashowpaths) put",
" convertToR /charfun (ashowchars) put",
" convertToR /widthadjfun (ashowwidthadj) put",
" convertToR /bboxfun (ashowbbox) put",
" mytext",
if (!(charpath || charpos)) {
# Do per-char adjustment
c(" dup length dup 4 index mul exch 3 index mul rmoveto",
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original text)
" true charpath")
} else {
"pop"
},
# Remove ax and ay
" pop pop",
" currentpoint newpath moveto",
"} def",
"/awidthshow {",
" convertToR /charpathfun (awidthshowpaths) put",
" convertToR /charfun (awidthshowchars) put",
" convertToR /widthadjfun (awidthshowwidthadj) put",
" convertToR /bboxfun (awidthshowbbox) put",
" mytext",
if (!(charpath || charpos)) {
# Do per-char adjustment
c(" dup length -1 add dup 4 index mul exch 3 index mul rmoveto",
# Check for any char adjustments
" dup { 4 index eq {5 index 5 index rmoveto} if } forall",
# Generate charpath so that currentpoint returns correct location
# (this also consumes the original text)
" true charpath")
} else {
"pop"
},
# Remove ax,ay,char,cx,cy
" pop pop pop pop pop",
" currentpoint newpath moveto",
"} def",
"end",
# end global settings
"false setglobal",
"%%EndProcSet",
"%% EndProlog",
"",
# Put converToR on the dictionary stack
"convertToR begin",
# Put userdict on top of dictionary stack for the file that is
# about to run
"userdict begin",
if (!is.null(setflat)) {
paste(setflat, "setflat")
},
"")
}
PScaptureFoot <-
c(
# Restore convertToR dict to dictionary stack in case the file
# that we just ran does something nasty like clearing the dict stack!
"convertToR begin",
# XML file footer info
"1 dict begin",
"/str 50 string def",
"(<summary count=') print convertToR /id get 1 sub str cvs print (') print",
"( ymax=') print convertToR /ymax get str cvs print (') print",
"( ymin=') print convertToR /ymin get str cvs print (') print",
"( xmax=') print convertToR /xmax get str cvs print (') print",
"( xmin=') print convertToR /xmin get str cvs print (') print",
"(/>\n\n) print",
"(</picture>\n) print",
"end",
# EOF
"%% EOF\n"
)
# Handle a "stringLine" that contains a NUL character
# ONE LINE ONLY at a time
processNUL <- function(filename, linenum) {
if (length(linenum) != 1)
stop("Bad computer!")
# Read in each piece of the element
bits <- scan(filename, skip=linenum - 1, nlines=1, quote=NULL,
sep=" ", quiet=TRUE, what="character")
# The
# string='###TEXT blah blah ###TEXT'
# part will be incomplete (terminated by the NUL char in blah blah)
# Replace
# string='###TEXT whatever
# with
# string=''
bits[grep("string='###TEXT", bits)] <-
paste(bits[grep("string='###TEXT", bits)], "###TEXT'", sep="")
# OR could be
# char='###TEXT^@###TEXT'
bits[grep("char='###TEXT", bits)] <- "char='###TEXT###TEXT'"
# Check for ###TEXT' too
bits[grep("###TEXT' $", bits)] <- " "
# Put it all back together
paste(bits, collapse=" ")
}
# Perform some post-processing of the XML file that is generated by the
# above PostScript code.
# (e.g., do some character escaping that would be more painful to do
# in PostScript code)
postProcess <- function(outfilename, enc, defaultcol) {
processStringLine <- function(stringLine) {
paste(stringLine[1],
gsub("<", "<",
gsub(">", ">",
gsub("'", "'",
gsub("&", "&",
stringLine[2])))),
stringLine[3],
sep="")
}
# The XML file has been created by ghostscript in ISO-8859-1
infile <- file(outfilename, "r", encoding="ISO-8859-1")
lines <- readLines(infile)
close(infile)
# All string values have been marked
stringLines <- grep("###TEXT", lines)
if (length(stringLines) > 0) {
# Check first for NUL-terminated text
# Test is no tag terminator, ">", at end of line
nulTerminated <- !grepl(">$", lines[stringLines])
if (any(nulTerminated)) {
for (i in stringLines[nulTerminated]) {
lines[i] <- processNUL(outfilename, i)
}
}
stringLinesBits <- strsplit(lines[stringLines], "###TEXT")
stringLinesMod <- sapply(stringLinesBits, processStringLine)
lines[stringLines] <- stringLinesMod
}
# Write the file using 'enc' encoding
outfile <- file(outfilename, "w", encoding=enc)
writeLines(lines, outfile)
close(outfile)
}
# Generate RGML file from PostScript file
PostScriptTrace <- function(file, outfilename,
charpath=TRUE, charpos=FALSE,
setflat=NULL, defaultcol="black",
encoding="ISO-8859-1", scaleEPS=.01) {
# Create temporary PostScript file which loads
# dictionary redefining stroke and fill operators
# and then runs target PostScript file
psfilename <- tempfile(fileext = ".ps")
psfile <- file(psfilename, "w")
writeLines(PScaptureHead(file, charpath, charpos,
setflat, encoding, scaleEPS),
psfile)
# Reconstitute file name here to handle Windows-style paths
# in the file name
writeLines(paste("(", file.path(dirname(file), basename(file)),
") run", sep=""), psfile)
writeLines(PScaptureFoot, psfile)
close(psfile)
if (missing(outfilename)) {
outfilename <- paste(basename(file), ".xml", sep="")
}
# Run temp file using ghostscript
# Determination of ghostscript command syntax derived from dev2bitmap()
gsexe <- Sys.getenv("R_GSCMD")
if (.Platform$OS.type == "windows") {
if(!nzchar(gsexe)) gsexe <- Sys.getenv("GSC")
if(is.null(gsexe) || !nzchar(gsexe)) {
poss <- Sys.which(c("gswin64c.exe", "gswin32c.exe"))
poss <- poss[nzchar(poss)]
gsexe <- if(length(poss)) poss[1] else "gswin32c.exe"
} else if(grepl(" ", gsexe, fixed = TRUE))
gsexe <- utils::shortPathName(gsexe)
outfile <- tempfile()
} else {
if (is.null(gsexe) || !nzchar(gsexe)) {
gsexe <- "gs"
rc <- system(paste(shQuote(gsexe), "-help > /dev/null"))
if (rc != 0)
stop("sorry, 'gs' cannot be found")
}
outfile <- "/dev/null"
}
cmd <- paste(shQuote(gsexe),
" -q -dBATCH -dNOPAUSE -dNOSAFER",
" -sDEVICE=ps2write -sOutputFile=",
outfile, " -sstdout=",
outfilename, " ",
psfilename, sep="")
ret <- switch(.Platform$OS.type,
unix = system(cmd),
windows = system(cmd, invisible = TRUE))
if(ret != 0) {
stop(gettextf("status %d in running command '%s'", ret, cmd),
domain = NA)
} else {
postProcess(outfilename, encoding, defaultcol)
}
invisible(cmd)
}
Try the grImport package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.