Description
In my efforts to write a grob that can word-wrap text, I need the grob to choose its height based on its width. I am encountering problems inserting such a grob into a gtable, because the grob's heightDetails() function is called before the grob is given its final width (i.e., before it is inserted into the table). As a consequence, the final height tends to be off.
Apologies for the somewhat longish reprex. It's the shortest I could make it. Also, I'm not entirely sure whether this is a gtable issue or a grid issue. Pinging @thomasp85 and @pmur002 since they may have input.
library(grid)
library(gtable)
library(rlang)
# a grob that draws a rectangle with fixed aspect ratio;
# chooses height based on width
aspect_grob <- function(asp, fill = "cornsilk") {
gTree(
asp = asp,
fill = fill,
cl = "aspect_grob"
)
}
makeContext.aspect_grob <- function(x) {
## calculate current width in pt
if (is.null(x$vp)) {
width <- convertWidth(unit(1, 'npc'), 'pt', TRUE)
} else {
n <- current.vpPath()$n %||% 0
pushViewport(x$vp)
width <- convertWidth(unit(1, 'npc'), 'pt', TRUE)
popViewport(current.vpPath()$n - n)
}
height <- x$asp*width
cat("makeContext() called; width:", width, "height:", height, "\n")
x$height <- unit(height, "pt")
x$width <- unit(width, "pt")
x
}
makeContent.aspect_grob <- function(x) {
cat("makeContent() called; width:", x$width, "height:", x$height, "\n")
g <- rectGrob(width = x$width, height = x$height, gp = gpar(fill = x$fill))
gl <- gList(g)
setChildren(x, gl)
}
heightDetails.aspect_grob <- function(x) {
cat("heightDetails() called; height:", x$height, "\n")
x$height
}
widthDetails.aspect_grob <- function(x) {
cat("widthDetails() called; width:", x$width, "\n")
x$width
}
grid.newpage()
asp_g <- aspect_grob(0.5)
gt <- gtable(
widths = unit.c(unit(1, "in"), unit(1, "null")),
heights = unit.c(grobHeight(asp_g), unit(1, "null"))
)
gt <- gtable_add_grob(gt, asp_g, t = 1, l = 2)
gt <- gtable_add_grob(gt, rectGrob(gp = gpar(fill = "palegreen")), t = 1, l = 1)
gt <- gtable_add_grob(gt, rectGrob(gp = gpar(fill = "skyblue1")), t = 2, l = 1)
gt <- gtable_add_grob(gt, rectGrob(gp = gpar(fill = "gray70")), t = 2, l = 2)
grid.draw(gt)
#> makeContext() called; width: 505.89 height: 252.945
#> heightDetails() called; height: 252.945
#> makeContext() called; width: 505.89 height: 252.945
#> heightDetails() called; height: 252.945
#> makeContext() called; width: 433.62 height: 216.81
#> makeContent() called; width: 433.62 height: 216.81
Created on 2019-08-16 by the reprex package (v0.3.0)
The problem is that the top right rectangle doesn't completely fill the available space. Its height is too small given its width. Looking at the debugging output that gets printed, we see that the final height details were based on a width of 505.89, but the final width upon drawing time is only 433.62. That causes the height of the cell to be off (too large).