trevorld / gridpattern
Showing 2 of 10 files from the diff.

@@ -0,0 +1,89 @@
Loading
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 +
}

@@ -131,11 +131,11 @@
Loading
131 131
    if (!inherits(y, "unit")) y <- unit(y, default.units)
132 132
133 133
    gTree(pattern=pattern, x=x, y=y, id=id, params=params, legend=legend,
134 -
          name=name, gp=gp, vp=vp, cl="pattern")
134 +
          name=name, gp=gp, vp=vp, cl="gridpattern_pattern")
135 135
}
136 136
137 137
#' @export
138 -
makeContent.pattern <- function(x) {
138 +
makeContent.gridpattern_pattern <- function(x) {
139 139
    # avoid weird errors with array patterns if there is an active device open
140 140
    current_dev <- grDevices::dev.cur()
141 141
    on.exit(grDevices::dev.set(current_dev))
Files Coverage
R 94.47%
Project Totals (34 files) 94.47%
Untitled

No yaml found.

Create your codecov.yml to customize your Codecov experience

Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading