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