add a demo app

DESCRIPTION

@@ -22,7 +22,8 @@ Imports:
     uuid
 Suggests:
     knitr,
-    rmarkdown
+    rmarkdown,
+    timevis
 License: MIT + file LICENSE
 LazyData: true
 VignetteBuilder: knitr

NAMESPACE

@@ -1,4 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
+export(runExample)
 export(screenshot)
 export(screenshotButton)

R/runExample.R

@@ -0,0 +1,12 @@
+#' Run shinyscreenshot example
+#'
+#' Launch an example Shiny app that shows how easy it is to take screenshots
+#' with `shinyscreenshot`.\cr\cr
+#' The demo app is also
+#' \href{https://daattali.com/shiny/shinyscreenshot-demo/}{available online}
+#' to experiment with.
+#' @export
+runExample <- function() {
+  appDir <- system.file("examples", "demo", package = "shinyscreenshot")
+  shiny::runApp(appDir, display.mode = "normal")
+}

R/screenshot.R

@@ -1,18 +1,18 @@
 #' Capture a screenshot of a shiny app
 #'
-#' Screenshots can be either of the entire viewable page, or of a specific
+#' Screenshots can be either of the entire viewable page (default), or of a specific
 #' section of the page. The captured image is automatically downloaded as a
 #' PNG image.\cr\cr
 #' This function gets called from the server portion of a Shiny app, unlike
-#' `screenshotButton()` which is similar but gets called from the UI.
+#' [`screenshotButton()`] which is similar but gets called from the UI.
 #'
 #' @param selector CSS selector for the element that should be captured. If multiple
 #' elements match the selector, only the first one is captured. Default is to capture
 #' the entire page.
 #' @param filename Name of the file to be saved. A PNG extension will automatically be added.
 #' @param id As an alternative to `selector`, an ID of the element that should be captured
 #' can be provided. If `id` is provided, then `selector` is ignored. When used in a module,
-#' the `id` **does not** need to be namespaced (it happens automatically).
+#' the `id` **does not** need to be namespaced (namespacing is automatic).
 #' @param scale The scale of the image. Default is 1, which means the dimensions of the image
 #' will be exactly the dimensions in the browser. For example, a value of 2 will result in an
 #' image that's twice the height and width (and a larger file size).
@@ -25,7 +25,7 @@
 #'
 #'   shinyApp(
 #'     ui = fluidPage(
-#'       h1("shinyscreenshot demo"),
+#'       h1("{shinyscreenshot} demo"),
 #'       numericInput("num", "Number of points", 50),
 #'       plotOutput("plot"),
 #'       actionButton("screenshot1", "Capture entire page"),
@@ -58,16 +58,16 @@ screenshot <- function(selector = "body", filename = "shinyscreenshot", id = "",
 #' Button that captures a screenshot of a shiny app
 #'
 #' Create a button that, when clicked, captures a screenshot of the Shiny app.
-#' Screenshots can be either of the entire viewable page, or of a specific
+#' Screenshots can be either of the entire viewable page (default), or of a specific
 #' section of the page. The captured image is automatically downloaded as a
 #' PNG image.\cr\cr
 #' This function gets called from the UI portion of a Shiny app, unlike
-#' `screenshotButton()` which is similar but gets called from the UI.
+#' [`screenshot()`] which is similar but gets called from the server.
 #' @inheritParams screenshot
 #' @param id As an alternative to `selector`, an ID of the element that should be captured
 #' can be provided. If `id` is provided, then `selector` is ignored. When used in a module,
 #' the `id` **does** need to be namespaced, like any other UI element.
-#' @param ... Any other parameters that should be passed onto the `shiny::actionButton()`.
+#' @param ... Any other parameters that should be passed along to the [`shiny::actionButton()`].
 #' @examples
 #' if (interactive()) {
 #'   library(shiny)

inst/examples/demo/app.R

@@ -0,0 +1,157 @@
+library(shiny)
+library(shinyscreenshot)
+
+share <- list(
+  title = "{shinyscreenshot} package",
+  url = "https://daattali.com/shiny/shinyscreenshot-demo/",
+  source = "https://github.com/daattali/shinyscreenshot",
+  image = "https://daattali.com/shiny/img/shinyscreenshot.png",
+  description = "Capture screenshots of entire pages or parts of pages in Shiny apps",
+  twitter_user = "daattali"
+)
+
+ui <- fluidPage(
+  shinydisconnect::disconnectMessage2(),
+  title = paste0("shinyscreenshot package ", as.character(packageVersion("shinyscreenshot"))),
+  tags$head(
+    includeCSS(file.path('www', 'style.css')),
+    # Favicon
+    tags$link(rel = "shortcut icon", type="image/x-icon", href="https://daattali.com/shiny/img/favicon.ico"),
+    # Facebook OpenGraph tags
+    tags$meta(property = "og:title", content = share$title),
+    tags$meta(property = "og:type", content = "website"),
+    tags$meta(property = "og:url", content = share$url),
+    tags$meta(property = "og:image", content = share$image),
+    tags$meta(property = "og:description", content = share$description),
+
+    # Twitter summary cards
+    tags$meta(name = "twitter:card", content = "summary"),
+    tags$meta(name = "twitter:site", content = paste0("@", share$twitter_user)),
+    tags$meta(name = "twitter:creator", content = paste0("@", share$twitter_user)),
+    tags$meta(name = "twitter:title", content = share$title),
+    tags$meta(name = "twitter:description", content = share$description),
+    tags$meta(name = "twitter:image", content = share$image)
+  ),
+
+  div(id = "header",
+      div(id = "pagetitle", share$title),
+      div(id = "subtitle", share$description),
+      div(id = "subsubtitle",
+          "Created by",
+          tags$a(href = "https://deanattali.com/", "Dean Attali"),
+          HTML("&bull;"),
+          "Available",
+          tags$a(href = share$source, "on GitHub"),
+          HTML("&bull;"),
+          tags$a(href = "https://daattali.com/shiny/", "More apps"), "by Dean"
+      )
+  ),
+
+  fluidRow(column(
+    width = 6, offset = 3,
+    div(
+      id = "main-row",
+      actionButton("action", "Take Screenshot", icon("camera"), class = "btn-success"),
+      br(), br()
+    )
+  )),
+
+  fluidRow(
+    column(
+      3,
+      div(
+        id = "inputs",
+        selectInput("selector", "What to capture?",
+                    c("Entire page" = "body", "Timeline" = "#timeline", "Inputs" = "#inputs")),
+        sliderInput("scale", "Scale", min = 0.5, max = 3, value = 1, step = 0.5),
+        textInput("filename", "File name", "screenshot")
+      ),
+      h3("Generated code"),
+      verbatimTextOutput("code")
+    ),
+    column(
+      9,
+      h3("World Cup 2014: take a screenshot after interacting with the timeline"),
+      timevis::timevisOutput("timeline"))
+  )
+)
+
+server <- function(input, output, session) {
+  output$timeline <- timevis::renderTimevis({
+    templateWC <- function(stage, team1, team2, score1, score2) {
+      sprintf(
+        '<table><tbody>
+      <tr><td colspan="3"><em>%s</em></td></tr>
+      <tr>
+        <td>%s</td>
+        <th>&nbsp;%s - %s&nbsp;</th>
+        <td>%s</td>
+      </tr>
+      <tr>
+        <td><img src="flags/%s.png" width="31" height="20" alt="%s"></td>
+        <th></th>
+        <td><img src="flags/%s.png" width="31" height="20" alt="%s"></td>
+      </tr>
+    </tbody></table>',
+        stage, team1, score1, score2, team2, gsub("\\s", "", tolower(team1)),
+        team1, gsub("\\s", "", tolower(team2)), team2
+      )
+    }
+
+    # Data for world cup 2014
+    dataWC <- data.frame(
+      id = 1:7,
+      start = c(
+        "2014-07-04 13:00",
+        "2014-07-04 17:00",
+        "2014-07-05 13:00",
+        "2014-07-05 17:00",
+        "2014-07-08 17:00",
+        "2014-07-09 17:00",
+        "2014-07-13 16:00"
+      ),
+      content = c(
+        templateWC("quarter-finals", "France", "Germany", 0, 1),
+        templateWC("quarter-finals", "Brazil", "Colombia", 2, 1),
+        templateWC("quarter-finals", "Argentina", "Belgium", 1, 0),
+        templateWC("quarter-finals", "Netherlands", "Costa Rica", "0 (4)", "0 (3)"),
+        templateWC("semi-finals", "Brazil", "Germany", 1, 7),
+        templateWC("semi-finals", "Netherlands", "Argentina", "0 (2)", "0 (4)"),
+        templateWC("final", "Germany", "Argentina", 1, 0)
+      )
+    )
+
+    timevis::timevis(dataWC)
+  })
+
+  code <- reactive({
+    if (input$selector == "body") {
+      selector <- ""
+    } else {
+      selector <- paste0('  selector = "', input$selector, '",\n')
+    }
+    paste0(
+      'screenshot(\n',
+      selector,
+      '  scale = ', input$scale, ',\n',
+      '  filename = "', input$filename, '"\n',
+      ')'
+    )
+  })
+
+  observeEvent(input$action, {
+    eval(parse(text = code()))
+  })
+
+  output$code <- renderText({
+    paste0(
+      "library(shiny)\nlibrary(shinyscreenshot)\n\n",
+      "ui <- fluidPage(\n  # UI code\n)\n\n",
+      "server <- function(input, output) {\n  # Take a screenshot\n  ",
+      gsub("\n", "\n  ", code()),
+      "\n}\n\nshinyApp(ui, server)"
+    )
+  })
+}
+
+shinyApp(ui, server)

inst/examples/demo/www/style.css

@@ -0,0 +1,85 @@
+body {
+  padding: 0 20px;
+  background: #fafafa;
+  color: #333;
+  font-size: 16px;
+}
+
+#header {
+  text-align: center;
+  color: #fdfdfd;
+  text-shadow: 0 0 1px #000;
+  padding: 20px 5px 40px;
+  border-bottom: 1px solid #ddd;
+  margin: 0 -35px 30px;
+  background-color: #00131a;
+  background-image: url('gplay.png');
+}
+
+#pagetitle {
+  font-size: 5em;
+  text-shadow: 0 0 5px #000;
+  line-height: 1.2;
+  margin-bottom: 15px;
+}
+
+#subtitle {
+  font-size: 2em;
+  margin-bottom: 15px;
+  line-height: 1.1;
+}
+
+#subsubtitle {
+  font-size: 1.3em;
+}
+
+#subsubtitle a {
+  color: #fdfdfd;
+  text-decoration: underline;
+}
+
+@media only screen and (max-width: 979px) {
+  #header {
+    padding: 15px 5px 35px;
+  }
+  #pagetitle {
+    font-size: 4em;
+  }
+  #subtitle {
+    font-size: 1.7em;
+  }
+  #subsubtitle {
+    font-size: 1.2em;
+  }
+}
+
+@media only screen and (max-width: 767px) {
+  #pagetitle {
+    font-size: 3.5em;
+  }
+  #subtitle {
+    font-size: 1.5em;
+  }
+  #subsubtitle {
+    font-size: 1.1em;
+  }
+}
+
+#main-row {
+  text-align: center;
+}
+#action {
+  font-size: 24px;
+  margin: 10px 0;
+  width: 100%;
+}
+#code {
+  background: white;
+  text-align: left;
+}
+
+#inputs {
+  border: 1px solid #ccc;
+  padding: 10px;
+  background: #f5f5f5;
+}