svglite/0000755000176200001440000000000013617316102011727 5ustar liggesuserssvglite/NAMESPACE0000644000176200001440000000036313617256561013164 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(print,svg) export(editSVG) export(htmlSVG) export(stringSVG) export(svglite) export(svgstring) export(xmlSVG) importFrom(Rcpp,sourceCpp) importFrom(gdtools,raster_view) useDynLib(svglite) svglite/README.md0000644000176200001440000000311713617022513013210 0ustar liggesusers# svglite [![Build Status](https://travis-ci.org/r-lib/svglite.svg?branch=master)](https://travis-ci.org/r-lib/svglite) [![Coverage Status](https://codecov.io/gh/r-lib/svglite/branch/master/graph/badge.svg)](https://codecov.io/github/r-lib/svglite?branch=master) [![CRAN Status Badge](http://www.r-pkg.org/badges/version/svglite)](https://cran.r-project.org/package=svglite) svglite is a graphics device that produces clean svg output, suitable for use on the web, or hand editing. Compared to the built-in `svg()`, svglite is considerably faster, produces smaller files, and leaves text as is. ## Installation Install the development version from github with: ```R # install.packages("devtools") devtools::install_github("r-lib/svglite") ``` ## Benchmarks Compared to the base svg device, svglite is quite a bit faster: ```R library(svglite) x <- runif(1e3) y <- runif(1e3) tmp1 <- tempfile() tmp2 <- tempfile() system.time({ svglite(tmp1) plot(x, y) dev.off() }) #> user system elapsed #> 0.003 0.001 0.003 system.time({ svg(tmp2, onefile = TRUE) plot(x, y) dev.off() }) #> user system elapsed #> 0.015 0.001 0.017 ``` It also produces considerably smaller files: ``` r file.size(tmp1) / 1024 #> [1] 93.54785 file.size(tmp2) / 1024 #> [1] 321.1357 ``` In both cases, compressing to make `.svgz` is worthwhile: ``` r gz <- function(in_path, out_path = tempfile()) { out <- gzfile(out_path, "w") writeLines(readLines(in_path), out) close(out) invisible(out_path) } file.size(gz(tmp1)) / 1024 #> [1] 9.064453 file.size(gz(tmp2)) / 1024 #> [1] 38.6123 ``` svglite/man/0000755000176200001440000000000013617022513012502 5ustar liggesuserssvglite/man/svgstring.Rd0000644000176200001440000000334413617023554015031 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/SVG.R \name{svgstring} \alias{svgstring} \title{Access current SVG as a string.} \usage{ svgstring( width = 10, height = 8, bg = "white", pointsize = 12, standalone = TRUE, system_fonts = list(), user_fonts = list() ) } \arguments{ \item{width}{Height and width in inches.} \item{height}{Height and width in inches.} \item{bg}{Default background color for the plot (defaults to "white").} \item{pointsize}{Default point size.} \item{standalone}{Produce a standalone svg file? If \code{FALSE}, omits xml header and default namespace.} \item{system_fonts}{Named list of font names to be aliased with fonts installed on your system. If unspecified, the R default families \code{sans}, \code{serif}, \code{mono} and \code{symbol} are aliased to the family returned by \code{\link[gdtools]{match_family}()}.} \item{user_fonts}{Named list of fonts to be aliased with font files provided by the user rather than fonts properly installed on the system. The aliases can be fonts from the fontquiver package, strings containing a path to a font file, or a list containing \code{name} and \code{file} elements with \code{name} indicating the font alias in the SVG output and \code{file} the path to a font file.} } \value{ A function with no arguments: call the function to get the current value of the string. } \description{ This is a variation on \code{\link{svglite}} that makes it easy to access the current value as a string. } \details{ See \code{\link{svglite}()} documentation for information about specifying fonts. } \examples{ s <- svgstring(); s() plot.new(); s(); text(0.5, 0.5, "Hi!"); s() dev.off() s <- svgstring() plot(rnorm(5), rnorm(5)) s() dev.off() } svglite/man/xmlSVG.Rd0000644000176200001440000000142213617022513014150 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/inlineSVG.R \name{xmlSVG} \alias{xmlSVG} \title{Run plotting code and return svg} \usage{ xmlSVG(code, ..., standalone = FALSE, height = 7, width = 7) } \arguments{ \item{code}{Plotting code to execute.} \item{...}{Other arguments passed on to \code{\link{svglite}}.} \item{standalone}{Produce a standalone svg file? If \code{FALSE}, omits xml header and default namespace.} \item{height}{Height and width in inches.} \item{width}{Height and width in inches.} } \value{ A \code{xml2::xml_document} object. } \description{ This is useful primarily for testing. Requires the \code{xml2} package. } \examples{ if (require("xml2")) { x <- xmlSVG(plot(1, axes = FALSE)) x xml_find_all(x, ".//text") } } svglite/man/stringSVG.Rd0000644000176200001440000000073513617022513014664 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/inlineSVG.R \name{stringSVG} \alias{stringSVG} \title{Run plotting code and return svg as string} \usage{ stringSVG(code, ...) } \arguments{ \item{code}{Plotting code to execute.} \item{...}{Other arguments passed on to \code{\link{svglite}}.} } \description{ This is useful primarily for testing but can be used as an alternative to \code{\link{svgstring}()}. } \examples{ stringSVG(plot(1:10)) } svglite/man/editSVG.Rd0000644000176200001440000000116513617022513014301 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/inlineSVG.R \name{editSVG} \alias{editSVG} \title{Run plotting code and open svg in OS/system default svg viewer or editor.} \usage{ editSVG(code, ..., width = NA, height = NA) } \arguments{ \item{code}{Plotting code to execute.} \item{...}{Other arguments passed on to \code{\link{svglite}}.} \item{width}{Height and width in inches.} \item{height}{Height and width in inches.} } \description{ This is useful primarily for testing or post-processing the SVG. } \examples{ if (interactive()) { editSVG(plot(1:10)) editSVG(contour(volcano)) } } svglite/man/htmlSVG.Rd0000644000176200001440000000101713617022513014314 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/inlineSVG.R \name{htmlSVG} \alias{htmlSVG} \title{Run plotting code and view svg in RStudio Viewer or web broswer.} \usage{ htmlSVG(code, ...) } \arguments{ \item{code}{Plotting code to execute.} \item{...}{Other arguments passed on to \code{\link{svglite}}.} } \description{ This is useful primarily for testing. Requires the \code{htmltools} package. } \examples{ if (require("htmltools")) { htmlSVG(plot(1:10)) htmlSVG(hist(rnorm(100))) } } svglite/man/svglite.Rd0000644000176200001440000000556013617256437014472 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/SVG.R \name{svglite} \alias{svglite} \title{An SVG Graphics Driver} \usage{ svglite( file = "Rplots.svg", width = 10, height = 8, bg = "white", pointsize = 12, standalone = TRUE, system_fonts = list(), user_fonts = list() ) } \arguments{ \item{file}{The file where output will appear.} \item{height, width}{Height and width in inches.} \item{bg}{Default background color for the plot (defaults to "white").} \item{pointsize}{Default point size.} \item{standalone}{Produce a standalone svg file? If \code{FALSE}, omits xml header and default namespace.} \item{system_fonts}{Named list of font names to be aliased with fonts installed on your system. If unspecified, the R default families \code{sans}, \code{serif}, \code{mono} and \code{symbol} are aliased to the family returned by \code{\link[gdtools]{match_family}()}.} \item{user_fonts}{Named list of fonts to be aliased with font files provided by the user rather than fonts properly installed on the system. The aliases can be fonts from the fontquiver package, strings containing a path to a font file, or a list containing \code{name} and \code{file} elements with \code{name} indicating the font alias in the SVG output and \code{file} the path to a font file.} } \description{ This function produces graphics compliant to the current w3 svg XML standard. The driver output is currently NOT specifying a DOCTYPE DTD. } \details{ svglite provides two ways of controlling fonts: system fonts aliases and user fonts aliases. Supplying a font alias has two effects. First it determines the \code{font-family} property of all text anchors in the SVG output. Secondly, the font is used to determine the dimensions of graphical elements and has thus an influence on the overall aspect of the plots. This means that for optimal display, the font must be available on both the computer used to create the svg, and the computer used to render the svg. See the \code{fonts} vignette for more information. } \examples{ # Save to file svglite(tempfile("Rplots.svg")) plot(1:11, (-5:5)^2, type = 'b', main = "Simple Example") dev.off() # Supply system font aliases. First check the font can be located: gdtools::match_family("Verdana") # Then supply a list of aliases: fonts <- list(sans = "Verdana", mono = "Times New Roman") svglite(tempfile("Rplots.svg"), system_fonts = fonts) plot.new() text(0.5, 0.5, "Some text", family = "mono") dev.off() # See the fonts vignettes for more options to deal with fonts } \references{ \emph{W3C Scalable Vector Graphics (SVG)}: \url{http://www.w3.org/Graphics/SVG/Overview.htm8} } \seealso{ \code{\link{pictex}}, \code{\link{postscript}}, \code{\link{Devices}} } \author{ This driver was written by T Jake Luciani \email{jakeluciani@yahoo.com} 2012: updated by Matthieu Decorde \email{matthieu.decorde@ens-lyon.fr} } \keyword{device} svglite/DESCRIPTION0000644000176200001440000000372313617316102013442 0ustar liggesusersPackage: svglite Version: 1.2.3 Title: An 'SVG' Graphics Device Description: A graphics device for R that produces 'Scalable Vector Graphics'. 'svglite' is a fork of the older 'RSvgDevice' package. Authors@R: c( person("Hadley", "Wickham", , "hadley@rstudio.com", "aut"), person("Lionel", "Henry", , "lionel@rstudio.com", c("aut")), person("Thomas Lin", "Pedersen", , "thomas.pedersen@rstudio.com", c("cre", "aut"), comment = c(ORCID = "0000-0002-5147-4711")), person("T Jake", "Luciani", , "jake@apache.org", "aut"), person("Matthieu", "Decorde", , "matthieu.decorde@ens-lyon.fr", "aut"), person("Vaudor", "Lise", , "lise.vaudor@ens-lyon.fr", "aut"), person("Tony", "Plate", role = "ctb", comment = "Early line dashing code"), person("David", "Gohel", role = "ctb", comment = "Line dashing code and raster code"), person("Yixuan", "Qiu", role = "ctb", comment = "Improved styles; polypath implementation"), person("Håkon", "Malmedal", role = "ctb", comment = "Opacity code"), person("RStudio", role = "cph") ) Encoding: UTF-8 Depends: R (>= 3.0.0) Imports: Rcpp, gdtools (>= 0.1.6) LinkingTo: Rcpp, gdtools, BH Suggests: htmltools, testthat, xml2 (>= 1.0.0), covr, fontquiver (>= 0.2.0), knitr, rmarkdown License: GPL (>= 2) URL: https://github.com/r-lib/svglite BugReports: https://github.com/r-lib/svglite/issues RoxygenNote: 7.0.2 VignetteBuilder: knitr NeedsCompilation: yes Packaged: 2020-02-07 13:03:51 UTC; thomas Author: Hadley Wickham [aut], Lionel Henry [aut], Thomas Lin Pedersen [cre, aut] (), T Jake Luciani [aut], Matthieu Decorde [aut], Vaudor Lise [aut], Tony Plate [ctb] (Early line dashing code), David Gohel [ctb] (Line dashing code and raster code), Yixuan Qiu [ctb] (Improved styles; polypath implementation), Håkon Malmedal [ctb] (Opacity code), RStudio [cph] Maintainer: Thomas Lin Pedersen Repository: CRAN Date/Publication: 2020-02-07 17:20:02 UTC svglite/build/0000755000176200001440000000000013617260067013036 5ustar liggesuserssvglite/build/vignette.rds0000644000176200001440000000033713617260067015400 0ustar liggesusersuM 0cZBM]t4\;D,&c^BhtA\ dmgey--gݸ" :xMS This is a string svglite/tests/testthat/test-no-clip.svg0000644000176200001440000000226113617022513017771 0ustar liggesusers Clipping svglite/tests/testthat/test-points.R0000644000176200001440000000256113617022513017351 0ustar liggesuserscontext("Points") library(xml2) test_that("radius is not given in points", { x <- xmlSVG({ plot.new() points(0.5, 0.5, cex = 20) text(0.5, 0.5, cex = 20) }) circle <- xml_find_all(x, ".//circle") expect_equal(xml_attr(circle, "r"), "54.00") }) test_that("points are given stroke and fill", { x <- xmlSVG({ plot.new() points(0.5, 0.5, pch = 21, col = "red", bg = "blue", cex = 20) }) circle <- xml_find_all(x, ".//circle") expect_equal(style_attr(circle, "stroke"), rgb(1, 0, 0)) expect_equal(style_attr(circle, "fill"), rgb(0, 0, 1)) }) test_that("points get alpha stroke and fill given stroke and fill", { x <- xmlSVG({ plot.new() points(0.5, 0.5, pch = 21, col = rgb(1, 0, 0, 0.1), bg = rgb(0, 0, 1, 0.1), cex = 20) }) circle <- xml_find_all(x, ".//circle") expect_equal(style_attr(circle, "stroke"), rgb(1, 0, 0)) expect_equal(style_attr(circle, "stroke-opacity"), "0.10") expect_equal(style_attr(circle, "fill"), rgb(0, 0, 1)) expect_equal(style_attr(circle, "fill-opacity"), "0.10") }) test_that("points are given stroke and fill", { x <- xmlSVG({ plot.new() points(0.5, 0.5, pch = 21, col = "red", bg = NA, cex = 20) }) style <- xml_text(xml_find_first(x, "//style")) expect_match(style, "fill: none;") circle <- xml_find_all(x, ".//circle") expect_equal(style_attr(circle, "fill"), NA_character_) }) svglite/tests/testthat/test-clip.R0000644000176200001440000000125613617022513016764 0ustar liggesuserscontext("Clipping") test_that("regression test for no clipping", { svglite("test-no-clip.svg", 4, 4, user_fonts = bitstream) on.exit(dev.off()) mini_plot(c(-1, 1), c(-1, 1), asp = 1, type = "n") rect(-0.5, -0.5, 0.5, 0.5, col = "blue") text(0, 0.5, "Clipping", cex = 2, srt = 30) abline(h = 0.5, col = "red") }) test_that("regression test for clipping", { svglite("test-clip.svg", 4, 4, user_fonts = bitstream) on.exit(dev.off()) mini_plot(c(-1, 1), c(-1, 1), asp = 1, type = "n") clip(-1, 0, -1, 0) rect(-0.5, -0.5, 0.5, 0.5, col = "blue") clip(0, 1, 0, 1) text(0, 0.5, "Clipping", cex = 2, srt = 30) clip(-1, 0, 0, 1) abline(h = 0.5, col = "red") }) svglite/tests/testthat/test-lines.R0000644000176200001440000000750013617022513017145 0ustar liggesuserscontext("Lines") library(xml2) test_that("segments don't have fill", { x <- xmlSVG({ plot.new() segments(0.5, 0.5, 1, 1) }) style <- xml_text(xml_find_first(x, "//style")) expect_match(style, "fill: none;") expect_equal(style_attr(xml_find_first(x, ".//line"), "fill"), NA_character_) }) test_that("lines don't have fill", { x <- xmlSVG({ plot.new() lines(c(0.5, 1, 0.5), c(0.5, 1, 1)) }) expect_equal(style_attr(xml_find_first(x, ".//polyline"), "fill"), NA_character_) }) test_that("polygons do have fill", { x <- xmlSVG({ plot.new() polygon(c(0.5, 1, 0.5), c(0.5, 1, 1), col = "red", border = "blue") }) polygon <- xml_find_first(x, ".//polygon") expect_equal(style_attr(polygon, "fill"), rgb(1, 0, 0)) expect_equal(style_attr(polygon, "stroke"), rgb(0, 0, 1)) }) test_that("polygons without border", { x <- xmlSVG({ plot.new() polygon(c(0.5, 1, 0.5), c(0.5, 1, 1), col = "red", border = NA) }) polygon <- xml_find_first(x, ".//polygon") expect_equal(style_attr(polygon, "fill"), rgb(1, 0, 0)) expect_equal(style_attr(polygon, "stroke"), "none") }) test_that("blank lines are omitted", { x <- xmlSVG(mini_plot(1:3, lty = "blank", type = "l")) expect_equal(length(xml_find_all(x, "//polygon")), 0) }) test_that("lines lty becomes stroke-dasharray", { expect_equal(dash_array(lty = 1), NA_integer_) expect_equal(dash_array(lty = 2), c(4, 4)) expect_equal(dash_array(lty = 3), c(1, 3)) expect_equal(dash_array(lty = 4), c(1, 3, 4, 3)) expect_equal(dash_array(lty = 5), c(7, 3)) expect_equal(dash_array(lty = 6), c(2, 2, 6, 2)) expect_equal(dash_array(lty = "1F"), c(1, 15)) expect_equal(dash_array(lty = "1234"), c(1, 2, 3, 4)) }) test_that("stroke-dasharray scales with lwd > 1", { expect_equal(dash_array(lty = 2, lwd = 1), c(4, 4)) expect_equal(dash_array(lty = 2, lwd = 1/2), c(4, 4)) expect_equal(dash_array(lty = 2, lwd = 1.1), c(4.4, 4.4)) expect_equal(dash_array(lty = 2, lwd = 2), c(8, 8)) }) test_that("line end shapes", { x1 <- xmlSVG({ plot.new() lines(c(0.3, 0.7), c(0.5, 0.5), lwd = 15, lend = "round") }) x2 <- xmlSVG({ plot.new() lines(c(0.3, 0.7), c(0.5, 0.5), lwd = 15, lend = "butt") }) x3 <- xmlSVG({ plot.new() lines(c(0.3, 0.7), c(0.5, 0.5), lwd = 15, lend = "square") }) style <- xml_text(xml_find_first(x1, "//style")) expect_match(style, "stroke-linecap: round;") expect_equal(style_attr(xml_find_first(x1, ".//polyline"), "stroke-linecap"), NA_character_) expect_equal(style_attr(xml_find_first(x2, ".//polyline"), "stroke-linecap"), "butt") expect_equal(style_attr(xml_find_first(x3, ".//polyline"), "stroke-linecap"), "square") }) test_that("line join shapes", { x1 <- xmlSVG({ plot.new() lines(c(0.3, 0.5, 0.7), c(0.1, 0.9, 0.1), lwd = 15, ljoin = "round") }) x2 <- xmlSVG({ plot.new() lines(c(0.3, 0.5, 0.7), c(0.1, 0.9, 0.1), lwd = 15, ljoin = "mitre", lmitre = 10) }) x3 <- xmlSVG({ plot.new() lines(c(0.3, 0.5, 0.7), c(0.1, 0.9, 0.1), lwd = 15, ljoin = "mitre", lmitre = 4) }) x4 <- xmlSVG({ plot.new() lines(c(0.3, 0.5, 0.7), c(0.1, 0.9, 0.1), lwd = 15, ljoin = "bevel") }) style <- xml_text(xml_find_first(x1, "//style")) expect_match(style, "stroke-linejoin: round;") expect_match(style, "stroke-miterlimit: 10.00;") expect_equal(style_attr(xml_find_all(x1, ".//polyline"), "stroke-linejoin"), NA_character_) expect_equal(style_attr(xml_find_all(x2, ".//polyline"), "stroke-linejoin"), "miter") expect_equal(style_attr(xml_find_all(x2, ".//polyline"), "stroke-miterlimit"), NA_character_) expect_equal(style_attr(xml_find_all(x3, ".//polyline"), "stroke-linejoin"), "miter") expect_equal(style_attr(xml_find_all(x3, ".//polyline"), "stroke-miterlimit"), "4.00") expect_equal(style_attr(xml_find_all(x4, ".//polyline"), "stroke-linejoin"), "bevel") }) svglite/tests/testthat/test-text-fonts.R0000644000176200001440000000511613617022513020147 0ustar liggesusers context("Fonts") test_that("font sets weight/style", { x <- xmlSVG({ plot.new() text(0.5, seq(0.9, 0.1, length = 4), "a", font = 1:4) }) text <- xml_find_all(x, ".//text") expect_equal(style_attr(text, "font-weight"), c(NA, "bold", NA, "bold")) expect_equal(style_attr(text, "font-style"), c(NA, NA, "italic", "italic")) }) test_that("metrics are computed for different weight/style", { x <- xmlSVG(user_fonts = fontquiver::font_families("Bitstream Vera"), { plot.new() text(1, 1, "text") text(1, 1, "text", font = 2) text(1, 1, "text", font = 4) }) text <- xml_find_all(x, ".//text") x <- xml_attr(text, "x") expect_false(any(x[2:3] == x[1])) }) test_that("symbol font family is 'Symbol'", { symbol_font <- alias_lookup()["symbol"] matched_symbol_font <- gdtools::match_family(symbol_font) x <- xmlSVG({ plot(c(0,2), c(0,2), type = "n", axes = FALSE, xlab = "", ylab = "") text(1, 1, expression(symbol("\042"))) }) text <- xml_find_all(x, ".//text") expect_equal(style_attr(text, "font-family"), matched_symbol_font) }) test_that("throw on malformed alias", { expect_error(validate_aliases(list(mono = letters), list()), "must be scalar") expect_warning(validate_aliases(list(sans = "foobar"), list()), "not found") }) test_that("fonts are aliased", { matched <- gdtools::match_family("cursive") x <- xmlSVG( system_fonts = list(sans = matched), user_fonts = list(mono = fontquiver::font_faces("Bitstream Vera", "Mono")), { plot.new() text(0.5, 0.1, "a", family = "serif") text(0.5, 0.5, "a", family = "sans") text(0.5, 0.9, "a", family = "mono") }) text <- xml_find_all(x, ".//text") families <- style_attr(text, "font-family") expect_false(families[[1]] == "serif") expect_true(all(families[2:3] == c(matched, "Bitstream Vera Sans Mono"))) }) test_that("metrics are computed for different fonts", { aliases <- fontquiver::font_families("Bitstream Vera") x <- xmlSVG(user_fonts = aliases, { plot.new() text(0.5, 0.9, "a", family = "serif") text(0.5, 0.9, "a", family = "mono") }) text <- xml_find_all(x, ".//text") x_attr <- xml_attr(text, "x") y_attr <- xml_attr(text, "y") expect_false(x_attr[[1]] == x_attr[[2]]) expect_false(y_attr[[1]] == y_attr[[2]]) }) test_that("unicode characters in plotmath are handled", { rho <- as.name("\u03c1") expr <- call("*", rho, rho) x <- xmlSVG({ plot.new() text(0.5, 0.5, as.expression(expr)) }) text <- xml_find_all(x, ".//text") x_attr <- as.double(xml_attr(text, "x")) expect_true(x_attr[2] - x_attr[1] > 0) }) svglite/tests/testthat/test-path.R0000644000176200001440000000355213617022513016772 0ustar liggesuserscontext("Paths") library(xml2) test_that("paths with winding fill mode", { x <- xmlSVG({ plot.new() polypath(c(.1, .1, .9, .9, NA, .2, .2, .8, .8), c(.1, .9, .9, .1, NA, .2, .8, .8, .2), col = rgb(0.5, 0.5, 0.5, 0.3), border = rgb(1, 0, 0, 0.3), rule = "winding") }) path <- xml_find_first(x, ".//path") expect_equal(style_attr(path, "fill-rule"), "nonzero") expect_equal(style_attr(path, "fill"), rgb(0.5, 0.5, 0.5)) expect_equal(style_attr(path, "fill-opacity"), "0.30") expect_equal(style_attr(path, "stroke"), rgb(1, 0, 0)) expect_equal(style_attr(path, "stroke-opacity"), "0.30") }) test_that("paths with evenodd fill mode", { x <- xmlSVG({ plot.new() polypath(c(.1, .1, .9, .9, NA, .2, .2, .8, .8), c(.1, .9, .9, .1, NA, .2, .8, .8, .2), col = rgb(0.5, 0.5, 0.5, 0.3), border = rgb(1, 0, 0, 0.3), rule = "evenodd") }) path <- xml_find_first(x, ".//path") expect_equal(style_attr(path, "fill-rule"), "evenodd") expect_equal(style_attr(path, "fill"), rgb(0.5, 0.5, 0.5)) expect_equal(style_attr(path, "fill-opacity"), "0.30") expect_equal(style_attr(path, "stroke"), rgb(1, 0, 0)) expect_equal(style_attr(path, "stroke-opacity"), "0.30") }) test_that("paths with no filling color", { x <- xmlSVG({ plot.new() polypath(c(.1, .1, .9, .9, NA, .2, .2, .8, .8), c(.1, .9, .9, .1, NA, .2, .8, .8, .2), col = NA, border = rgb(1, 0, 0, 0.3), rule = "winding") }) style <- xml_text(xml_find_first(x, "//style")) expect_match(style, "fill: none;") path <- xml_find_first(x, ".//path") expect_equal(style_attr(path, "fill-rule"), "nonzero") expect_equal(style_attr(path, "fill"), NA_character_) expect_equal(style_attr(path, "stroke"), rgb(1, 0, 0)) expect_equal(style_attr(path, "stroke-opacity"), "0.30") }) svglite/tests/testthat/test-colour.R0000644000176200001440000000117513617022513017340 0ustar liggesuserscontext("colour") library(xml2) test_that("transparent blacks are written", { x <- xmlSVG({ plot.new() points(0.5, 0.5, col = rgb(0, 0, 0, 0.25)) points(0.5, 0.5, col = rgb(0, 0, 0, 0.50)) points(0.5, 0.5, col = rgb(0, 0, 0, 0.75)) }) circle <- xml_find_all(x, ".//circle") expect_equal(style_attr(circle, "stroke"), rep("#000000", 3)) expect_equal(style_attr(circle, "stroke-opacity"), c("0.25", "0.50", "0.75")) }) test_that("transparent colours are not written", { x <- xmlSVG({ plot.new() points(0.5, 0.5, col = NA) }) circle <- xml_find_all(x, ".//circle") expect_length(circle, 0) }) svglite/tests/testthat/test-clip.svg0000644000176200001440000000273113617022513017361 0ustar liggesusers Clipping svglite/tests/testthat/helper-manual.R0000644000176200001440000000002513617022513017603 0ustar liggesusers init_manual_tests() svglite/tests/testthat/test-devSVG.R0000644000176200001440000000230013617022513017162 0ustar liggesuserscontext("devSVG") library(xml2) style_attr <- function(nodes, attr) { style <- xml_attr(nodes, "style") ifelse(grepl(sprintf("%s: [^;]*;", attr), style), gsub(sprintf(".*%s: ([^;]*);.*", attr), "\\1", style), NA_character_) } test_that("adds default background", { x <- xmlSVG(plot.new()) expect_equal(style_attr(xml_find_first(x, ".//rect"), "fill"), "#FFFFFF") }) test_that("adds background set by device driver", { x <- xmlSVG(plot.new(), bg = "red") expect_equal(style_attr(xml_find_first(x, ".//rect"), "fill"), rgb(1, 0, 0)) }) test_that("default background respects par", { x <- xmlSVG({ par(bg = "red") plot.new() }) expect_equal(style_attr(xml_find_first(x, ".//rect"), "fill"), rgb(1, 0, 0)) }) test_that("if bg is transparent in par(), use device driver background", { x <- xmlSVG({ par(bg = NA) plot.new() }, bg = "blue") style <- xml_text(xml_find_first(x, "//style")) expect_match(style, "fill: none;") expect_equal(style_attr(xml_find_first(x, ".//rect"), "fill"), rgb(0, 0, 1)) }) test_that("can only have one page", { svglite(tempfile()) on.exit(dev.off()) plot.new() expect_error(plot.new(), "only supports one page") }) svglite/tests/testthat/test-scale.R0000644000176200001440000000224213617022513017120 0ustar liggesuserscontext("Scale") library("grid") # Tests requiring manual oversight are registered as such. They # specify files that should be opened with multiple browsers to make # sure the SVG appearance is consistent. Use open_manual_tests() after # running testthat to open them in your default browser. test_that("text has correct dimensions", { register_manual_test("test-scale-text.html") ttf <- fontquiver::font("Liberation", "Sans", "Regular")$ttf metrics <- gdtools::str_metrics("foobar", fontfile = ttf) w <- metrics[["width"]] h <- metrics[["ascent"]] svglite("test-scale-text.svg", width = w / 72, height = h / 72, user_fonts = fontquiver::font_families("Liberation")) on.exit(dev.off()) grid.newpage() grid.rect(0, 1, width = unit(w, "bigpts"), height = unit(h, "bigpts"), hjust = 0, vjust = 1, gp = gpar(col = "red", lwd = 1)) grid.text("foobar", 0, 1, hjust = 0, vjust = 1, gp = gpar(fontsize = 12)) pushViewport(viewport()) }) test_that("lwd has correct dimensions", { x <- xmlSVG({ plot.new() segments(0, 1, 0, 0, lwd = 96 / 72) }) line <- xml_find_all(x, "//line") expect_equal(xml_attr(line, "style"), "stroke-width: 1.00;") }) svglite/tests/testthat/test-scale-text.html0000644000176200001440000000045213617022513020646 0ustar liggesusers This test requires the Liberation Sans family to be installed on the system.

