loading and status

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: capture
 Title: Capture Screenshot in Web Page
-Version: 0.1.4.9000
+Version: 0.1.5
 Authors@R: 
     c(person(given = "Victor",
              family = "Perrier",

NEWS.md

@@ -2,6 +2,8 @@
 
 * Allow floating numbers in `scale =` argument [#13](https://github.com/dreamRs/capture/issues/13).
 * Allow to pass JavaScript function in `options$filter` argument [#12](https://github.com/dreamRs/capture/issues/12).
+* Added `loading` parameters to `capture()` like in `capture_pdf()`
+* Added `statusInputId` parameter to `capture()` and `capture_pdf()` to retrieve status information in an `input` value server-side.
 
 
 # capture 0.1.4

R/capture.R

@@ -11,6 +11,8 @@
 #' @param inputId An `inputId` to retrieve image as base64 in an `input` slot server-side.
 #' @param options Options (as a list) passed to [html-to-image](https://github.com/bubkoo/html-to-image#options)
 #'  method, for example you can use `backgroundColor` to set background color.
+#' @param loading Add a loading indicator if taking screenshot take time, see [loading()] for usage.
+#' @param statusInputId Retrieve status information in an `input` value server-side.
 #' @param button_class Class to use for the HTML tag `<button>`
 #'
 #' @note It's only possible to take screenshot of elements that are actually visible on screen. It doesn't work in Internet Explorer.
@@ -30,6 +32,8 @@ capture <- function(selector,
                     scale = NULL, 
                     inputId = NULL,
                     options = NULL,
+                    loading = NULL, 
+                    statusInputId = NULL,
                     button_class = "btn btn-default") {
   format <- match.arg(format)
   ext <- tools::file_ext(filename)
@@ -43,7 +47,16 @@ capture <- function(selector,
       `data-options` = toJSON(x = options, auto_unbox = TRUE),
       `data-scale` = scale,
       `data-inputId` = inputId,
-      ...
+      `data-loading` = tolower(!is.null(loading)),
+      `data-status-id` = statusInputId,
+      ...,
+      if (length(loading) > 0) {
+        tags$script(
+          type = "application/json",
+          `data-for` = "capture-loading-config",
+          toJSON(loading, auto_unbox = TRUE)
+        )
+      }
     ),
     html_dependency_capture()
   )
@@ -58,7 +71,6 @@ capture <- function(selector,
 #'
 #' @inheritParams capture
 #' @param margins Margins to add to PDF.
-#' @param loading Add a loading indicator if taking screenshot take time, see [loading()] for usage.
 #'
 #' @return an HTML tag that can be used in UI or rmarkdown HTML document.
 #' @export
@@ -72,9 +84,10 @@ capture_pdf <- function(selector,
                         filename, 
                         ..., 
                         margins = 15, 
-                        loading = NULL, 
                         scale = NULL, 
                         options = NULL,
+                        loading = NULL, 
+                        statusInputId = NULL,
                         button_class = "btn btn-default") {
   ext <- tools::file_ext(filename)
   if (!identical(ext, "pdf"))
@@ -85,11 +98,12 @@ capture_pdf <- function(selector,
       `data-selector` = selector,
       `data-filename` = filename,
       `data-margins` = margins,
-      `data-loading` = tolower(!is.null(loading)),
       `data-options` = toJSON(x = options, auto_unbox = TRUE),
-      `data-scale` = if (!is.null(scale)) scale,
+      `data-scale` = scale,
+      `data-loading` = tolower(!is.null(loading)),
+      `data-status-id` = statusInputId,
       ...,
-      if (!is.null(loading)) {
+      if (length(loading) > 0) {
         tags$script(
           type = "application/json",
           `data-for` = "capture-loading-config",

R/loading.R

@@ -1,14 +1,14 @@
 
 #' Loading indicator to be displayed when generating screenshot
-#'
+#' 
 #' @param text Text to be displayed below loading animation.
 #' @param type Type of loading animation.
 #' @param color Color for text and loading indicator.
 #' @param background Background color.
 #' @param size Size (in pixels).
 #' @param ... Other arguments.
 #'
-#' @return a `list` that can be used in [capture_pdf()].
+#' @return a `list` that can be used in [capture()] or [capture_pdf()].
 #' @export
 #'
 loading <- function(text = "Generating PDF, please wait...",
@@ -18,7 +18,7 @@ loading <- function(text = "Generating PDF, please wait...",
                     size = "80px",
                     ...) {
   type <- match.arg(type)
-  list(
+  dropNulls(list(
     text = text,
     type = type,
     options = list(
@@ -27,6 +27,6 @@ loading <- function(text = "Generating PDF, please wait...",
       svgColor = color,
       ...
     )
-  )
+  ))
 }
 

R/utils.R

@@ -0,0 +1,4 @@
+
+dropNulls <- function(x) {
+  x[!vapply(x, is.null, FUN.VALUE = logical(1))]
+}

examples/default.R

@@ -7,15 +7,14 @@ ui <- fluidPage(
     selector = "body",
     filename = "all-page",
     icon("camera"), "Take screenshot of all page",
-    format = "jpeg"
+    format = "png"
   ),
   tags$br(),
   fluidRow(
     column(
       width = 4,
       wellPanel(
         tags$b("Parameters :"),
-
         selectInput(
           inputId = "loi",
           label = "Law:",

examples/scales-pdf.R

@@ -29,7 +29,6 @@ ui <- fluidPage(
       width = 4,
       wellPanel(
         tags$b("Parameters :"),
-
         selectInput(
           inputId = "loi",
           label = "Law:",

examples/status-pdf.R

@@ -0,0 +1,72 @@
+library(shiny)
+library(capture)
+
+ui <- fluidPage(
+  tags$h2("Capture PDF (loading) example"),
+  capture_pdf(
+    selector = "body",
+    filename = "all-page",
+    icon("camera"), "Take screenshot of all page",
+    scale = 2,
+    statusInputId = "loading"
+  ),
+  tags$br(),
+  fluidRow(
+    column(
+      width = 4,
+      wellPanel(
+        tags$b("Parameters :"),
+        selectInput(
+          inputId = "loi",
+          label = "Law:",
+          choices = c("normal", "uniform", "exponential")
+        )
+      )
+    ),
+    column(
+      width = 8,
+      tags$div(
+        id = "result-block",
+        tags$b("Results :"),
+        plotOutput(outputId = "plot"),
+        uiOutput(outputId = "mean"),
+        verbatimTextOutput(outputId = "raw")
+      )
+    )
+  )
+)
+
+server <- function(input, output, session) {
+  distrib_r <- reactive({
+    switch(
+      input$loi,
+      "normal" = rnorm(1000),
+      "uniform" = runif(1000),
+      "exponential" = rexp(1000)
+    )
+  })
+
+  output$plot <- renderPlot({
+    hist(distrib_r())
+  })
+
+  output$mean <- renderUI({
+    tags$p(tags$b("The mean is :"), round(mean(distrib_r()), 2))
+  })
+
+  output$raw <- renderPrint({
+    summary(distrib_r())
+  })
+
+  observeEvent(input$loading, {
+    if (identical(input$loading$status, "started")) {
+      showNotification(ui = "Capturing screenshot, please wait...")
+    }
+    if (identical(input$loading$status, "finished")) {
+      showNotification(ui = "Screenshot captured!", type = "message")
+    }
+  })
+}
+
+if (interactive())
+  shinyApp(ui, server)

examples/status.R

@@ -0,0 +1,79 @@
+library(shiny)
+library(capture)
+
+ui <- fluidPage(
+  tags$h2("Capture (loading) example"),
+  capture(
+    selector = "body",
+    filename = "all-page",
+    icon("camera"), "Auto loading indicator",
+    loading = loading(text = "Capturing screenshot...")
+  ),
+  capture(
+    selector = "body",
+    filename = "all-page",
+    icon("camera"), "Input value",
+    statusInputId = "loading"
+  ),
+  tags$br(),
+  fluidRow(
+    column(
+      width = 4,
+      wellPanel(
+        tags$b("Parameters :"),
+        selectInput(
+          inputId = "loi",
+          label = "Law:",
+          choices = c("normal", "uniform", "exponential")
+        )
+      )
+    ),
+    column(
+      width = 8,
+      tags$div(
+        id = "result-block",
+        tags$b("Results :"),
+        plotOutput(outputId = "plot"),
+        uiOutput(outputId = "mean"),
+        verbatimTextOutput(outputId = "raw")
+      )
+    )
+  )
+)
+
+server <- function(input, output, session) {
+
+  distrib_r <- reactive({
+    switch(
+      input$loi,
+      "normal" = rnorm(1000),
+      "uniform" = runif(1000),
+      "exponential" = rexp(1000)
+    )
+  })
+
+  output$plot <- renderPlot({
+    hist(distrib_r())
+  })
+
+  output$mean <- renderUI({
+    tags$p(tags$b("The mean is :"), round(mean(distrib_r()), 2))
+  })
+
+  output$raw <- renderPrint({
+    summary(distrib_r())
+  })
+
+  observeEvent(input$loading, {
+    if (identical(input$loading$status, "started")) {
+      showNotification(ui = "Capturing screenshot, please wait...")
+    }
+    if (identical(input$loading$status, "finished")) {
+      showNotification(ui = "Screenshot captured!", type = "message")
+    }
+  })
+
+}
+
+if (interactive())
+  shinyApp(ui, server)