added fill to gpar in geom_curve()

NEWS.md

@@ -20,6 +20,10 @@
   of padding between elements (@karawoo, #2143). A `reverse` parameter allows 
   you to reverse the placement order of bars and boxes (@karawoo, #2171).
 
+* The `geom_segment()` and `geom_curve()` geoms both have a new 
+  `arrow.fill` parameter which enables specifying a separate fill colour for 
+  closed arrowheads. (@hrbrmstr and @clauswilke, #2375).
+
 * The `expand` argument for `scale_*_continuous()` and `scale_*_discrete()`
   now accepts separate expansion values for the lower and upper range
   limits. The expansion limits can be specified using the convenience

R/geom-curve.r

@@ -8,6 +8,7 @@ geom_curve <- function(mapping = NULL, data = NULL,
                        angle = 90,
                        ncp = 5,
                        arrow = NULL,
+                       arrow.fill = NULL,
                        lineend = "butt",
                        na.rm = FALSE,
                        show.legend = NA,
@@ -22,6 +23,7 @@ geom_curve <- function(mapping = NULL, data = NULL,
     inherit.aes = inherit.aes,
     params = list(
       arrow = arrow,
+      arrow.fill = arrow.fill,
       curvature = curvature,
       angle = angle,
       ncp = ncp,
@@ -38,21 +40,27 @@ geom_curve <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomCurve <- ggproto("GeomCurve", GeomSegment,
+  default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
   draw_panel = function(data, panel_params, coord, curvature = 0.5, angle = 90,
-                        ncp = 5, arrow = NULL, lineend = "butt", na.rm = FALSE) {
+                        ncp = 5, arrow = NULL, arrow.fill, lineend = "butt", na.rm = FALSE) {
+
     if (!coord$is_linear()) {
       warning("geom_curve is not implemented for non-linear coordinates",
         call. = FALSE)
     }
+
     trans <- coord$transform(data, panel_params)
 
+    arrow.fill <- arrow.fill %||% trans$colour
+
     curveGrob(
       trans$x, trans$y, trans$xend, trans$yend,
       default.units = "native",
       curvature = curvature, angle = angle, ncp = ncp,
       square = FALSE, squareShape = 1, inflect = FALSE, open = TRUE,
       gp = gpar(
         col = alpha(trans$colour, trans$alpha),
+        fill = alpha(arrow.fill, trans$alpha),
         lwd = trans$size * .pt,
         lty = trans$linetype,
         lineend = lineend),

R/geom-segment.r

@@ -12,6 +12,8 @@
 #' @inheritParams layer
 #' @inheritParams geom_point
 #' @param arrow specification for arrow heads, as created by arrow().
+#' @param arrow.fill fill color to use for the arrow head (if closed). `NULL`
+#'        means use `colour` aesthetic.
 #' @param lineend Line end style (round, butt, square).
 #' @param linejoin Line join style (round, mitre, bevel).
 #' @seealso [geom_path()] and [geom_line()] for multi-
@@ -67,6 +69,7 @@ geom_segment <- function(mapping = NULL, data = NULL,
                          stat = "identity", position = "identity",
                          ...,
                          arrow = NULL,
+                         arrow.fill = NULL,
                          lineend = "butt",
                          linejoin = "round",
                          na.rm = FALSE,
@@ -82,6 +85,7 @@ geom_segment <- function(mapping = NULL, data = NULL,
     inherit.aes = inherit.aes,
     params = list(
       arrow = arrow,
+      arrow.fill = arrow.fill,
       lineend = lineend,
       linejoin = linejoin,
       na.rm = na.rm,
@@ -99,7 +103,7 @@ GeomSegment <- ggproto("GeomSegment", Geom,
   non_missing_aes = c("linetype", "size", "shape"),
   default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
 
-  draw_panel = function(data, panel_params, coord, arrow = NULL,
+  draw_panel = function(data, panel_params, coord, arrow = NULL, arrow.fill = NULL,
                         lineend = "butt", linejoin = "round", na.rm = FALSE) {
 
     data <- remove_missing(data, na.rm = na.rm,
@@ -109,11 +113,12 @@ GeomSegment <- ggproto("GeomSegment", Geom,
 
     if (coord$is_linear()) {
       coord <- coord$transform(data, panel_params)
+      arrow.fill <- arrow.fill %||% coord$colour
       return(segmentsGrob(coord$x, coord$y, coord$xend, coord$yend,
         default.units = "native",
         gp = gpar(
           col = alpha(coord$colour, coord$alpha),
-          fill = alpha(coord$colour, coord$alpha),
+          fill = alpha(arrow.fill, coord$alpha),
           lwd = coord$size * .pt,
           lty = coord$linetype,
           lineend = lineend,