1#' Add a single grob, possibly spanning multiple rows or columns. 2#' 3#' This only adds grobs into the table - it doesn't affect the table layout in 4#' any way. In the gtable model, grobs always fill up the complete table 5#' cell. If you want custom justification you might need to define the grob 6#' dimension in absolute units, or put it into another gtable that can then be 7#' added to the gtable instead of the grob. 8#' 9#' @param x a [gtable()] object 10#' @param grobs a single grob or a list of grobs 11#' @param t a numeric vector giving the top extent of the grobs 12#' @param l a numeric vector giving the left extent of the grobs 13#' @param b a numeric vector giving the bottom extent of the grobs 14#' @param r a numeric vector giving the right extent of the grobs 15#' @param z a numeric vector giving the order in which the grobs should be 16#' plotted. Use `Inf` (the default) to plot above or `-Inf` 17#' below all existing grobs. By default positions are on the integers, 18#' giving plenty of room to insert new grobs between existing grobs. 19#' @param clip should drawing be clipped to the specified cells 20#' (`"on"`), the entire table (`"inherit"`), or not at all 21#' (`"off"`) 22#' @param name name of the grob - used to modify the grob name before it's 23#' plotted. 24#' 25#' @return A gtable object with the new grob(s) added 26#' 27#' @family gtable manipulation 28#' 29#' @export 30#' 31#' @examples 32#' library(grid) 33#' 34#' gt <- gtable(widths = unit(c(1, 1), 'null'), heights = unit(c(1, 1), 'null')) 35#' pts <- pointsGrob(x = runif(5), y = runif(5)) 36#' 37#' # Add a grob to a single cell (top-right cell) 38#' gt <- gtable_add_grob(gt, pts, t = 1, l = 2) 39#' 40#' # Add a grob spanning multiple cells 41#' gt <- gtable_add_grob(gt, pts, t = 1, l = 1, b = 2) 42#' 43#' plot(gt) 44#' 45gtable_add_grob <- function(x, grobs, t, l, b = t, r = l, z = Inf, clip = "on", name = x$name) { 46 if (!is.gtable(x)) stop("x must be a gtable", call. = FALSE) 47 if (is.grob(grobs)) grobs <- list(grobs) 48 if (!is.list(grobs)) stop("grobs must either be a single grob or a list of grobs", call. = FALSE) 49 n_grobs <- length(grobs) 50 51 if (is.logical(clip)) { 52 clip <- ifelse(clip, "on", "off") 53 } 54 55 layout <- unclass(x$layout) 56 57 # Check that inputs have the right length 58 if (!all(vapply( 59 list(t, r, b, l, z, clip, name), len_same_or_1, 60 logical(1), n_grobs 61 ))) { 62 stop("Not all inputs have either length 1 or same length same as 'grobs'") 63 } 64 65 # If z is just one value, replicate to same length as grobs 66 z <- rep(z, length.out = n_grobs) 67 68 # Get the existing z values from x$layout, and new non-Inf z-values 69 zval <- c(layout$z, z[!is.infinite(z)]) 70 if (length(zval) == 0) { 71 # If there are no existing finite z values, set these so that 72 # -Inf values get assigned ..., -2, -1, 0 and 73 # +Inf values get assigned 1, 2, 3, ... 74 zmin <- 1 75 zmax <- 0 76 } else { 77 zmin <- min(zval) 78 zmax <- max(zval) 79 } 80 z[z == -Inf] <- zmin - rev(seq_len(sum(z == -Inf))) 81 z[z == Inf] <- zmax + seq_len(sum(z == Inf)) 82 83 x_row <- length(x$heights) 84 x_col <- length(x$widths) 85 86 t <- rep(neg_to_pos(t, x_row), length.out = n_grobs) 87 b <- rep(neg_to_pos(b, x_row), length.out = n_grobs) 88 l <- rep(neg_to_pos(l, x_col), length.out = n_grobs) 89 r <- rep(neg_to_pos(r, x_col), length.out = n_grobs) 90 clip <- rep(clip, length.out = n_grobs) 91 name <- rep(name, length.out = n_grobs) 92 93 x$grobs <- c(x$grobs, grobs) 94 95 x$layout <- new_data_frame(list( 96 t = c(layout$t, t), 97 l = c(layout$l, l), 98 b = c(layout$b, b), 99 r = c(layout$r, r), 100 z = c(layout$z, z), 101 clip = c(layout$clip, clip), 102 name = c(layout$name, name) 103 )) 104 105 x 106} 107