diff --git a/NEWS.md b/NEWS.md index 987506defa..16cffc09e2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,6 +17,8 @@ * `stat_boxplot()` treats `width` as an optional aesthetic (@Yunuuuu, #6575) * Fixed regression where the first (unnamed) argument to colour/fill scales was not passed as the `name` argument (@teunbrand, #6623) +* Fixed issue where vectorised `arrow()`s caused errors in drawing the + legend glyphs (@teunbrand, #6594) # ggplot2 4.0.0 diff --git a/R/legend-draw.R b/R/legend-draw.R index 621cde0aa2..fe35b0c945 100644 --- a/R/legend-draw.R +++ b/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"]] ) } @@ -211,8 +213,10 @@ draw_key_path <- function(data, params, size) { ) if (!is.null(params[["arrow"]])) { angle <- deg2rad(params[["arrow"]]$angle) - length <- convertUnit(params[["arrow"]]$length, "cm", valueOnly = TRUE) + 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 @@ -232,8 +236,10 @@ draw_key_vpath <- function(data, params, size) { ) if (!is.null(params[["arrow"]])) { angle <- deg2rad(params[["arrow"]]$angle) - length <- convertUnit(params[["arrow"]]$length, "cm", valueOnly = TRUE) + 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"]] ) }