# Functions for generating arbitrary SVG elements
elementGrob <- function(el, name = NULL, attrs = NULL,
namespace = NULL,
namespaceDefinitions = NULL,
children = NULL,
vp = NULL, childrenvp = NULL,
asis = FALSE) {
eg <- gTree(name = name, vp = vp,
children = children, childrenvp = childrenvp,
cl = "element")
# Keeping copy of name because of asis.
# If it's TRUE, we leave the id alone.
# When FALSE, the resulting id attribute could get modified
# by things like gTrees so that the name is a *path*.
eg$asis <- asis
eg$origname <- eg$name
eg$el <- el
eg$attrs <- if (is.null(attrs)) list() else attrs
eg$namespace <- namespace
eg$namespaceDefinitions <- namespaceDefinitions
cl <- class(eg)
class(eg) <- unique(c("element.grob", cl))
eg
}
grid.element <- function(el, name = NULL, attrs = NULL,
namespace = NULL,
namespaceDefinitions = NULL,
children = NULL,
vp = NULL, childrenvp = NULL,
asis = FALSE) {
grid.draw(elementGrob(el, name, attrs, namespace,
namespaceDefinitions, children,
vp, childrenvp, asis))
}
devGrob.element.grob <- function(x, dev) {
list(id = if (x$asis) x$origname
else getID(x$name, "grob"),
name = x$el,
classes = x$classes,
attrs = x$attrs,
namespace = x$namespace,
namespaceDefinitions = x$namespaceDefinitions)
}
# Unlike gTrees, we don't need a group for children because it
# complicates output, when we want clear output to SVG.
# Also, do *not* add gpars because they also complicate output,
# if we *really* want to do it, then just use the 'attrs' arg.
primToDev.element.grob <- function(x, dev) {
devStartElement(devGrob(x, dev), NULL, dev)
lapply(x$children, function(child) {
grobToDev(child, dev)
})
devEndElement(x$name, dev)
}
devGrob.textnode.grob <- function(x, dev) {
list(text = x$text)
}
primToDev.textnode.grob <- function(x, dev) {
devTextNode(devGrob(x, dev), dev)
}
textNodeGrob <- function(text, name = NULL, vp = NULL) {
if (length(text) > 1)
stop("'text' must be a single element character vector")
tng <- grob(name = name, vp = vp, cl = "textNode")
tng$text <- text
cl <- class(tng)
class(tng) <- unique(c("textnode.grob", cl))
tng
}
grid.textNode <- function(text, name = NULL, vp = NULL) {
grid.draw(textNodeGrob(text, name, vp))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.