1#' Create a single column gtable 2#' 3#' This function stacks a list of grobs into a single column gtable of the given 4#' width and heights. 5#' 6#' @inheritParams gtable 7#' @inheritParams gtable_add_grob 8#' @param width a unit vector giving the width of this column 9#' @param vp a grid viewport object (or NULL). 10#' 11#' @return A gtable with one column and as many rows as elements in the grobs 12#' list. 13#' 14#' @family gtable construction 15#' 16#' @export 17#' 18#' @examples 19#' library(grid) 20#' a <- rectGrob(gp = gpar(fill = "red")) 21#' b <- circleGrob() 22#' c <- linesGrob() 23#' gt <- gtable_col("demo", list(a, b, c)) 24#' gt 25#' plot(gt) 26#' gtable_show_layout(gt) 27gtable_col <- function(name, grobs, width = NULL, heights = NULL, 28 z = NULL, vp = NULL) { 29 width <- width %||% unit(max(unlist(lapply(grobs, width_cm))), "cm") 30 heights <- heights %||% rep(unit(1, "null"), length(grobs)) 31 32 # z is either NULL, or a vector of the same length as grobs 33 if (!(is.null(z) || length(z) == length(grobs))) stop("z must be either NULL or the same length as grobs", call. = FALSE) 34 if (is.null(z)) { 35 z <- Inf 36 } 37 38 table <- gtable(widths = width, heights = heights, name = name, vp = vp, 39 rownames = names(grobs)) 40 table <- gtable_add_grob(table, grobs, 41 t = seq_along(grobs), l = 1, 42 z = z, clip = "off" 43 ) 44 45 table 46} 47 48#' Create a single row gtable. 49#' 50#' This function puts grobs in a list side-by-side in a single-row gtable from 51#' left to right witrh the given widths and height. 52#' 53#' @inheritParams gtable 54#' @inheritParams gtable_add_grob 55#' @param height a unit vector giving the height of this row 56#' @param vp a grid viewport object (or NULL). 57#' 58#' @return A gtable with a single row and the same number of columns as 59#' elements in the grobs list 60#' 61#' @family gtable construction 62#' 63#' @export 64#' 65#' @examples 66#' library(grid) 67#' a <- rectGrob(gp = gpar(fill = "red")) 68#' b <- circleGrob() 69#' c <- linesGrob() 70#' gt <- gtable_row("demo", list(a, b, c)) 71#' gt 72#' plot(gt) 73#' gtable_show_layout(gt) 74gtable_row <- function(name, grobs, height = NULL, widths = NULL, 75 z = NULL, vp = NULL) { 76 height <- height %||% unit(max(unlist(lapply(grobs, height_cm))), "cm") 77 widths <- widths %||% rep(unit(1, "null"), length(grobs)) 78 79 # z is either NULL, or a vector of the same length as grobs 80 if (!(is.null(z) || length(z) == length(grobs))) stop("z must be either NULL or the same length as grobs", call. = FALSE) 81 if (is.null(z)) { 82 z <- Inf 83 } 84 85 table <- gtable(widths = widths, heights = height, name = name, vp = vp, 86 colnames = names(grobs)) 87 table <- gtable_add_grob(table, grobs, 88 l = seq_along(grobs), t = 1, 89 z = z, clip = "off" 90 ) 91 92 table 93} 94 95#' Create a gtable from a matrix of grobs. 96#' 97#' This function takes a matrix of grobs and create a gtable matching with the 98#' grobs in the same position as they were in the matrix, with the given heights 99#' and widths. 100#' 101#' @inheritParams gtable 102#' @inheritParams gtable_add_grob 103#' @param z a numeric matrix of the same dimensions as `grobs`, 104#' specifying the order that the grobs are drawn. 105#' @param vp a grid viewport object (or NULL). 106#' 107#' @return A gtable of the same dimensions as the grobs matrix. 108#' 109#' @family gtable construction 110#' 111#' @export 112#' 113#' @examples 114#' library(grid) 115#' a <- rectGrob(gp = gpar(fill = "red")) 116#' b <- circleGrob() 117#' c <- linesGrob() 118#' 119#' row <- matrix(list(a, b, c), nrow = 1) 120#' col <- matrix(list(a, b, c), ncol = 1) 121#' mat <- matrix(list(a, b, c, nullGrob()), nrow = 2) 122#' 123#' gtable_matrix("demo", row, unit(c(1, 1, 1), "null"), unit(1, "null")) 124#' gtable_matrix("demo", col, unit(1, "null"), unit(c(1, 1, 1), "null")) 125#' gtable_matrix("demo", mat, unit(c(1, 1), "null"), unit(c(1, 1), "null")) 126#' 127#' # Can specify z ordering 128#' z <- matrix(c(3, 1, 2, 4), nrow = 2) 129#' gtable_matrix("demo", mat, unit(c(1, 1), "null"), unit(c(1, 1), "null"), z = z) 130gtable_matrix <- function(name, grobs, widths = NULL, heights = NULL, 131 z = NULL, respect = FALSE, clip = "on", vp = NULL) { 132 if (length(widths) != ncol(grobs)) stop("width must be the same as the number of columns in grob", call. = FALSE) 133 if (length(heights) != nrow(grobs)) stop("height must be the same as the number of rows in grob", call. = FALSE) 134 # z is either NULL or a matrix of the same dimensions as grobs 135 if (!(is.null(z) || identical(dim(grobs), dim(z)))) stop("z must be either NULL or have the same dimensions as grobs", call. = FALSE) 136 if (is.null(z)) { 137 z <- Inf 138 } 139 table <- gtable(widths = widths, heights = heights, name = name, 140 respect = respect, vp = vp, 141 rownames = rownames(grobs), colnames = colnames(grobs)) 142 table <- gtable_add_grob(table, grobs, 143 t = c(row(grobs)), l = c(col(grobs)), 144 z = as.vector(z), clip = clip 145 ) 146 147 table 148} 149 150#' Create a row/col spacer gtable. 151#' 152#' Create a zero-column or zero-row gtable with the given heights or widths 153#' respectively. 154#' 155#' @name gtable_spacer 156#' 157#' @return A gtable object 158#' 159#' @family gtable construction 160NULL 161 162#' @param widths unit vector of widths 163#' @rdname gtable_spacer 164#' @export 165gtable_row_spacer <- function(widths) { 166 gtable_add_cols(gtable(), widths) 167} 168 169#' @param heights unit vector of heights 170#' @rdname gtable_spacer 171#' @export 172gtable_col_spacer <- function(heights) { 173 gtable_add_rows(gtable(), heights) 174} 175