Close issues #2573 & #2576 (#2577)

* add improved debugging mode for justify_grobs

* closes #2576

* Make justify_grobs() respect internal angle of grobs. Closes #2573.

* fix regression

* add visual test

* use trigonometry

* Enable continuous rotation for all text labels, regardless of vjust/hjust setting

* code clean-up

Author: clauswilke

R/guide-colorbar.r

@@ -342,8 +342,7 @@ guide_gengrob.colorbar <- function(guide, theme) {
 
   title_width <- width_cm(grob.title)
   title_height <- height_cm(grob.title)
-  title_fontsize <- title.theme$size
-  if (is.null(title_fontsize)) title_fontsize <- 0
+  title_fontsize <- title.theme$size %||% calc_element("legend.title", theme)$size %||% 0
 
   # gap between keys etc
   # the default horizontal and vertical gap need to be the same to avoid strange
@@ -527,7 +526,13 @@ guide_gengrob.colorbar <- function(guide, theme) {
     b = 1 + max(vps$label.row), l = 1 + min(vps$label.col))
   gt <- gtable_add_grob(
     gt,
-    justify_grobs(grob.title, hjust = title.hjust, vjust = title.vjust, debug = title.theme$debug),
+    justify_grobs(
+      grob.title,
+      hjust = title.hjust,
+      vjust = title.vjust,
+      int_angle = title.theme$angle,
+      debug = title.theme$debug
+    ),
     name = "title",
     clip = "off",
     t = 1 + min(vps$title.row), r = 1 + max(vps$title.col),

R/guide-legend.r

@@ -345,8 +345,7 @@ guide_gengrob.legend <- function(guide, theme) {
 
   title_width <- width_cm(grob.title)
   title_height <- height_cm(grob.title)
-  title_fontsize <- title.theme$size
-  if (is.null(title_fontsize)) title_fontsize <- 0
+  title_fontsize <- title.theme$size %||% calc_element("legend.title", theme)$size %||% 0
 
   # gap between keys etc
   # the default horizontal and vertical gap need to be the same to avoid strange
@@ -375,17 +374,15 @@ guide_gengrob.legend <- function(guide, theme) {
     if (is.null(guide$label.theme$vjust) && is.null(theme$legend.text$vjust)) label.theme$vjust <- NULL
 
     # label.theme in param of guide_legend() > theme$legend.text.align > default
-    hjust <- x <- guide$label.hjust %||% theme$legend.text.align %||% label.theme$hjust %||%
+    hjust <- guide$label.hjust %||% theme$legend.text.align %||% label.theme$hjust %||%
       just_defaults$hjust
-    vjust <- y <- guide$label.vjust %||% label.theme$vjust %||%
+    vjust <- guide$label.vjust %||% label.theme$vjust %||%
       just_defaults$vjust
 
     grob.labels <- lapply(guide$key$.label, function(label, ...) {
       g <- element_grob(
         element = label.theme,
         label = label,
-        x = x,
-        y = y,
         hjust = hjust,
         vjust = vjust,
         margin_x = TRUE,
@@ -694,7 +691,13 @@ guide_gengrob.legend <- function(guide, theme) {
   )
   gt <- gtable_add_grob(
     gt,
-    justify_grobs(grob.title, hjust = title.hjust, vjust = title.vjust, debug = title.theme$debug),
+    justify_grobs(
+      grob.title,
+      hjust = title.hjust,
+      vjust = title.vjust,
+      int_angle = title.theme$angle,
+      debug = title.theme$debug
+    ),
     name = "title",
     clip = "off",
     t = 1 + min(vps.title.row),
@@ -714,7 +717,13 @@ guide_gengrob.legend <- function(guide, theme) {
   )
   gt <- gtable_add_grob(
     gt,
-    justify_grobs(grob.labels, hjust = hjust, vjust = vjust, debug = label.theme$debug),
+    justify_grobs(
+      grob.labels,
+      hjust = hjust,
+      vjust = vjust,
+      int_angle = label.theme$angle,
+      debug = label.theme$debug
+    ),
     name = paste("label", vps$label.row, vps$label.col, sep = "-"),
     clip = "off",
     t = 1 + vps$label.row,

R/margins.R

@@ -39,24 +39,13 @@ title_spec <- function(label, x, y, hjust, vjust, angle, gp = gpar(),
 
   if (is.null(label)) return(zeroGrob())
 
-  angle <- angle %% 360
-  if (0 <= angle & angle < 90) {
-    xp <- hjust
-    yp <- vjust
-  } else if (90 <= angle & angle < 180) {
-    xp <- 1 - vjust
-    yp <- hjust
-  } else if (180 <= angle & angle < 270) {
-    xp <- 1 - hjust
-    yp <- 1 - vjust
-  } else if (270 <= angle & angle < 360) {
-    xp <- vjust
-    yp <- 1 - hjust
-  }
+  # We rotate the justifiation values to obtain the correct x and y reference point,
+  # since hjust and vjust are applied relative to the rotated text frame in textGrob
+  just <- rotate_just(angle, hjust, vjust)
 
   n <- max(length(x), length(y), 1)
-  x <- x %||% unit(rep(xp, n), "npc")
-  y <- y %||% unit(rep(yp, n), "npc")
+  x <- x %||% unit(rep(just$hjust, n), "npc")
+  y <- y %||% unit(rep(just$vjust, n), "npc")
 
   text_grob <- textGrob(
     label,
@@ -234,14 +223,18 @@ heightDetails.titleGrob <- function(x) {
 #'   should be performed. If `NULL`, justification will be done relative to the
 #'   enclosing drawing area (i.e., `x = hjust` and `y = vjust`).
 #' @param hjust,vjust Horizontal and vertical justification of the grob relative to `x` and `y`.
+#' @param int_angle Internal angle of the grob to be justified. When justifying a text
+#'   grob with rotated text, this argument can be used to make `hjust` and `vjust` operate
+#'   relative to the direction of the text.
 #' @param debug If `TRUE`, aids visual debugging by drawing a solid
 #'   rectangle behind the complete grob area.
 #'
 #' @noRd
-justify_grobs <- function(grobs, x = NULL, y = NULL, hjust = 0.5, vjust = 0.5, debug = FALSE) {
+justify_grobs <- function(grobs, x = NULL, y = NULL, hjust = 0.5, vjust = 0.5,
+                          int_angle = 0, debug = FALSE) {
   if (!inherits(grobs, "grob")) {
     if (is.list(grobs)) {
-      return(lapply(grobs, justify_grobs, x, y, hjust, vjust, debug))
+      return(lapply(grobs, justify_grobs, x, y, hjust, vjust, int_angle, debug))
     }
     else {
       stop("need individual grob or list of grobs as argument.")
@@ -252,8 +245,12 @@ justify_grobs <- function(grobs, x = NULL, y = NULL, hjust = 0.5, vjust = 0.5, d
     return(grobs)
   }
 
-  x <- x %||% unit(hjust, "npc")
-  y <- y %||% unit(vjust, "npc")
+  # adjust hjust and vjust according to internal angle
+  just <- rotate_just(int_angle, hjust, vjust)
+
+  x <- x %||% unit(just$hjust, "npc")
+  y <- y %||% unit(just$vjust, "npc")
+
 
   if (isTRUE(debug)) {
     children <- gList(
@@ -265,14 +262,46 @@ justify_grobs <- function(grobs, x = NULL, y = NULL, hjust = 0.5, vjust = 0.5, d
     children = gList(grobs)
   }
 
-  gTree(
+
+  result_grob <- gTree(
     children = children,
     vp = viewport(
       x = x,
       y = y,
       width = grobWidth(grobs),
       height = grobHeight(grobs),
-      just = c(hjust, vjust)
+      just = unlist(just)
     )
   )
+
+
+  if (isTRUE(debug)) {
+    #cat("x, y:", c(x, y), "\n")
+    #cat("E - hjust, vjust:", c(hjust, vjust), "\n")
+    grobTree(
+      result_grob,
+      pointsGrob(x, y, pch = 20, gp = gpar(col = "mediumturquoise"))
+    )
+  } else {
+    result_grob
+  }
+}
+
+
+#' Rotate justification parameters counter-clockwise
+#'
+#' @param angle angle of rotation, in degrees
+#' @param hjust horizontal justification
+#' @param vjust vertical justification
+#' @return A list with two components, `hjust` and `vjust`, containing the rotated hjust and vjust values
+#'
+#' @noRd
+rotate_just <- function(angle, hjust, vjust) {
+  # convert angle to radians
+  rad <- (angle %||% 0) * pi / 180
+
+  hnew <- cos(rad) * hjust - sin(rad) * vjust + (1 - cos(rad) + sin(rad)) / 2
+  vnew <- sin(rad) * hjust + cos(rad) * vjust + (1 - cos(rad) - sin(rad)) / 2
+
+  list(hjust = hnew, vjust = vnew)
 }

R/plot-build.r

@@ -287,6 +287,7 @@ ggplot_gtable.ggplot_built <- function(data) {
     tag_parent <- justify_grobs(tag, x = xpos, y = ypos,
                                 hjust = theme$plot.tag$hjust,
                                 vjust = theme$plot.tag$vjust,
+                                int_angle = theme$plot.tag$angle,
                                 debug = theme$plot.tag$debug)
     plot_table <- gtable_add_grob(plot_table, tag_parent, name = "tag", t = 1,
                                   b = nrow(plot_table), l = 1,