# x is string vector with elements:
# [1] = stroke or fill
# [2:4] = R G B colour
# [5] = line width
getrgb <- function(x) {
  do.call("rgb", as.list(as.numeric(x[2:4])))
}
getlwd <- function(x) {
  as.numeric(x[5])
}

# Read a processed PostScript file and produce a list of PSobjs from it
PSimport <- function(file) {
  inText <- readLines(file)
  nlines <- length(inText)

  # Which lines are moves
  moves <- grep("move", inText)
  nmoves <- length(moves)
  # which lines are strokes/fills
  strokes <- grep("stroke", inText)
  fills <- grep("fill", inText)
  # which lines are closes
  closes <- grep("close", inText)
  # replace close with line to previous move
  for (i in closes)
    inText[i] <- gsub("move", "line", inText[max(moves[moves < i])])
  # what is the current colour for stroke/fill
  strokesrgb <- sapply(strsplit(inText[strokes], " "), getrgb)
  fillsrgb <- sapply(strsplit(inText[fills], " "), getrgb)
  strokeslwd <- sapply(strsplit(inText[strokes], " "), getlwd)
  fillslwd <- sapply(strsplit(inText[fills], " "), getlwd)
  # which moves are strokes
  stroke <- rep(NA, nmoves)
  stroke[(moves - 1) %in% fills] <- FALSE
  stroke[(moves - 1) %in% strokes] <- TRUE
  stroke <- c(stroke[2:nmoves],
              if (max(fills) > max(strokes)) FALSE
              else TRUE)
  while (any(is.na(stroke))) {
    stroke[is.na(stroke)] <- stroke[(1:nmoves)[is.na(stroke)] + 1]
  }
  # get the rgb settings for each stroke/fill
  rgb <- rep(NA, nmoves)
  if (length(fillsrgb) > 0) rgb[(moves - 1) %in% fills] <- fillsrgb
  if (length(strokesrgb) > 0) rgb[(moves - 1) %in% strokes] <- strokesrgb
  rgb <- c(rgb[2:nmoves])
  if (max(fills) > max(strokes))
    rgb[nmoves] <- fillsrgb[length(fills)]
  else
    rgb[nmoves] <- strokesrgb[length(strokes)]
  while (any(is.na(rgb))) {
    rgb[is.na(rgb)] <- rgb[(1:nmoves)[is.na(rgb)] + 1]
  }
  lwd <- rep(NA, nmoves)
  if (length(fillslwd) > 0) lwd[(moves - 1) %in% fills] <- fillslwd
  if (length(strokeslwd) > 0) lwd[(moves - 1) %in% strokes] <- strokeslwd
  lwd <- c(lwd[2:nmoves])
  if (max(fills) > max(strokes))
    lwd[nmoves] <- fillslwd[length(fills)]
  else
    lwd[nmoves] <- strokeslwd[length(strokes)]
  while (any(is.na(lwd))) {
    lwd[is.na(lwd)] <- lwd[(1:nmoves)[is.na(lwd)] + 1]
  }
  # Extract numeric locations
  numText <- inText
  numText <- sub("close(stroke|fill)", "NA NA", numText)
  numText <- sub("move ", "", numText)
  numText <- sub("line ", "", numText)
  xloc <- as.numeric(substr(numText,
                            regexpr(" -?[0-9.]+", numText),
                            nchar(numText)))
  yloc <- as.numeric(substr(numText, 1,
                            regexpr(" -?[0-9.]+", numText)))
  # Build R objects
  outlines <- vector("list", nmoves)
  for (i in 1:nmoves) {
    if (i == nmoves) {
      x <- xloc[moves[i]:nlines]
      y <- yloc[moves[i]:nlines]
    } else if ((moves[i + 1] - 1) %in% strokes ||
               (moves[i + 1] - 1) %in% fills) {
      x <- xloc[moves[i]:(moves[i + 1] - 2)]
      y <- yloc[moves[i]:(moves[i + 1] - 2)]
    } else {
      x <- xloc[moves[i]:(moves[i + 1] - 1)]
      y <- yloc[moves[i]:(moves[i + 1] - 1)]
    }
    if (stroke[i]) {
      outlines[[i]] <- PSobj(x, y, rgb[i], lwd[i], "stroke")
    } else {
      outlines[[i]] <- PSobj(x, y, rgb[i], lwd[i], "fill")
    }
  }
  outlines
}

setClass("PSop",
         representation(x="numeric",
                        y="numeric",
                        rgb="character",
                        lwd="numeric"))

setClass("PSstroke",
         representation("PSop"))

setClass("PSfill",
         representation("PSop"))

PSobj <- function(x, y, rgb, lwd, cl) {
  switch(cl,
         stroke=new("PSstroke", x=x, y=y, rgb=rgb, lwd=lwd),
         fill=new("PSfill", x=x, y=y, rgb=rgb, lwd=lwd))
}