Add "stop_motion" to preview all past plots

DESCRIPTION

@@ -56,6 +56,8 @@ Suggests:
     dplyr,
     systemfonts,
     scales,
-    extrafont
+    extrafont,
+    htmltools,
+    slickR
 VignetteBuilder: knitr
 Config/testthat/edition: 3

NAMESPACE

@@ -22,8 +22,12 @@ importFrom(magick,image_read)
 importFrom(magick,image_resize)
 importFrom(magick,image_write)
 importFrom(rlang,caller_env)
+importFrom(rlang,check_installed)
 importFrom(rlang,env_bind)
 importFrom(rlang,env_unbind)
+importFrom(slickR,"%synch%")
+importFrom(slickR,settings)
+importFrom(slickR,slickR)
 importFrom(svglite,svglite)
 importFrom(tools,file_ext)
 importFrom(tools,file_path_sans_ext)

R/preview.R

@@ -33,14 +33,18 @@ preview_film <- function(){
 
 #' get list of recorded files in recording dir
 #' @noRd
-get_file_records <- function(full_path = FALSE){
+get_file_records <-
+  function(full_path = FALSE,
+           path = GG_RECORDING_ENV$recording_dir,
+           ext = GG_RECORDING_ENV$device_ext) {
 
-  file_preview_ext <- paste0("[.]", GG_RECORDING_ENV$device_ext, "$")
+
+  file_preview_ext <- paste0("[.]",ext , "$")
 
   file_preview_format <- "\\d{4}_\\d{2}_\\d{2}_\\d{2}_\\d{2}_\\d{2}[.]\\d+"
 
   list.files(
-    path    = GG_RECORDING_ENV$recording_dir,
+    path    = path,
     pattern = paste0("^",file_preview_format,file_preview_ext),
     full.names = full_path
   )
@@ -55,19 +59,7 @@ get_file_records <- function(full_path = FALSE){
 #'
 film_cyclotron <- function(IMAGE,filename = tempfile(fileext = ".html")){
 
-  image_path <- file.path(GG_RECORDING_ENV$recording_dir, IMAGE)
-  image_ext <- file_ext(IMAGE)
-
-  if(tolower(image_ext) %in% c("tiff","emf","eps","ps")){
-    temp_image <- tempfile(fileext = ".png")
-    image <- magick::image_read(image_path)
-    converted_image <- magick::image_convert(image,format = "png")
-    magick::image_write(converted_image, path = temp_image)
-    image_path <- temp_image
-    image_ext <- "png"
-  }
-
-  b64 <-  paste0("data:image/",image_ext,";base64," , base64_enc(readBin(image_path, "raw", file.info(image_path)[1, "size"])))
+  b64 <- read_image_b64(file.path(GG_RECORDING_ENV$recording_dir, IMAGE))
 
   viewer_html <- c(
     "<div style='height:100%;width:100%;'>",
@@ -302,3 +294,19 @@ film_cyclotron <- function(IMAGE,filename = tempfile(fileext = ".html")){
       sep = "\n",
       file = filename)
 }
+
+read_image_b64 <- function(path){
+
+  image_ext <- file_ext(path)
+
+  if(tolower(image_ext) %in% c("tiff","emf","eps","ps")){
+    temp_image <- tempfile(fileext = ".png")
+    image <- magick::image_read(path)
+    converted_image <- magick::image_convert(image,format = "png")
+    magick::image_write(converted_image, path = temp_image)
+    path <- temp_image
+    image_ext <- "png"
+  }
+
+  paste0("data:image/",image_ext,";base64," , base64_enc(readBin(path, "raw", file.info(path)[1, "size"])))
+}

R/show_history.R

@@ -0,0 +1,134 @@
+#' Show previous plots as a stop motion slideshow
+#'
+#' Using slickjs, preview all historical plots as a image carousel using slick js via the
+#' slickR package.
+#'
+#' slickR and htmltools must be installed for this function to operate.
+#'
+#' @param height Set the height of the carousel widget and images in pixels. Defaults to 500.
+#' @param dir directory the saved intermediate plots are in. When able, uses the set directory from `gg_record`.
+#' @param ext extension type of the saved intermediate plots to display. When able, uses the set device extention from `gg_record`.
+#'
+#' @returns Returns a slickR htmlwidget populated with the plots
+#'
+#' @examples
+#'
+#' if(require(ggplot2) & interactive()){
+#'
+#'   gg_record(dir = file.path(tempdir(),"recording"), device = "png" )
+#'   ggplot(data.frame(x = 1, y = 1), aes(x=x, y=y)) + geom_point() + ylim(0,4)
+#'   ggplot(data.frame(x = 1, y = 2), aes(x=x, y=y)) + geom_point() + ylim(0,4)
+#'
+#'   ## resize canvas of the last plot
+#'   gg_resize_film(height = 10, width = 5, dpi = 350)
+#'
+#'   ggplot(data.frame(x = 1, y = 3), aes(x=x, y=y)) + geom_point() + ylim(0,4)
+#'
+#'   stop_motion()
+#' }
+#'
+#'
+#' @importFrom rlang check_installed
+#' @importFrom slickR slickR settings %synch%
+stop_motion <- function(height = 500, dir = GG_RECORDING_ENV$recording_dir, ext = GG_RECORDING_ENV$device_ext, filename = NULL){
+
+  if(is.null(dir)){
+    stop("Set `dir` to the directory where the intermediate plots are saved in.")
+  }
+
+  check_installed("slickR", reason = "To generate the stop_motion, slickR must be installed")
+  check_installed("htmltools", reason = "To generate the stop_motion, htmltools must be installed")
+
+  stopifnot(is.numeric(height))
+  stopifnot(height > 1)
+
+
+  if(is.null(ext)){
+    warning("No file extension set. All allowable image file extentions will be used")
+  }
+
+  records <- get_file_records(full_path = FALSE, path = dir, ext = ext %||% "(png)|(pdf)|(jpeg)|(bmp)|(tiff)|(emf)|(svg)|(eps)|(ps)")
+
+  slick_content <- lapply(records, function(image_path, img_height){
+    img_ext <- tools::file_ext(image_path)
+    if(img_ext%in% c("tif", "emf", "eps", "ps")){
+      img_tag <- htmltools::tags$img(src = image_path,
+                          style = paste0(
+                            "max-height:100%;",
+                            "max-width:100%",
+                            "width:auto;height:auto;",
+                            "margin-left: auto; margin-right: auto;",
+                            "vertical-align:middle;"))
+    }else if( img_ext %in% c("pdf")){
+
+      img_tag <- htmltools::tags$img(src = pdf_to_png(file.path(dir, image_path)),
+                                     style = paste0(
+                                       "max-height:100%;",
+                                       "width:auto;height:auto;",
+                                       "margin-left: auto; margin-right: auto;",
+                                       "vertical-align:middle;"))
+    }else{
+
+      img_tag <- htmltools::tags$img(src = image_path,
+                          style = paste0(
+                            "max-height:100%;",
+                            "width:auto;height:auto;",
+                            "margin-left: auto; margin-right: auto;",
+                            "vertical-align:middle;"))
+    }
+    htmltools::tags$div(
+      img_tag,style = paste0("margin-left:auto;margin-right:auto;width:fit-content;height:",img_height,"px;")
+    )
+  }, img_height = height)
+
+  slick_carousel <- (
+    slickR::slickR(
+      slick_content,
+      height = height,
+      width = "95%") +
+      slickR::settings(infinite = FALSE)
+  )
+
+  if(is.null(filename)){
+    filename <- file.path(dir, "carousel.html")
+  }
+
+  htmltools::save_html(
+    slick_carousel,
+    file = filename
+  )
+
+  viewer <- getOption("viewer", utils::browseURL)
+
+  if (is.function(viewer) &&
+      length(filename) > 0 && interactive()) {
+    viewer(filename)
+  }
+
+  invisible()
+
+
+}
+
+pdf_to_png <- function(pdf_path, path = tempdir()){
+
+  pdf_name <- basename(pdf_path)
+  pdf_name_sans_ext <- file_path_sans_ext(pdf_name)
+
+  png_path <- normalizePath(
+    file.path(path, paste0(pdf_name_sans_ext,".png")),
+    winslash = "/"
+  )
+
+  if(!file.exists(png_path)){
+    pdftools::pdf_convert(
+      pdf = pdf_path,
+      format = 'png',
+      verbose = FALSE,
+      filenames = png_path
+      )
+  }
+
+  return(png_path)
+
+}