Skip to content

Instantly share code, notes, and snippets.

@vnijs
Last active May 10, 2020 19:20
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save vnijs/82d4a49448f8cf93e01537c5c8557200 to your computer and use it in GitHub Desktop.
Save vnijs/82d4a49448f8cf93e01537c5c8557200 to your computer and use it in GitHub Desktop.
Generate a shiny-app screenshot using snapper and download it using shinyFiles, shiny, or snapper
library(shiny)
# remotes::install_github("yonicd/snapper")
# remotes::install_github("thomas85p/shinyFiles")
library(snapper)
library(base64enc)
library(png)
library(shinyFiles)
js <- '
function get_img_src() {
var img_src = $("#screenshot_link_preview img").attr("src");
Shiny.setInputValue("img_src", img_src);
}
'
ui <- navbarPage("Snapper app",
navbarMenu("", icon = icon("save"),
tabPanel(
snapper::preview_link(
"screenshot_link", ui = "body", previewId = "screenshot_link_preview", label = "Take a screenshot",
opts = config(
ignoreElements = "function (el) {return el.className === 'dropdown-menu';}"
)
)
)
),
tags$head(
tags$style(HTML("img { max-width: 85% !important; height: auto; }")),
tags$script(HTML(js)),
snapper::load_snapper()
)
)
server <- function(input, output, session) {
volumes <- c(Home = fs::path_home(), getVolumes()())
shinyFileSave(input, "download_screenshot_sf", roots = volumes, session = session)
shinyFileSave(input, "download_screenshot_sf_link", roots = volumes, session = session)
observeEvent(input$screenshot_link, {
showModal(
modalDialog(
title = "App screenshot",
span(snapper::snapper_div(id = "screenshot_link_preview")),
footer = tagList(
shinySaveLink(
"download_screenshot_sf_link", "", icon = icon("save"), "Save file as...",
filename = "screenshot-sf-link.png", filetype = list(picture = "png"),
onclick = "get_img_src();"
),
shinySaveButton(
"download_screenshot_sf", "Download (sf)", icon = icon("save"), "Save file as...",
filename = "screenshot-sf-button.png", filetype = list(picture = "png"),
onclick = "get_img_src();"
),
downloadButton("download_screenshot", "Download (shiny)", onclick = "get_img_src();"),
snapper::download_button(
ui = "#screenshot_link_preview",
label = "Download (snapper)",
filename = "screenshot-snapper.png"
),
modalButton("Cancel"),
),
size = "m",
easyClose = TRUE
)
)
})
observeEvent(input$download_screenshot_sf_link, {
if (is.integer(input$download_screenshot_sf_link)) return()
path <- shinyFiles::parseSavePath(volumes, input$download_screenshot_sf_link)
if (!inherits(path, "try-error") && length(path$datapath) > 0) {
plt <- sub("data:.+base64,", "", input$img_src)
plt <- png::readPNG(base64enc::base64decode(what = plt))
png::writePNG(plt, path$datapath, dpi = 144)
}
})
observeEvent(input$download_screenshot_sf, {
if (is.integer(input$download_screenshot_sf)) return()
path <- shinyFiles::parseSavePath(volumes, input$download_screenshot_sf)
if (!inherits(path, "try-error") && length(path$datapath) > 0) {
plt <- sub("data:.+base64,", "", input$img_src)
plt <- png::readPNG(base64enc::base64decode(what = plt))
png::writePNG(plt, path$datapath, dpi = 144)
}
})
output$download_screenshot <- downloadHandler(
filename = function() {
"radiant-screenshot.png"
},
content = function(file) {
plt <- sub("data:.+base64,", "", isolate(input$img_src))
plt <- png::readPNG(base64enc::base64decode(what = plt))
png::writePNG(plt, file, dpi = 144)
}
)
}
shinyApp(ui, server)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment