├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS.md ├── R ├── svgout.R ├── utils-colour.R ├── utils-style.R └── utils.R ├── README.Rmd ├── README.md ├── man ├── create_style_string.Rd ├── figures │ ├── example-basic-2.svg │ ├── example-basic-3.svg │ ├── example-basic.svg │ ├── example-css.gif │ ├── example-css.svg │ ├── example-filter.svg │ ├── example-javascript.png │ ├── example-javascript.svg │ ├── example-manual.svg │ ├── example-pie.svg │ ├── example-retro.svg │ ├── example-usgs.svg │ ├── gradient-examples │ │ ├── MilesMcbain.jpg │ │ └── VictimOfMaths.png │ ├── logo.png │ ├── logo.svg │ ├── patterns.svg │ └── svgout-example.svg ├── fill_style.Rd ├── filter_style.Rd ├── font_style.Rd ├── glue_two.Rd ├── is_black.Rd ├── is_transparent.Rd ├── is_white.Rd ├── rgba_to_alpha.Rd ├── rgba_to_hex.Rd ├── stroke_style.Rd ├── style_string.Rd ├── svg_callback.Rd ├── svg_strWidth.Rd ├── svgout.Rd └── transformer_round.Rd └── vignettes ├── .gitignore ├── data ├── drugs.rds └── suicides.rds ├── heart-beat.Rmd ├── images ├── ONS.png ├── VictimOfMaths.png ├── blue.png ├── victimofmaths00 └── victimofmaths01 ├── svg-with-css.Rmd ├── svg-with-d3-complex.Rmd ├── svg-with-gradient-fill.Rmd ├── svg-with-javascript.Rmd └── svg ├── DrugDeaths.svg ├── gradient-example.svg ├── test-gradient.svg └── timelyportfolio-devout.svg /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | ^.*\.svg$ 5 | ^working$ 6 | ^pkgdown$ 7 | ^doc$ 8 | ^Meta$ 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | .Rhistory 3 | *.Rproj 4 | .Rproj.user 5 | *.swp 6 | working 7 | *.txt 8 | inst/doc 9 | pkgdown 10 | doc 11 | Meta 12 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: devoutsvg 2 | Type: Package 3 | Title: SVG Graphics Device with Pattern Fill Support 4 | Version: 0.2.1 5 | Author: mikefc@coolbutuseless.com 6 | Maintainer: mikefc 7 | Description: SVG graphics device written in R. Supports regions filled with patterns. 8 | License: MIT + file LICENSE 9 | Encoding: UTF-8 10 | LazyData: true 11 | URL: https://coolbutuseless.github.io/package/devoutsvg,https://github.com/coolbutuseless/devoutsvg 12 | Depends: 13 | R (>= 3.5.0), 14 | devout 15 | Imports: 16 | gdtools, 17 | glue, 18 | minisvg (>= 0.1.6) 19 | Suggests: 20 | knitr, 21 | rmarkdown, 22 | dplyr, 23 | tidyr, 24 | ggplot2, 25 | ggridges, 26 | svgpatternsimple, 27 | htmltools, 28 | d3r, 29 | multiscales, 30 | class, 31 | scales, 32 | KernSmooth 33 | RoxygenNote: 7.1.0 34 | VignetteBuilder: knitr 35 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019,2020 mikefc@coolbutuseless.com 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(svg_callback) 4 | export(svgout) 5 | import(devout) 6 | import(gdtools) 7 | import(glue) 8 | importFrom(grDevices,rgb) 9 | importFrom(utils,installed.packages) 10 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | 2 | # devoutsvg 0.2.1 2020-04-19 3 | 4 | * Minor update to use new interface to `devout::rdevice()` which accepts 5 | function objects, not just function names 6 | 7 | # devoutsvg 0.2.0 2020-01-20 8 | 9 | * Removed old `{devoutsvg-0.1.0}` api for pattern integration. 10 | * Instead, use `pattern_list` object to define patterns and filters to use 11 | for specific colours 12 | * Update default width and height to to match `svglite` 13 | 14 | # devoutsvg 0.1.1 2020-01-19 15 | 16 | * Added support for patterns with filters 17 | * Added checks on validity of `pattern_pkg` given by user. 18 | 19 | # devoutsvg 0.1.0 20 | 21 | * Initial release 22 | -------------------------------------------------------------------------------- /R/svgout.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 5 | # When opening a device 6 | # - create a "canvas". For svg, the canvas is just a text string of SVG 7 | # commands that we'll keep adding to with each device call 8 | # - add the canvas to the 'state$rdata' list 9 | # - always return the state so we keep the canvas across different device calls 10 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 11 | svg_open <- function(args, state) { 12 | 13 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 14 | # Create a 'minisvg' document. The 'viewBox' will be set by the width and 15 | # height, but then remove the 'width' and 'height' attributes and keep only 16 | # the 'viewBox' 17 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 18 | msvg <- minisvg::SVGDocument$new( 19 | width = state$dd$right, 20 | height = state$dd$bottom 21 | )$update(width = NULL, height = NULL) 22 | 23 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 24 | # Add a default style 25 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 26 | msvg$add_css(" 27 | line, polyline, polygon, path, rect, circle { 28 | fill: none; 29 | stroke: #000000; 30 | stroke-linecap: round; 31 | stroke-linejoin: round; 32 | stroke-miterlimit: 10.00; 33 | }") 34 | 35 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 36 | # add a blank white rectangle as the background 37 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 38 | msvg$rect(width='100%', height='100%', style='stroke: none; fill: #ffffff') 39 | 40 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 41 | # Did the user specify an external CSS location? 42 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 43 | msvg$add_css_url(state$rdata$css_url) 44 | msvg$add_css (state$rdata$css_decl) 45 | msvg$add_js_url (state$rdata$js_url) 46 | msvg$add_js_code(state$rdata$js_code) 47 | 48 | state$rdata$msvg <- msvg 49 | 50 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 51 | # Keep track of what clip regions have been defined, and the ID of 52 | # the current clip region 53 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 54 | state$rdata$current_clip_id <- NULL 55 | state$rdata$all_clip_ids <- character(0) 56 | 57 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 58 | # Keep track of which fills and filters have been added 59 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 60 | state$rdata$all_fill_ids <- character(0) 61 | state$rdata$all_filter_ids <- character(0) 62 | 63 | 64 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 65 | # `pattern_list` object must be an actual list. 66 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 67 | if (is.null(state$rdata$pattern_list) || !is.list(state$rdata$pattern_list)) { 68 | state$rdata$pattern_list <- list() 69 | } 70 | 71 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 72 | # Ensure all names of hex colours are uppercase to match svgout internals 73 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 74 | names(state$rdata$pattern_list) <- toupper(names(state$rdata$pattern_list)) 75 | 76 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 77 | # Initialise some idx counters for element numbering 78 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 79 | state$rdata$idx <- list( 80 | polygon = 0L, 81 | polyline = 0L, 82 | path = 0L, 83 | circle = 0L, 84 | rect = 0L, 85 | text = 0L, 86 | line = 0L 87 | ) 88 | 89 | 90 | state 91 | } 92 | 93 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 94 | # When the device is closed 95 | # - add the closing tag 96 | # - output the SVG to file 97 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 98 | svg_close <- function(args, state) { 99 | 100 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 101 | # Write svg text to file 102 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 103 | state$rdata$msvg$save(filename = state$rdata$filename, include_declaration = TRUE) 104 | 105 | state 106 | } 107 | 108 | 109 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 110 | # Add a circle to the SVG 111 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 112 | svg_circle <- function(args, state) { 113 | geom <- 'circle' 114 | attr_names <- c('fill', 'stroke', 'filter') 115 | 116 | state$rdata$idx[[geom]] <- state$rdata$idx[[geom]] + 1L 117 | 118 | state$rdata$msvg$circle( 119 | id = sprintf("%s-%04i", geom, state$rdata$idx[[geom]]), 120 | cx = round(args$x, 2), 121 | cy = round(args$y, 2), 122 | r = paste0(round(args$r, 2), 'pt'), 123 | style = style_string(attr_names = attr_names, state = state, geom = geom), 124 | clip_path = clip_path_string(state = state) 125 | ) 126 | 127 | 128 | state 129 | } 130 | 131 | 132 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 133 | # Add a polyline to the SVG 134 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 135 | svg_polyline <- function(args, state) { 136 | geom <- 'polyline' 137 | attr_names <- c('stroke', 'filter') 138 | 139 | state$rdata$idx[[geom]] <- state$rdata$idx[[geom]] + 1L 140 | 141 | state$rdata$msvg$polyline( 142 | id = sprintf("%s-%04i", geom, state$rdata$idx[[geom]]), 143 | xs = round(args$x, 2), 144 | ys = round(args$y, 2), 145 | style = style_string(attr_names = attr_names, state = state, geom = geom), 146 | clip_path = clip_path_string(state = state) 147 | ) 148 | 149 | state 150 | } 151 | 152 | 153 | 154 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 155 | # Convert a set of x,y coordinates to 156 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 157 | coords_to_svg_path_string <- function(xs, ys) { 158 | xs = round(xs, 4) 159 | ys = round(ys, 4) 160 | paste("M", paste(xs, ys, collapse = " L ", sep=" "), "Z") 161 | } 162 | 163 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 164 | # Draw multiple paths 165 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 166 | svg_path <- function(args, state) { 167 | 168 | geom <- 'path' 169 | attr_names <- c('stroke', 'fill', 'filter') 170 | 171 | state$rdata$idx[[geom]] <- state$rdata$idx[[geom]] + 1L 172 | 173 | extents <- c(0, cumsum(args$nper)) 174 | 175 | for (poly in seq_len(args$npoly)) { 176 | subargs <- args 177 | lower <- extents[poly ] + 1L 178 | upper <- extents[poly + 1L] 179 | subargs$x <- subargs$x[lower:upper] 180 | subargs$y <- subargs$y[lower:upper] 181 | state$rdata$msvg$path( 182 | id = sprintf("%s-%04i-%02i", geom, state$rdata$idx[[geom]], poly), 183 | d = coords_to_svg_path_string(subargs$x, subargs$y), 184 | style = style_string(attr_names = attr_names, state = state, geom = geom), 185 | clip_path = clip_path_string(state = state) 186 | ) 187 | } 188 | 189 | state 190 | } 191 | 192 | 193 | 194 | 195 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 196 | # Add a polygon to the SVG 197 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 198 | svg_polygon <- function(args, state) { 199 | 200 | geom <- 'polygon' 201 | attr_names <- c('fill', 'stroke', 'filter') 202 | 203 | state$rdata$idx[[geom]] <- state$rdata$idx[[geom]] + 1L 204 | 205 | state$rdata$msvg$polygon( 206 | id = sprintf("%s-%04i", geom, state$rdata$idx[[geom]]), 207 | xs = round(args$x, 4), 208 | ys = round(args$y, 4), 209 | style = style_string(attr_names = attr_names, state = state, geom = geom), 210 | clip_path = clip_path_string(state) 211 | ) 212 | 213 | state 214 | } 215 | 216 | 217 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 218 | # Add a line to the SVG 219 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 220 | svg_line <- function(args, state) { 221 | geom <- 'line' 222 | attr_names <- c('fill', 'stroke', 'filter') 223 | 224 | state$rdata$idx[[geom]] <- state$rdata$idx[[geom]] + 1L 225 | 226 | state$rdata$msvg$line( 227 | id = sprintf("%s-%04i", geom, state$rdata$idx[[geom]]), 228 | x1 = round(args$x1, 2), 229 | y1 = round(args$y1, 2), 230 | x2 = round(args$x2, 2), 231 | y2 = round(args$y2, 2), 232 | style = style_string(attr_names = attr_names, state = state, geom = geom), 233 | clip_path = clip_path_string(state = state) 234 | ) 235 | 236 | state 237 | } 238 | 239 | 240 | 241 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 242 | # Unpack font information from the graphics context 243 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 244 | get_font_info <- function(state) { 245 | fontfamily <- state$gc$fontfamily 246 | fontface <- state$gc$fontface 247 | is_bold <- fontface %in% c(2, 4) 248 | is_italic <- fontface %in% c(3, 4) 249 | is_symbol <- fontface == 5 250 | 251 | if (is_symbol) { 252 | fontfamily <- 'symbol' 253 | } else if (fontfamily == '') { 254 | fontfamily <- 'sans' 255 | } 256 | 257 | fontfamily <- gdtools::match_family(fontfamily) 258 | 259 | 260 | fontsize <- state$gc$cex * state$gc$ps 261 | 262 | 263 | list(family = fontfamily, bold = is_bold, italic = is_italic, size = fontsize) 264 | } 265 | 266 | 267 | 268 | 269 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 270 | # Add text to the SVG 271 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 272 | svg_text <- function(args, state) { 273 | 274 | geom <- 'text' 275 | attr_names <- 'font' 276 | 277 | state$rdata$idx[[geom]] <- state$rdata$idx[[geom]] + 1L 278 | 279 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 280 | # Calculate the display width of the string 281 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 282 | font <- get_font_info(state) 283 | metrics <- gdtools::str_metrics(args$str, fontname = font$family, fontsize = font$size, bold = font$bold,italic = font$italic, fontfile = "") 284 | width <- metrics[['width']] 285 | 286 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 287 | # Only calculate a transform if the rotation is non-zero 288 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 289 | transform <- NULL 290 | if (args$rot != 0) { 291 | transform <- minisvg::svg_prop$transform$rotate( 292 | a = -round(args$rot, 2), 293 | x = round(args$x , 2), 294 | y = round(args$y , 2) 295 | ) 296 | } 297 | 298 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 299 | # Add a 'g' group to the SVG. 300 | # - the clip-path goes on the group 301 | # - the text element is a child of the group 302 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 303 | state$rdata$msvg$g( 304 | clip_path = clip_path_string(state), 305 | minisvg::stag$text( 306 | id = sprintf("%s-%04i", geom, state$rdata$idx[[geom]]), 307 | trimws(args$str), 308 | x = round(args$x, 2), 309 | y = round(args$y, 2), 310 | textLength = paste0(round(width, 2), "px"), 311 | lengthAdjust = "spacingAndGlyphs", 312 | style = style_string(attr_names = attr_names, state = state, geom = geom), 313 | transform 314 | ) 315 | ) 316 | 317 | 318 | state 319 | } 320 | 321 | 322 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 323 | # Add RECT to the SVG 324 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 325 | svg_rect <- function(args, state) { 326 | 327 | geom <- 'rect' 328 | attr_names <- c('fill', 'stroke', 'filter') 329 | 330 | state$rdata$idx[[geom]] <- state$rdata$idx[[geom]] + 1L 331 | 332 | 333 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 334 | # Has the user defined an internal element in the pattern_list? 335 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 336 | gc <- state$gc 337 | fill <- gc$fill 338 | hexcolour <- rgba_to_hex(fill) 339 | inner <- state$rdata$pattern_list[[hexcolour]][['inner']] 340 | 341 | 342 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 343 | # Calculate rectangle extents 344 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 345 | x <- min(args$x0, args$x1) 346 | y <- min(args$y0, args$y1) 347 | width <- abs(args$x1 - args$x0) 348 | height <- abs(args$y1 - args$y0) 349 | 350 | state$rdata$msvg$rect( 351 | id = sprintf("%s-%04i", geom, state$rdata$idx[[geom]]), 352 | x = round(x, 2), 353 | y = round(y, 2), 354 | width = round(width , 2), 355 | height = round(height, 2), 356 | style = style_string(attr_names = attr_names, state = state, geom = geom), 357 | clip_path = clip_path_string(state = state), 358 | class = state$rdata$pattern_list[[hexcolour]][['class']], 359 | inner 360 | ) 361 | 362 | state 363 | } 364 | 365 | 366 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 367 | #' Return the width of the given string 368 | #' 369 | #' @param args,state standard pass-through from device driver 370 | #' 371 | #' @import gdtools 372 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 373 | svg_strWidth <- function(args, state) { 374 | 375 | fontsize <- state$gc$cex * state$gc$ps 376 | metrics <- gdtools::str_metrics(args$str, fontname = "sans", fontsize = fontsize, bold = FALSE, italic = FALSE, fontfile = "") 377 | state$width <- metrics[['width']] 378 | 379 | state 380 | } 381 | 382 | 383 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 384 | # Return some info about font size 385 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 386 | svg_metricInfo <- function(args, state) { 387 | 388 | cint <- abs(args$c) 389 | str <- intToUtf8(cint) 390 | 391 | fontsize <- state$gc$cex * state$gc$ps 392 | metrics <- gdtools::str_metrics(str, fontname = "sans", fontsize = fontsize, bold = FALSE, italic = FALSE, fontfile = "") 393 | 394 | state$ascent <- metrics[['ascent' ]] 395 | state$descent <- metrics[['descent']] 396 | state$width <- metrics[['width' ]] 397 | 398 | state 399 | } 400 | 401 | 402 | 403 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 404 | # SVG attribute for Current clip-path 405 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 406 | clip_path <- function(state) { 407 | 408 | if (is.null(state$rdata$current_clip_id)) { 409 | '' 410 | } else { 411 | glue::glue("clip-path='url(#{state$rdata$current_clip_id})'") 412 | } 413 | } 414 | 415 | 416 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 417 | # SVG attribute for Current clip-path 418 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 419 | clip_path_string <- function(state) { 420 | if (is.null(state$rdata$current_clip_id)) { 421 | NULL 422 | } else { 423 | glue::glue("url(#{state$rdata$current_clip_id})") 424 | } 425 | } 426 | 427 | 428 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 429 | # Update the clipping path 430 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 431 | svg_clip <- function(args, state) { 432 | 433 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 434 | # What's the current clip ID. Could be NULL if not yet set. 435 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 436 | current_clip_id <- state$rdata$current_clip_id 437 | 438 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 439 | # Create an ID string but just concatenating all the coordiantes 440 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 441 | this_clip <- with(args, round(c(x0, y0, x1, y1), 2)) 442 | this_clip_id <- paste0("clip_", gsub("\\.", "_", paste(this_clip, collapse="_"))) 443 | # print(this_clip) 444 | 445 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 446 | # If the requested clipping is already active, no need to add anything to SVG 447 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 448 | if (identical(this_clip_id, current_clip_id)) { 449 | return(state) 450 | } 451 | 452 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 453 | # Set this new clip ID as the current clipping 454 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 455 | state$rdata$current_clip_id <- this_clip_id 456 | 457 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 458 | # If the clip ID already exists in IDs we have output to the SVG, then 459 | # there is no need to output the clip definition again. 460 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 461 | if (this_clip_id %in% state$rdata$all_clip_ids) { 462 | return(state) 463 | } 464 | 465 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 466 | # Add the current clip ID to the list of all clip IDs in this SVG 467 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 468 | state$rdata$all_clip_ids <- c(state$rdata$all_clip_ids, this_clip_id) 469 | 470 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 471 | # Calcualte clipping rectangle extents 472 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 473 | x <- min(args$x0, args$x1) 474 | y <- min(args$y0, args$y1) 475 | width <- abs(args$x1 - args$x0) 476 | height <- abs(args$y1 - args$y0) 477 | 478 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 479 | # Add the clipPath to the SVG 480 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 481 | state$rdata$msvg$defs()$clipPath( 482 | id = this_clip_id, 483 | minisvg::stag$rect( 484 | x = round(x , 2), 485 | y = round(y , 2), 486 | width = round(width , 2), 487 | height = round(height, 2) 488 | ) 489 | ) 490 | 491 | 492 | state 493 | } 494 | 495 | 496 | 497 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 498 | #' The main SVG callback. 499 | #' 500 | #' @param device_call name of device call 501 | #' @param args arguments to the call 502 | #' @param state rdata, gc and dd 503 | #' 504 | #' @import glue 505 | #' 506 | #' @export 507 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 508 | svg_callback <- function(device_call, args, state) { 509 | switch( 510 | device_call, 511 | "open" = svg_open (args, state), 512 | "close" = svg_close (args, state), 513 | "circle" = svg_circle (args, state), 514 | "line" = svg_line (args, state), 515 | "polyline" = svg_polyline (args, state), 516 | "path" = svg_path (args, state), 517 | "polygon" = svg_polygon (args, state), 518 | "text" = svg_text (args, state), 519 | "textUTF8" = svg_text (args, state), 520 | 'rect' = svg_rect (args, state), 521 | 'strWidth' = svg_strWidth (args, state), 522 | 'strWidthUTF8' = svg_strWidth (args, state), 523 | 'metricInfo' = svg_metricInfo(args, state), 524 | 'clip' = svg_clip (args, state), 525 | { 526 | # if (!device_call %in% c('size', 'mode')) {print(device_call)}; 527 | state 528 | } 529 | ) 530 | } 531 | 532 | 533 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 534 | #' SVG device written in R. 535 | #' 536 | #' As with all devices based upon \code{devout}, this function realy just 537 | #' notifies \code{devout::rdevice()} to call \code{devoutsvg::svg_callback()} 538 | #' 539 | #' @param filename default: "svgout.svg" 540 | #' @param width,height size in inches. Default: 10x8 541 | #' @param js_url URL to external javascript to include in SVG output. 542 | #' Default: NULL (no external JS) 543 | #' @param js_code character string of javascript code to include in SVG output. 544 | #' Default: NULL (no javascript code to include) 545 | #' @param css_url URL to extenal CSS to include in SVG output. 546 | #' Default: NULL (no external CSS) 547 | #' @param css_decl character string of CSS declarations to include in SVG output. 548 | #' Default: NULL (no CSS declarations to include) 549 | #' @param pattern_list named list of patterns and filters to use as fills for the 550 | #' colour they represent. See vignettes() for more information. 551 | #' Default: NULL (no replacement patterns or filters) 552 | #' @param ... arguments passed to \code{devout::rdevice} 553 | #' 554 | #' @importFrom utils installed.packages 555 | #' @import devout 556 | #' 557 | #' @export 558 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 559 | svgout <- function(filename = "svgout.svg", width = 10, height = 8, 560 | js_url = NULL, js_code = NULL, 561 | css_url = NULL, css_decl = NULL, 562 | pattern_list = NULL, ...) { 563 | requireNamespace('devout') 564 | devout::rdevice( 565 | svg_callback, 566 | filename = filename, 567 | width = width, 568 | height = height, 569 | js_url = js_url, 570 | js_code = js_code, 571 | css_url = css_url, 572 | css_decl = css_decl, 573 | pattern_list = pattern_list, ...) 574 | } 575 | 576 | -------------------------------------------------------------------------------- /R/utils-colour.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 4 | #' Convert a 4-element rgba vector to hex RGB 5 | #' 6 | #' @param rgba_vec 4 element rgba with integer values [0, 255] 7 | #' 8 | #' @return colour hex triplet as string e.g. "#0156fe" 9 | #' @importFrom grDevices rgb 10 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 11 | rgba_to_hex <- function(rgba_vec) { 12 | rgb(rgba_vec[1], rgba_vec[2], rgba_vec[3], names = NULL, maxColorValue = 255) 13 | } 14 | 15 | 16 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 17 | #' Calcuate the alpha value from the 4-element RGBA vector 18 | #' 19 | #' @param rgba_vec 4 element rgba with integer values [0, 255] 20 | #' 21 | #' @return alpha in range [0,1] 22 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 23 | rgba_to_alpha <- function(rgba_vec) { 24 | round(rgba_vec[4]/255, 2) 25 | } 26 | 27 | 28 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 29 | #' Is the colour black? 30 | #' 31 | #' @param rgba_vec 4 element rgba with integer values [0, 255] 32 | #' 33 | #' @return TRUE if black 34 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 35 | is_black <- function(rgba_vec) { 36 | rgba_vec[1] == 0 && rgba_vec[2] == 0 && rgba_vec[3] == 0 37 | } 38 | 39 | 40 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 41 | #' Is the colour white? 42 | #' 43 | #' @param rgba_vec 4 element rgba with integer values [0, 255] 44 | #' 45 | #' @return TRUE if white 46 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 47 | is_white <- function(rgba_vec) { 48 | rgba_vec[1] == 255 && rgba_vec[2] == 255 && rgba_vec[3] == 255 49 | } 50 | 51 | 52 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 53 | #' Is the colour transparent? 54 | #' 55 | #' @param rgba_vec 4 element rgba with integer values [0, 255] 56 | #' 57 | #' @return TRUE if alpha == 0 58 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 59 | is_transparent <- function(rgba_vec) { 60 | rgba_vec[4] == 0 61 | } 62 | -------------------------------------------------------------------------------- /R/utils-style.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | geoms_with_pattern_fill <- c('rect', 'polygon', 'path', 'circle') 4 | 5 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 6 | #' Construct a vector of styles related to 'stroke' 7 | #' 8 | #' Note: 1 lwd = 1/96", but units in rest of document are 1/72" 9 | #' 10 | #' @param state list including 'gc' (graphics context) 11 | #' @param geom which geometry has asked for a style 12 | #' 13 | #' @return character vector of multiple "{attr_name}: {value}" strings for 14 | #' 'stroke', 'stroke-width', 'stroke-opacity' 15 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 16 | stroke_style <- function(state, geom) { 17 | gc <- state$gc 18 | 19 | style <- c() 20 | 21 | if (is_transparent(gc$col)) { 22 | return("stroke: none") 23 | } 24 | 25 | if (!is_black(gc$col)) { 26 | style <- c(style, glue_two("stroke: {rgba_to_hex(gc$col)}")) 27 | } 28 | 29 | style <- c(style, glue_two("stroke-width: {round(gc$lwd / 96.0 * 72, 2)}")) 30 | 31 | if (rgba_to_alpha(gc$col) != 1) { 32 | style <- c(style, glue_two("stroke-opacity: {rgba_to_alpha(gc$col)}")) 33 | } 34 | 35 | style 36 | } 37 | 38 | 39 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 40 | #' Construct a vector of styles related to 'font' 41 | #' 42 | #' TODO: add font choice and style 43 | #' 44 | #' @inheritParams stroke_style 45 | #' 46 | #' @return character vector of multiple "{attr_name}: {value}" strings for 47 | #' 'font-size', 'font-family', 'fill' 48 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 49 | font_style <- function(state, geom) { 50 | 51 | gc <- state$gc 52 | 53 | # fontsize <- gc$cex * gc$ps 54 | font <- get_font_info(state) 55 | 56 | style <- c( 57 | glue_two("font-size: {font$size}px"), 58 | glue("font-family: {font$family}") 59 | ) 60 | 61 | if (!is_black(gc$col)) { 62 | style <- c(style, glue_two("fill: {rgba_to_hex(gc$col)}")) 63 | } 64 | 65 | style 66 | } 67 | 68 | 69 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 70 | #' Construct a vector of styles related to 'fill' 71 | #' 72 | #' @inheritParams stroke_style 73 | #' 74 | #' @return character vector of multiple "{attr_name}: {value}" strings for 'fill', 75 | #' 'fill-opacity' 76 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 77 | fill_style <- function(state, geom) { 78 | 79 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 80 | # Setup 81 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 82 | gc <- state$gc 83 | fill <- gc$fill 84 | hexcolour <- rgba_to_hex(fill) 85 | 86 | style <- NULL 87 | 88 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 89 | # Check if: 90 | # (1) This geom supports pattern fill 91 | # (2) this hex colour is in the pattern list 92 | # (3) the pattern_list entry for this hexcolour includes a 'pattern' 93 | # 94 | # Some patterns also have a filter. include this if present. 95 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 96 | plist <- state$rdata$pattern_list 97 | if (geom %in% geoms_with_pattern_fill) { 98 | pattern <- plist[[hexcolour]][['fill']] 99 | if (!is.null(pattern)) { 100 | if (inherits(pattern, 'SVGElement')) { 101 | state$rdata$msvg$defs(pattern) 102 | style <- glue::glue("fill: url(#{pattern$attribs$id})") 103 | if (!is.null(pattern$filter_def)) { 104 | state$rdata$msvg$defs(pattern$filter_def) 105 | style <- c(style, glue::glue("filter: url(#{pattern$filter_def$attribs$id})")) 106 | } 107 | } else { 108 | message("devoutsvg: 'fill' pattern for ", hexcolour, ' in the `pattern_list` must be of class SVGElement, not ', 109 | deparse(class(pattern)), ". Using colour only.") 110 | } 111 | } 112 | } 113 | 114 | 115 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 116 | # If there was no pattern in the pattern_list, then just use the colour 117 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 118 | if (is.null(style)) { 119 | style <- glue_two("fill: {hexcolour}") 120 | } 121 | 122 | 123 | if (rgba_to_alpha(gc$fill) != 1) { 124 | style <- c(style, glue_two("fill-opacity: {rgba_to_alpha(fill)}")) 125 | } 126 | 127 | style 128 | } 129 | 130 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 131 | #' Construct a vector of styles related to 'filter' 132 | #' 133 | #' @inheritParams stroke_style 134 | #' 135 | #' @return character "{attr_name}: {value}" strings for 'filter' or NULL 136 | #' if no filter available. 137 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 138 | filter_style <- function(state, geom) { 139 | 140 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 141 | # Setup 142 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 143 | gc <- state$gc 144 | fill <- gc$fill 145 | hexcolour <- rgba_to_hex(fill) 146 | 147 | style <- NULL 148 | 149 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 150 | # Check if: 151 | # (1) This element wanted to use the pattern list for 'fill' 152 | # (2) this hex colour is in the pattern list 153 | # (3) the pattern_list entry for this hexcolour includes a 'pattern' 154 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 155 | plist <- state$rdata$pattern_list 156 | pattern <- plist[[hexcolour]][['filter']] 157 | if (!is.null(pattern)) { 158 | if (inherits(pattern, 'SVGElement')) { 159 | state$rdata$msvg$defs(pattern) 160 | style <- glue("filter: url(#{pattern$attribs$id})") 161 | } else { 162 | message("devoutsvg: 'filter' pattern for ", hexcolour, ' in the `pattern_list` must be of class SVGElement, not ', 163 | deparse(class(pattern)), ".") 164 | } 165 | } 166 | 167 | style 168 | } 169 | 170 | 171 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 172 | #' Create stryle strings for the given attritute or set of attributes 173 | #' 174 | #' @param attr_name attribute name of name for a set of attributes 175 | #' @inheritParams stroke_style 176 | #' 177 | #' @return character vector of one or more "{attr_name}: {value}" strings 178 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 179 | create_style_string <- function(attr_name, state, geom) { 180 | switch( 181 | attr_name, 182 | "fill" = fill_style (state = state, geom = geom), 183 | "stroke" = stroke_style(state = state, geom = geom), 184 | "font" = font_style (state = state, geom = geom), 185 | "filter" = filter_style(state = state, geom = geom) 186 | ) 187 | } 188 | 189 | 190 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 191 | #' Create CSS styles for the given attributes 192 | #' 193 | #' @param attr_names character vector of e.g 'fill', 'stroke', 'font' 194 | #' @inheritParams stroke_style 195 | #' 196 | #' @return style string ready for inclusion in an SVG tag e.g. 197 | #' "stroke: #ffffff; fill: #000000;" 198 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 199 | style_string <- function(attr_names, state, geom) { 200 | if (length(attr_names) == 0) { return(NULL) } 201 | 202 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 203 | # Create the individual style strings for all the attributes 204 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 205 | styles <- lapply(attr_names, create_style_string, state = state, geom = geom) 206 | 207 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 208 | # Collapse them into a single string 209 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 210 | styles <- paste(unlist(styles), collapse = "; ") 211 | 212 | styles 213 | } 214 | 215 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | 2 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 3 | #' Transformer for \code{glue} to round numeric values to decimal places and convert NULL to text 4 | #' 5 | #' @param text,envir standard transformer arguments 6 | #' 7 | #' @return evaluated text value 8 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 9 | transformer_round <- function(text, envir) { 10 | if (is.null(text)) { 11 | return("NULL") 12 | } 13 | 14 | res <- eval(parse(text = text, keep.source = FALSE), envir) 15 | 16 | if (is.double(res)) { 17 | res <- round(res, 2) 18 | } 19 | 20 | res 21 | } 22 | 23 | 24 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 25 | #' Custom version of \code{glue} which rounds all numerics to 2 decimals 26 | #' 27 | #' @param ...,.envir standard glue args 28 | #' 29 | #' @return interpolated string 30 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 31 | glue_two <- function(..., .envir = parent.frame()) { 32 | glue(..., .envir = .envir, .transformer = transformer_round) 33 | } 34 | 35 | 36 | 37 | '%||%' <- function(x, y) { 38 | if (is.null(x)) { 39 | y 40 | } else { 41 | x 42 | } 43 | } -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-" 12 | ) 13 | 14 | 15 | set.seed(1) 16 | 17 | suppressPackageStartupMessages({ 18 | library(dplyr) 19 | library(devout) 20 | library(devoutsvg) 21 | library(ggplot2) 22 | library(sf) 23 | library(svgpatternusgs) 24 | }) 25 | ``` 26 | 27 | 28 | 29 | 30 | ```{r echo = FALSE, eval = FALSE} 31 | # pkgdown::build_site(override = list(destination = "../coolbutuseless.github.io/package/devoutsvg")) 32 | ``` 33 | 34 | 35 | 36 | # devoutsvg 37 | 38 | 39 | ![](https://img.shields.io/badge/cool-useless-green.svg) 40 | ![](http://img.shields.io/badge/dev-out-blue.svg) 41 | ![](http://img.shields.io/badge/lifecycle-very_experimental-blue.svg) 42 | 43 | 44 | `devoutsvg` provides a bespoke SVG graphics device written in plain R. 45 | 46 | 47 | Because github sanitises SVG to remove some elements of style, scripting and animation, 48 | please see the [devoutsvg pkgdown website](https://coolbutuseless.github.io/package/devoutsvg/index.html) 49 | to view the animations. 50 | 51 | #### Key Features 52 | 53 | * Behaves like a normal graphic output device 54 | * Written in plain R (making use of [devout](https://github.com/coolbutuseless/devout) for the interface to C) 55 | * Can use pattern fills for area - either using raw SVG, `minisvg` documents or 56 | packages such as: 57 | * [`svgpatternsimple`](https://github.com/coolbutuseless/svgpatternsimple) for simple repeating stripes and dots etc 58 | * [`svgpatternusgs`](https://github.com/coolbutuseless/svgpatternusgs) for geological patterns from the [USGS](//usgs.gov) 59 | * Can include Javascript to further customise the output. 60 | 61 | 62 | #### What's New 63 | 64 | * Complete refactor of how pattern fills are specified. This used to be via 65 | packages which provided patterns, but is now done directly in a `pattern_list` 66 | object supplied by the user when the `svgout` device is called. 67 | 68 | 69 | #### Future 70 | 71 | * Work out a convenient way to specify CSS, Javascript and SVG on individual elements 72 | within the plot. 73 | 74 | #### Warning 75 | 76 | This package is still **very** experimental. The means of specifying CSS, javascript, 77 | patterns and filters will evolve. 78 | 79 | ## Installation 80 | 81 | You can install from [GitHub](https://github.com/coolbutuseless/devoutsvg) with: 82 | 83 | ``` r 84 | # install.packages("devtools") 85 | devtools::install_github("coolbutuseless/minisvg") # SVG creation 86 | devtools::install_github("coolbutuseless/devout") # Device interface 87 | devtools::install_github("coolbutuseless/devoutsvg") # This package 88 | ``` 89 | ## Using the `svgout` device 90 | 91 | Use this device in the same way you would use `pdf()`, `png()` any of the other 92 | graphics output devices in R. 93 | 94 | 95 | ```{r svgout_example} 96 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 97 | # Create a very boring plot 98 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 99 | example_plot <- ggplot(mtcars) + 100 | geom_density(aes(mpg, fill = as.factor(cyl))) + 101 | labs(title = "Example `devoutsvg::svgout()` device output") + 102 | theme_bw() + 103 | scale_fill_manual(values = c('4' = '#df536b', '6' = '#61d04f', '8' = '#2297e6')) 104 | 105 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 106 | # Output the plot to the `svgout` device 107 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 108 | devoutsvg::svgout(filename = "man/figures/svgout-example.svg", width = 8, height = 4) 109 | example_plot 110 | invisible(dev.off()) 111 | ``` 112 | 113 | 114 | 115 | 116 | ## Filling with patterns 117 | 118 | In comparison to standard SVG output devices (such as 119 | `svg` and `svglite`) this device has options to modify and 120 | insert SVG into the output. 121 | 122 | The `svgout` device can be instructed to use patterns instead of the actual RGB 123 | colour - this is achieved by 124 | 125 | 1. Defining a pattern through either: 126 | * Providing SVG in a text string 127 | * A `minisvg` object 128 | 2. Creating a named list associating a hex colour with a pattern 129 | 3. Passing this named list to the `svgout` device. 130 | 131 | 132 | 133 | ```{r define_patterns} 134 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 135 | # 1. Define a pattern 136 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 137 | pattern_gear4 <- svgpatternsimple::create_pattern_stipple( 138 | id = 'stipple', 139 | colour = '#61d04f', 140 | spacing = 10 141 | ) 142 | 143 | pattern_gear6 <- svgpatternsimple::create_pattern_hex( 144 | id = 'hex', 145 | angle = 0, 146 | spacing = 20, 147 | fill_fraction = 0.1, 148 | colour = '#2297e6' 149 | ) 150 | ``` 151 | 152 | ```{r echo=FALSE} 153 | plist <- minisvg::SVGPatternList_to_svg(list(pattern_gear4, pattern_gear6), 154 | width = 400, height = 200) 155 | plist$save("man/figures/patterns.svg") 156 | ``` 157 | 158 | 159 | 160 | 161 | 162 | 163 | ```{r pattern_manual} 164 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 165 | # 2. Create a named list associating a hex colour with a pattern to fill with 166 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 167 | my_pattern_list <- list( 168 | '#61d04f' = list(fill = pattern_gear4), 169 | '#2297e6' = list(fill = pattern_gear6) 170 | ) 171 | 172 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 173 | # 3. Pass this named `pattern_list` to the `svgout` device 174 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 175 | svgout(filename = "man/figures/example-manual.svg", width = 8, height = 4, 176 | pattern_list = my_pattern_list) 177 | 178 | example_plot + 179 | labs(title = "Example - manual pattern specification") 180 | 181 | invisible(dev.off()) 182 | ``` 183 | 184 | 185 | 186 | 187 | ## Applying an SVG filter to a object 188 | 189 | The `svgout` device can be instructed to apply an SVG filter to a region. Filters can 190 | be applied in addition to patterns. 191 | 192 | 1. Defining a pattern/filter through either: 193 | * Providing SVG in a text string 194 | * A `minisvg` object 195 | 2. Creating a named list associating a hex colour with a pattern 196 | 3. Passing this named list to the `svgout` device. 197 | 198 | 199 | 200 | ```{r define_filter} 201 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 202 | # 1. Define a pattern 203 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 204 | pattern_gear4 <- svgpatternsimple::create_pattern_gradient( 205 | id = 'fire_gradient', 206 | colour1 = 'red', 207 | colour2 = 'gold', 208 | angle = 90 209 | ) 210 | 211 | pattern_gear6 <- svgpatternsimple::create_pattern_hex( 212 | id = 'hex', 213 | angle = 0, 214 | spacing = 20, 215 | fill_fraction = 0.1, 216 | colour = '#2297e6' 217 | ) 218 | 219 | fire_filter <- svgfilter::create_filter_turbulent_displacement( 220 | id = "fire1" 221 | ) 222 | ``` 223 | 224 | 225 | 226 | 227 | ```{r filter_example} 228 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 229 | # 2. Create a named list associating a hex colour with a pattern to fill with 230 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 231 | my_pattern_list <- list( 232 | '#61d04f' = list(fill = pattern_gear4, filter = fire_filter), 233 | '#2297e6' = list(fill = pattern_gear6) 234 | ) 235 | 236 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 237 | # 3. Pass this named `pattern_list` to the `svgout` device 238 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 239 | svgout(filename = "man/figures/example-filter.svg", width = 8, height = 4, 240 | pattern_list = my_pattern_list) 241 | 242 | example_plot + 243 | labs(title = "Example - patterns + filters") 244 | 245 | invisible(dev.off()) 246 | ``` 247 | 248 | 249 | 250 | 251 | ## Including javascript to customise a plot 252 | 253 | The following example includes the [D3](https://d3js.org/) javascript library and includes javascript 254 | code to manipulate the plot. You don't have to include any javascript libraries 255 | if you don't want - and you can just write raw javascript to manipulate the DOM. 256 | 257 | Note: because github removes js/css from SVG objects a screenshot of the resulting 258 | SVG is included. 259 | 260 | ```{r} 261 | my_js_code <- " 262 | d3.select('#polygon-0001').style('fill', null); 263 | d3.select('#polygon-0003').style('stroke-width', 10); 264 | " 265 | 266 | svgout(filename = "man/figures/example-javascript.svg", width = 8, height = 4, 267 | js_url = "https://d3js.org/d3.v5.min.js", js_code = my_js_code) 268 | 269 | example_plot + 270 | labs(title = "Example - javascript (D3)") 271 | 272 | invisible(dev.off()) 273 | ``` 274 | 275 | 276 | 277 | 278 | 279 | ## Including CSS to customise a plot 280 | 281 | The following example includes the [animate.css](https://daneden.github.io/animate.css/) 282 | CSS library and includes CSS declarations to apply these styles to some objects. 283 | 284 | 285 | You don't have to include any CSS libraries 286 | if you don't want - and you can just write raw CSS to style the DOM. 287 | 288 | Note: because github removes js/css from SVG objects a screenshot of the resulting 289 | SVG is included. 290 | 291 | ```{r} 292 | my_css_decl <- " 293 | @keyframes pulse { 294 | from {transform: scale3d(1, 1, 1);} 295 | 50% {transform: scale3d(1.15, 1.15, 1.15);} 296 | to {transform: scale3d(1, 1, 1);} 297 | } 298 | 299 | #polygon-0003 { 300 | animation-name: pulse; 301 | animation-duration: 4s; 302 | animation-fill-mode: both; 303 | animation-iteration-count: infinite; 304 | } 305 | 306 | rect:hover { 307 | fill: green !important; 308 | } 309 | " 310 | 311 | svgout(filename = "man/figures/example-css.svg", width = 8, height = 4, 312 | css_decl = my_css_decl) 313 | 314 | example_plot + 315 | labs(title = "Example - CSS") 316 | 317 | invisible(dev.off()) 318 | ``` 319 | 320 | 321 | 322 | 323 | 324 | 325 | ## More examples of patterns and filters 326 | 327 | ### Patterns in base plotting 328 | 329 | ```{r base_plots} 330 | my_pattern_list <- list( 331 | `#000001` = list( 332 | fill = svgpatternsimple::create_pattern_stipple( 333 | id = 'stipple', 334 | colour = '#ff4455', 335 | spacing = 10 336 | )), 337 | 338 | `#000002` = list( 339 | fill = svgpatternsimple::create_pattern_hex( 340 | id = 'hex', 341 | colour = '#ddff55', 342 | spacing = 8 343 | )), 344 | 345 | `#000003` = list( 346 | fill = svgpatternsimple::create_pattern_check( 347 | id = 'check', 348 | colour = '#ee55ff', 349 | spacing = 10 350 | ) 351 | ) 352 | ) 353 | 354 | colours <- c('tomato', '#000001', '#000002', '#000003') 355 | 356 | devoutsvg::svgout(filename = "man/figures/example-pie.svg", width = 4, height = 4, 357 | pattern_list = my_pattern_list) 358 | pie(c(cool = 4, but = 2, use = 1, less = 8), col = colours) 359 | invisible(dev.off()) 360 | ``` 361 | 362 | 363 | 364 | ### Geological patterns 365 | 366 | ```{r warning=FALSE} 367 | library(sf) 368 | library(svgpatternusgs) 369 | 370 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 371 | # Select some data 372 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 373 | nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE) 374 | nc$mid <- sf::st_centroid(nc$geometry) 375 | nc <- nc[nc$NAME %in% c('Surry', 'Stokes', 'Rockingham', 'Yadkin', 'Forsyth', 'Guilford'), ] 376 | 377 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 378 | # Encode specific USGS pattern numbers into colours 379 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 380 | my_pattern_list <- list( 381 | `#000001` = list(fill = svgpatternusgs::create_usgs_pattern(usgs_code = 601, spacing = 100, fill='#77ff99')), 382 | `#000002` = list(fill = svgpatternusgs::create_usgs_pattern(usgs_code = 606, spacing = 100)), 383 | `#000003` = list(fill = svgpatternusgs::create_usgs_pattern(usgs_code = 629, spacing = 100)), 384 | `#000004` = list(fill = svgpatternusgs::create_usgs_pattern(usgs_code = 632, spacing = 100)), 385 | `#000005` = list(fill = svgpatternusgs::create_usgs_pattern(usgs_code = 706, spacing = 100)), 386 | `#000006` = list(fill = svgpatternusgs::create_usgs_pattern(usgs_code = 717, spacing = 100)) 387 | ) 388 | 389 | devoutsvg::svgout(filename = "man/figures/example-usgs.svg", width = 6, height = 4, 390 | pattern_list = my_pattern_list) 391 | ggplot(nc) + 392 | geom_sf(aes(fill = NAME)) + 393 | scale_fill_manual(values = names(my_pattern_list)) + 394 | theme(legend.key.size = unit(0.6, "cm")) + 395 | labs(title = "U.S. Geological Survey Patterns with `geom_sf()`") + 396 | theme_bw() 397 | invisible(dev.off()) 398 | ``` 399 | 400 | 401 | 402 | 403 | ### Retro B&W plotting 404 | 405 | ```{r} 406 | my_pattern_list <- list( 407 | `#000001` = list(fill = svgpatternsimple::create_pattern_stripe(id = 'pattern1', spacing = 5, fill_fraction = 0.7, angle = 0)), 408 | `#000002` = list(fill = svgpatternsimple::create_pattern_stripe(id = 'pattern2', spacing = 5, fill_fraction = 0.7, angle = 45)), 409 | `#000003` = list(fill = svgpatternsimple::create_pattern_stripe(id = 'pattern3', spacing = 5, fill_fraction = 0.7, angle = 135)), 410 | `#000004` = list(fill = svgpatternsimple::create_pattern_hatch (id = 'pattern4', spacing = 7, fill_fraction = 0.2, angle = 0)), 411 | `#000005` = list(fill = svgpatternsimple::create_pattern_hatch (id = 'pattern5', spacing = 7, fill_fraction = 0.2, angle = 45)), 412 | `#000006` = list(fill = svgpatternsimple::create_pattern_dot (id = 'pattern6', spacing = 4, fill_fraction = 0.8, angle = 0)), 413 | `#000007` = list(fill = svgpatternsimple::create_pattern_dot (id = 'pattern7', spacing = 8, fill_fraction = 0.7)) 414 | ) 415 | 416 | 417 | devoutsvg::svgout(filename = "man/figures/example-retro.svg", width = 6, height = 4, 418 | pattern_list = my_pattern_list) 419 | ggplot(mpg) + 420 | geom_bar(aes(class, fill=class), colour='black') + 421 | theme_bw() + 422 | theme( 423 | panel.grid = element_blank(), 424 | text = element_text(size=12, family="Courier New", face = 'bold'), 425 | legend.position = 'none' 426 | ) + 427 | scale_fill_manual(values = names(my_pattern_list)) 428 | invisible(dev.off()) 429 | ``` 430 | 431 | 432 | 433 | 434 | 435 |
436 | 437 | 438 | 439 | 440 | 441 | ## Real-world examples 442 | 443 | #### Left - Death trends 444 | 445 | The following was created by [VictimOfMaths](https://twitter.com/VictimOfmaths) 446 | to compare deaths over time based upon [UK ONS data](https://www.ons.gov.uk/peoplepopulationandcommunity/healthandsocialcare/healthandwellbeing/articles/middleagedgenerationmostlikelytodiebysuicideanddrugpoisoning/2019-08-13). 447 | 448 | The original code is on [VictimOfMaths github](), and a modified version is 449 | included as a vignette (`vignette('svg-with-gradient-fill', package = 'devoutsvg')`) - see 450 | also the [online devoutsvg documentation](https://coolbutuseless.github.io/package/devoutsvg/articles/svg-with-gradient-fill.html) 451 | 452 | 453 | 454 | #### Right - Fire Season Workloads 455 | 456 | A similar approach was used by [MilesMcbain](https://twitter.com/MilesMcBain) to 457 | create this plot of fire season workloads: 458 | 459 | 460 | 461 | 462 |
463 | 464 | 465 | 466 | ## Convert SVG to PDF 467 | 468 | If you need a PDF version of an SVG file, there are a number of options. 469 | 470 | 1. [Inkscape](https://inkscape.org/) 471 | 2. `rsvg` on the command line 472 | * `rsvg-convert -f pdf -o t.pdf t.svg` 473 | 3. `CairoSVG` on the command line (python based) 474 | * `cairosvg in.svg -o out.pdf` 475 | 4. `Imagemagick` (not 100% sure) 476 | * `convert file.svg file.pdf ` 477 | 5. `Chrome` headless (maybe?) 478 | * `chrome --headless --disable-gpu --print-to-pdf="output.pdf" "input.svg"` 479 | 6. Web-based. There are lots of these e.g. 480 | * [https://cloudconvert.com/svg-to-pdf](https://cloudconvert.com/svg-to-pdf) 481 | 482 | 483 | 484 | ## Creating the logo for this package 485 | 486 | Note: Because github sanitizes SVG files it makes the SVG produced in this section 487 | unviewable. Instead, the SVG was first saved, and then rendered to PNG 488 | 489 | 490 | ```{r} 491 | library(minisvg) 492 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 493 | # Building an SVG logo with an animated stripe 494 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 495 | logo <- svg_doc(width = 200, height = 200)$ 496 | update(width=NULL, height=NULL) 497 | 498 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 499 | # Background White Rect 500 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 501 | logo$rect(x=0, y=0, width="100%", height="100%", fill='white') 502 | 503 | 504 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 505 | # Create a hexagon filled, and add it to the document 506 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 507 | len <- 95 508 | angles <- (seq(0, 360, 60) + 90) * pi/180 509 | xs <- round(len * cos(angles) + 100, 2) 510 | ys <- round(len * sin(angles) + 100, 2) 511 | hex <- stag$polygon(id = 'hex', xs = xs, ys = ys) 512 | hex$update(stroke = '#223344', fill_opacity=0, stroke_width = 3) 513 | logo$append(hex) 514 | 515 | 516 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 517 | # Text label 518 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 519 | text1 <- stag$text( 520 | "/dev/out/", 521 | class = "mainfont", 522 | x = 22, y = 90 523 | ) 524 | 525 | text2 <- stag$text( 526 | "svg", 527 | class = "mainfont", 528 | x = 72, y = 135 529 | ) 530 | 531 | logo$append(text1) 532 | logo$append(text2) 533 | 534 | 535 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 536 | # Load CSS for google font and specify styling for 'mainfont' 537 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 538 | logo$add_css_url("https://fonts.googleapis.com/css?family=Abril%20Fatface") 539 | logo$add_css(" 540 | .mainfont { 541 | font-size: 38px; 542 | font-family: 'Abril Fatface', sans-serif; 543 | fill: #223344; 544 | } 545 | ") 546 | 547 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 548 | # output 549 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 550 | # logo$show() 551 | logo$save("man/figures/logo.svg") 552 | ``` 553 | 554 | 555 | ```{r echo=FALSE, results='asis'} 556 | cat( 557 | "
",
558 |   "
 Show/hide SVG text ",
