gt table support

DESCRIPTION

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

R/gg_record.R

@@ -1,8 +1,8 @@
 #' @title Record and generate plot histories
 #'
 #' @description Record plots created over time and generate a GIF of the plots
-#'    made in the 'R' session. Overrides the print methods for ggplot and patchwork objects
-#'    from the 'ggplot2' and 'patchwork' packages respectively.
+#'    made in the 'R' session. Overrides the print methods for ggplot, patchwork, and gt_tbl objects
+#'    from the 'ggplot2', 'patchwork', and 'gt' packages respectively.
 #'
 #' @rdname Recording
 #'
@@ -12,6 +12,7 @@
 #' @param device_ext file extension to use for images created. Does not usually need to be populated manually.
 #' @return Used initialize recording, nothing returned
 #' @inheritParams ggplot2::ggsave
+#' @inheritParams webshot2::webshot
 #'
 #' @importFrom ggplot2 ggsave
 #'
@@ -40,7 +41,9 @@ gg_record <- function(dir = NULL,
                       dpi = 300,
                       limitsize = TRUE,
                       device_ext = NULL,
-                      bg = NULL
+                      bg = NULL,
+                      expand = 5,
+                      zoom = 2
 ){
 
   if (is.null(dir)) {
@@ -92,6 +95,9 @@ gg_record <- function(dir = NULL,
   GG_RECORDING_ENV$bg           <- bg
   GG_RECORDING_ENV$limitsize    <- limitsize
 
+  GG_RECORDING_ENV$expand       <- expand
+  GG_RECORDING_ENV$zoom         <- zoom
+
   GG_RECORDING_ENV$shims_registered <- FALSE
 
   register_camcorder_shims()
@@ -202,11 +208,13 @@ gg_playback <-
 #' @description resize the film for recording, reprints and saves last plot
 #'
 #' @inheritParams ggplot2::ggsave
+#' @inheritParams webshot2::webshot
 #' @export
 #'
 #' @return Returns the last plot generated, resized to new dimensions
 #'
-gg_resize_film <- function(height = NA, width = NA, units = NA, dpi = NA){
+gg_resize_film <- function(height = NA, width = NA, units = NA, dpi = NA,
+                           scale = NA, limitsize = NA, expand = NA, zoom = NA){
 
   if(!is.na(height)){
     GG_RECORDING_ENV$image_height <- height
@@ -221,6 +229,19 @@ gg_resize_film <- function(height = NA, width = NA, units = NA, dpi = NA){
   if(!is.na(dpi)){
     GG_RECORDING_ENV$image_dpi <- dpi
   }
+  if(!is.na(scale)){
+    GG_RECORDING_ENV$scale <- scale
+  }
+  if(!is.na(limitsize)){
+    GG_RECORDING_ENV$limitsize <- limitsize
+  }
+
+  if(!all(is.na(expand))){
+    GG_RECORDING_ENV$expand <- expand
+  }
+  if(!is.na(zoom)){
+    GG_RECORDING_ENV$zoom <- zoom
+  }
 
   print(GG_RECORDING_ENV$last_plot)
   invisible()

R/recording.R

@@ -89,6 +89,75 @@ record_patchwork <- function(x,...) {
 
 }
 
+#' Record gt tables
+#'
+#' @description Record gt tables as png using webshot2.
+#'
+#' @param x gt table to save
+#' @param ... allow for traditionally pass arguments to printing that are ignored
+#'
+#' @noRd
+#'
+record_gt <- function(x, ...) {
+
+  rlang::check_installed("webshot2", reason = "to record gt tables")
+
+  table_dims <- dim(x[["_data"]])
+  if (GG_RECORDING_ENV$limitsize && (table_dims[1] > 100 || table_dims[2] > 30)) {
+    rlang::abort(c(
+      "Table dimensions exceed 100x30",
+      i = "Render a subset with `gt_preview()` or use `limitsize = FALSE`"
+    ))
+  }
+
+  plot_files <-
+    file.path(GG_RECORDING_ENV$recording_dir, paste0(
+      format(Sys.time(), "%Y_%m_%d_%H_%M_%OS6"),
+      ".",
+      c("html", "png") # webshot() only supports png for raster
+    ))
+
+  # Convert to pixel for webshot()
+  as_pixel <- function(x) {
+    if (is.na(x)) {
+      return(NULL)
+    }
+    ratio <- switch(
+      GG_RECORDING_ENV$image_units,
+      "cm" = 1/2.54,
+      "mm" = 1/25.4,
+      "px" = 1,
+      "in" = 1
+    )
+    dpi_scaling <- if (GG_RECORDING_ENV$image_units == "px") {
+      1
+    } else {
+      GG_RECORDING_ENV$image_dpi
+    }
+    round(x * ratio * dpi_scaling)
+  }
+
+  suppressMessages({
+    gt::gtsave(data = x, filename = plot_files[1])
+    # Doesn't suppress webshot() messages
+    # - known issue: https://github.com/rstudio/webshot2/issues/24
+    webshot2::webshot(
+      url = plot_files[1],
+      file = plot_files[2],
+      vwidth = as_pixel(GG_RECORDING_ENV$image_width) %||% formals(webshot2::webshot)$vwidth,
+      vheight = as_pixel(GG_RECORDING_ENV$image_height) %||% formals(webshot2::webshot)$vheight,
+      selector = "table",
+      expand = GG_RECORDING_ENV$expand,
+      zoom = GG_RECORDING_ENV$zoom
+    )
+  })
+
+  preview_film()
+
+  GG_RECORDING_ENV$last_plot <- x
+
+}
+
 #' Record Plots - generic
 #'
 #' @description For plot types that don't have a special print method, use this

R/shims.R

@@ -34,6 +34,15 @@ register_camcorder_shims <- function(){
     )
   }
 
+  if("package:gt" %in% search()){
+    registerS3method(
+      genname = "print",
+      class = "gt_tbl",
+      method = "record_gt",
+      envir = getNamespace("camcorder")
+    )
+  }
+
   GG_RECORDING_ENV$shims_registered <- TRUE
 
 }
@@ -63,6 +72,15 @@ detach_camcorder_shims <- function(){
     )
   }
 
+  if("package:gt" %in% search()){
+    registerS3method(
+      genname = "print",
+      class = "gt_tbl",
+      method = "print.gt_tbl",
+      envir = getNamespace("gt")
+    )
+  }
+
   GG_RECORDING_ENV$shims_registered <- FALSE
 
 }