# Function to extract outlines from PostScript paths

PScaptureHead <- c("%!PS-Adobe-2.0 EPSF-1.2",
                   "%%BeginProcSet:convertToR 0 0",
                   "/convertToR dup 100 dict def load begin",
                   "/str 20 string def",
                   # override path operators
                   "/mymove {(move ) print str cvs print ( ) print str cvs print (\n) print} def",
                   "/myline {(line ) print str cvs print ( ) print str cvs print (\n) print} def",
                   "/mycurve {(curve ) print str cvs print ( ) print str cvs print (\n) print} def",
                   "/myclose {(close \n) print} def", 
                   # print out "closestroke" marker plus graphics state info
                   # make sure the colour is RGB not BGR
                   # multiply line width by 1.33 (R converts 1 to 0.75 when
                   #   writing PostScript)
                   "/mystroke {(stroke ) print currentrgbcolor 2 index str cvs print ( ) print 1 index str cvs print ( ) print str cvs print pop pop ( ) print currentlinewidth 1.33 mul str cvs print (\n) print} def",
                   "/myfill {(fill ) print currentrgbcolor 2 index str cvs print ( ) print 1 index str cvs print ( ) print str cvs print pop pop ( ) print currentlinewidth 1.33 mul str cvs print (\n) print} def",
                   # override paint operators
                   "/stroke {flattenpath {mymove} {myline} {mycurve} {myclose} pathforall mystroke newpath} def",
                   "/fill {flattenpath {mymove} {myline} {mycurve} {myclose} pathforall myfill newpath} def",
                   "/show {charpath flattenpath {mymove} {myline} {mycurve} {myclose} pathforall myfill newpath} def",
                   "end",
                   "%%EndProcSet",
                   "%% EndProlog",
                   "",
                   "convertToR begin",
                   "")

PScaptureFoot <- c("%% EOF")

PStrace <- function(file) {
  # Create temporary PostScript file which loads
  # dictionary redefining stroke and fill operators
  # and then runs target PostScript file
  psfilename <- paste("capture", file, sep="")
  psfile <- file(psfilename, "w")
  writeLines(PScaptureHead, psfile)
  writeLines(paste("(", file, ") run", sep=""), psfile)
  writeLines(PScaptureFoot, psfile)
  close(psfile)
  # Run temp file using ghostscript
  outfilename <- paste(file, ".out", sep="")
  system(paste("gs -q -dBATCH -dNOPAUSE -sDEVICE=nullpage",
               psfilename, ">", outfilename))
}