559 |   htmltools::htmlEscape(as.character(logo)),
560 |   "
",
561 |   "
", sep='') 562 | ``` 563 | 564 | 565 | 566 | 567 | 568 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # devoutsvg 5 | 6 | 7 | 8 | ![](https://img.shields.io/badge/cool-useless-green.svg) 9 | ![](http://img.shields.io/badge/dev-out-blue.svg) 10 | ![](http://img.shields.io/badge/lifecycle-very_experimental-blue.svg) 11 | 12 | 13 | `devoutsvg` provides a bespoke SVG graphics device written in plain R. 14 | 15 | Because github sanitises SVG to remove some elements of style, scripting 16 | and animation, please see the [devoutsvg pkgdown 17 | website](https://coolbutuseless.github.io/package/devoutsvg/index.html) 18 | to view the animations. 19 | 20 | #### Key Features 21 | 22 | - Behaves like a normal graphic output device 23 | - Written in plain R (making use of 24 | [devout](https://github.com/coolbutuseless/devout) for the interface 25 | to C) 26 | - Can use pattern fills for area - either using raw SVG, `minisvg` 27 | documents or packages such as: 28 | - [`svgpatternsimple`](https://github.com/coolbutuseless/svgpatternsimple) 29 | for simple repeating stripes and dots etc 30 | - [`svgpatternusgs`](https://github.com/coolbutuseless/svgpatternusgs) 31 | for geological patterns from the [USGS](//usgs.gov) 32 | - Can include Javascript to further customise the output. 33 | 34 | #### What’s New 35 | 36 | - Complete refactor of how pattern fills are specified. This used to 37 | be via packages which provided patterns, but is now done directly in 38 | a `pattern_list` object supplied by the user when the `svgout` 39 | device is called. 40 | 41 | #### Future 42 | 43 | - Work out a convenient way to specify CSS, Javascript and SVG on 44 | individual elements within the plot. 45 | 46 | #### Warning 47 | 48 | This package is still **very** experimental. The means of specifying 49 | CSS, javascript, patterns and filters will evolve. 50 | 51 | ## Installation 52 | 53 | You can install from 54 | [GitHub](https://github.com/coolbutuseless/devoutsvg) with: 55 | 56 | ``` r 57 | # install.packages("devtools") 58 | devtools::install_github("coolbutuseless/minisvg") # SVG creation 59 | devtools::install_github("coolbutuseless/devout") # Device interface 60 | devtools::install_github("coolbutuseless/devoutsvg") # This package 61 | ``` 62 | 63 | ## Using the `svgout` device 64 | 65 | Use this device in the same way you would use `pdf()`, `png()` any of 66 | the other graphics output devices in R. 67 | 68 | ``` r 69 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 70 | # Create a very boring plot 71 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 72 | example_plot <- ggplot(mtcars) + 73 | geom_density(aes(mpg, fill = as.factor(cyl))) + 74 | labs(title = "Example `devoutsvg::svgout()` device output") + 75 | theme_bw() + 76 | scale_fill_manual(values = c('4' = '#df536b', '6' = '#61d04f', '8' = '#2297e6')) 77 | 78 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 79 | # Output the plot to the `svgout` device 80 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 81 | devoutsvg::svgout(filename = "man/figures/svgout-example.svg", width = 8, height = 4) 82 | example_plot 83 | invisible(dev.off()) 84 | ``` 85 | 86 | 87 | 88 | ## Filling with patterns 89 | 90 | In comparison to standard SVG output devices (such as `svg` and 91 | `svglite`) this device has options to modify and insert SVG into the 92 | output. 93 | 94 | The `svgout` device can be instructed to use patterns instead of the 95 | actual RGB colour - this is achieved by 96 | 97 | 1. Defining a pattern through either: 98 | - Providing SVG in a text string 99 | - A `minisvg` object 100 | 2. Creating a named list associating a hex colour with a pattern 101 | 3. Passing this named list to the `svgout` device. 102 | 103 | 104 | 105 | ``` r 106 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 107 | # 1. Define a pattern 108 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 109 | pattern_gear4 <- svgpatternsimple::create_pattern_stipple( 110 | id = 'stipple', 111 | colour = '#61d04f', 112 | spacing = 10 113 | ) 114 | 115 | pattern_gear6 <- svgpatternsimple::create_pattern_hex( 116 | id = 'hex', 117 | angle = 0, 118 | spacing = 20, 119 | fill_fraction = 0.1, 120 | colour = '#2297e6' 121 | ) 122 | ``` 123 | 124 | 125 | 126 | ``` r 127 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 128 | # 2. Create a named list associating a hex colour with a pattern to fill with 129 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 130 | my_pattern_list <- list( 131 | '#61d04f' = list(fill = pattern_gear4), 132 | '#2297e6' = list(fill = pattern_gear6) 133 | ) 134 | 135 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 136 | # 3. Pass this named `pattern_list` to the `svgout` device 137 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 138 | svgout(filename = "man/figures/example-manual.svg", width = 8, height = 4, 139 | pattern_list = my_pattern_list) 140 | 141 | example_plot + 142 | labs(title = "Example - manual pattern specification") 143 | 144 | invisible(dev.off()) 145 | ``` 146 | 147 | 148 | 149 | ## Applying an SVG filter to a object 150 | 151 | The `svgout` device can be instructed to apply an SVG filter to a 152 | region. Filters can be applied in addition to patterns. 153 | 154 | 1. Defining a pattern/filter through either: 155 | - Providing SVG in a text string 156 | - A `minisvg` object 157 | 2. Creating a named list associating a hex colour with a pattern 158 | 3. Passing this named list to the `svgout` device. 159 | 160 | 161 | 162 | ``` r 163 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 164 | # 1. Define a pattern 165 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 166 | pattern_gear4 <- svgpatternsimple::create_pattern_gradient( 167 | id = 'fire_gradient', 168 | colour1 = 'red', 169 | colour2 = 'gold', 170 | angle = 90 171 | ) 172 | 173 | pattern_gear6 <- svgpatternsimple::create_pattern_hex( 174 | id = 'hex', 175 | angle = 0, 176 | spacing = 20, 177 | fill_fraction = 0.1, 178 | colour = '#2297e6' 179 | ) 180 | 181 | fire_filter <- svgfilter::create_filter_turbulent_displacement( 182 | id = "fire1" 183 | ) 184 | ``` 185 | 186 | ``` r 187 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 188 | # 2. Create a named list associating a hex colour with a pattern to fill with 189 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 190 | my_pattern_list <- list( 191 | '#61d04f' = list(fill = pattern_gear4, filter = fire_filter), 192 | '#2297e6' = list(fill = pattern_gear6) 193 | ) 194 | 195 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 196 | # 3. Pass this named `pattern_list` to the `svgout` device 197 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 198 | svgout(filename = "man/figures/example-filter.svg", width = 8, height = 4, 199 | pattern_list = my_pattern_list) 200 | 201 | example_plot + 202 | labs(title = "Example - patterns + filters") 203 | 204 | invisible(dev.off()) 205 | ``` 206 | 207 | 208 | 209 | ## Including javascript to customise a plot 210 | 211 | The following example includes the [D3](https://d3js.org/) javascript 212 | library and includes javascript code to manipulate the plot. You don’t 213 | have to include any javascript libraries if you don’t want - and you can 214 | just write raw javascript to manipulate the DOM. 215 | 216 | Note: because github removes js/css from SVG objects a screenshot of the 217 | resulting SVG is included. 218 | 219 | ``` r 220 | my_js_code <- " 221 | d3.select('#polygon-0001').style('fill', null); 222 | d3.select('#polygon-0003').style('stroke-width', 10); 223 | " 224 | 225 | svgout(filename = "man/figures/example-javascript.svg", width = 8, height = 4, 226 | js_url = "https://d3js.org/d3.v5.min.js", js_code = my_js_code) 227 | 228 | example_plot + 229 | labs(title = "Example - javascript (D3)") 230 | 231 | invisible(dev.off()) 232 | ``` 233 | 234 | 235 | 236 | ## Including CSS to customise a plot 237 | 238 | The following example includes the 239 | [animate.css](https://daneden.github.io/animate.css/) CSS library and 240 | includes CSS declarations to apply these styles to some objects. 241 | 242 | You don’t have to include any CSS libraries if you don’t want - and you 243 | can just write raw CSS to style the DOM. 244 | 245 | Note: because github removes js/css from SVG objects a screenshot of the 246 | resulting SVG is included. 247 | 248 | ``` r 249 | my_css_decl <- " 250 | @keyframes pulse { 251 | from {transform: scale3d(1, 1, 1);} 252 | 50% {transform: scale3d(1.15, 1.15, 1.15);} 253 | to {transform: scale3d(1, 1, 1);} 254 | } 255 | 256 | #polygon-0003 { 257 | animation-name: pulse; 258 | animation-duration: 4s; 259 | animation-fill-mode: both; 260 | animation-iteration-count: infinite; 261 | } 262 | 263 | rect:hover { 264 | fill: green !important; 265 | } 266 | " 267 | 268 | svgout(filename = "man/figures/example-css.svg", width = 8, height = 4, 269 | css_decl = my_css_decl) 270 | 271 | example_plot + 272 | labs(title = "Example - CSS") 273 | 274 | invisible(dev.off()) 275 | ``` 276 | 277 | 278 | 279 | ## More examples of patterns and filters 280 | 281 | ### Patterns in base plotting 282 | 283 | ``` r 284 | my_pattern_list <- list( 285 | `#000001` = list( 286 | fill = svgpatternsimple::create_pattern_stipple( 287 | id = 'stipple', 288 | colour = '#ff4455', 289 | spacing = 10 290 | )), 291 | 292 | `#000002` = list( 293 | fill = svgpatternsimple::create_pattern_hex( 294 | id = 'hex', 295 | colour = '#ddff55', 296 | spacing = 8 297 | )), 298 | 299 | `#000003` = list( 300 | fill = svgpatternsimple::create_pattern_check( 301 | id = 'check', 302 | colour = '#ee55ff', 303 | spacing = 10 304 | ) 305 | ) 306 | ) 307 | 308 | colours <- c('tomato', '#000001', '#000002', '#000003') 309 | 310 | devoutsvg::svgout(filename = "man/figures/example-pie.svg", width = 4, height = 4, 311 | pattern_list = my_pattern_list) 312 | pie(c(cool = 4, but = 2, use = 1, less = 8), col = colours) 313 | invisible(dev.off()) 314 | ``` 315 | 316 | 317 | 318 | ### Geological patterns 319 | 320 | ``` r 321 | library(sf) 322 | library(svgpatternusgs) 323 | 324 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 325 | # Select some data 326 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 327 | nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE) 328 | nc$mid <- sf::st_centroid(nc$geometry) 329 | nc <- nc[nc$NAME %in% c('Surry', 'Stokes', 'Rockingham', 'Yadkin', 'Forsyth', 'Guilford'), ] 330 | 331 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 332 | # Encode specific USGS pattern numbers into colours 333 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 334 | my_pattern_list <- list( 335 | `#000001` = list(fill = svgpatternusgs::create_usgs_pattern(usgs_code = 601, spacing = 100, fill='#77ff99')), 336 | `#000002` = list(fill = svgpatternusgs::create_usgs_pattern(usgs_code = 606, spacing = 100)), 337 | `#000003` = list(fill = svgpatternusgs::create_usgs_pattern(usgs_code = 629, spacing = 100)), 338 | `#000004` = list(fill = svgpatternusgs::create_usgs_pattern(usgs_code = 632, spacing = 100)), 339 | `#000005` = list(fill = svgpatternusgs::create_usgs_pattern(usgs_code = 706, spacing = 100)), 340 | `#000006` = list(fill = svgpatternusgs::create_usgs_pattern(usgs_code = 717, spacing = 100)) 341 | ) 342 | 343 | devoutsvg::svgout(filename = "man/figures/example-usgs.svg", width = 6, height = 4, 344 | pattern_list = my_pattern_list) 345 | ggplot(nc) + 346 | geom_sf(aes(fill = NAME)) + 347 | scale_fill_manual(values = names(my_pattern_list)) + 348 | theme(legend.key.size = unit(0.6, "cm")) + 349 | labs(title = "U.S. Geological Survey Patterns with `geom_sf()`") + 350 | theme_bw() 351 | invisible(dev.off()) 352 | ``` 353 | 354 | 355 | 356 | ### Retro B\&W plotting 357 | 358 | ``` r 359 | my_pattern_list <- list( 360 | `#000001` = list(fill = svgpatternsimple::create_pattern_stripe(id = 'pattern1', spacing = 5, fill_fraction = 0.7, angle = 0)), 361 | `#000002` = list(fill = svgpatternsimple::create_pattern_stripe(id = 'pattern2', spacing = 5, fill_fraction = 0.7, angle = 45)), 362 | `#000003` = list(fill = svgpatternsimple::create_pattern_stripe(id = 'pattern3', spacing = 5, fill_fraction = 0.7, angle = 135)), 363 | `#000004` = list(fill = svgpatternsimple::create_pattern_hatch (id = 'pattern4', spacing = 7, fill_fraction = 0.2, angle = 0)), 364 | `#000005` = list(fill = svgpatternsimple::create_pattern_hatch (id = 'pattern5', spacing = 7, fill_fraction = 0.2, angle = 45)), 365 | `#000006` = list(fill = svgpatternsimple::create_pattern_dot (id = 'pattern6', spacing = 4, fill_fraction = 0.8, angle = 0)), 366 | `#000007` = list(fill = svgpatternsimple::create_pattern_dot (id = 'pattern7', spacing = 8, fill_fraction = 0.7)) 367 | ) 368 | 369 | 370 | devoutsvg::svgout(filename = "man/figures/example-retro.svg", width = 6, height = 4, 371 | pattern_list = my_pattern_list) 372 | ggplot(mpg) + 373 | geom_bar(aes(class, fill=class), colour='black') + 374 | theme_bw() + 375 | theme( 376 | panel.grid = element_blank(), 377 | text = element_text(size=12, family="Courier New", face = 'bold'), 378 | legend.position = 'none' 379 | ) + 380 | scale_fill_manual(values = names(my_pattern_list)) 381 | invisible(dev.off()) 382 | ``` 383 | 384 | 385 | 386 |
387 | 388 | 389 | 390 | 391 | ## Real-world examples 392 | 393 | #### Left - Death trends 394 | 395 | The following was created by 396 | [VictimOfMaths](https://twitter.com/VictimOfmaths) to compare deaths 397 | over time based upon [UK ONS 398 | data](https://www.ons.gov.uk/peoplepopulationandcommunity/healthandsocialcare/healthandwellbeing/articles/middleagedgenerationmostlikelytodiebysuicideanddrugpoisoning/2019-08-13). 399 | 400 | The original code is on [VictimOfMaths github](), and a modified version 401 | is included as a vignette (`vignette('svg-with-gradient-fill', package = 402 | 'devoutsvg')`) - see also the [online devoutsvg 403 | documentation](https://coolbutuseless.github.io/package/devoutsvg/articles/svg-with-gradient-fill.html) 404 | 405 | #### Right - Fire Season Workloads 406 | 407 | A similar approach was used by 408 | [MilesMcbain](https://twitter.com/MilesMcBain) to create this plot of 409 | fire season workloads: 410 | 411 | 412 | 413 | 414 |
415 | 416 | 417 | ## Convert SVG to PDF 418 | 419 | If you need a PDF version of an SVG file, there are a number of options. 420 | 421 | 1. [Inkscape](https://inkscape.org/) 422 | 2. `rsvg` on the command line 423 | - `rsvg-convert -f pdf -o t.pdf t.svg` 424 | 3. `CairoSVG` on the command line (python based) 425 | - `cairosvg in.svg -o out.pdf` 426 | 4. `Imagemagick` (not 100% sure) 427 | - `convert file.svg file.pdf` 428 | 5. `Chrome` headless (maybe?) 429 | - `chrome --headless --disable-gpu --print-to-pdf="output.pdf" 430 | "input.svg"` 431 | 6. Web-based. There are lots of these e.g. 432 | - 433 | 434 | ## Creating the logo for this package 435 | 436 | Note: Because github sanitizes SVG files it makes the SVG produced in 437 | this section unviewable. Instead, the SVG was first saved, and then 438 | rendered to PNG 439 | 440 | ``` r 441 | library(minisvg) 442 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 443 | # Building an SVG logo with an animated stripe 444 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 445 | logo <- svg_doc(width = 200, height = 200)$ 446 | update(width=NULL, height=NULL) 447 | 448 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 449 | # Background White Rect 450 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 451 | logo$rect(x=0, y=0, width="100%", height="100%", fill='white') 452 | 453 | 454 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 455 | # Create a hexagon filled, and add it to the document 456 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 457 | len <- 95 458 | angles <- (seq(0, 360, 60) + 90) * pi/180 459 | xs <- round(len * cos(angles) + 100, 2) 460 | ys <- round(len * sin(angles) + 100, 2) 461 | hex <- stag$polygon(id = 'hex', xs = xs, ys = ys) 462 | hex$update(stroke = '#223344', fill_opacity=0, stroke_width = 3) 463 | logo$append(hex) 464 | 465 | 466 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 467 | # Text label 468 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 469 | text1 <- stag$text( 470 | "/dev/out/", 471 | class = "mainfont", 472 | x = 22, y = 90 473 | ) 474 | 475 | text2 <- stag$text( 476 | "svg", 477 | class = "mainfont", 478 | x = 72, y = 135 479 | ) 480 | 481 | logo$append(text1) 482 | logo$append(text2) 483 | 484 | 485 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 486 | # Load CSS for google font and specify styling for 'mainfont' 487 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 488 | logo$add_css_url("https://fonts.googleapis.com/css?family=Abril%20Fatface") 489 | logo$add_css(" 490 | .mainfont { 491 | font-size: 38px; 492 | font-family: 'Abril Fatface', sans-serif; 493 | fill: #223344; 494 | } 495 | ") 496 | 497 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 498 | # output 499 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 500 | # logo$show() 501 | logo$save("man/figures/logo.svg") 502 | ``` 503 | 504 | 
 Show/hide SVG text <?xml version="1.0" encoding="UTF-8"?>
