1 2transform <- function(xy, m) { 3 newX = m[1] * xy[,1] + m[3] * xy[,2] + m[5] 4 newY = m[2] * xy[,1] + m[4] * xy[,2] + m[6] 5 cbind(newX, newY) 6} 7 8oneline <- function(x, id) { 9 x <- trimws(gsub('^m', "", x)) 10 ss <- trimws(unlist(strsplit(x, "m "))) 11 out <- list() 12 for (j in 1:length(ss)) { 13 v <- unlist(utils::read.table(text=ss[j], sep=" ")) 14 vv <- as.numeric(unlist(strsplit(v, ","))) 15 vv <- matrix(vv, ncol=2, byrow=TRUE) 16 if (j > 1) { 17 vv[1,] <- vv[1,] + a[1,] 18 } 19 a <- apply(vv, 2, cumsum) 20 out[[j]] <- a 21 } 22 out <- lapply(1:length(out), function(p) cbind(id=id, part=p, out[[p]], hole=0)) 23 out <- do.call(rbind, out) 24 out[,4] <- -out[,4] 25 #out[,3:4] <- transform(out[,3:4], m) 26 out 27} 28 29 30readSVG <- function(f) { 31 doc <- XML::htmlParse(f) 32 p <- XML::xpathSApply(doc, "//path", XML::xmlGetAttr, "d") 33 s <- list() 34 for (i in 1:length(p)) { 35 s[[i]] <- oneline(p[i], i) 36 } 37 ss <- do.call(rbind, s) 38 v <- vect(ss, type="polygons") 39 40 a <- XML::xpathSApply(doc, "//path", XML::xmlAttrs) 41 a <- unique(unlist(sapply(a, names))) 42 a <- a[-grep(":", a)] 43 a <- a[a != "d"] 44 if (length(a) > 0) { 45 att <- list() 46 for (i in 1:length(a)) { 47 z <- XML::xpathSApply(doc, "//path", XML::xmlGetAttr, a[i]) 48 att[[i]] <- sapply(z, function(i) if (is.null(i)) NA else i, USE.NAMES = FALSE) 49 } 50 names(att) <- a 51 values(v) <- data.frame(att) 52 } 53 v 54} 55 56 57 58 59