Special grob for strips. Fixes #1286.

Author: hadley

NAMESPACE

@@ -69,6 +69,7 @@ S3method(guide_merge,colorbar)
 S3method(guide_merge,legend)
 S3method(guide_train,colorbar)
 S3method(guide_train,legend)
+S3method(heightDetails,stripGrob)
 S3method(heightDetails,titleGrob)
 S3method(heightDetails,zeroGrob)
 S3method(interleave,default)
@@ -103,6 +104,7 @@ S3method(scale_type,logical)
 S3method(scale_type,numeric)
 S3method(str,uneval)
 S3method(summary,ggplot)
+S3method(widthDetails,stripGrob)
 S3method(widthDetails,titleGrob)
 S3method(widthDetails,zeroGrob)
 export("%+%")

R/facet-labels.r

@@ -523,8 +523,16 @@ ggstrip <- function(text, horizontal = TRUE, theme) {
   text_theme <- if (horizontal) "strip.text.x" else "strip.text.y"
   if (is.list(text)) text <- text[[1]]
 
-  label <- element_render(theme, text_theme, text, expand_x = !horizontal,
-    expand_y = horizontal)
+  element <- calc_element(text_theme, theme)
+  if (inherits(element, "element_blank"))
+    return(zeroGrob())
+
+  gp <- gpar(fontsize = element$size, col = element$colour,
+    fontfamily = element$family, fontface = element$face,
+    lineheight = element$lineheight)
+
+  label <- stripGrob(text, element$hjust, element$vjust, element$angle,
+    margin = element$margin, gp = gp, debug = element$debug)
 
   ggname("strip", absoluteGrob(
     gList(
@@ -534,6 +542,7 @@ ggstrip <- function(text, horizontal = TRUE, theme) {
     width = grobWidth(label),
     height = grobHeight(label)
   ))
+
 }
 
 # Helper to adjust angle of switched strips

R/margins.R

@@ -113,3 +113,56 @@ widthDetails.titleGrob <- function(x) {
 heightDetails.titleGrob <- function(x) {
   sum(x$heights)
 }
+
+# Works like titleGrob, but designed to place one label per viewport.
+# This means it doesn't have the lengths of labels available, so must use
+# alternative layout strategy
+stripGrob <- function(label, hjust, vjust, angle = 0, gp = gpar(),
+                      margin = NULL, debug = FALSE) {
+  if (is.null(margin)) {
+    margin <- margin()
+  }
+
+  text_grob <- textGrob(label, rot = angle, gp = gp)
+
+  widths <- unit.c(margin[4], unit(1, "grobwidth", text_grob), margin[2])
+  heights <- unit.c(margin[1], unit(1, "grobheight", text_grob), margin[3])
+
+  vp <- viewport(
+    hjust, vjust, just = c(hjust, vjust),
+    width = sum(widths),
+    height = sum(heights),
+    layout = grid.layout(3, 3, heights = heights, widths = widths),
+    name = "top"
+  )
+  child_vp <- viewport(layout.pos.row = 2, layout.pos.col = 2)
+
+  if (debug) {
+    children <- gList(
+      rectGrob(gp = gpar(fill = "cornsilk", col = NA)),
+      pointsGrob(unit(hjust, "npc"), unit(vjust, "npc"), pch = 20,
+        gp = gpar(col = "gold")),
+      text_grob
+    )
+  } else {
+    children <- gList(text_grob)
+  }
+
+  gTree(
+    children = children,
+    vp = vpTree(vp, vpList(child_vp)),
+    widths = widths,
+    heights = heights,
+    cl = "stripGrob"
+  )
+}
+
+#' @export
+widthDetails.stripGrob <- function(x) {
+  sum(x$widths)
+}
+
+#' @export
+heightDetails.stripGrob <- function(x) {
+  sum(x$heights)
+}