1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
#
# An example of processing an SVG document
# See the example in the parallel directory data/svg.xml.
#
#
# xmlplot <- xmlTreeParse("data/svg.xml")
# x11()
# svgRender(xmlplot)
#
# See also: mathml.R
#
#
# need support for the general SVG tags and attributes
# desc
# path
# image
# viewbox
# stroke
# transform matrix
#
svgRender <-
function(doc)
{
UseMethod("svgRender",doc)
}
svgRender.default <-
function(doc)
{
svgRender(doc$doc$children$svg)
}
svgRender.XMLNode <-
#
# This processes an XML node assumed to come from an
# SVG document and either
# a) renders the corresponding element
# and potentially recursively operates on its children, or
# b) stores the settings specified in a group tag (<g> or <svg>)
# for use in the processing of the sub-nodes.
#
# This has basic support for circles, rectangles, polygons,
# text
#
function(top, settings = NULL)
{
if(is.null(settings)) {
settings <- SVGSettings()
}
if(top$name == "svg") {
dims <- top$attributes
frame()
par(usr=c(0, as.integer(dims[["width"]]) + 1, 0, as.integer(dims[["height"]])+1))
} else if(top$name == "g") {
if(!is.na(match("style", names(top$attributes)))) {
settings$fill <- properties(top$attributes[["style"]])[["fill"]]
}
}
for(i in top$children) {
if(class(i) == "XMLComment")
next
ats <- i$attributes
if(i$name == "rect") {
if(!is.na(match("style", names(ats)))) {
col <- properties(ats[["style"]])[["fill"]]
} else {
col <- settings$fill
}
rect(as.integer(ats[["x"]]), as.integer(ats[["y"]]), as.integer(ats[["x"]]) + as.integer(ats[["width"]]), as.integer(ats[["y"]]) + as.integer(ats[["width"]]), col = col)
} else if(i$name == "text") {
# need to gather up all the children in case the text
# is split into different components.
val <- i$children[[1]]$value
text(as.integer(ats[["x"]]), as.integer(ats[["y"]]), val, adj=1.0)
} else if(i$name == "polygon") {
# read the points attribute as a integer vector
data <- scan.string(ats[["points"]])
idx <- seq(1,length(data), by=2)
x <- data[idx]
y <- data[idx+1]
if(!is.na(match("style", names(ats)))) {
col <- properties(ats[["style"]])[["fill"]]
} else {
col <- settings$fill
}
polygon(x,y, col)
} else if(i$name == "ellipse") {
if(!is.na(match("style", names(ats)))) {
col <- properties(ats[["style"]])[["fill"]]
} else {
col <- settings$fill
}
r <- min(as.integer(ats[["rx"]]), as.integer(ats[["ry"]]))
symbols(as.integer(ats[["cx"]]), as.integer(ats[["cy"]]), circles=as.integer(r),inches=F, add=T)
} else if(i$name == "g") {
svgRender(i, settings)
}
}
invisible(return(T))
}
SVGSettings <-
#
# This class of object is used for storing the
# "global" or currently active settings for within
# an SVG group. This includes things such as color
# fill style and color, font, etc.
function()
{
val <- list(fill=NULL, font=NULL, fg=NULL, bg=NULL)
class(val) <- "SVGSettings"
val
}
#
# The following are very simple (inefficient and potentially inconsistent with R)
# ways of manipulating strings. These would be implemented using textConnection
# objects in S4.
#
scan.string <- function(data)
{
# This could use string split
# strsplit(data, rx)
cmd <- paste("perl -e '$x = join(\"\n\", split(/ /, $ARGV[0])); printf \"$x\n\";'", paste("'",data,"'", collapse="",sep=""))
els <- system(cmd, intern=T)
vals <- as.integer(sapply(els, as.integer))
return(vals)
}
properties <-
function(str)
{
cmd <- paste("perl -e '$x = join(\"\n\", split(/ /, $ARGV[0])); printf \"$x\n\";'", paste("'",str,"'", collapse="",sep=""))
els <- system(cmd, intern=T)
idx <- seq(1,length(els), by=2)
vals <- els[idx+1]
names(vals) <- els[idx]
return(vals)
}
|
