Skip to content

Commit

Permalink
clean up grid code
Browse files Browse the repository at this point in the history
  • Loading branch information
thomasp85 committed Oct 25, 2024
1 parent 5805a64 commit c6cdff6
Show file tree
Hide file tree
Showing 2 changed files with 5 additions and 24 deletions.
1 change: 0 additions & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,6 @@ S3method(dimnames,gtable)
S3method(heightDetails,gtable)
S3method(length,gtable)
S3method(makeContent,gtable)
S3method(makeContext,gTableChild)
S3method(makeContext,gtable)
S3method(plot,gtable)
S3method(print,gtable)
Expand Down
28 changes: 5 additions & 23 deletions R/grid.R
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ gtable_layout <- function(x) {

vpname <- function(row) {
row <- unclass(row)
paste(row$name, ".", row$t, "-", row$r, "-", row$b, "-", row$l, sep = "")
paste0(row$name, ".", row$t, "-", row$r, "-", row$b, "-", row$l)
}

#' @export
Expand All @@ -51,30 +51,18 @@ makeContext.gtable <- function(x) {

#' @export
makeContent.gtable <- function(x) {
child_name <- vpname(x$layout)
children_vps <- mapply(child_vp,
vp_name = vpname(x$layout),
vp_name = child_name,
t = .subset2(x$layout, "t"), r = .subset2(x$layout, "r"),
b = .subset2(x$layout, "b"), l = .subset2(x$layout, "l"),
clip = .subset2(x$layout, "clip"),
SIMPLIFY = FALSE
)
x$grobs <- mapply(wrap_gtableChild, x$grobs, children_vps,
x$grobs <- mapply(grobTree, x$grobs, name = child_name, vp = children_vps,
SIMPLIFY = FALSE
)
setChildren(x, do.call("gList", x$grobs[order(.subset2(x$layout, "z"))]))
}

#' @export
makeContext.gTableChild <- function(x) {
if (is.null(x$vp)) {
x$vp <- x$wrapvp
} else {
x$vp <- vpStack(x$wrapvp, x$vp)
}
# A gTableChild extends an arbitrary grob class
# so allow existing makeContext() behaviour of
# original grob class to still occur
NextMethod()
setChildren(x, inject(gList(!!!x$grobs[order(.subset2(x$layout, "z"))])))
}

# Return the viewport for a child grob in a gtable
Expand All @@ -84,9 +72,3 @@ child_vp <- function(vp_name, t, r, b, l, clip) {
layout.pos.col = l:r, clip = clip
)
}

# Turn a grob into a gtableChild, and store information about the
# viewport used within the gtable
wrap_gtableChild <- function(grob, vp) {
grobTree(grob, name = vp$name, vp = vp)
}

0 comments on commit c6cdff6

Please sign in to comment.