hafen / trelliscopejs
1
write_thumb <- function(panel_example, path, width, height, thumb = TRUE) {
2 1
  if (thumb) {
3 1
    if (inherits(panel_example, "htmlwidget")) {
4 1
      widget_thumbnail(panel_example, path, width, height)
5
    } else {
6 1
      suppressMessages(
7 1
        make_png(panel_example, file = path,
8 1
          width = width, height = height))
9
    }
10
  }
11

12
  # need "!thumb" in case overwriting existing
13 1
  if (!file.exists(path) || !thumb) {
14 1
    suppressMessages(
15 1
      make_png(blank_image(), file = path,
16 1
        width = width, height = height))
17
  }
18
}
19

20
#' @importFrom graphics plot
21
#' @importFrom webshot webshot
22
widget_thumbnail <- function(p, thumb_path, width, height, delay = 0.5) {
23 1
  thumb_path <- path.expand(thumb_path)
24

25 1
  success <- FALSE
26 1
  res <- try({
27 1
    ff <- tempfile(fileext = ".html")
28 1
    ffjs <- tempfile(fileext = ".js")
29

30
    # don't want any padding
31 1
    p$sizingPolicy$padding <- 0 # nolint
32 1
    suppressMessages(htmlwidgets::saveWidget(p, ff, selfcontained = FALSE))
33

34 1
    webshot::webshot(paste0("file://", ff), thumb_path, vwidth = width, vheight = height,
35 1
      delay = delay)
36 1
  }, silent = TRUE)
37 1
  if (!inherits(res, "try-error")) {
38 1
    success <- TRUE
39
  }
40 1
  if (!file.exists(thumb_path))
41 0
    success <- FALSE
42

43 1
  if (!success)
44 0
    message("* could not create htmlwidget thumbnail... will use blank thumbnail...")
45
}
46

47
#' @import ggplot2
48
blank_image <- function(txt = "no thumbnail") {
49 1
  ggplot(data = data.frame(x = 0.5, y = 0.75, label = txt)) +
50 1
    geom_text(aes(x = x, y = y, label = label), size = 8) +
51 1
    labs(x = NULL, y = NULL, title = NULL) +
52 1
    scale_x_continuous(expand = c(0, 0), limits = c(0, 1)) +
53 1
    scale_y_continuous(expand = c(0, 0), limits = c(0, 1)) +
54 1
    theme(
55 1
      panel.background = element_rect(fill = "transparent", colour = NA),
56 1
      plot.background = element_rect(fill = "transparent", colour = NA),
57 1
      panel.grid = element_blank(),
58 1
      panel.border = element_blank(),
59 1
      plot.margin = unit(c(0, 0, 0, 0), "null"),
60 1
      axis.ticks = element_blank(),
61 1
      axis.text = element_blank(),
62 1
      axis.title = element_blank(),
63 1
      axis.line = element_blank(),
64 1
      legend.position = "none",
65 1
      axis.ticks.length = unit(0, "null")
66
    )
67
}

Read our documentation on viewing source code .

Loading