Take screenshot of element

[hadley]

It would be very useful to be able to take a screenshot of an element, i.e. find the element, compute it's bounds, and then only screenshot that region.

[cpsievert]

Note that you can do this for output elements:

...do you have a use case for non-output elements?

[hadley]

I want to generate screenshots of input elements, and generally of layouts.

(This isn't for testing rather than generating screenshots for a book so I don't need to iteratively figure out the width and height)

[cpsievert]

Have you tried webshot with CSS selectors? https://github.com/wch/webshot#usage

(see also https://github.com/rstudio/webshot2)

[hadley]

How would I point webshot to a shiny app and then tell it to do stuff? I'd rather not reimplement all the shinytest features that I need.

[cpsievert]

You could do it in a similar way to this:

callr::r_bg(function() {
  shiny::runExample("01_hello", port = 8001)
})

webshot::webshot("http://localhost:8001", selector = ".shiny-input-container")

[hadley]

I think it would be better to bake directly into shinytest. It doesn't seem like it would be that hard to implement.

[jcheng5]

Here's my (failed) attempt: https://github.com/jcheng5/shiny-book/blob/master/common.R

[hadley]

@jcheng5 that's mostly my code!!

[jcheng5]

Oh 🤣 I swear I did something similar! (And that it didn't quite work)

[wch]

From the app object, you can get the WebDriver object via `app$.enclos_env$private$web, which allows low-level control of the browser. Currently it's using WebDriver but we plan on replacing it with Chromote in the future.

[hadley]

@wch could you please give me some hint as to how to take a screenshot of an element given a WebDriver?

[wch]

Here's what I've come up with:

library(shiny)

testApp <- function(ui, server = NULL) {
  if (is.null(server)) {
    server <- function(input, output, session) {}
  }

  app_dir <- tempfile()
  dir.create(app_dir)
  saveRDS(ui, file.path(app_dir, "ui.rds"))
  saveRDS(server, file.path(app_dir, "server.rds"))

  app <- rlang::expr({
    library(shiny)
    ui <- readRDS("ui.rds")
    server <- readRDS("server.rds")

    shinyApp(ui, server)
  })
  cat(rlang::expr_text(app), file = file.path(app_dir, "app.R"))

  shinytest::ShinyDriver$new(app_dir)
}


ui <- fluidPage(
  div(class = "foo", "Hello!"),
  "Some other text"
)


sd <- testApp(ui)
tmp <- tempfile(fileext = ".png")
sd$takeScreenshot(tmp)

# Find bounding rectangle of target div
wd <- sd$.__enclos_env__$private$web
obj <- wd$findElement(".foo")
rect <- obj$getRect()

# Clip to the bounding rectangle
img <- png::readPNG(tmp)
img <- img[seq(rect$y, rect$y + rect$height), seq(rect$x, rect$x + rect$width), 1:4]
png::writePNG(img, "out.png")
browseURL("out.png")

unlink(img)

[hadley]

Thanks!

[hadley]

Here's what I ended up with:

show_raster <- function(x) {
  withr::local_par(list(bg = "grey90"))
  plot(as.raster(x))
}

app_wait <- function(app) {
  app$waitFor("!$('html').first().hasClass('shiny-busy')")
}

screenshot_element <- function(app, id, parent = FALSE) {
  path <- tempfile()
  app$takeScreenshot(path)
  png <- png::readPNG(path )

  element <- app$findElement(paste0("#", id))
  if (parent) {
    element <- element$findElement(xpath = "..")
  }
  pos <- element$getRect()
  pos$x2 <- pos$x + pos$width
  pos$y2 <- pos$y + pos$height
  png[pos$y:pos$y2, pos$x:pos$x2, ]
}

app <- shinytest::ShinyDriver$new("apps/shiny-test")
app$setInputs(x = 10)
app$waitFor("!$('html').first().hasClass('shiny-busy')")
snap <- screenshot_element(app, "x", parent = TRUE)
show_raster(snap)

path2 <- tempfile()
png::writePNG(snap, path2)

[hadley]

Probably should be screenshot method for Widget class.