foobar
svglite/tests/testthat/test-text.R0000644000176200001440000000453413617022513017023 0ustar liggesuserscontext("Text") library(xml2) test_that("par(cex) affects strwidth", { xmlSVG({ plot.new() w1 <- strwidth("X") par(cex = 4) w4 <- strwidth("X") }) expect_equal(w4 / w1, 4, tol = 1e-4) }) test_that("cex affects strwidth", { inlineSVG(height = 7, width = 7, { plot.new() w1 <- strwidth("X") w4 <- strwidth("X", cex = 4) }) expect_equal(w4 / w1, 4, tol = 1e-4) }) test_that("special characters are escaped", { x <- xmlSVG({ plot.new() text(0.5, 0.5, "<&>") }) # xml_text unescapes for us - this still tests that the # file parses, which it wouldn't otherwise expect_equal(xml_text(xml_find_first(x, ".//text")), "<&>") }) test_that("utf-8 characters are preserved", { skip_on_os("windows") # skip because of xml2 buglet skip_if_not(l10n_info()$`UTF-8`) x <- xmlSVG({ plot.new() text(0.5, 0.5, "\u00b5") }) # xml_text unescapes for us - this still tests that the # file parses, which it wouldn't otherwise expect_equal(xml_text(xml_find_first(x, ".//text")), "\u00b5") }) test_that("special characters are escaped", { x <- xmlSVG({ plot.new() text(0.5, 0.5, "a", col = "#113399") }) # xml_text unescapes for us - this still tests that the # file parses, which it wouldn't otherwise expect_equal(style_attr(xml_find_first(x, ".//text"), "fill"), "#113399") }) test_that("default point size is 12", { x <- xmlSVG({ plot.new() text(0.5, 0.5, "a") }) expect_equal(style_attr(xml_find_first(x, ".//text"), "font-size"), "12.00px") }) test_that("cex generates fractional font sizes", { x <- xmlSVG({ plot.new() text(0.5, 0.5, "a", cex = 0.1) }) expect_equal(style_attr(xml_find_first(x, ".//text"), "font-size"), "1.20px") }) test_that("a symbol has width greater than 0", { xmlSVG({ plot.new() strw <- strwidth(expression(symbol("\042"))) }) expect_lt(.Machine$double.eps, strw) }) test_that("strwidth and height correctly computed", { svglite("test-text.svg", 4, 4, user_fonts = bitstream) on.exit(dev.off()) plot.new() str <- "This is a string" text(0.5, 0.5, str) h <- strheight(str) w <- strwidth(str) rect(0.5 - w / 2, 0.5 - h / 2, 0.5 + w / 2, 0.5 + h / 2) }) test_that("strwidth has fallback for unknown glyphs", { xmlSVG(user_fonts = bitstream, { plot.new() w <- strwidth("正規分布") }) expect_true(w > 0) }) svglite/tests/testthat/test-scale-text.svg0000644000176200001440000000136613617022513020506 0ustar liggesusers foobar svglite/tests/testthat/helper-style.R0000644000176200001440000000062713617022513017476 0ustar liggesusersstyle_attr <- function(nodes, attr) { style <- xml_attr(nodes, "style") ifelse( grepl(sprintf("%s: [^;]*;", attr), style), gsub(sprintf(".*%s: ([^;]*);.*", attr), "\\1", style), NA_character_ ) } dash_array <- function(...) { x <- xmlSVG(mini_plot(1:3, ..., type = "l")) dash <- style_attr(xml_find_first(x, "//polyline"), "stroke-dasharray") as.numeric(strsplit(dash, ",")[[1]]) } svglite/tests/testthat/test-output.R0000644000176200001440000000124713617022513017375 0ustar liggesuserscontext("Output") test_that("different string and file output produce identical svg", { ## 1. Write to a file f1 <- tempfile() svglite(f1) plot(1:5) dev.off() out1 <- readLines(f1) ## 2. Write to a string stream s <- svgstring() plot(1:5) dev.off() out2 <- strsplit(s(), "\n")[[1]] expect_equal(out1, out2) }) test_that("intermediate outputs are always valid svg", { path <- tempfile() svglite(path) expect_valid_svg <- function() { expect_error(xml2::read_xml(path), NA) } mini_plot(1:10) expect_valid_svg() rect(2, 2, 3, 3) expect_valid_svg() segments(5, 5, 6, 6) expect_valid_svg() dev.off() expect_valid_svg() }) svglite/tests/testthat/test-rect.R0000644000176200001440000000123213617022513016764 0ustar liggesuserscontext("Rect") library(xml2) test_that("rects equivalent regardless of direction", { x1 <- xmlSVG({ plot.new() rect(0.2, 0.2, 0.8, 0.8) }) x2 <- xmlSVG({ plot.new() rect(0.8, 0.8, 0.2, 0.2) }) rect1 <- xml_attrs(xml_find_all(x1, "./rect")[[2]]) rect2 <- xml_attrs(xml_find_all(x2, "./rect")[[2]]) expect_equal(rect1, rect2) }) test_that("fill and stroke colors", { x <- xmlSVG({ plot.new() rect(0.2, 0.2, 0.8, 0.8, col = "blue", border = "red") }) rectangle <- xml_find_all(x, "./rect")[[2]] expect_equal(style_attr(rectangle, "fill"), rgb(0, 0, 1)) expect_equal(style_attr(rectangle, "stroke"), rgb(1, 0, 0)) }) svglite/tests/testthat/helper-aliases.R0000644000176200001440000000007213617022513017751 0ustar liggesusers bitstream <- fontquiver::font_families("Bitstream Vera") svglite/tests/testthat/test-raster.R0000644000176200001440000000044513617022513017334 0ustar liggesuserscontext("Raster") library(xml2) test_that("raster exists", { x <- xmlSVG({ image(matrix(runif(64), nrow = 8), useRaster = TRUE) }, standalone = TRUE) ns <- xml_ns(x) img <- xml_attr(xml_find_all(x, ".//d1:image", ns = ns), "xlink:href", ns = ns) expect_gt(nchar(img), 1000) }) svglite/tests/testthat.R0000644000176200001440000000007213617022513015053 0ustar liggesuserslibrary(testthat) library(svglite) test_check("svglite") svglite/src/0000755000176200001440000000000013617260067012526 5ustar liggesuserssvglite/src/utils.h0000644000176200001440000000032313617022513014025 0ustar liggesusers#ifndef __UTILS__ #define __UTILS__ #include #include double dbl_format(double x) { if (std::abs(x) < std::numeric_limits::epsilon()) return 0.00; else return x; } #endif svglite/src/SvgStream.h0000644000176200001440000000711213617022513014603 0ustar liggesusers#ifndef __SVG_STREAM__ #define __SVG_STREAM__ #include #include #include #include "utils.h" namespace svglite { namespace internal { template void write_double(T& stream, double data) { std::streamsize prec = stream.precision(); uint8_t newprec = std::fabs(data) >= 1 || data == 0. ? prec : std::ceil(-std::log10(std::fabs(data))) + 1; stream << std::setprecision(newprec) << data << std::setprecision(prec); } }} // namespace svglite::internal class SvgStream { public: virtual ~SvgStream() {}; virtual void write(int data) = 0; virtual void write(double data) = 0; virtual void write(const char* data) = 0; virtual void write(const std::string& data) = 0; virtual void write(char data) = 0; void put(char data) { write(data); } virtual void flush() = 0; virtual void finish() = 0; }; template SvgStream& operator<<(SvgStream& object, const T& data) { object.write(data); return object; } template <> SvgStream& operator<<(SvgStream& object, const double& data) { // Make sure negative zeros are converted to positive zero for // reproducibility of SVGs object.write(dbl_format(data)); return object; } class SvgStreamFile : public SvgStream { std::ofstream stream_; public: SvgStreamFile(const std::string& path) { stream_.open(R_ExpandFileName(path.c_str())); if (stream_.fail()) Rcpp::stop("cannot open stream " + path); stream_ << std::fixed << std::setprecision(2); } void write(int data) { stream_ << data; } void write(double data) { svglite::internal::write_double(stream_, data); } void write(const char* data) { stream_ << data; } void write(char data) { stream_ << data; } void write(const std::string& data) { stream_ << data; } // Adding a final newline here creates problems on Windows when // seeking back to original position. So we only write the newline // in finish() void flush() { stream_ << ""; stream_.seekp(-6, std::ios_base::cur); stream_.flush(); } void finish() { stream_ << "\n"; stream_.flush(); } ~SvgStreamFile() { stream_.close(); } }; class SvgStreamString : public SvgStream { std::stringstream stream_; Rcpp::Environment env_; public: SvgStreamString(Rcpp::Environment env): env_(env) { stream_ << std::fixed << std::setprecision(2); env_["is_closed"] = false; } void write(int data) { stream_ << data; } void write(double data) { svglite::internal::write_double(stream_, data); } void write(const char* data) { stream_ << data; } void write(char data) { stream_ << data; } void write(const std::string& data) { stream_ << data; } void flush() { } void finish() { // When device is closed, stream_ will be destroyed, so we can no longer // get the svg string from stream_. In this case, we save the final string // to the environment env, so that R can read from env$svg_string even // after device is closed. env_["is_closed"] = true; stream_.flush(); std::string svgstr = stream_.str(); // If the current svg is empty, we also make the string empty // Otherwise append "" to make it a valid SVG if(!svgstr.empty()) { svgstr.append(""); } env_["svg_string"] = svgstr; } Rcpp::XPtr string_src() { // `false` means this pointer should not be "deleted" by R // The object will be automatically destroyed when device is closed return Rcpp::XPtr(&stream_, false); } }; #endif svglite/src/devSVG.cpp0000644000176200001440000005646313617022513014376 0ustar liggesusers// (C) 2002 T Jake Luciani: SVG device, based on PicTex device // (C) 2008 Tony Plate: Line type support from RSVGTipsDevice package // (C) 2012 Matthieu Decorde: UTF-8 support, XML reserved characters and XML header // (C) 2015 RStudio (Hadley Wickham): modernisation & refactoring // // This program is free software; you can redistribute it and/or modify // it under the terms of the GNU General Public License as published by // the Free Software Foundation; either version 2 of the License, or // (at your option) any later version. // // This program is distributed in the hope that it will be useful, // but WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with this program; if not, write to the Free Software // Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA #include #include #include #include #include #include #include #include "SvgStream.h" #include "utils.h" typedef boost::shared_ptr SvgStreamPtr; // SVG device metadata class SVGDesc { public: SvgStreamPtr stream; int pageno; std::string clipid; // ID for the clip path double clipx0, clipx1, clipy0, clipy1; // Save the previous clip path to avoid duplication bool standalone; Rcpp::List system_aliases; Rcpp::List user_aliases; XPtrCairoContext cc; SVGDesc(SvgStreamPtr stream_, bool standalone_, Rcpp::List aliases_): stream(stream_), pageno(0), clipx0(0), clipx1(0), clipy0(0), clipy1(0), standalone(standalone_), system_aliases(Rcpp::wrap(aliases_["system"])), user_aliases(Rcpp::wrap(aliases_["user"])), cc(gdtools::context_create()) { } }; inline bool is_black(int col) { return (R_RED(col) == 0) && (R_GREEN(col) == 0) && (R_BLUE(col) == 0) && (R_ALPHA(col) == 255); } inline bool is_filled(int col) { return R_ALPHA(col) != 0; } inline bool is_bold(int face) { return face == 2 || face == 4; } inline bool is_italic(int face) { return face == 3 || face == 4; } inline bool is_bolditalic(int face) { return face == 4; } inline bool is_symbol(int face) { return face == 5; } inline std::string find_alias_field(std::string& family, Rcpp::List& alias, const char* face, const char* field) { if (alias.containsElementNamed(face)) { Rcpp::List font = alias[face]; if (font.containsElementNamed(field)) return font[field]; } return std::string(); } inline std::string find_user_alias(std::string& family, Rcpp::List const& aliases, int face, const char* field) { std::string out; if (aliases.containsElementNamed(family.c_str())) { Rcpp::List alias = aliases[family]; if (is_bolditalic(face)) out = find_alias_field(family, alias, "bolditalic", field); else if (is_bold(face)) out = find_alias_field(family, alias, "bold", field); else if (is_italic(face)) out = find_alias_field(family, alias, "italic", field); else if (is_symbol(face)) out = find_alias_field(family, alias, "symbol", field); else out = find_alias_field(family, alias, "plain", field); } return out; } inline std::string find_system_alias(std::string& family, Rcpp::List const& aliases) { std::string out; if (aliases.containsElementNamed(family.c_str())) { SEXP alias = aliases[family]; if (TYPEOF(alias) == STRSXP && Rf_length(alias) == 1) out = Rcpp::as(alias); } return out; } inline std::string fontname(const char* family_, int face, Rcpp::List const& system_aliases, Rcpp::List const& user_aliases) { std::string family(family_); if (face == 5) family = "symbol"; else if (family == "") family = "sans"; std::string alias = find_system_alias(family, system_aliases); if (!alias.size()) alias = find_user_alias(family, user_aliases, face, "name"); if (alias.size()) return alias; else return family; } inline std::string fontfile(const char* family_, int face, Rcpp::List user_aliases) { std::string family(family_); if (face == 5) family = "symbol"; else if (family == "") family = "sans"; return find_user_alias(family, user_aliases, face, "file"); } inline void write_escaped(SvgStreamPtr stream, const char* text) { for(const char* cur = text; *cur != '\0'; ++cur) { switch(*cur) { case '&': (*stream) << "&"; break; case '<': (*stream) << "<"; break; case '>': (*stream) << ">"; break; default: (*stream) << *cur; } } } inline void write_attr_dbl(SvgStreamPtr stream, const char* attr, double value) { (*stream) << ' ' << attr << "='" << value << '\''; } inline void write_attr_str(SvgStreamPtr stream, const char* attr, const char* value) { (*stream) << ' ' << attr << "='" << value << '\''; } // Writing clip path attribute inline void write_attr_clip(SvgStreamPtr stream, std::string clipid) { if (!clipid.size()) return; (*stream) << " clip-path='url(#cp" << clipid << ")'"; } // Beginning of writing style attributes inline void write_style_begin(SvgStreamPtr stream) { (*stream) << " style='"; } // End of writing style attributes inline void write_style_end(SvgStreamPtr stream) { (*stream) << "'"; } // Writing style attributes related to colors inline void write_style_col(SvgStreamPtr stream, const char* attr, int col, bool first = false) { int alpha = R_ALPHA(col); if(!first) (*stream) << ' '; if (alpha == 0) { (*stream) << attr << ": none;"; return; } else { (*stream) << tfm::format("%s: #%02X%02X%02X;", attr, R_RED(col), R_GREEN(col), R_BLUE(col)); if (alpha != 255) (*stream) << ' ' << attr << "-opacity: " << alpha / 255.0 << ';'; } } // Writing style attributes whose values are double type inline void write_style_dbl(SvgStreamPtr stream, const char* attr, double value, bool first = false) { if(!first) (*stream) << ' '; (*stream) << attr << ": " << value << ';'; } inline void write_style_fontsize(SvgStreamPtr stream, double value, bool first = false) { if(!first) (*stream) << ' '; // Firefox requires that we provide a unit (even though px is // redundant here) (*stream) << "font-size: " << value << "px;"; } // Writing style attributes whose values are strings inline void write_style_str(SvgStreamPtr stream, const char* attr, const char* value, bool first = false) { if(!first) (*stream) << ' '; (*stream) << attr << ": " << value << ';'; } inline double scale_lty(int lty, double lwd) { // Don't rescale if lwd < 1 // https://github.com/wch/r-source/blob/master/src/library/grDevices/src/cairo/cairoFns.c#L134 return ((lwd > 1) ? lwd : 1) * (lty & 15); } // Writing style attributes related to line types inline void write_style_linetype(SvgStreamPtr stream, const pGEcontext gc, bool first = false) { int lty = gc->lty; // 1 lwd = 1/96", but units in rest of document are 1/72" write_style_dbl(stream, "stroke-width", gc->lwd / 96.0 * 72, first); // Default is "stroke: #000000;" as declared in \n"; (*stream) << "\n"; (*stream) << "fill)) write_style_col(stream, "fill", gc->fill); else write_style_col(stream, "fill", dd->startfill); write_style_end(stream); (*stream) << "/>\n"; svgd->stream->flush(); svgd->pageno++; VOID_END_RCPP } void svg_close(pDevDesc dd) { SVGDesc *svgd = (SVGDesc*) dd->deviceSpecific; svgd->stream->finish(); delete(svgd); } void svg_line(double x1, double y1, double x2, double y2, const pGEcontext gc, pDevDesc dd) { SVGDesc *svgd = (SVGDesc*) dd->deviceSpecific; SvgStreamPtr stream = svgd->stream; (*stream) << "clipid); (*stream) << " />\n"; stream->flush(); } void svg_poly(int n, double *x, double *y, int filled, const pGEcontext gc, pDevDesc dd, const char* node_name) { SVGDesc *svgd = (SVGDesc*) dd->deviceSpecific; SvgStreamPtr stream = svgd->stream; (*stream) << "<" << node_name << " points='"; for (int i = 0; i < n; i++) { (*stream) << x[i] << ',' << y[i] << ' '; } stream->put('\''); write_style_begin(stream); write_style_linetype(stream, gc, true); if (filled) write_style_col(stream, "fill", gc->fill); write_style_end(stream); write_attr_clip(stream, svgd->clipid); (*stream) << " />\n"; stream->flush(); } void svg_polyline(int n, double *x, double *y, const pGEcontext gc, pDevDesc dd) { svg_poly(n, x, y, 0, gc, dd, "polyline"); } void svg_polygon(int n, double *x, double *y, const pGEcontext gc, pDevDesc dd) { svg_poly(n, x, y, 1, gc, dd, "polygon"); } void svg_path(double *x, double *y, int npoly, int *nper, Rboolean winding, const pGEcontext gc, pDevDesc dd) { SVGDesc *svgd = (SVGDesc*) dd->deviceSpecific; SvgStreamPtr stream = svgd->stream; // Create path data (*stream) << "put('Z'); } // Finish path data stream->put('\''); write_style_begin(stream); // Specify fill rule write_style_str(stream, "fill-rule", winding ? "nonzero" : "evenodd", true); if (is_filled(gc->fill)) write_style_col(stream, "fill", gc->fill); write_style_linetype(stream, gc); write_style_end(stream); write_attr_clip(stream, svgd->clipid); (*stream) << " />\n"; stream->flush(); } double svg_strwidth(const char *str, const pGEcontext gc, pDevDesc dd) { SVGDesc *svgd = (SVGDesc*) dd->deviceSpecific; std::string file = fontfile(gc->fontfamily, gc->fontface, svgd->user_aliases); std::string name = fontname(gc->fontfamily, gc->fontface, svgd->system_aliases, svgd->user_aliases); gdtools::context_set_font(svgd->cc, name, gc->cex * gc->ps, is_bold(gc->fontface), is_italic(gc->fontface), file); FontMetric fm = gdtools::context_extents(svgd->cc, std::string(str)); return fm.width; } void svg_rect(double x0, double y0, double x1, double y1, const pGEcontext gc, pDevDesc dd) { SVGDesc *svgd = (SVGDesc*) dd->deviceSpecific; SvgStreamPtr stream = svgd->stream; // x and y give top-left position (*stream) << "fill)) write_style_col(stream, "fill", gc->fill); write_style_end(stream); write_attr_clip(stream, svgd->clipid); (*stream) << " />\n"; stream->flush(); } void svg_circle(double x, double y, double r, const pGEcontext gc, pDevDesc dd) { SVGDesc *svgd = (SVGDesc*) dd->deviceSpecific; SvgStreamPtr stream = svgd->stream; (*stream) << "fill)) write_style_col(stream, "fill", gc->fill); write_style_end(stream); write_attr_clip(stream, svgd->clipid); (*stream) << " />\n"; stream->flush(); } void svg_text(double x, double y, const char *str, double rot, double hadj, const pGEcontext gc, pDevDesc dd) { SVGDesc *svgd = (SVGDesc*) dd->deviceSpecific; SvgStreamPtr stream = svgd->stream; // If we specify the clip path inside , the "transform" also // affects the clip path, so we need to specify clip path at an outer level if (svgd->clipid.size()) { (*stream) << "clipid); stream->put('>'); } (*stream) << "cex * gc->ps; write_style_begin(stream); write_style_fontsize(stream, fontsize, true); if (is_bold(gc->fontface)) write_style_str(stream, "font-weight", "bold"); if (is_italic(gc->fontface)) write_style_str(stream, "font-style", "italic"); if (!is_black(gc->col)) write_style_col(stream, "fill", gc->col); std::string font = fontname(gc->fontfamily, gc->fontface, svgd->system_aliases, svgd->user_aliases); write_style_str(stream, "font-family", font.c_str()); write_style_end(stream); std::string file = fontfile(gc->fontfamily, gc->fontface, svgd->user_aliases); gdtools::context_set_font(svgd->cc, font, fontsize, is_bold(gc->fontface), is_italic(gc->fontface), file); FontMetric fm = gdtools::context_extents(svgd->cc, std::string(str)); (*stream) << " textLength='" << fm.width << "px'"; (*stream) << " lengthAdjust='spacingAndGlyphs'"; stream->put('>'); write_escaped(stream, str); (*stream) << ""; if (svgd->clipid.size()) (*stream) << ""; stream->put('\n'); stream->flush(); } void svg_size(double *left, double *right, double *bottom, double *top, pDevDesc dd) { *left = dd->left; *right = dd->right; *bottom = dd->bottom; *top = dd->top; } void svg_raster(unsigned int *raster, int w, int h, double x, double y, double width, double height, double rot, Rboolean interpolate, const pGEcontext gc, pDevDesc dd) { SVGDesc *svgd = (SVGDesc*) dd->deviceSpecific; SvgStreamPtr stream = svgd->stream; if (height < 0) height = -height; std::vector raster_(w*h); for (std::vector::size_type i = 0 ; i < raster_.size(); ++i) { raster_[i] = raster[i] ; } std::string base64_str = gdtools::raster_to_str(raster_, w, h, width, height, (Rboolean) interpolate); // If we specify the clip path inside , the "transform" also // affects the clip path, so we need to specify clip path at an outer level if (svgd->clipid.size()) { (*stream) << "clipid); stream->put('>'); } (*stream) << ""; if (svgd->clipid.size()) (*stream) << ""; stream->put('\n'); stream->flush(); } pDevDesc svg_driver_new(SvgStreamPtr stream, int bg, double width, double height, double pointsize, bool standalone, Rcpp::List& aliases) { pDevDesc dd = (DevDesc*) calloc(1, sizeof(DevDesc)); if (dd == NULL) return dd; dd->startfill = bg; dd->startcol = R_RGB(0, 0, 0); dd->startps = pointsize; dd->startlty = 0; dd->startfont = 1; dd->startgamma = 1; // Callbacks dd->activate = NULL; dd->deactivate = NULL; dd->close = svg_close; dd->clip = svg_clip; dd->size = svg_size; dd->newPage = svg_new_page; dd->line = svg_line; dd->text = svg_text; dd->strWidth = svg_strwidth; dd->rect = svg_rect; dd->circle = svg_circle; dd->polygon = svg_polygon; dd->polyline = svg_polyline; dd->path = svg_path; dd->mode = NULL; dd->metricInfo = svg_metric_info; dd->cap = NULL; dd->raster = svg_raster; // UTF-8 support dd->wantSymbolUTF8 = (Rboolean) 1; dd->hasTextUTF8 = (Rboolean) 1; dd->textUTF8 = svg_text; dd->strWidthUTF8 = svg_strwidth; // Screen Dimensions in pts dd->left = 0; dd->top = 0; dd->right = width * 72; dd->bottom = height * 72; // Magic constants copied from other graphics devices // nominal character sizes in pts dd->cra[0] = 0.9 * pointsize; dd->cra[1] = 1.2 * pointsize; // character alignment offsets dd->xCharOffset = 0.4900; dd->yCharOffset = 0.3333; dd->yLineBias = 0.2; // inches per pt dd->ipr[0] = 1.0 / 72.0; dd->ipr[1] = 1.0 / 72.0; // Capabilities dd->canClip = TRUE; dd->canHAdj = 0; dd->canChangeGamma = FALSE; dd->displayListOn = FALSE; dd->haveTransparency = 2; dd->haveTransparentBg = 2; dd->deviceSpecific = new SVGDesc(stream, standalone, aliases); return dd; } void makeDevice(SvgStreamPtr stream, std::string bg_, double width, double height, double pointsize, bool standalone, Rcpp::List& aliases) { int bg = R_GE_str2col(bg_.c_str()); R_GE_checkVersionOrDie(R_GE_version); R_CheckDeviceAvailable(); BEGIN_SUSPEND_INTERRUPTS { pDevDesc dev = svg_driver_new(stream, bg, width, height, pointsize, standalone, aliases); if (dev == NULL) Rcpp::stop("Failed to start SVG device"); pGEDevDesc dd = GEcreateDevDesc(dev); GEaddDevice2(dd, "devSVG"); GEinitDisplayList(dd); } END_SUSPEND_INTERRUPTS; } // [[Rcpp::export]] bool svglite_(std::string file, std::string bg, double width, double height, double pointsize, bool standalone, Rcpp::List aliases) { SvgStreamPtr stream(new SvgStreamFile(file)); makeDevice(stream, bg, width, height, pointsize, standalone, aliases); return true; } // [[Rcpp::export]] Rcpp::XPtr svgstring_(Rcpp::Environment env, std::string bg, double width, double height, double pointsize, bool standalone, Rcpp::List aliases) { SvgStreamPtr stream(new SvgStreamString(env)); makeDevice(stream, bg, width, height, pointsize, standalone, aliases); SvgStreamString* strstream = static_cast(stream.get()); return strstream->string_src(); } // [[Rcpp::export]] std::string get_svg_content(Rcpp::XPtr p) { p->flush(); std::string svgstr = p->str(); // If the current SVG is empty, we also make the string empty // Otherwise append "" to make it a valid SVG if(!svgstr.empty()) { svgstr.append(""); } return svgstr; } svglite/src/RcppExports.cpp0000644000176200001440000000601113617022513015511 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include using namespace Rcpp; // svglite_ bool svglite_(std::string file, std::string bg, double width, double height, double pointsize, bool standalone, Rcpp::List aliases); RcppExport SEXP _svglite_svglite_(SEXP fileSEXP, SEXP bgSEXP, SEXP widthSEXP, SEXP heightSEXP, SEXP pointsizeSEXP, SEXP standaloneSEXP, SEXP aliasesSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type file(fileSEXP); Rcpp::traits::input_parameter< std::string >::type bg(bgSEXP); Rcpp::traits::input_parameter< double >::type width(widthSEXP); Rcpp::traits::input_parameter< double >::type height(heightSEXP); Rcpp::traits::input_parameter< double >::type pointsize(pointsizeSEXP); Rcpp::traits::input_parameter< bool >::type standalone(standaloneSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type aliases(aliasesSEXP); rcpp_result_gen = Rcpp::wrap(svglite_(file, bg, width, height, pointsize, standalone, aliases)); return rcpp_result_gen; END_RCPP } // svgstring_ Rcpp::XPtr svgstring_(Rcpp::Environment env, std::string bg, double width, double height, double pointsize, bool standalone, Rcpp::List aliases); RcppExport SEXP _svglite_svgstring_(SEXP envSEXP, SEXP bgSEXP, SEXP widthSEXP, SEXP heightSEXP, SEXP pointsizeSEXP, SEXP standaloneSEXP, SEXP aliasesSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< Rcpp::Environment >::type env(envSEXP); Rcpp::traits::input_parameter< std::string >::type bg(bgSEXP); Rcpp::traits::input_parameter< double >::type width(widthSEXP); Rcpp::traits::input_parameter< double >::type height(heightSEXP); Rcpp::traits::input_parameter< double >::type pointsize(pointsizeSEXP); Rcpp::traits::input_parameter< bool >::type standalone(standaloneSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type aliases(aliasesSEXP); rcpp_result_gen = Rcpp::wrap(svgstring_(env, bg, width, height, pointsize, standalone, aliases)); return rcpp_result_gen; END_RCPP } // get_svg_content std::string get_svg_content(Rcpp::XPtr p); RcppExport SEXP _svglite_get_svg_content(SEXP pSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< Rcpp::XPtr >::type p(pSEXP); rcpp_result_gen = Rcpp::wrap(get_svg_content(p)); return rcpp_result_gen; END_RCPP } static const R_CallMethodDef CallEntries[] = { {"_svglite_svglite_", (DL_FUNC) &_svglite_svglite_, 7}, {"_svglite_svgstring_", (DL_FUNC) &_svglite_svgstring_, 7}, {"_svglite_get_svg_content", (DL_FUNC) &_svglite_get_svg_content, 1}, {NULL, NULL, 0} }; RcppExport void R_init_svglite(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } svglite/vignettes/0000755000176200001440000000000013617260067013747 5ustar liggesuserssvglite/vignettes/fonts.Rmd0000644000176200001440000001455113617022513015542 0ustar liggesusers--- title: "Specifying fonts" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Specifying fonts} %\VignetteEngine{knitr::rmarkdown} \usepackage[utf8]{inputenc} --- ```{r, echo = FALSE, message = FALSE} knitr::opts_chunk$set(collapse = T, comment = "#>") library("svglite") ``` svglite produces SVG files containing plain text but fonts are still important for plot generation and rendering. Fonts are used during SVG generation to figure out the metrics of graphical elements. The font name is then recorded in the `font-family` property of text anchors so that SVG renderers know what fonts to use. svglite does try to ensure a consistent figure rendering even when fonts are not available at the time of rendering (by supplying the [textLength](http://www.w3.org/TR/SVG/text.html#TextElementTextLengthAttribute) SVG text attribute). However, the text may look slightly distorted when a fallback font is used. This means that for optimal display, the font must be available on both the computer used to create the svg, and the computer used to render the svg. The defaults are fonts that are available on almost all systems: there may be small differences between them, but they are unlikely to cause problems in most causes. | R family | Font on Windows | Font on Unix | |----------|--------------------|--------------| | `sans` | Arial | Arial | | `serif` | Times New Roman | Times | | `mono` | Courier | Courier | | `symbol` | Standard Symbols L | Symbol | One downside to these default fonts is that they do not have good coverage of characters for non-latin alphabets. This can be fixed by using the arguments `system_fonts` and `user_fonts` which provide control over which fonts to use during SVG generation and rendering. ## System font aliases `system_fonts` takes a named list of font families as argument. The names typically correspond to standard R faces but they can also alias non-standard families (though this is less useful): ```{r, eval=FALSE} fonts <- list( sans = "Helvetica", mono = "Consolas", `Times New Roman` = "DejaVu Serif" ) ss <- svgstring(system_fonts = fonts) plot(1:10) text(0.8, 0.8, "Some text", family = "mono") text(0.2, 0.2, "Other text", family = "Times New Roman") dev.off() ss() ``` If you need support for non-latin characters, choose fonts with good Unicode coverage. "Arial Unicode MS" is a sans serif font with good coverage that is available on macOS and Windows systems (on the latter, only if MS Office is installed). Note that this font does not support kerning and has no bold or italic faces. ```{r, eval=FALSE} svglite("Rplots.svg", system_fonts = list(sans = "Arial Unicode MS")) plot.new() text(0.5, 0.5, "正規分布") dev.off() ``` The [Noto fontset](https://www.google.com/get/noto/) provided by Google as well as the [Han Sans family](https://github.com/adobe-fonts/source-han-sans) by Adobe have excellent coverage but may not be available at the time of rendering. This can be a concern if you distribute the SVG files on the Internet. ## User font aliases In addition to system fonts, you can also provide fonts that are not necessarily installed on the system (i.e., fonts that live in user space). The main reason to do this is to generate reproducible SVG files as different platforms can have different versions of a font and thus produce different text metrics. The `user_fonts` arguments takes either paths to font files, fonts from the `fontquiver` package, or a list that specifies the alias. Whereas `system_fonts` gets a named list of families as argument, `user_fonts` takes a named tree of lists of families (`sans`, `serif`, `mono` and `symbol`) and faces (`plain`, `italic`, `bold`, `bolditalic`, `symbol`): ```{r, eval=FALSE} # Using ttf files from fontquiver here, but it could be any ttf some_file <- fontquiver::font("Liberation", "Sans", "Regular")$ttf other_file <- fontquiver::font("Liberation", "Sans", "Italic")$ttf serif_file <- fontquiver::font("Liberation", "serif", "Italic")$ttf # The outer named list contains families while the inner named list # contains faces: fonts <- list( sans = list( plain = some_file, italic = other_file ), serif = list(plain = serif_file) ) ss <- svglite("plot.svg", user_fonts = fonts) plot.new() text(0.5, 0.5, "Sans Plain text") text(0.2, 0.2, "Sans Italic text", font = 3) text(0.8, 0.8, "Serif text", family = "serif") dev.off() ``` You can also control which font gets written in the `font-family` fields of SVGs by supplying a list containing `alias` and `file` elements: ```{r, eval=FALSE} file_with_alias <- list(alias = "Foobar Font", file = other_file) fonts <- list(sans = list(plain = file_with_alias)) ss <- svgstring(user_fonts = fonts) plot(1:10) text(0.5, 0.5, "Sans text") dev.off() ss() ``` `fontquiver` fonts are particularly useful for creating reproducible SVG files. The `vdiffr` package uses svglite with fontquiver fonts to create visual unit tests reliably across platforms. The Liberation fontset is appropriate for this usage because it features all 12 combinations of standard R families and faces. In addition fontquiver provides Symbola for the symbol font. The function `fontquiver::font_families()` produces a list with the appropriate structure and can be directly supplied to svglite: ```{r, eval=FALSE} fonts <- fontquiver::font_families("Liberation") fonts$symbol$symbol <- fontquiver::font_symbol("Symbola") str(fonts, 2) svglite("reproducible.svg", user_fonts = fonts) plot(1:10) dev.off() ``` ## Debugging font matching The C library Fontconfig is used as backend to find fonts installed on the system. Fontconfig is the standard interface to system fonts on Linux systems. It is also provided on macOS alongside the X11 graphics system and comes with R on Windows. A warning is issued if Fontconfig cannot find a system font. The gdtools package provides tools in case you have trouble with a particular font: ```{r, eval=FALSE} gdtools::match_family("Helvetica") gdtools::match_font("Helvetica", bold = TRUE) ``` Sometimes Fontconfig cannot find a font because it is not configured correctly. Use the `debug` argument to find out which configuration files Fontconfig is currently using: ```{r, eval=FALSE} gdtools::match_family("Helvetica", debug = "config") ``` See for more information on configuring Fontconfig. svglite/vignettes/scaling.Rmd0000644000176200001440000001576313617022513016037 0ustar liggesusers--- title: "Scaling Issues" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Scaling Issues} %\VignetteEngine{knitr::rmarkdown} \usepackage[utf8]{inputenc} --- ## Scaling SVG outputs The SVG files produced by svglite do not include `width` and `height` properties. This is a deliberate choice intended to make it easier to fit fluidly a SVG figure to its enclosing container. The scaling straightforward but requires some understanding of the `viewBox` SVG attribute which is included in all SVGs produced by svglite. This property defines the aspect ratio of the plot (as well as a *user coordinate system*, see next section). ### Fluid scaling The viewBox is determined by the `width` and `height` arguments of svglite's device functions (with 10'' x 8'' the default). Although those dimensions are supplied in inches, the viewBox's user coordinate system is completely unit agnostic. The main effect is thus to determine an aspect ratio. Since dimensions are not provided, the dimensions of the enclosing container are used instead and the SVG is rescaled to fit the container (although Internet Explorer currently requires some CSS tricks to get this behaviour, see ). Aspect ratio is preserved by default when the figure is scaled up or down. The details of how the aspect ratio is preserved can be adjusted in multiple ways via the `preserveAspectRatio` attribute. See for more information about this property. Other useful resource: ### Natural scaling Another strategy is needed in order to scale the figure to make the text within the SVG consistent with the text in the surrounding web page. That could be useful, for instance, to create a consistent appearance in an HTML presentation. Since the user coordinate system defined by the viewBox is unitless, we need to map the figure to its natural dimensions. This will ensure a correspondence between the scale of the figure and that of the web page. As mentioned above, the natural scale of svglite's figures is in points and is determined by the `width` and `height` arguments that you supply to the device functions (10'' x 8'' being the default). Although those dimensions are specified in inches, the coordinate system is scaled in points. Counting 72 points per inch, the default SVG surface is thus 720 x 576 pt. Note that the CSS standard defines 12pt to be equal to 16px, the default size of text in most browsers. Since 12pt is the default text size in svglite as well, a SVG scaled to its natural dimensions will appear seamless with web text of 16px. If the text in your web page has another size, you will have to compute a scale factor and adjust the dimensions of the SVG accordingly. To sum up, displaying a plot according to its natural dimensions requires providing the user agent with information about what the lengths defined within the SVG actually mean. There are several ways to achieve this. First you can edit the SVG and enclose it in another pair of `` tags that defines `height` and `width`. The root `` element determines the final dimensions of the figure. A second way is to enclose the figure in a `
` tag with appropriate dimensions and let the SVG figure rescale itself to that container (cf. the section on fluid scaling): ```html
``` Finally, you can directly specify the dimensions in the `` or `` tag that is embedding the figure. Note that the dimension attributes of those tags do not accept arbitrary units, so you will have to supply the dimensions in pixels. Just multiply the width and height measured in points with a factor of 16/12: ```html ``` ## Internal notes ### Device scaling As other graphics devices, svglite is scaled in big points (1/72 inch) rather than pica points (1/72.27 inch). Note that in LaTeX and in the `grid` graphics system on which ggplot2 is based, points refer to pica points. Big points are denoted in LaTeX by `bp` and in CSS by `pt`. We use the latter notation. See for some historical background about these units. The conversion between device units and physical dimensions is determined by the DevDesc parameter `ipr`. IPR stands for inches per raster (native device coordinates are sometimes called rasters in R terminology) and is set to 1/72 in svglite. The device's physical dimensions are set by the following DevDesc parameters (with `width` and `height` the plot dimensions set by the user in inches): | Parameter | Value | |-----------|---------------| | `left` | `0` | | `top` | `0` | | `right` | `width * 72` | | `bottom` | `height * 72` | A default svglite plot surface is thus 720 x 576 pt. ### Scaling of graphical elements It is conventional for the fundamental line width (`lwd = 1`) to correspond to a line width of 1/96 inch and svglite obeys this convention. Also, like other R graphics devices, svglite interprets all point sizes directly as big points (e.g. the `ps` graphical parameter and the `fontsize` argument of device functions). The default font size is 12pt. Text metrics are computed by Cairo thanks to David Gohel's gdtools package. gdtools instantiates a PDF Cairo surface scaled in big points. When svglite needs to compute metrics for a string of text, it supplies the current scaled font size to Cairo: `cex * ps`. The Base graphics system also makes use of the obscure `cra` parameter and its relatives (`cin`, `cxy`, and `csi`). `cra` serves as a crude measure for a default character height and width for the default fontsize provided when the device is called (12pt in svgilte). The main effect of this parameter (more specifically, the height component) is to change the relationship between the margin parameters `mar`/`mai` and `oma`/`omi`. The margins `mar` and `oma` are specified in line units and character height is used as a measure of line spacing to convert margins measured in lines to physical margins. As in other devices, `cra[0]` is set to `0.9 * pointsize` and `cra[1]` to `1.2 * pointsize`. These parameters are completely unused in the Grid graphics system. ### SVG output The SVG output sets up a viewBox (a user coordinate system) with values scaled in big points. **viewBox**: The width and height are set to `dd->right` and `dd->bottom` respectively (these values are determined by the user-supplied figure `width` and `height`). **Line width**: `1 lwd` should equal 1/96 inch. svglite gets values scaled in device coordinates (big points), so the line width is multiplied by 72/96. **Text**: gdtools returns metrics scaled in big points so no transformation is needed. We do need to add `px` units to work around a rendering bug in Firefox. Note that when a viewBox is set up, a pixel equals one unit in the user coordinate system and thus actually represents a big point. svglite/vignettes/releases/0000755000176200001440000000000013617022513015542 5ustar liggesuserssvglite/vignettes/releases/svglite-1.2.0.Rmd0000644000176200001440000000425713617022513020327 0ustar liggesusers--- title: "svglite 1.2.0" --- Today we are pleased to release a new version of svglite. This release fixes many bugs, includes new documentation vignettes, and improves fonts support. You can install svglite with: ```{r, eval=FALSE} install.packages("svglite") ``` ## Font handling Fonts are tricky with SVG because they are needed at two stages: * When creating the SVG file, the fonts are needed in order to correctly measure the amount space each character occupies. This is particularly important for plot that use `plotmath`. * When drawing the SVG file on screen, the fonts are needed to draw each character correctly. For the best display, that means you need to have the same fonts installed on both the computer that generates the SVG file and the computer that draws it. By default, svglite uses fonts that are installed on pretty much every computer. svglite's font support is now much more flexible thanks to two new arguments: `system_fonts` and `user_fonts`. 1. `system_fonts` allows you to specify the name of a font installed on your computer. This is useful, for example, if you'd like to use a font with better CJK support: ```{r, eval=FALSE} svglite("Rplots.svg", system_fonts = list(sans = "Arial Unicode MS")) plot.new() text(0.5, 0.5, "正規分布") dev.off() ``` 1. `user_fonts` allows you to specify a font installed in a R package (like [fontquiver](https://github.com/lionel-/fontquiver)). This is needed if you want to generate identical plot across different operating systems, and are using in the upcoming [vdiffr package](https://github.com/lionel-/vdiffr) which provides graphical unit tests. For more details, see `vignette("fonts")`. ## Text scaling This update also fixes many bugs. The most important is that text is now properly scaled within the plot, and we provide a vignette that describes the details: `vignette("scaling")`. It documents, for instance, how to include a svglite graphic in a web page with the figure text consistently scaled with the surrounding text. Find a full list of changes in the [release notes](https://github.com/hadley/svglite/releases/tag/v1.2.0). svglite/R/0000755000176200001440000000000013617256560012143 5ustar liggesuserssvglite/R/inlineSVG.R0000644000176200001440000000430113617023651014113 0ustar liggesusers#' Run plotting code and view svg in RStudio Viewer or web broswer. #' #' This is useful primarily for testing. Requires the \code{htmltools} #' package. #' #' @param code Plotting code to execute. #' @param ... Other arguments passed on to \code{\link{svglite}}. #' @export #' @examples #' if (require("htmltools")) { #' htmlSVG(plot(1:10)) #' htmlSVG(hist(rnorm(100))) #' } htmlSVG <- function(code, ...) { svg <- inlineSVG(code, ...) htmltools::browsable( htmltools::HTML(svg) ) } #' Run plotting code and return svg #' #' This is useful primarily for testing. Requires the \code{xml2} package. #' #' @return A \code{xml2::xml_document} object. #' @inheritParams htmlSVG #' @inheritParams svglite #' @export #' @examples #' if (require("xml2")) { #' x <- xmlSVG(plot(1, axes = FALSE)) #' x #' xml_find_all(x, ".//text") #' } xmlSVG <- function(code, ..., standalone = FALSE, height = 7, width = 7) { plot <- inlineSVG(code, ..., standalone = standalone, height = height, width = width ) xml2::read_xml(plot) } #' Run plotting code and open svg in OS/system default svg viewer or editor. #' #' This is useful primarily for testing or post-processing the SVG. #' #' @inheritParams htmlSVG #' @inheritParams svglite #' @export #' @examples #' if (interactive()) { #' editSVG(plot(1:10)) #' editSVG(contour(volcano)) #' } editSVG <- function(code, ..., width = NA, height = NA) { dim <- plot_dim(c(width, height)) tmp <- tempfile(fileext = ".svg") svglite(tmp, width = dim[1], height = dim[2], ...) tryCatch(code, finally = grDevices::dev.off() ) system(sprintf("open %s", shQuote(tmp))) } #' Run plotting code and return svg as string #' #' This is useful primarily for testing but can be used as an #' alternative to \code{\link{svgstring}()}. #' #' @inheritParams htmlSVG #' @export #' @examples #' stringSVG(plot(1:10)) stringSVG <- function(code, ...) { svg <- inlineSVG(code, ...) structure(svg, class = "svg") } inlineSVG <- function(code, ..., width = NA, height = NA) { dim <- plot_dim(c(width, height)) svg <- svgstring(width = dim[1], height = dim[2], ...) tryCatch(code, finally = grDevices::dev.off() ) out <- svg() class(out) <- NULL out } svglite/R/utils.R0000644000176200001440000000367213617022513013423 0ustar liggesusers mini_plot <- function(...) graphics::plot(..., axes = FALSE, xlab = "", ylab = "") plot_dim <- function(dim = c(NA, NA)) { if (any(is.na(dim))) { if (length(grDevices::dev.list()) == 0) { default_dim <- c(7, 7) } else { default_dim <- grDevices::dev.size() } dim[is.na(dim)] <- default_dim[is.na(dim)] dim_f <- prettyNum(dim, digits = 3) message("Saving ", dim_f[1], "\" x ", dim_f[2], "\" image") } dim } vapply_chr <- function(.x, .f, ...) { vapply(.x, .f, character(1), ...) } vapply_lgl <- function(.x, .f, ...) { vapply(.x, .f, logical(1), ...) } lapply_if <- function(.x, .p, .f, ...) { if (!is.logical(.p)) { .p <- vapply_lgl(.x, .p) } .x[.p] <- lapply(.x[.p], .f, ...) .x } keep <- function(.x, .p, ...) { .x[vapply_lgl(.x, .p, ...)] } compact <- function(x) { Filter(length, x) } `%||%` <- function(x, y) { if (is.null(x)) y else x } is_scalar_character <- function(x) { is.character(x) && length(x) == 1 } names2 <- function(x) { names(x) %||% rep("", length(x)) } ilapply <- function(.x, .f, ...) { idx <- names(.x) %||% seq_along(.x) out <- Map(.f, names(.x), .x, ...) names(out) <- names(.x) out } ilapply_if <- function(.x, .p, .f, ...) { if (!is.logical(.p)) { .p <- vapply_lgl(.x, .p) } .x[.p] <- ilapply(.x[.p], .f, ...) .x } set_names <- function(x, nm = x) { stats::setNames(x, nm) } zip <- function(.l) { fields <- set_names(names(.l[[1]])) lapply(fields, function(i) { lapply(.l, .subset2, i) }) } svglite_manual_tests <- new.env() register_manual_test <- function(file) { testthat_dir <- getwd() testfile <- file.path(testthat_dir, file) assign(file, testfile, svglite_manual_tests) } init_manual_tests <- function() { remove(list = names(svglite_manual_tests), envir = svglite_manual_tests) } open_manual_tests <- function() { lapply(names(svglite_manual_tests), function(test) { utils::browseURL(svglite_manual_tests[[test]]) }) } svglite/R/RcppExports.R0000644000176200001440000000114313617256560014556 0ustar liggesusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 svglite_ <- function(file, bg, width, height, pointsize, standalone, aliases) { .Call('_svglite_svglite_', PACKAGE = 'svglite', file, bg, width, height, pointsize, standalone, aliases) } svgstring_ <- function(env, bg, width, height, pointsize, standalone, aliases) { .Call('_svglite_svgstring_', PACKAGE = 'svglite', env, bg, width, height, pointsize, standalone, aliases) } get_svg_content <- function(p) { .Call('_svglite_get_svg_content', PACKAGE = 'svglite', p) } svglite/R/fonts.R0000644000176200001440000000535013617022513013407 0ustar liggesusers r_font_families <- c("sans", "serif", "mono", "symbol") r_font_faces <- c("plain", "bold", "italic", "bolditalic", "symbol") alias_lookup <- function() { if (.Platform$OS.type == "windows") { serif_font <- "Times New Roman" symbol_font <- "Standard Symbols L" } else { serif_font <- "Times" symbol_font <- "Symbol" } c( sans = "Arial", serif = serif_font, mono = "Courier", symbol = symbol_font ) } validate_aliases <- function(system_fonts, user_fonts) { system_fonts <- compact(lapply(system_fonts, compact)) user_fonts <- compact(lapply(user_fonts, compact)) system_fonts <- lapply(system_fonts, validate_system_alias) user_fonts <- ilapply(user_fonts, validate_user_alias) aliases <- c(names(system_fonts), names(user_fonts)) if (any(duplicated(aliases))) { stop("Cannot supply both system and font alias", call. = FALSE) } # Add missing system fonts for base families missing_aliases <- setdiff(r_font_families, aliases) system_fonts[missing_aliases] <- lapply(alias_lookup()[missing_aliases], gdtools::match_family) list( system = system_fonts, user = user_fonts ) } validate_system_alias <- function(alias) { if (!is_scalar_character(alias)) { stop("System fonts must be scalar character vector", call. = FALSE) } matched <- gdtools::match_family(alias) if (alias != matched) { warning(call. = FALSE, "System font `", alias, "` not found. ", "Closest match: `", matched, "`") } matched } is_user_alias <- function(x) { is.list(x) && (is_scalar_character(x$file) || is_scalar_character(x$ttf)) && (is_scalar_character(x$alias) || is_scalar_character(x$name)) } validate_user_alias <- function(default_name, family) { if (!all(names(family) %in% r_font_faces)) { stop("Faces must contain only: `plain`, `bold`, `italic`, `bolditalic`, `symbol`", call. = FALSE) } is_alias_object <- vapply_lgl(family, is_user_alias) is_alias_plain <- vapply_lgl(family, is_scalar_character) is_valid_alias <- is_alias_object | is_alias_plain if (any(!is_valid_alias)) { stop(call. = FALSE, "The following faces are invalid for `", default_name, "`: ", paste0(names(family)[!is_valid_alias], collapse = ", ") ) } names <- ifelse(is_alias_plain, default_name, family) names <- lapply_if(names, is_alias_object, function(obj) { obj$alias %||% obj$name }) files <- lapply_if(family, is_alias_object, function(obj) { obj$file %||% obj$ttf }) file_exists <- vapply_lgl(files, file.exists) if (any(!file_exists)) { missing <- unlist(files)[!file_exists] stop(call. = FALSE, "Could not find font file: ", paste0(missing, collapse = ", ") ) } zip(list(name = names, file = files)) } svglite/R/SVG.R0000644000176200001440000001043413617256411012722 0ustar liggesusers#' An SVG Graphics Driver #' #' This function produces graphics compliant to the current w3 svg XML #' standard. The driver output is currently NOT specifying a DOCTYPE DTD. #' #' svglite provides two ways of controlling fonts: system fonts #' aliases and user fonts aliases. Supplying a font alias has two #' effects. First it determines the \code{font-family} property of all #' text anchors in the SVG output. Secondly, the font is used to #' determine the dimensions of graphical elements and has thus an #' influence on the overall aspect of the plots. This means that for #' optimal display, the font must be available on both the computer #' used to create the svg, and the computer used to render the #' svg. See the \code{fonts} vignette for more information. #' #' @param file The file where output will appear. #' @param height,width Height and width in inches. #' @param bg Default background color for the plot (defaults to "white"). #' @param pointsize Default point size. #' @param standalone Produce a standalone svg file? If \code{FALSE}, omits #' xml header and default namespace. #' @param system_fonts Named list of font names to be aliased with #' fonts installed on your system. If unspecified, the R default #' families \code{sans}, \code{serif}, \code{mono} and \code{symbol} #' are aliased to the family returned by #' \code{\link[gdtools]{match_family}()}. #' @param user_fonts Named list of fonts to be aliased with font files #' provided by the user rather than fonts properly installed on the #' system. The aliases can be fonts from the fontquiver package, #' strings containing a path to a font file, or a list containing #' \code{name} and \code{file} elements with \code{name} indicating #' the font alias in the SVG output and \code{file} the path to a #' font file. #' @references \emph{W3C Scalable Vector Graphics (SVG)}: #' \url{http://www.w3.org/Graphics/SVG/Overview.htm8} #' @author This driver was written by T Jake Luciani #' \email{jakeluciani@@yahoo.com} 2012: updated by Matthieu Decorde #' \email{matthieu.decorde@@ens-lyon.fr} #' @seealso \code{\link{pictex}}, \code{\link{postscript}}, \code{\link{Devices}} #' @examples #' # Save to file #' svglite(tempfile("Rplots.svg")) #' plot(1:11, (-5:5)^2, type = 'b', main = "Simple Example") #' dev.off() #' #' # Supply system font aliases. First check the font can be located: #' gdtools::match_family("Verdana") #' #' # Then supply a list of aliases: #' fonts <- list(sans = "Verdana", mono = "Times New Roman") #' svglite(tempfile("Rplots.svg"), system_fonts = fonts) #' plot.new() #' text(0.5, 0.5, "Some text", family = "mono") #' dev.off() #' #' # See the fonts vignettes for more options to deal with fonts #' #' @keywords device #' @useDynLib svglite #' @importFrom Rcpp sourceCpp #' @importFrom gdtools raster_view #' @export svglite <- function(file = "Rplots.svg", width = 10, height = 8, bg = "white", pointsize = 12, standalone = TRUE, system_fonts = list(), user_fonts = list()) { aliases <- validate_aliases(system_fonts, user_fonts) invisible(svglite_(file, bg, width, height, pointsize, standalone, aliases)) } #' Access current SVG as a string. #' #' This is a variation on \code{\link{svglite}} that makes it easy to access #' the current value as a string. #' #' See \code{\link{svglite}()} documentation for information about #' specifying fonts. #' #' @return A function with no arguments: call the function to get the #' current value of the string. #' @examples #' s <- svgstring(); s() #' #' plot.new(); s(); #' text(0.5, 0.5, "Hi!"); s() #' dev.off() #' #' s <- svgstring() #' plot(rnorm(5), rnorm(5)) #' s() #' dev.off() #' @inheritParams svglite #' @export svgstring <- function(width = 10, height = 8, bg = "white", pointsize = 12, standalone = TRUE, system_fonts = list(), user_fonts = list()) { aliases <- validate_aliases(system_fonts, user_fonts) env <- new.env(parent = emptyenv()) string_src <- svgstring_(env, width = width, height = height, bg = bg, pointsize = pointsize, standalone = standalone, aliases = aliases) function() { svgstr <- if(env$is_closed) env$svg_string else get_svg_content(string_src) structure(svgstr, class = "svg") } } #' @export print.svg <- function(x, ...) cat(x, "\n", sep = "") svglite/NEWS.md0000644000176200001440000000753713617210260013037 0ustar liggesusers# svglite 1.2.3 # svglite (development version) * The radius of circles is no longer expressed in pt (#93, @vandenman). * Dimensions smaller than 1 now retain two significant figures (#94, @ilia-kats). * @thomasp85 takes over as maintainer # svglite 1.2.2 * Improvements to reproducibility of generated SVGs: Negative zeros are now treated as positive, and the clip ID are now generated from truncated elements. * svglite now uses the `polygon` SVG element. This ensures that polygons are properly closed (#82). * Text metrics are now correctly computed for Unicode characters in plotmath expressions (#81). # svglite 1.2.1 This release makes svglite compatible with gdtools 0.1.6 # svglite 1.2.0 ## New features * The device functions gain `system_fonts` and `user_fonts` arguments. * Two new vignettes: `vignette("fonts")` and `vignette("scaling")`. The vignette on fonts explains in detail how to use the new fonts arguments and why. The vignette on scaling goes over scaling issues, e.g. when embedding svglite outputs in a web page. * `xmlSVG()` gains `height` and `width` arguments (#66). * New `stringSVG()` device function for quick testing. ## Improvements * Greatly improves the performance of `svgstring()` (#58). * Clip paths now get a unique identifier to avoid collisions when multiple plots are included in a document (#67). * Raster graphics are now correctly cropped (#64) and handle transparency properly. * The dimensions of text fields are now hardcoded in the SVGs to prevent alignment issues. ## Bug fixes * `editSVG()` works again (#56). * The dashes in lines with `lwd < 1` are scaled better (#68). * Transparent blacks are written correctly (#62, #63). * Text is now scaled correctly (#72, #59). See also the new vignette on scaling. # svglite 1.1.0 * Text metrics now converted from points to pixels (#45, #48) - this fixes text alignment issues. * Intermediate outputs are always valid SVG (#53). * New `svgstring()` returns plot as a string (#40, @yixuan). * Use raster test compatible with older versions of R. * Add support for `clip()`. This also fixes a number of minor issues with grid graphics (@yixuan, #47 and #49). * Fix incorrect device size (#50). # svglite 1.0.0 svglite is fully featured svg graphics device that works on all platforms, forked from RSvgDevice. It supports all graphics device features: * All types of line dashing are supported (#15). All line end and line join styles are supported (#24). * Text is now coloured, and uses the same default fonts as R (Arial, Times New Roman, and Courier). Font metrics are computed using the gdtools package so that `plotmath()` and `strwidth()` now work. * Transparent colours are now generated with `rgba()` rather than using `stroke-opacity` and `fill-opacity` styles (#16). NA fills and colours are translated to "none". * `par(bg)` affects the background colour (#8). * Rasters are supported by embedding base64-encoded pngs in a data url (#2). * `polypath()` is now supported, which also allows the `showtext` package to render fonts correctly with this device (#36). We also made a few other tweaks to the rendered SVG: * Only the `viewBox` attribute of `` is set (not `width` and `height`): I'm reasonably certain this makes it easier to use in more places (#12). * Default styling properties are specified in a global `