R/element.R

In gridSVG: Export 'grid' Graphics as SVG

# 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))
}