From e5abb05a8ae8a4268dbcffaa300fc82d353b59b1 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 14 Dec 2023 11:59:15 +0100
Subject: [PATCH] Arrow key size (#5565)

* adjust `draw_key_{v}path()`

* adjust derived keys

* Add news bullet
---
 NEWS.md         |  2 ++
 R/legend-draw.R | 36 +++++++++++++++++++++++++++++-------
 2 files changed, 31 insertions(+), 7 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 55dffd0401..96b0f65b80 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* Legend keys that can draw arrows have their size adjusted for arrows.
+
 * The `trans` argument in scales and secondary axes has been renamed to 
   `transform`. The `trans` argument itself is deprecated. To access the
   transformation from the scale, a new `get_transformation()` method is 
diff --git a/R/legend-draw.R b/R/legend-draw.R
index 8ee116f65c..a7b692a05f 100644
--- a/R/legend-draw.R
+++ b/R/legend-draw.R
@@ -160,8 +160,7 @@ draw_key_path <- function(data, params, size) {
   } else {
     data$linetype[is.na(data$linetype)] <- 0
   }
-
-  segmentsGrob(0.1, 0.5, 0.9, 0.5,
+  grob <- segmentsGrob(0.1, 0.5, 0.9, 0.5,
     gp = gpar(
       col = alpha(data$colour %||% data$fill %||% "black", data$alpha),
       fill = alpha(params$arrow.fill %||% data$colour
@@ -172,12 +171,19 @@ draw_key_path <- function(data, params, size) {
     ),
     arrow = params$arrow
   )
+  if (!is.null(params$arrow)) {
+    angle <- deg2rad(params$arrow$angle)
+    length <- convertUnit(params$arrow$length, "cm", valueOnly = TRUE)
+    attr(grob, "width")  <- cos(angle) * length * 1.25
+    attr(grob, "height") <- sin(angle) * length * 2
+  }
+  grob
 }
 
 #' @export
 #' @rdname draw_key
 draw_key_vpath <- function(data, params, size) {
-  segmentsGrob(0.5, 0.1, 0.5, 0.9,
+  grob <- segmentsGrob(0.5, 0.1, 0.5, 0.9,
     gp = gpar(
       col = alpha(data$colour %||% data$fill %||% "black", data$alpha),
       lwd = (data$linewidth %||% 0.5) * .pt,
@@ -186,6 +192,13 @@ draw_key_vpath <- function(data, params, size) {
     ),
     arrow = params$arrow
   )
+  if (!is.null(params$arrow)) {
+    angle <- deg2rad(params$arrow$angle)
+    length <- convertUnit(params$arrow$length, "cm", valueOnly = TRUE)
+    attr(grob, "width")  <- sin(angle) * length * 2
+    attr(grob, "height") <- cos(angle) * length * 1.25
+  }
+  grob
 }
 
 #' @export
@@ -215,10 +228,14 @@ draw_key_linerange <- function(data, params, size) {
 #' @export
 #' @rdname draw_key
 draw_key_pointrange <- function(data, params, size) {
-  grobTree(
-    draw_key_linerange(data, params, size),
+  linerange <- draw_key_linerange(data, params, size)
+  grob <- grobTree(
+    linerange,
     draw_key_point(transform(data, size = (data$size %||% 1.5) * 4), params)
   )
+  attr(grob, "width")  <- attr(linerange, "width")
+  attr(grob, "height") <- attr(linerange, "height")
+  grob
 }
 
 #' @export
@@ -227,10 +244,15 @@ draw_key_smooth <- function(data, params, size) {
   data$fill <- alpha(data$fill %||% "grey60", data$alpha)
   data$alpha <- 1
 
-  grobTree(
+  path <- draw_key_path(data, params, size)
+
+  grob <- grobTree(
     if (isTRUE(params$se)) rectGrob(gp = gpar(col = NA, fill = data$fill)),
-    draw_key_path(data, params, size)
+    path
   )
+  attr(grob, "width") <- attr(path, "width")
+  attr(grob, "height") <- attr(path, "height")
+  grob
 }
 
 #' @export