-
Notifications
You must be signed in to change notification settings - Fork 34
/
thumb.R
73 lines (63 loc) · 2.09 KB
/
thumb.R
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
#' Make a thumbnail for an htmlwidget panel
#'
#' @param p htmlwidget object
#' @param thumbPath where to save thumbnail file
#' @param timeout how many milliseconds to wait until plot is rendered
#' @note This is used internally \code{\link{makeDisplay}} to create thumbnails of htmlwidget panel functions.
#' @export
#' @importFrom htmlwidgets saveWidget
widgetThumbnail <- function(p, thumbPath, timeout = 1500) {
phantom <- findPhantom()
thumbPath <- path.expand(thumbPath)
success <- FALSE
if(phantom == "") {
message("** phantomjs dependency could not be found - thumbnail cannot be generated (run phantomInstall() for details)")
} else {
res <- try({
ff <- tempfile(fileext = ".html")
ffjs <- tempfile(fileext = ".js")
# don't want any padding
p$sizingPolicy$padding <- 0
suppressMessages(saveWidget(p, ff, selfcontained = FALSE))
js <- paste0("var page = require('webpage').create();
page.open('file://", ff, "', function() {
window.setTimeout(function () {
page.render('", thumbPath, "');
phantom.exit();
}, ", timeout, ");
});")
cat(js, file = ffjs)
system2(phantom, ffjs)
})
if(!inherits(res, "try-error")) {
success <- TRUE
}
if(!file.exists(thumbPath))
success <- FALSE
# system(paste("open ", ffjs))
# system(paste("open ", dirname(ffjs)))
}
if(!success) {
message("** could not create htmlwidget thumbnail... creating an empty thumbnail...")
grDevices::png(filename = thumbPath)
plot(1, 1, type = "n", xlab = "", ylab = "", axes = FALSE)
grDevices::dev.off()
}
}
#' Get instructions on how to install phantomjs
#' @examples
#' phantomInstall()
#' @export
phantomInstall <- function() {
message("Please visit this page to install phantomjs on your system: http://phantomjs.org/download.html")
}
# similar to webshot
findPhantom <- function() {
phantom <- Sys.which("phantomjs")
if(Sys.which("phantomjs") == "") {
if(identical(.Platform$OS.type, "windows")) {
phantom <- Sys.which(file.path(Sys.getenv("APPDATA"), "npm", "phantomjs.cmd"))
}
}
phantom
}