505 | <svg viewBox="0 0 200 200" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
506 | <style type='text/css'>
507 | <![CDATA[
508 | @import url(https://fonts.googleapis.com/css?family=Abril%20Fatface);
509 | 
510 | .mainfont {
511 |   font-size: 38px;
512 |   font-family: 'Abril Fatface', sans-serif;
513 |   fill: #223344;
514 | }
515 | 
516 | ]]>
517 | </style>
518 |   <rect fill="white" x="0" y="0" width="100%" height="100%" />
519 |   <polygon points="100,195 17.73,147.5 17.73,52.5 100,5 182.27,52.5 182.27,147.5 100,195" id="hex" stroke="#223344" fill-opacity="0" stroke-width="3" />
520 |   <text x="22" y="90" class="mainfont">
521 |     /dev/out/
522 |   </text>
523 |   <text x="72" y="135" class="mainfont">
524 |     svg
525 |   </text>
526 | </svg>
527 | 528 | 529 | -------------------------------------------------------------------------------- /man/create_style_string.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-style.R 3 | \name{create_style_string} 4 | \alias{create_style_string} 5 | \title{Create stryle strings for the given attritute or set of attributes} 6 | \usage{ 7 | create_style_string(attr_name, state, geom) 8 | } 9 | \arguments{ 10 | \item{attr_name}{attribute name of name for a set of attributes} 11 | 12 | \item{state}{list including 'gc' (graphics context)} 13 | 14 | \item{geom}{which geometry has asked for a style} 15 | } 16 | \value{ 17 | character vector of one or more "{attr_name}: {value}" strings 18 | } 19 | \description{ 20 | Create stryle strings for the given attritute or set of attributes 21 | } 22 | -------------------------------------------------------------------------------- /man/figures/example-basic-3.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 2 86 | 87 | 88 | 89 | 90 | 3 91 | 92 | 93 | 94 | 95 | 4 96 | 97 | 98 | 99 | 100 | 5 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 10 116 | 117 | 118 | 119 | 120 | 15 121 | 122 | 123 | 124 | 125 | 20 126 | 127 | 128 | 129 | 130 | 25 131 | 132 | 133 | 134 | 135 | 30 136 | 137 | 138 | 139 | 140 | 35 141 | 142 | 143 | 144 | 145 | mpg 146 | 147 | 148 | 149 | 150 | wt 151 | 152 | 153 | 154 | 155 | {devoutsvg} - CSS Animation of elements 156 | 157 | 158 | 159 | -------------------------------------------------------------------------------- /man/figures/example-basic.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 2 83 | 84 | 85 | 86 | 87 | 3 88 | 89 | 90 | 91 | 92 | 4 93 | 94 | 95 | 96 | 97 | 5 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 10 113 | 114 | 115 | 116 | 117 | 15 118 | 119 | 120 | 121 | 122 | 20 123 | 124 | 125 | 126 | 127 | 25 128 | 129 | 130 | 131 | 132 | 30 133 | 134 | 135 | 136 | 137 | 35 138 | 139 | 140 | 141 | 142 | mpg 143 | 144 | 145 | 146 | 147 | wt 148 | 149 | 150 | 151 | 152 | 153 | as.factor(cyl) 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 4 165 | 166 | 167 | 168 | 169 | 6 170 | 171 | 172 | 173 | 174 | 8 175 | 176 | 177 | 178 | 179 | Example - Basic 180 | 181 | 182 | 183 | -------------------------------------------------------------------------------- /man/figures/example-css.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/devoutsvg/9151bd07a58a506ffa3d39f46d0982fd1e1693e1/man/figures/example-css.gif -------------------------------------------------------------------------------- /man/figures/example-javascript.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/devoutsvg/9151bd07a58a506ffa3d39f46d0982fd1e1693e1/man/figures/example-javascript.png -------------------------------------------------------------------------------- /man/figures/example-pie.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | cool 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | 188 | 189 | 190 | 191 | 192 | 193 | 194 | 195 | 196 | 197 | 198 | 199 | 200 | 201 | 202 | but 203 | 204 | 205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | 213 | 214 | 215 | 216 | 217 | 218 | 219 | 220 | 221 | 222 | 223 | 224 | use 225 | 226 | 227 | 228 | 229 | 230 | 231 | 232 | 233 | 234 | 235 | 236 | 237 | 238 | 239 | 240 | less 241 | 242 | 243 | 244 | -------------------------------------------------------------------------------- /man/figures/example-retro.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 0 87 | 88 | 89 | 90 | 91 | 20 92 | 93 | 94 | 95 | 96 | 40 97 | 98 | 99 | 100 | 101 | 60 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 2seater 118 | 119 | 120 | 121 | 122 | compact 123 | 124 | 125 | 126 | 127 | midsize 128 | 129 | 130 | 131 | 132 | minivan 133 | 134 | 135 | 136 | 137 | pickup 138 | 139 | 140 | 141 | 142 | subcompact 143 | 144 | 145 | 146 | 147 | suv 148 | 149 | 150 | 151 | 152 | class 153 | 154 | 155 | 156 | 157 | count 158 | 159 | 160 | 161 | -------------------------------------------------------------------------------- /man/figures/gradient-examples/MilesMcbain.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/devoutsvg/9151bd07a58a506ffa3d39f46d0982fd1e1693e1/man/figures/gradient-examples/MilesMcbain.jpg -------------------------------------------------------------------------------- /man/figures/gradient-examples/VictimOfMaths.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/devoutsvg/9151bd07a58a506ffa3d39f46d0982fd1e1693e1/man/figures/gradient-examples/VictimOfMaths.png -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/devoutsvg/9151bd07a58a506ffa3d39f46d0982fd1e1693e1/man/figures/logo.png -------------------------------------------------------------------------------- /man/figures/logo.svg: -------------------------------------------------------------------------------- 1 | 2 | 14 | 15 | 16 | 17 | /dev/out/ 18 | 19 | 20 | svg 21 | 22 | 23 | -------------------------------------------------------------------------------- /man/figures/patterns.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | -------------------------------------------------------------------------------- /man/fill_style.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-style.R 3 | \name{fill_style} 4 | \alias{fill_style} 5 | \title{Construct a vector of styles related to 'fill'} 6 | \usage{ 7 | fill_style(state, geom) 8 | } 9 | \arguments{ 10 | \item{state}{list including 'gc' (graphics context)} 11 | 12 | \item{geom}{which geometry has asked for a style} 13 | } 14 | \value{ 15 | character vector of multiple "{attr_name}: {value}" strings for 'fill', 16 | 'fill-opacity' 17 | } 18 | \description{ 19 | Construct a vector of styles related to 'fill' 20 | } 21 | -------------------------------------------------------------------------------- /man/filter_style.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-style.R 3 | \name{filter_style} 4 | \alias{filter_style} 5 | \title{Construct a vector of styles related to 'filter'} 6 | \usage{ 7 | filter_style(state, geom) 8 | } 9 | \arguments{ 10 | \item{state}{list including 'gc' (graphics context)} 11 | 12 | \item{geom}{which geometry has asked for a style} 13 | } 14 | \value{ 15 | character "{attr_name}: {value}" strings for 'filter' or NULL 16 | if no filter available. 17 | } 18 | \description{ 19 | Construct a vector of styles related to 'filter' 20 | } 21 | -------------------------------------------------------------------------------- /man/font_style.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-style.R 3 | \name{font_style} 4 | \alias{font_style} 5 | \title{Construct a vector of styles related to 'font'} 6 | \usage{ 7 | font_style(state, geom) 8 | } 9 | \arguments{ 10 | \item{state}{list including 'gc' (graphics context)} 11 | 12 | \item{geom}{which geometry has asked for a style} 13 | } 14 | \value{ 15 | character vector of multiple "{attr_name}: {value}" strings for 16 | 'font-size', 'font-family', 'fill' 17 | } 18 | \description{ 19 | TODO: add font choice and style 20 | } 21 | -------------------------------------------------------------------------------- /man/glue_two.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{glue_two} 4 | \alias{glue_two} 5 | \title{Custom version of \code{glue} which rounds all numerics to 2 decimals} 6 | \usage{ 7 | glue_two(..., .envir = parent.frame()) 8 | } 9 | \arguments{ 10 | \item{..., .envir}{standard glue args} 11 | } 12 | \value{ 13 | interpolated string 14 | } 15 | \description{ 16 | Custom version of \code{glue} which rounds all numerics to 2 decimals 17 | } 18 | -------------------------------------------------------------------------------- /man/is_black.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-colour.R 3 | \name{is_black} 4 | \alias{is_black} 5 | \title{Is the colour black?} 6 | \usage{ 7 | is_black(rgba_vec) 8 | } 9 | \arguments{ 10 | \item{rgba_vec}{4 element rgba with integer values [0, 255]} 11 | } 12 | \value{ 13 | TRUE if black 14 | } 15 | \description{ 16 | Is the colour black? 17 | } 18 | -------------------------------------------------------------------------------- /man/is_transparent.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-colour.R 3 | \name{is_transparent} 4 | \alias{is_transparent} 5 | \title{Is the colour transparent?} 6 | \usage{ 7 | is_transparent(rgba_vec) 8 | } 9 | \arguments{ 10 | \item{rgba_vec}{4 element rgba with integer values [0, 255]} 11 | } 12 | \value{ 13 | TRUE if alpha == 0 14 | } 15 | \description{ 16 | Is the colour transparent? 17 | } 18 | -------------------------------------------------------------------------------- /man/is_white.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-colour.R 3 | \name{is_white} 4 | \alias{is_white} 5 | \title{Is the colour white?} 6 | \usage{ 7 | is_white(rgba_vec) 8 | } 9 | \arguments{ 10 | \item{rgba_vec}{4 element rgba with integer values [0, 255]} 11 | } 12 | \value{ 13 | TRUE if white 14 | } 15 | \description{ 16 | Is the colour white? 17 | } 18 | -------------------------------------------------------------------------------- /man/rgba_to_alpha.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-colour.R 3 | \name{rgba_to_alpha} 4 | \alias{rgba_to_alpha} 5 | \title{Calcuate the alpha value from the 4-element RGBA vector} 6 | \usage{ 7 | rgba_to_alpha(rgba_vec) 8 | } 9 | \arguments{ 10 | \item{rgba_vec}{4 element rgba with integer values [0, 255]} 11 | } 12 | \value{ 13 | alpha in range [0,1] 14 | } 15 | \description{ 16 | Calcuate the alpha value from the 4-element RGBA vector 17 | } 18 | -------------------------------------------------------------------------------- /man/rgba_to_hex.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-colour.R 3 | \name{rgba_to_hex} 4 | \alias{rgba_to_hex} 5 | \title{Convert a 4-element rgba vector to hex RGB} 6 | \usage{ 7 | rgba_to_hex(rgba_vec) 8 | } 9 | \arguments{ 10 | \item{rgba_vec}{4 element rgba with integer values [0, 255]} 11 | } 12 | \value{ 13 | colour hex triplet as string e.g. "#0156fe" 14 | } 15 | \description{ 16 | Convert a 4-element rgba vector to hex RGB 17 | } 18 | -------------------------------------------------------------------------------- /man/stroke_style.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-style.R 3 | \name{stroke_style} 4 | \alias{stroke_style} 5 | \title{Construct a vector of styles related to 'stroke'} 6 | \usage{ 7 | stroke_style(state, geom) 8 | } 9 | \arguments{ 10 | \item{state}{list including 'gc' (graphics context)} 11 | 12 | \item{geom}{which geometry has asked for a style} 13 | } 14 | \value{ 15 | character vector of multiple "{attr_name}: {value}" strings for 16 | 'stroke', 'stroke-width', 'stroke-opacity' 17 | } 18 | \description{ 19 | Note: 1 lwd = 1/96", but units in rest of document are 1/72" 20 | } 21 | -------------------------------------------------------------------------------- /man/style_string.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-style.R 3 | \name{style_string} 4 | \alias{style_string} 5 | \title{Create CSS styles for the given attributes} 6 | \usage{ 7 | style_string(attr_names, state, geom) 8 | } 9 | \arguments{ 10 | \item{attr_names}{character vector of e.g 'fill', 'stroke', 'font'} 11 | 12 | \item{state}{list including 'gc' (graphics context)} 13 | 14 | \item{geom}{which geometry has asked for a style} 15 | } 16 | \value{ 17 | style string ready for inclusion in an SVG tag e.g. 18 | "stroke: #ffffff; fill: #000000;" 19 | } 20 | \description{ 21 | Create CSS styles for the given attributes 22 | } 23 | -------------------------------------------------------------------------------- /man/svg_callback.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/svgout.R 3 | \name{svg_callback} 4 | \alias{svg_callback} 5 | \title{The main SVG callback.} 6 | \usage{ 7 | svg_callback(device_call, args, state) 8 | } 9 | \arguments{ 10 | \item{device_call}{name of device call} 11 | 12 | \item{args}{arguments to the call} 13 | 14 | \item{state}{rdata, gc and dd} 15 | } 16 | \description{ 17 | The main SVG callback. 18 | } 19 | -------------------------------------------------------------------------------- /man/svg_strWidth.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/svgout.R 3 | \name{svg_strWidth} 4 | \alias{svg_strWidth} 5 | \title{Return the width of the given string} 6 | \usage{ 7 | svg_strWidth(args, state) 8 | } 9 | \arguments{ 10 | \item{args, state}{standard pass-through from device driver} 11 | } 12 | \description{ 13 | Return the width of the given string 14 | } 15 | -------------------------------------------------------------------------------- /man/svgout.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/svgout.R 3 | \name{svgout} 4 | \alias{svgout} 5 | \title{SVG device written in R.} 6 | \usage{ 7 | svgout( 8 | filename = "svgout.svg", 9 | width = 10, 10 | height = 8, 11 | js_url = NULL, 12 | js_code = NULL, 13 | css_url = NULL, 14 | css_decl = NULL, 15 | pattern_list = NULL, 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{filename}{default: "svgout.svg"} 21 | 22 | \item{width, height}{size in inches. Default: 10x8} 23 | 24 | \item{js_url}{URL to external javascript to include in SVG output. 25 | Default: NULL (no external JS)} 26 | 27 | \item{js_code}{character string of javascript code to include in SVG output. 28 | Default: NULL (no javascript code to include)} 29 | 30 | \item{css_url}{URL to extenal CSS to include in SVG output. 31 | Default: NULL (no external CSS)} 32 | 33 | \item{css_decl}{character string of CSS declarations to include in SVG output. 34 | Default: NULL (no CSS declarations to include)} 35 | 36 | \item{pattern_list}{named list of patterns and filters to use as fills for the 37 | colour they represent. See vignettes() for more information. 38 | Default: NULL (no replacement patterns or filters)} 39 | 40 | \item{...}{arguments passed to \code{devout::rdevice}} 41 | } 42 | \description{ 43 | As with all devices based upon \code{devout}, this function realy just 44 | notifies \code{devout::rdevice()} to call \code{devoutsvg::svg_callback()} 45 | } 46 | -------------------------------------------------------------------------------- /man/transformer_round.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{transformer_round} 4 | \alias{transformer_round} 5 | \title{Transformer for \code{glue} to round numeric values to decimal places and convert NULL to text} 6 | \usage{ 7 | transformer_round(text, envir) 8 | } 9 | \arguments{ 10 | \item{text, envir}{standard transformer arguments} 11 | } 12 | \value{ 13 | evaluated text value 14 | } 15 | \description{ 16 | Transformer for \code{glue} to round numeric values to decimal places and convert NULL to text 17 | } 18 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /vignettes/data/drugs.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/devoutsvg/9151bd07a58a506ffa3d39f46d0982fd1e1693e1/vignettes/data/drugs.rds -------------------------------------------------------------------------------- /vignettes/data/suicides.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/devoutsvg/9151bd07a58a506ffa3d39f46d0982fd1e1693e1/vignettes/data/suicides.rds -------------------------------------------------------------------------------- /vignettes/heart-beat.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "heart-beat" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{heart-beat} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | 11 | ```{r setup} 12 | library(dplyr) 13 | library(tidyr) 14 | library(ggplot2) 15 | library(devoutsvg) 16 | ``` 17 | 18 | 19 | # A static heart plot in ggplot 20 | 21 | ```{r fig.width = 8, fig.height = 4} 22 | plot_df <- tibble( 23 | t = seq(-pi, 0, 0.001), 24 | x1 = 16 * sin(t) ^ 2, 25 | x2 = -x1, 26 | y = 13 * cos(t) - 5 * cos(2 * t) - 2 * cos(3 * t) - cos(4*t) 27 | ) %>% 28 | gather(side, x, x1, x2) 29 | 30 | 31 | p <- ggplot(plot_df, aes(x, y)) + 32 | geom_polygon(fill = 'red') + 33 | coord_fixed() + 34 | theme_minimal() 35 | 36 | p 37 | ``` 38 | 39 | # Add CSS styling to the SVG output 40 | 41 | The CSS below defines 3 frames of animation (`@keyframes`) which take place 42 | of 2 seconds and apply to the ID of the first polygon in the scene: `#polygon-0001`. 43 | 44 | The CSS is added to the output when calling the device i.e. `devoutsvg::svgout(..., css_decl = my_css, ...)` 45 | 46 | ```{r} 47 | my_css_decl <- " 48 | @keyframes pulse { 49 | from {transform: scale3d(1, 1, 1);} 50 | 50% {transform: scale3d(1.15, 1.15, 1.15);} 51 | to {transform: scale3d(1, 1, 1);} 52 | } 53 | 54 | #polygon-0001 { 55 | animation-name: pulse; 56 | animation-duration: 2s; 57 | animation-fill-mode: both; 58 | animation-iteration-count: infinite; 59 | } 60 | } 61 | " 62 | 63 | svgfile <- tempfile(fileext = '.svg') 64 | devoutsvg::svgout(filename = svgfile, width = 8, height = 4, 65 | css_decl = my_css_decl) 66 | 67 | p + 68 | labs(title = "Beating heart with {devoutsvg}", 69 | subtitle = "SVG graphics output with added CSS styling") 70 | 71 | invisible(dev.off()) 72 | ``` 73 | 74 | 75 | 76 | ```{r, echo=FALSE} 77 | htmltools::includeHTML(svgfile) 78 | ``` 79 | 80 | 81 | 82 | -------------------------------------------------------------------------------- /vignettes/images/ONS.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/devoutsvg/9151bd07a58a506ffa3d39f46d0982fd1e1693e1/vignettes/images/ONS.png -------------------------------------------------------------------------------- /vignettes/images/VictimOfMaths.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/devoutsvg/9151bd07a58a506ffa3d39f46d0982fd1e1693e1/vignettes/images/VictimOfMaths.png -------------------------------------------------------------------------------- /vignettes/images/blue.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/devoutsvg/9151bd07a58a506ffa3d39f46d0982fd1e1693e1/vignettes/images/blue.png -------------------------------------------------------------------------------- /vignettes/images/victimofmaths00: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/devoutsvg/9151bd07a58a506ffa3d39f46d0982fd1e1693e1/vignettes/images/victimofmaths00 -------------------------------------------------------------------------------- /vignettes/images/victimofmaths01: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/coolbutuseless/devoutsvg/9151bd07a58a506ffa3d39f46d0982fd1e1693e1/vignettes/images/victimofmaths01 -------------------------------------------------------------------------------- /vignettes/svg-with-css.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "svg-with-css" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{svg-with-css} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | ``` 16 | 17 | ```{r setup} 18 | library(ggplot2) 19 | library(devoutsvg) 20 | ``` 21 | 22 | 23 | ```{r fig.width = 8, fig.height = 4} 24 | example_plot <- ggplot(mtcars) + 25 | geom_density(aes(mpg, fill = as.factor(cyl))) + 26 | labs(title = "Example plot") + 27 | theme_bw() + 28 | scale_fill_manual(values = c('4' = '#df536b', '6' = '#61d04f', '8' = '#2297e6')) 29 | 30 | example_plot 31 | ``` 32 | 33 | 34 | ```{r} 35 | my_css_decl <- " 36 | @keyframes pulse { 37 | from {transform: scale3d(1, 1, 1);} 38 | 50% {transform: scale3d(1.15, 1.15, 1.15);} 39 | to {transform: scale3d(1, 1, 1);} 40 | } 41 | 42 | #polygon-0003 { 43 | animation-name: pulse; 44 | animation-duration: 4s; 45 | animation-fill-mode: both; 46 | animation-iteration-count: infinite; 47 | } 48 | 49 | rect:hover { 50 | fill: green !important; 51 | } 52 | " 53 | 54 | svgfile <- tempfile(fileext = '.svg') 55 | svgout(filename = svgfile, width = 8, height = 4, 56 | css_decl = my_css_decl) 57 | 58 | example_plot + 59 | labs(title = "Example - CSS") 60 | 61 | invisible(dev.off()) 62 | ``` 63 | 64 | 65 | 66 | ```{r, echo=FALSE} 67 | htmltools::includeHTML(svgfile) 68 | ``` 69 | 70 | 71 | 72 | 73 | 74 | 75 | -------------------------------------------------------------------------------- /vignettes/svg-with-d3-complex.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "svg-with-d3" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{svg-with-d3} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | ``` 16 | 17 | ```{r setup} 18 | library(devoutsvg) 19 | ``` 20 | 21 | 22 | # Introduction 23 | 24 | This example is an adapted version of [timelyportfolio](https://twitter.com/timelyportfolio)'s interactive 25 | version of a plot originally by [Claus Wilke](http://wilkelab.org/). 26 | 27 | My input here is minimal. The D3 javascript code is taken almost verbatim from [timelyportfolio](https://twitter.com/timelyportfolio)'s examples: 28 | 29 | * [example 1](https://bl.ocks.org/timelyportfolio/47cac2df130436f3292afaa38253072d) 30 | * [example 2](https://bl.ocks.org/timelyportfolio/b5b22cf7519261fa692a8cc696a943ce) 31 | 32 | The difference with this {devoutsvg} example is that the d3 code is injected into the 33 | plot during the process of rendering to device. While in [timelyportfolio](https://twitter.com/timelyportfolio)'s examples, 34 | the plot is output to SVG, the SVG is then read back in and manipulated as a character string, and then written back out. 35 | 36 | 37 | # Code 38 | 39 | 40 | 41 | ```{r} 42 | # will need newest ggplot2, github multiscales, and dev version of colorspace 43 | # install.packages('ggplot2') 44 | # install.packages("colorspace", repos = "http://R-Forge.R-project.org") 45 | # devtools::install_github("clauswilke/multiscales") 46 | 47 | # http://bl.ocks.org/timelyportfolio/47cac2df130436f3292afaa38253072d/9bde7a2417cc44b3b14038a6a945f604960cef87 48 | 49 | library(htmltools) 50 | library(ggplot2) 51 | library(d3r) 52 | library(multiscales) 53 | library(class) 54 | library(KernSmooth) 55 | ``` 56 | 57 | 58 | ```{r} 59 | # example from Claus Wilke's multiscales README 60 | colors <- scales::colour_ramp( 61 | colors = c(red = "#AC202F", purple = "#740280", blue = "#2265A3") 62 | )((0:7)/7) 63 | ``` 64 | 65 | 66 | ```{r fig.width=7, fig.height=4} 67 | ggp <- ggplot(US_polling) + 68 | geom_sf(aes(fill = zip(Clinton_lead, moe_normalized)), color = "gray30", size = 0.2) + 69 | coord_sf(datum = NA) + 70 | bivariate_scale("fill", 71 | pal_vsup(values = colors, max_desat = 0.8, pow_desat = 0.2, max_light = 0.7, pow_light = 1), 72 | name = c("Clinton lead", "uncertainty"), 73 | limits = list(c(-40, 40), c(0, 1)), 74 | breaks = list(c(-40, -20, 0, 20, 40), c(0, 0.25, 0.50, 0.75, 1.)), 75 | labels = list(waiver(), scales::percent), 76 | guide = "colourfan" 77 | ) + 78 | theme_void() + 79 | theme( 80 | legend.key.size = grid::unit(0.8, "cm"), 81 | legend.title.align = 0.5, 82 | plot.margin = margin(5.5, 20, 5.5, 5.5) 83 | ) 84 | 85 | ggp 86 | ``` 87 | 88 | 89 | ```{r} 90 | my_js_code <- " 91 | var svg = d3.select('svg') 92 | 93 | // add original fill as data on each state path 94 | svg.selectAll('path').each( function(d) { 95 | d3.select(this).datum({color: d3.select(this).style('fill')}) 96 | }) 97 | 98 | // this is not necessary but makes it cleaner 99 | // add g group for each polygon in the legend 100 | // the polygons are multiple small portions of the space in the legend 101 | // rather than one polygon for each color 102 | var legendcolors = d3.set() 103 | svg.selectAll('polygon').each(function(d){legendcolors.add(d3.select(this).style('fill'))}) 104 | 105 | legendcolors.values().forEach(function(color) { 106 | var g = svg.insert('g','svg>polygon').classed('legend-color',true).datum({color: color}) 107 | svg.selectAll('polygon') 108 | .filter(function(d) {return d3.select(this).style('fill') === color}) 109 | .each(function(d) { 110 | g.node().appendChild(this) 111 | }) 112 | }) 113 | 114 | svg.selectAll('g.legend-color').on('mouseover', function(d) { 115 | svg.selectAll('path').filter(pathd => pathd.color !== d.color).style('fill', 'white') 116 | svg.selectAll('path').filter(pathd => pathd.color === d.color).style('fill', d.color) 117 | }) 118 | 119 | svg.selectAll('g.legend-color').on('mouseout', function(d) { 120 | svg.selectAll('path').style('fill', pathd => pathd.color) 121 | }) 122 | " 123 | ``` 124 | 125 | 126 | ```{r eval=TRUE} 127 | svgfile <- tempfile(fileext = ".svg") 128 | devoutsvg::svgout( 129 | filename = svgfile, 130 | js_url = "https://d3js.org/d3.v5.min.js", 131 | js_code = my_js_code 132 | ) 133 | ggp 134 | invisible(dev.off()) 135 | ``` 136 | 137 | 138 | ```{r} 139 | htmltools::includeHTML(svgfile) 140 | ``` 141 | 142 | -------------------------------------------------------------------------------- /vignettes/svg-with-gradient-fill.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "svg-with-gradient-fill" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{svg-with-gradient-fill} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | 16 | dir.create("svg", showWarnings = FALSE) 17 | ``` 18 | 19 | ```{r setup, warning=FALSE,message=FALSE} 20 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 21 | # install devout and its dependencies 22 | # 23 | # svgpatternsimple - a set of simple patterns in SVG 24 | # devout - Framework for creating graphics devices in plain R 25 | # devoutsvg - Custom SVG device 26 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 27 | # devtools::install_github("coolbutuseless/svgpatternsimple") 28 | # devtools::install_github("coolbutuseless/devout") 29 | # devtools::install_github("coolbutuseless/devoutsvg") 30 | 31 | suppressPackageStartupMessages({ 32 | library(devout) 33 | library(devoutsvg) 34 | library(svgpatternsimple) 35 | 36 | library(dplyr) 37 | library(tidyr) 38 | library(ggplot2) 39 | library(ggridges) 40 | }) 41 | ``` 42 | 43 | 44 | # Deaths Of Drug Poisoning 45 | 46 | This vignette recreates a plot with vertical colour gradient. It was developed by 47 | [VictimOfMaths](https://twitter.com/VictimOfMaths) and the complete version is 48 | available on [github](https://github.com/VictimOfMaths/DeathsOfDespair). 49 | 50 | The image below on the left is from the [UK Office for National Statistics (ONS)](https://www.ons.gov.uk/peoplepopulationandcommunity/healthandsocialcare/healthandwellbeing/articles/middleagedgenerationmostlikelytodiebysuicideanddrugpoisoning/2019-08-13). 51 | 52 | The image on the right is created using `R`, `ggplot` and `devoutsvg` 53 | 54 |
55 | 56 | 57 |
58 |
59 | 60 | 61 | # Simple gradient example 62 | 63 | Create, view, debug and iterate to find a gradient fill of your liking. 64 | 65 | ```{r} 66 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 67 | # Create SVG gradient pattern definition 68 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 69 | gradient_pattern <- svgpatternsimple::create_pattern_gradient( 70 | id = "p1", # HTML/SVG id to assign to this pattern 71 | angle = 90, # Direction of the gradient 72 | colour1 = "White", # Starting colour 73 | colour2 = "#0570b0" # Final colour 74 | ) 75 | 76 | # Contents of 'gradient_pattern' 77 | #> 78 | #> 79 | #> 80 | #> 81 | 82 | # Visualise in viewer in Rstudio 83 | # gradient_pattern$show() 84 | ``` 85 | 86 | 87 | ```{r echo = FALSE, eval = FALSE} 88 | if (interactive()) { 89 | gradient_pattern$show() 90 | } 91 | gradient_pattern$save_full_svg("svg/gradient-example.svg", height=100, include_declaration = FALSE) 92 | ``` 93 | 94 | 95 | 96 | 97 | 98 | 99 | ```{r eval=TRUE} 100 | my_pattern_list <- list( 101 | `#000001` = list(fill = gradient_pattern) 102 | ) 103 | 104 | 105 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 106 | # Render the graph to the 'svgout' device and nominate any patterns to be 107 | # rendered by the 'svgpatternsimple' package 108 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 109 | svgout(filename = "svg/test-gradient.svg", pattern_list = my_pattern_list) 110 | ggplot(iris, aes(x=Sepal.Width, y=Species)) + 111 | geom_density_ridges(alpha=0.33, scale=2, fill='#000001', colour=alpha(0.1)) + 112 | theme_classic() 113 | invisible(dev.off()) 114 | ``` 115 | 116 | 117 | 118 | 119 | 120 | 121 | # Recreate the ONS Plot 122 | 123 | * Grab the raw data from the ONS 124 | * Reshape into tidy form 125 | * Create a `ggridges` plot 126 | * Use the `devoutsvg` device with `svgpatternsimple` 127 | * Use the encoded gradient created above (i.e. `gradRGB`) as the 128 | fill colour for the ridges. 129 | 130 | 131 | ```{r warning=FALSE, eval=TRUE} 132 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 133 | # Read (and cache) the data from the ONS 134 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 135 | # drugs <- readr::read_csv("https://www.ons.gov.uk/visualisations/dvc661/drugs/datadownload.csv" ) 136 | # saveRDS(drugs, "data/drugs.rds") 137 | drugs <- readRDS("data/drugs.rds") 138 | 139 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 140 | # Tidy + reshape data 141 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 142 | drugs <- drugs %>% 143 | mutate( 144 | Age = case_when( 145 | Age == "<10" ~ "9", 146 | Age == "90+" ~ "90", 147 | TRUE ~ Age 148 | ) 149 | ) %>% 150 | tidyr::gather("Year", "Deaths", -Age) %>% 151 | mutate( 152 | Age = as.integer(Age), 153 | Year = as.integer(Year) 154 | ) 155 | 156 | 157 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 158 | # Render the graph to the 'svgout' device and nominate any fill colours to be 159 | # rendered by the 'svgpatternsimple' package 160 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 161 | svgout(filename = "svg/DrugDeaths.svg", pattern_list = my_pattern_list, width=4, height=6) 162 | ggplot(drugs, aes(Age, Year, height=Deaths, group=Year)) + 163 | geom_density_ridges(stat='identity', scale = 3, colour=NA, fill='#000001') + 164 | scale_y_reverse(position = 'right', breaks = sort(unique(drugs$Year))) + 165 | scale_x_continuous(breaks = seq(10, 90, 10)) + 166 | theme_classic() + 167 | theme( 168 | axis.line.y = element_blank(), 169 | axis.ticks.y = element_blank(), 170 | axis.title.y = element_blank(), 171 | text = element_text(family="Georgia") 172 | ) + 173 | labs( 174 | title = "Trends in deaths from drug poisoning", 175 | subtitle = "Data from England and Wales 1993-2017", 176 | caption = "Source: Office for National Statistics\nPlot by @VictimOfMaths" 177 | ) 178 | invisible(dev.off()) 179 | ``` 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | 188 | 189 | -------------------------------------------------------------------------------- /vignettes/svg-with-javascript.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "svg-with-javascript" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{svg-with-javascript} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | ``` 16 | 17 | ```{r setup} 18 | library(devoutsvg) 19 | library(ggplot2) 20 | ``` 21 | 22 | 23 | 24 | 25 | ```{r fig.width = 8, fig.height = 4} 26 | example_plot <- ggplot(mtcars) + 27 | geom_density(aes(mpg, fill = as.factor(cyl))) + 28 | labs(title = "Example plot") + 29 | theme_bw() + 30 | scale_fill_manual(values = c('4' = '#df536b', '6' = '#61d04f', '8' = '#2297e6')) 31 | 32 | example_plot 33 | ``` 34 | 35 | ```{r svgout_basic3} 36 | library(minisvg) 37 | 38 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 39 | # D3.js code to add a rectangle 40 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 41 | my_js_code <- " 42 | console.log('start {devoutsvg}'); 43 | d3.select('svg') 44 | .append('rect') 45 | .attr('x', '25%') 46 | .attr('y', '25%') 47 | .attr('width', '50%') 48 | .attr('height', '50%') 49 | .attr('style', 'fill: blue; fill-opacity: 0.5;') 50 | console.log('end {devoutsvg}'); 51 | " 52 | 53 | 54 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 55 | # Set up the {devoutsvg} graphics device and output a ggplot 56 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 57 | svgfile <- tempfile(fileext = '.svg') 58 | devoutsvg::svgout( 59 | filename = svgfile, 60 | width = 8, 61 | height = 4, 62 | js_url = "https://d3js.org/d3.v5.min.js", 63 | js_code = my_js_code 64 | ) 65 | 66 | example_plot 67 | 68 | invisible(dev.off()) 69 | ``` 70 | 71 | 72 | ```{r, echo=FALSE} 73 | htmltools::includeHTML(svgfile) 74 | ``` -------------------------------------------------------------------------------- /vignettes/svg/gradient-example.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | --------------------------------------------------------------------------------