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