add arrow logic to other line-ish keys

Author: teunbrand

R/legend-draw.R

@@ -44,10 +44,12 @@ draw_key_abline <- function(data, params, size) {
   segmentsGrob(0, 0, 1, 1,
     gp = gg_par(
       col = alpha(data$colour %||% data$fill %||% "black", data$alpha),
+      fill = alpha(params$arrow.fill %||% data$colour %||% data$fill %||% "black", data$alpha),
       lwd = data$linewidth %||% 0.5,
       lty = data$linetype %||% 1,
       lineend = params$lineend %||% "butt"
-    )
+    ),
+    arrow = params[["arrow"]]
   )
 }
 
@@ -212,7 +214,9 @@ draw_key_path <- function(data, params, size) {
   if (!is.null(params[["arrow"]])) {
     angle <- deg2rad(params[["arrow"]]$angle)
     length <- convertUnit(params[["arrow"]]$length[1], "cm", valueOnly = TRUE)
+    # grob spans '0.8 * full width', so multiply by 1/0.8
     attr(grob, "width")  <- cos(angle) * length * 1.25
+    # arrow is symmetric, so double height
     attr(grob, "height") <- sin(angle) * length * 2
   }
   grob
@@ -233,7 +237,9 @@ draw_key_vpath <- function(data, params, size) {
   if (!is.null(params[["arrow"]])) {
     angle <- deg2rad(params[["arrow"]]$angle)
     length <- convertUnit(params[["arrow"]]$length[1], "cm", valueOnly = TRUE)
+    # arrow is symmetric, so double width
     attr(grob, "width")  <- sin(angle) * length * 2
+    # grob spans '0.8 * full height', so multiply by 1/0.8
     attr(grob, "height") <- cos(angle) * length * 1.25
   }
   grob
@@ -369,14 +375,26 @@ draw_key_label <- function(data, params, size) {
 #' @export
 #' @rdname draw_key
 draw_key_vline <- function(data, params, size) {
-  segmentsGrob(0.5, 0, 0.5, 1,
+  # main difference between `draw_key_vline` and `draw_key_vpath` is that
+  # `draw_key_vline` spans the whole height
+  grob <- segmentsGrob(0.5, 0, 0.5, 1,
     gp = gg_par(
       col = alpha(data$colour %||% data$fill %||% "black", data$alpha),
+      fill = alpha(params$arrow.fill %||% data$colour %||% data$fill %||% "black", data$alpha),
       lwd = data$linewidth %||% 0.5,
       lty = data$linetype %||% 1,
       lineend = params$lineend %||% "butt"
-    )
+    ),
+    arrow = params[["arrow"]]
   )
+  if (!is.null(params[["arrow"]])) {
+    angle <- deg2rad(params[["arrow"]]$angle)
+    length <- convertUnit(params[["arrow"]]$length[1], "cm", valueOnly = TRUE)
+    # arrow is symmetric, so use double the width
+    attr(grob, "width")  <- sin(angle) * length * 2
+    attr(grob, "height") <- cos(angle) * length
+  }
+  grob
 }
 
 #' @export
@@ -385,16 +403,17 @@ draw_key_timeseries <- function(data, params, size) {
   if (is.null(data$linetype)) {
     data$linetype <- 0
   }
-
   grid::linesGrob(
     x = c(0, 0.4, 0.6, 1),
     y = c(0.1, 0.6, 0.4, 0.9),
     gp = gg_par(
       col = alpha(data$colour %||% data$fill %||% "black", data$alpha),
+      fill = alpha(params$arrow.fill %||% data$colour %||% data$fill %||% "black", data$alpha),
       lwd = data$linewidth %||% 0.5,
       lty = data$linetype %||% 1,
       lineend = params$lineend %||% "butt",
       linejoin = params$linejoin %||% "round"
-    )
+    ),
+    arrow = params[["arrow"]]
   )
 }