R/import.R

Defines functions checkValidSVG readPicture

Documented in readPicture

readPicture <- function(file, warn = TRUE, initDefs = TRUE) {
    if (missing(file))
        stop("'file' must be a character string representing a path to a file.")
    doc <- xmlParse(file)
    checkValidSVG(doc, warn = warn)
    svgImage <- xmlRoot(doc)
    pictureDims <- getPictureDims(svgImage)
    ## Initialise defs in .grImport2Env so can be modded on-the-fly
    ## during parseImage
    if (initDefs) {
        assign("defs", new("PictureDefinitions"), envir=.grImport2Env)
    }
    ## Parsing can create temporary graphics devices, so make sure
    ## that the current device BEFORE this call is restored
    cd <- dev.cur()
    if (cd > 1)
        on.exit(dev.set(cd))
    # Fill up picture definitions table first
    parsePictureDefinitions(svgImage)
    # Now parse the contents of the image (<defs> are ignored).
    # <use>s are resolved to "real" elements
    pic <- parseImage(xmlChildren(svgImage, addNames = FALSE),
                      createDefs = FALSE)
    # Update defs for changes during parseImage
    picdefs <- get("defs", envir=.grImport2Env)
    new("Picture",
        content = pic,
        defs = picdefs,
        summary = new("PictureSummary",
                      xscale = c(0, pictureDims[1]),
                      yscale = c(pictureDims[2], 0)))
}

checkValidSVG <- function(doc, minVersion = NA, warn = TRUE) {
    if (xmlName(xmlRoot(doc)) != "svg")
        stop("This picture is not an SVG document.")
    if (! warn)
        return()
    # Note: suppressing warnings because we know we just want comments
    # and do not care about the namespace (SVG) that they belong in
    comments <- suppressWarnings(getNodeSet(doc, "//comment()"))
    grConvertSVG <- length(comments) &&
        grepl("Created by grConvert", xmlValue(comments[[1]]))
    if (grConvertSVG) {
        cairoSVG <- TRUE
        ## Future proofing on grConvert input, add a min version check on
        ## the output that grConvert creates.
        if (! is.na(minVersion)) {
            grConvertComment <- xmlValue(grConvertComment[[1]])
            ## Collect the version number (of the form v0.1-0, for example)
            fileVersion <-
                gsub(".*v([0-9.-]+) $", "\\1", grConvertComment, perl = TRUE)
            if (package_version(fileVersion) < package_version(minVersion))
                warning(paste0("This picture was generated by an old version ",
                               " of 'grConvert'. ",
                               "The minimum supported version is ",
                               minVersion,". Errors may result"))
        }
    } else {
        ## This only works for Cairo versions < 1.18.0
        topGroup <- getNodeSet(doc, "/svg:svg/svg:g[1]",
                               namespaces=c(svg="http://www.w3.org/2000/svg"))
        if (length(topGroup)) {
            groupAttrs <- xmlAttrs(topGroup[[1]])
        } else {
            groupAttrs <- NULL
        }
        cairoSVG <- length(groupAttrs) && "id" %in% names(groupAttrs) &&
            grepl("^surface", groupAttrs["id"])
    }
    
    if (!cairoSVG) {
        warningText <- 
        "This picture may not have been generated by Cairo graphics; errors may result"
        warning(warningText)
    }
}

Try the grImport2 package in your browser

Any scripts or data that you put into this service are public.

grImport2 documentation built on Oct. 27, 2023, 9:07 a.m.