Reorganise plot rendering (#6665)

* revert d35f103

* break up `ggplot_gtable()` method into smaller functions

* move `by_layer`

* scales have already been extracted from plot object

* redocument

Author: teunbrand

DESCRIPTION

@@ -213,6 +213,7 @@ Collate:
     'plot-build.R'
     'plot-construction.R'
     'plot-last.R'
+    'plot-render.R'
     'plot.R'
     'position-.R'
     'position-collide.R'

R/plot-build.R

@@ -83,7 +83,7 @@ build_ggplot <- S7::method(ggplot_build, class_ggplot) <- function(plot, ...) {
   data <- by_layer(function(l, d) l$map_statistic(d, plot), layers, data, "mapping stat to aesthetics")
 
   # Make sure missing (but required) aesthetics are added
-  plot@scales$add_missing(c("x", "y"), plot@plot_env)
+  scales$add_missing(c("x", "y"), plot@plot_env)
 
   # Reparameterise geoms from (e.g.) y and width to ymin and ymax
   data <- by_layer(function(l, d) l$compute_geom_1(d), layers, data, "setting up geom")
@@ -190,146 +190,6 @@ get_layer_grob <- function(plot = get_last_plot(), i = 1L) {
 #' @rdname ggplot_build
 layer_grob <- get_layer_grob
 
-#' Build a plot with all the usual bits and pieces.
-#'
-#' This function builds all grobs necessary for displaying the plot, and
-#' stores them in a special data structure called a [`gtable`][gtable::gtable].
-#' This object is amenable to programmatic manipulation, should you want
-#' to (e.g.) make the legend box 2 cm wide, or combine multiple plots into
-#' a single display, preserving aspect ratios across the plots.
-#'
-#' The `ggplot_gtable()` function is vestigial and the `gtable_ggplot()` function
-#' should be used instead.
-#'
-#' @seealso
-#' [print.ggplot()] and [benchplot()] for
-#' for functions that contain the complete set of steps for generating
-#' a ggplot2 plot.
-#'
-#' The `r link_book("gtable step section", "internals#sec-ggplotgtable")`
-#' @return a `gtable` object
-#' @keywords internal
-#' @param data plot data generated by [ggplot_build()]
-#' @export
-ggplot_gtable <- function(data) {
-  # TODO: Swap to S7 generic once S7/#543 is resolved
-  attach_plot_env(data@plot@plot_env)
-  UseMethod("ggplot_gtable")
-}
-
-S7::method(ggplot_gtable, class_ggplot_built) <- function(data) {
-  plot <- data@plot
-  layout <- data@layout
-  data <- data@data
-  theme <- plot@theme
-
-  geom_grobs <- by_layer(function(l, d) l$draw_geom(d, layout), plot@layers, data, "converting geom to grob")
-
-  plot_table <- layout$render(geom_grobs, data, theme, plot@labels)
-
-  # Legends
-  legend_box <- plot@guides$assemble(theme)
-  plot_table <- table_add_legends(plot_table, legend_box, theme)
-
-  # Title
-  title <- element_render(
-    theme, "plot.title", plot@labels$title,
-    margin_y = TRUE, margin_x = TRUE
-  )
-  title_height <- grobHeight(title)
-
-  # Subtitle
-  subtitle <- element_render(
-    theme, "plot.subtitle", plot@labels$subtitle,
-    margin_y = TRUE, margin_x = TRUE
-  )
-  subtitle_height <- grobHeight(subtitle)
-
-  # whole plot annotation
-  caption <- element_render(
-    theme, "plot.caption", plot@labels$caption,
-    margin_y = TRUE, margin_x = TRUE
-  )
-  caption_height <- grobHeight(caption)
-
-  # positioning of title and subtitle is governed by plot.title.position
-  # positioning of caption is governed by plot.caption.position
-  #   "panel" means align to the panel(s)
-  #   "plot" means align to the entire plot (except margins and tag)
-  title_pos <- arg_match0(
-    theme$plot.title.position %||% "panel",
-    c("panel", "plot"),
-    arg_nm = "plot.title.position",
-    error_call = expr(theme())
-  )
-
-  caption_pos <- arg_match0(
-    theme$plot.caption.position %||% "panel",
-    values = c("panel", "plot"),
-    arg_nm = "plot.caption.position",
-    error_call = expr(theme())
-  )
-
-  pans <- plot_table$layout[grepl("^panel", plot_table$layout$name), , drop = FALSE]
-  if (title_pos == "panel") {
-    title_l <- min(pans$l)
-    title_r <- max(pans$r)
-  } else {
-    title_l <- 1
-    title_r <- ncol(plot_table)
-  }
-  if (caption_pos == "panel") {
-    caption_l <- min(pans$l)
-    caption_r <- max(pans$r)
-  } else {
-    caption_l <- 1
-    caption_r <- ncol(plot_table)
-  }
-
-  plot_table <- gtable_add_rows(plot_table, subtitle_height, pos = 0)
-  plot_table <- gtable_add_grob(plot_table, subtitle, name = "subtitle",
-    t = 1, b = 1, l = title_l, r = title_r, clip = "off")
-
-  plot_table <- gtable_add_rows(plot_table, title_height, pos = 0)
-  plot_table <- gtable_add_grob(plot_table, title, name = "title",
-    t = 1, b = 1, l = title_l, r = title_r, clip = "off")
-
-  plot_table <- gtable_add_rows(plot_table, caption_height, pos = -1)
-  plot_table <- gtable_add_grob(plot_table, caption, name = "caption",
-    t = -1, b = -1, l = caption_l, r = caption_r, clip = "off")
-
-  plot_table <- table_add_tag(plot_table, plot@labels$tag, theme)
-
-  # Margins
-  plot_margin <- calc_element("plot.margin", theme) %||% margin()
-  plot_table  <- gtable_add_padding(plot_table, plot_margin)
-
-  if (is_theme_element(theme$plot.background)) {
-    plot_table <- gtable_add_grob(plot_table,
-      element_render(theme, "plot.background"),
-      t = 1, l = 1, b = -1, r = -1, name = "background", z = -Inf)
-    plot_table$layout <- plot_table$layout[c(nrow(plot_table$layout), 1:(nrow(plot_table$layout) - 1)),]
-    plot_table$grobs <- plot_table$grobs[c(nrow(plot_table$layout), 1:(nrow(plot_table$layout) - 1))]
-  }
-
-  # add alt-text as attribute
-  attr(plot_table, "alt-label") <- plot@labels$alt
-
-  plot_table
-}
-
-#' Generate a ggplot2 plot grob.
-#'
-#' @param x ggplot2 object
-#' @keywords internal
-#' @export
-ggplotGrob <- function(x) {
-  ggplot_gtable(ggplot_build(x))
-}
-
-S7::method(as.gtable, class_ggplot) <- function(x, ...) ggplotGrob(x)
-S7::method(as.gtable, class_ggplot_built) <- function(x, ...) ggplot_gtable(x)
-
 # Apply function to layer and matching data
 by_layer <- function(f, layers, data, step = NULL) {
   ordinal <- label_ordinal()
@@ -349,209 +209,3 @@ by_layer <- function(f, layers, data, step = NULL) {
   )
   out
 }
-
-# Add the tag element to the gtable
-table_add_tag <- function(table, label, theme) {
-  # Initialise the tag margins
-  table <- gtable_add_padding(table, unit(0, "pt"))
-
-  # Early exit when label is absent or element is blank
-  if (length(label) < 1) {
-    return(table)
-  }
-  element <- calc_element("plot.tag", theme)
-  if (is_theme_element(element, "blank")) {
-    return(table)
-  }
-
-  # Resolve position
-  position <- calc_element("plot.tag.position", theme) %||% "topleft"
-  location <- calc_element("plot.tag.location", theme) %||%
-    (if (is.numeric(position)) "plot" else "margin")
-
-  if (is.numeric(position)) {
-    if (location == "margin") {
-      cli::cli_abort(paste0(
-        "A {.cls numeric} {.arg plot.tag.position} cannot be used with ",
-        "`{.val margin}` as {.arg plot.tag.location}."
-      ),
-      call = expr(theme()))
-    }
-    check_length(
-      position, 2L, call = expr(theme()),
-      arg = I("A {.cls numeric} {.arg plot.tag.position}")
-    )
-    top <- left <- right <- bottom <- FALSE
-  } else {
-    # Break position into top/left/right/bottom
-    position <- arg_match0(
-      position[1],
-      c("topleft", "top", "topright", "left",
-        "right", "bottomleft", "bottom", "bottomright"),
-      arg_nm = "plot.tag.position",
-      error_call = expr(theme())
-    )
-    top    <- position %in% c("topleft",    "top",    "topright")
-    left   <- position %in% c("topleft",    "left",   "bottomleft")
-    right  <- position %in% c("topright",   "right",  "bottomright")
-    bottom <- position %in% c("bottomleft", "bottom", "bottomright")
-  }
-
-  # Resolve tag and sizes
-  tag <- element_grob(element, label = label, margin_y = TRUE, margin_x = TRUE)
-  height <- grobHeight(tag)
-  width  <- grobWidth(tag)
-
-  if (location %in% c("plot", "panel")) {
-    if (!is.numeric(position)) {
-      hjust <- try_prop(element, "hjust", default = 0.5)
-      if (right || left) {
-        x <- (1 - hjust) * width
-        if (right) {
-          x <- unit(1, "npc") - x
-        }
-      } else {
-        x <- unit(hjust, "npc")
-      }
-      if (top || bottom) {
-        vjust <- try_prop(element, "vjust", default = 0.5)
-        y <- (1 - vjust) * height
-        if (top) {
-          y <- unit(1, "npc") - y
-        }
-      } else {
-        y <- unit(vjust, "npc")
-      }
-    } else {
-      x <- unit(position[1], "npc")
-      y <- unit(position[2], "npc")
-    }
-    # Re-render with manual positions
-    tag <- element_grob(
-      element, x = x, y = y, label = label,
-      margin_y = TRUE, margin_x = TRUE
-    )
-    if (location == "plot") {
-      table <- gtable_add_grob(
-        table, tag, name = "tag", clip = "off",
-        t = 1, b = nrow(table), l = 1, r = ncol(table)
-      )
-      return(table)
-    }
-  }
-
-  if (location == "panel") {
-    place <- find_panel(table)
-  } else {
-    n_col <- ncol(table)
-    n_row <- nrow(table)
-    # Actually fill margin with relevant units
-    if (top)    table$heights <- unit.c(height, table$heights[-1])
-    if (left)   table$widths  <- unit.c(width,  table$widths[-1])
-    if (right)  table$widths  <- unit.c(table$widths[-n_col],  width)
-    if (bottom) table$heights <- unit.c(table$heights[-n_row], height)
-    place <- data_frame0(t = 1L, r = n_col, b = n_row, l = 1L)
-  }
-
-  # Shrink placement to position
-  if (top)    place$b <- place$t
-  if (left)   place$r <- place$l
-  if (right)  place$l <- place$r
-  if (bottom) place$t <- place$b
-
-  gtable_add_grob(
-    table, tag, name = "tag", clip = "off",
-    t = place$t, l = place$l, b = place$b, r = place$r
-  )
-}
-
-# Add the legends to the gtable
-table_add_legends <- function(table, legends, theme) {
-
-  if (is_zero(legends)) {
-    legends <- rep(list(zeroGrob()), 5)
-    names(legends) <- c(.trbl, "inside")
-  }
-
-  # Extract sizes
-  widths <- heights <- set_names(
-    rep(list(unit(0, "cm")), length(legends)),
-    names(legends)
-  )
-
-  empty <- vapply(legends, is_zero, logical(1))
-  widths[!empty]  <- lapply(legends[!empty], gtable_width)
-  heights[!empty] <- lapply(legends[!empty], gtable_height)
-  spacing <- calc_element("legend.box.spacing", theme) %||% unit(0.2, "cm")
-
-  # If legend is missing, set spacing to zero for that legend
-  zero    <- unit(0, "pt")
-  spacing <- lapply(empty, function(is_empty) if (is_empty) zero else spacing)
-
-  location <- switch(
-    theme$legend.location %||% "panel",
-    "plot" = plot_extent,
-    find_panel
-  )
-
-  place <- location(table)
-
-  # Add right legend
-  table <- gtable_add_cols(table, spacing$right, pos = -1)
-  table <- gtable_add_cols(table, widths$right,  pos = -1)
-  table <- gtable_add_grob(
-    table, legends$right, clip = "off",
-    t = place$t, b = place$b, l = -1, r = -1,
-    name = "guide-box-right"
-  )
-
-  # Add left legend
-  table <- gtable_add_cols(table, spacing$left, pos = 0)
-  table <- gtable_add_cols(table, widths$left,  pos = 0)
-  table <- gtable_add_grob(
-    table, legends$left, clip = "off",
-    t = place$t, b = place$b, l = 1, r = 1,
-    name = "guide-box-left"
-  )
-
-  place <- location(table)
-
-  # Add bottom legend
-  table <- gtable_add_rows(table, spacing$bottom, pos = -1)
-  table <- gtable_add_rows(table, heights$bottom, pos = -1)
-  table <- gtable_add_grob(
-    table, legends$bottom, clip = "off",
-    t = -1, b = -1, l = place$l, r = place$r,
-    name = "guide-box-bottom"
-  )
-
-  # Add top legend
-  table <- gtable_add_rows(table, spacing$top, pos = 0)
-  table <- gtable_add_rows(table, heights$top, pos = 0)
-  table <- gtable_add_grob(
-    table, legends$top, clip = "off",
-    t = 1, b = 1, l = place$l, r = place$r,
-    name = "guide-box-top"
-  )
-
-  # Add manual legend
-  place <- find_panel(table)
-  table <- gtable_add_grob(
-    table, legends$inside, clip = "off",
-    t = place$t, b = place$b, l = place$l, r = place$r,
-    name = "guide-box-inside"
-  )
-
-  table
-}
-
-plot_extent <- function(table) {
-  layout <- table$layout
-  data_frame0(
-    t = min(layout[["t"]]),
-    r = max(layout[["r"]]),
-    b = max(layout[["b"]]),
-    l = min(layout[["l"]]),
-    .size = 1L
-  )
-}