|
1 |
+ |
#' Clip grob using another grob to specify the clipping path |
|
2 |
+ |
#' |
|
3 |
+ |
#' `clippingPathGrob()` clips a grob using another grob to specify the clipping path |
|
4 |
+ |
#' |
|
5 |
+ |
#' @param clippee Grob to be clipped |
|
6 |
+ |
#' @param clipper Grob that defines clipping region |
|
7 |
+ |
#' @param use_R4.1_clipping If `TRUE` use the grid clipping path feature introduced in R v4.1.0 |
|
8 |
+ |
#' else do a `rasterGrob` approximation. |
|
9 |
+ |
#' Note not all graphic devices support the grid clipping path feature. |
|
10 |
+ |
#' @param png_device \dQuote{png} graphics device to use if `use_R4.1_clipping` is `FALSE`. |
|
11 |
+ |
#' If `NULL` (default) will use `ragg::agg_png()` if the |
|
12 |
+ |
#' suggested package `ragg` is available else `grDevices::png()`. |
|
13 |
+ |
#' @param res Resolution of desired `rasterGrob` in pixels per inch if `use_R4.1_clipping` is `FALSE`. |
|
14 |
+ |
#' @return A `grid` grob |
|
15 |
+ |
#' @inheritParams grid::polygonGrob |
|
16 |
+ |
#' @examples |
|
17 |
+ |
#' if (capabilities("png") && require("grid")) { |
|
18 |
+ |
#' clippee <- patternGrob("circle", gp = gpar(col = "black", fill = "yellow"), |
|
19 |
+ |
#' spacing = 0.1, density = 0.5) |
|
20 |
+ |
#' angle <- seq(2 * pi / 4, by = 2 * pi / 6, length.out = 7) |
|
21 |
+ |
#' x_hex_outer <- 0.5 + 0.5 * cos(angle) |
|
22 |
+ |
#' y_hex_outer <- 0.5 + 0.5 * sin(angle) |
|
23 |
+ |
#' x_hex_inner <- 0.5 + 0.25 * cos(rev(angle)) |
|
24 |
+ |
#' y_hex_inner <- 0.5 + 0.25 * sin(rev(angle)) |
|
25 |
+ |
#' clipper <- grid::pathGrob(x = c(x_hex_outer, x_hex_inner), |
|
26 |
+ |
#' y = c(y_hex_outer, y_hex_inner), |
|
27 |
+ |
#' rule = "evenodd") |
|
28 |
+ |
#' clipped <- clippingPathGrob(clippee, clipper, use_R4.1_clipping = FALSE) |
|
29 |
+ |
#' grid.newpage() |
|
30 |
+ |
#' grid.draw(clipped) |
|
31 |
+ |
#' } |
|
32 |
+ |
#' @export |
|
33 |
+ |
clippingPathGrob <- function(clippee, clipper, |
|
34 |
+ |
use_R4.1_clipping = getOption("ggpattern_use_R4.1_clipping", FALSE), |
|
35 |
+ |
png_device = NULL, res = 72, |
|
36 |
+ |
name = NULL, gp = gpar(), vp = NULL) { |
|
37 |
+ |
if (use_R4.1_clipping) { |
|
38 |
+ |
grob_clip <- grobTree(clippee, vp = viewport(clip = clipper), name = "clip") |
|
39 |
+ |
grobTree(grob_clip, name = name, gp = gp, vp = vp) |
|
40 |
+ |
} else { |
|
41 |
+ |
gTree(clippee = clippee, clipper = clipper, |
|
42 |
+ |
res = res, png_device = png_device, |
|
43 |
+ |
name=name, gp=gp, vp=vp, cl="gridpattern_clip") |
|
44 |
+ |
} |
|
45 |
+ |
} |
|
46 |
+ |
|
|
47 |
+ |
#' @export |
|
48 |
+ |
makeContent.gridpattern_clip <- function(x) { |
|
49 |
+ |
current_dev <- grDevices::dev.cur() |
|
50 |
+ |
on.exit(grDevices::dev.set(current_dev)) |
|
51 |
+ |
|
|
52 |
+ |
height <- x$res * convertHeight(unit(1, "npc"), "in", valueOnly = TRUE) |
|
53 |
+ |
width <- x$res * convertWidth(unit(1, "npc"), "in", valueOnly = TRUE) |
|
54 |
+ |
png_clippee <- tempfile(fileext = ".png") |
|
55 |
+ |
on.exit(unlink(png_clippee)) |
|
56 |
+ |
if (is.null(x$png_device)) { |
|
57 |
+ |
if (requireNamespace("ragg", quietly = TRUE)) |
|
58 |
+ |
png_device <- ragg::agg_png |
|
59 |
+ |
else |
|
60 |
+ |
png_device <- grDevices::png |
|
61 |
+ |
} |
|
62 |
+ |
|
|
63 |
+ |
png_device(png_clippee, height = height, width = width, bg = "transparent") |
|
64 |
+ |
|
|
65 |
+ |
grid.draw(x$clippee) |
|
66 |
+ |
dev.off() |
|
67 |
+ |
|
|
68 |
+ |
png_clipper <- tempfile(fileext = ".png") |
|
69 |
+ |
on.exit(unlink(png_clipper)) |
|
70 |
+ |
png_device(png_clipper, height = height, width = width, bg = "transparent") |
|
71 |
+ |
pushViewport(viewport(gp = gpar(lwd = 0, col = NA, fill = "black"))) |
|
72 |
+ |
grid.draw(x$clipper) |
|
73 |
+ |
popViewport() |
|
74 |
+ |
dev.off() |
|
75 |
+ |
|
|
76 |
+ |
raster_clippee <- png::readPNG(png_clippee, native = FALSE) |
|
77 |
+ |
raster_clipper <- png::readPNG(png_clipper, native = FALSE) |
|
78 |
+ |
clip_region <- apply(raster_clipper, c(1,2), function(x) any(x > 0)) |
|
79 |
+ |
if (length(dim(raster_clippee) == 2)) { |
|
80 |
+ |
raster_clippee[!clip_region] <- 0 |
|
81 |
+ |
} else { |
|
82 |
+ |
for (j in seq_len(dim(raster_clippee)[3])) { |
|
83 |
+ |
raster_clippee[!clip_region, j] <- 0 |
|
84 |
+ |
} |
|
85 |
+ |
} |
|
86 |
+ |
grob <- rasterGrob(raster_clippee, name = "clip") |
|
87 |
+ |
gl <- gList(grob) |
|
88 |
+ |
setChildren(x, gl) |
|
89 |
+ |
} |
trevorld
