trevorld · trevorld · Apr 29, 2024 · Apr 29, 2024
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: gridpattern
 Type: Package
 Title: 'grid' Pattern Grobs
-Version: 1.2.0-5
+Version: 1.2.0-6
 Authors@R: c(person("Mike", "FC", role = "aut", comment = "Code/docs adapted from ggpattern"),
         person("Trevor L.", "Davis", role=c("aut", "cre"), email="[email protected]",
                comment = c(ORCID = "0000-0001-6341-4639")),

diff --git a/NEWS.md b/NEWS.md
@@ -18,6 +18,11 @@ New Features
   `grid::pattern()` fill object (#70).
 * The "geometry" patterns (e.g. "circle", "stripe", etc.) now allow
   the `fill` to be pattern fills (#67).
+* The "geometry" patterns (e.g. "circle", "stripe", etc.) now allow
+  the new `units` parameter to set which `grid::unit()` to use for the
+  the `spacing`, `xoffset`, and `yoffset` parameters
+  (and for the "wave" pattern also the `amplitude` and `frequency` parameters) (#58).
+  By default it will continue to be "snpc" units but can now be changed to "cm", "in", etc.
 * `update_alpha()` updates fill colour and/or pattern transparency.
 
   + It is a fork of `ggplot2::fill_alpha()` by @teunbrand.
@@ -37,6 +42,9 @@ New Features
 Bug fixes and minor improvements
 --------------------------------
 
+* The `wave` pattern no longer quietly and incorrectly ignores the `frequency` parameter.
+  The effective wavelength of the wave pattern is now `1 / frequency` instead of `spacing`.
+  However `frequency` will continue to default to `1 / spacing`.
 * `clippingPathGrob()` can now more efficiently compute a `rasterGrob()` approximation
   via `ragg::agg_capture()` and for `png_device` functions that support
   the clipping path feature such as`png(type = "cairo")`(#74).

diff --git a/R/pattern-both-rose.R b/R/pattern-both-rose.R
@@ -34,7 +34,7 @@ grid.pattern_rose <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1L, ...
                               colour = gp$col %||% "grey20",
                               fill = gp$fill %||% "grey80",
                               angle = 30, density = 0.2,
-                              spacing = 0.05, xoffset = 0, yoffset = 0,
+                              spacing = 0.05, xoffset = 0, yoffset = 0, units = "snpc",
                               frequency = 0.1,
                               grid = "square", type = NULL, subtype = NULL,
                               rot = 0,
@@ -50,7 +50,7 @@ grid.pattern_rose <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1L, ...
     if (missing(colour) && hasName(l <- list(...), "color")) colour <- l$color
     grid.pattern("rose", x, y, id,
                  colour = colour, fill = fill, angle = angle,
-                 density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset,
+                 density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset, units = units,
                  scale = scale, frequency = frequency,
                  grid = grid, type = type, subtype = subtype, rot = rot,
                  use_R4.1_masks = use_R4.1_masks, png_device = png_device, res = res,

diff --git a/R/pattern-both-text.R b/R/pattern-both-text.R
@@ -27,7 +27,7 @@ grid.pattern_text <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1L, ...
                               colour = gp$col %||% "grey20",
                               angle = 30,
                               spacing = 0.05,
-                              xoffset = 0, yoffset = 0,
+                              xoffset = 0, yoffset = 0, units = "snpc",
                               scale = 0.5,
                               shape = "X",
                               grid = "square", type = NULL, subtype = NULL, rot = 0,
@@ -43,7 +43,7 @@ grid.pattern_text <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1L, ...
     if (missing(colour) && hasName(l <- list(...), "color")) colour <- l$color
     grid.pattern("text", x, y, id,
                  colour = colour, angle = angle,
-                 spacing = spacing, xoffset = xoffset, yoffset = yoffset,
+                 spacing = spacing, xoffset = xoffset, yoffset = yoffset, units = units,
                  scale = scale, shape = shape,
                  grid = grid, type = type, subtype = subtype, rot = rot,
                  alpha = alpha, size = size, fontfamily = fontfamily, fontface = fontface,

diff --git a/R/pattern-geometry-circle.R b/R/pattern-geometry-circle.R
@@ -8,9 +8,10 @@
 #' @param fill Fill colour(s) or [grid::pattern()] / gradient object(s).
 #' @param angle Rotation angle in degrees.
 #' @param density Approx. fraction of area the pattern fills.
-#' @param spacing Spacing between repetitions of pattern ('snpc' units between 0 and 1).
-#' @param xoffset Shift pattern along x axis ('snpc' units between 0 and 1).
-#' @param yoffset Shift pattern along y axis ('snpc' units between 0 and 1).
+#' @param spacing Spacing between repetitions of pattern (in `units` units).
+#' @param xoffset Shift pattern along x axis (in `units` units).
+#' @param yoffset Shift pattern along y axis (in `units` units).
+#' @param units [grid::unit()] units for `spacing`, `xoffset`, and `yoffset` parameters.
 #' @param alpha Alpha (between 0 and 1) or `NA` (default, preserves colors' alpha value).
 #' @param linetype Stroke linetype.
 #' @param linewidth Stroke linewidth.
@@ -45,7 +46,7 @@
 #' @export
 grid.pattern_circle <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1L, ...,
                                 colour = gp$col %||% "grey20", fill = gp$fill %||% "grey80", angle = 30,
-                                density = 0.2, spacing = 0.05, xoffset = 0, yoffset = 0,
+                                density = 0.2, spacing = 0.05, xoffset = 0, yoffset = 0, units = "snpc",
                                 alpha = gp$alpha %||% NA_real_,
                                 linetype = gp$lty %||% 1,
                                 linewidth = size %||% gp$lwd %||% 1,
@@ -55,7 +56,7 @@ grid.pattern_circle <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1L, .
     if (missing(colour) && hasName(l <- list(...), "color")) colour <- l$color
     grid.pattern("circle", x, y, id,
                  colour = colour, fill = fill, angle = angle,
-                 density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset,
+                 density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset, units = units,
                  alpha = alpha, linetype = linetype, linewidth = linewidth,
                  grid = grid, type = type, subtype = subtype,
                  default.units = default.units, name = name, gp = gp , draw = draw, vp = vp)

diff --git a/R/pattern-geometry-crosshatch.R b/R/pattern-geometry-crosshatch.R
@@ -20,7 +20,7 @@ grid.pattern_crosshatch <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1
                                     colour = gp$col %||% "grey20",
                                     fill = gp$fill %||% "grey80", fill2 = fill,
                                     angle = 30, density = 0.2,
-                                    spacing = 0.05, xoffset = 0, yoffset = 0,
+                                    spacing = 0.05, xoffset = 0, yoffset = 0, units = "snpc",
                                     alpha = gp$alpha %||% NA_real_,
                                     linetype = gp$lty %||% 1,
                                     linewidth = size %||% gp$lwd %||% 1,
@@ -30,7 +30,7 @@ grid.pattern_crosshatch <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1
     if (missing(colour) && hasName(l <- list(...), "color")) colour <- l$color
     grid.pattern("crosshatch", x, y, id,
                  colour = colour, fill = fill, fill2 = fill2, angle = angle,
-                 density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset,
+                 density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset, units = units,
                  alpha = alpha, linetype = linetype, linewidth = linewidth,
                  grid = grid,
                  default.units = default.units, name = name, gp = gp , draw = draw, vp = vp)

diff --git a/R/pattern-geometry-pch.R b/R/pattern-geometry-pch.R
@@ -49,7 +49,7 @@ grid.pattern_pch <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1L, ...,
                                          colour = gp$col %||% "grey20",
                                          fill = gp$fill %||% "grey80",
                                          angle = 30, density = 0.2,
-                                         spacing = 0.05, xoffset = 0, yoffset = 0,
+                                         spacing = 0.05, xoffset = 0, yoffset = 0, units = "snpc",
                                          scale = 0.5, shape = 1L,
                                          grid = "square", type = NULL, subtype = NULL, rot = 0,
                                          alpha = gp$alpha %||% NA_real_,
@@ -61,7 +61,7 @@ grid.pattern_pch <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1L, ...,
     if (missing(colour) && hasName(l <- list(...), "color")) colour <- l$color
     grid.pattern("pch", x, y, id,
                  colour = colour, fill = fill, angle = angle,
-                 density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset,
+                 density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset, units = units,
                  scale = scale, shape = shape,
                  grid = grid, type = type, subtype = subtype, rot = rot,
                  alpha = alpha, linetype = linetype, linewidth = linewidth,

diff --git a/R/pattern-geometry-regular_polygon.R b/R/pattern-geometry-regular_polygon.R
@@ -68,7 +68,7 @@ grid.pattern_regular_polygon <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), i
                                          colour = gp$col %||% "grey20",
                                          fill = gp$fill %||% "grey80",
                                          angle = 30, density = 0.2,
-                                         spacing = 0.05, xoffset = 0, yoffset = 0,
+                                         spacing = 0.05, xoffset = 0, yoffset = 0, units = "snpc",
                                          scale = 0.5, shape = "convex4",
                                          grid = "square", type = NULL, subtype = NULL, rot = 0,
                                          alpha = gp$alpha %||% NA_real_,
@@ -80,7 +80,7 @@ grid.pattern_regular_polygon <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), i
     if (missing(colour) && hasName(l <- list(...), "color")) colour <- l$color
     grid.pattern("regular_polygon", x, y, id,
                  colour = colour, fill = fill, angle = angle,
-                 density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset,
+                 density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset, units = units,
                  scale = scale, shape = shape,
                  grid = grid, type = type, subtype = subtype, rot = rot,
                  alpha = alpha, linetype = linetype, linewidth = linewidth,

diff --git a/R/pattern-geometry-stripe.R b/R/pattern-geometry-stripe.R
@@ -18,7 +18,7 @@
 #' @export
 grid.pattern_stripe <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1L, ...,
                                 colour = gp$col %||% "grey20", fill = gp$fill %||% "grey80", angle = 30,
-                                density = 0.2, spacing = 0.05, xoffset = 0, yoffset = 0,
+                                density = 0.2, spacing = 0.05, xoffset = 0, yoffset = 0, units = "snpc",
                                 alpha = gp$alpha %||% NA_real_,
                                 linetype = gp$lty %||% 1,
                                 linewidth = size %||% gp$lwd %||% 1,
@@ -28,7 +28,7 @@ grid.pattern_stripe <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1L, .
     if (missing(colour) && hasName(l <- list(...), "color")) colour <- l$color
     grid.pattern("stripe", x, y, id,
                  colour = colour, fill = fill, angle = angle,
-                 density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset,
+                 density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset, units = units,
                  alpha = alpha, linetype = linetype, linewidth = linewidth,
                  grid = grid,
                  default.units = default.units, name = name, gp = gp , draw = draw, vp = vp)

diff --git a/R/pattern-geometry-tiling.R b/R/pattern-geometry-tiling.R
@@ -85,7 +85,7 @@
 grid.pattern_polygon_tiling <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1L, ...,
                                         colour = gp$col %||% "grey20",
                                         fill = gp$fill %||% "grey80",
-                                        angle = 30, spacing = 0.05, xoffset = 0, yoffset = 0,
+                                        angle = 30, spacing = 0.05, xoffset = 0, yoffset = 0, units = "snpc",
                                         type = "square",
                                         alpha = gp$alpha %||% NA_real_,
                                         linetype = gp$lty %||% 1,
@@ -96,7 +96,7 @@ grid.pattern_polygon_tiling <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id
     if (missing(colour) && hasName(l <- list(...), "color")) colour <- l$color
     grid.pattern("polygon_tiling", x, y, id,
                  colour = colour, fill = fill, angle = angle,
-                 spacing = spacing, xoffset = xoffset, yoffset = yoffset,
+                 spacing = spacing, xoffset = xoffset, yoffset = yoffset, units = units,
                  type = type,
                  alpha = alpha, linetype = linetype, linewidth = linewidth,
                  default.units = default.units, name = name, gp = gp , draw = draw, vp = vp)

diff --git a/R/pattern-geometry-wave.R b/R/pattern-geometry-wave.R
@@ -3,8 +3,9 @@
 #' `grid.pattern_wave()` draws a wave pattern onto the graphic device.
 #'
 #' @inheritParams grid.pattern_circle
-#' @param amplitude Wave amplitude (\dQuote{snpc} units)
-#' @param frequency Linear frequency (inverse \dQuote{snpc} units)
+#' @param units [grid::unit()] units for `amplitude`, `frequency`, `spacing`, `xoffset`, and `yoffset` parameters.
+#' @param amplitude Wave amplitude (in `units` units)
+#' @param frequency Linear frequency (in inverse `units` units)
 #' @param type Either \dQuote{sine} or \dQuote{triangle} (default).
 #' @return A grid grob object invisibly.  If `draw` is `TRUE` then also draws to the graphic device as a side effect.
 #' @examples
@@ -25,7 +26,7 @@
 #' @export
 grid.pattern_wave <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1L, ...,
                                 colour = gp$col %||% "grey20", fill = gp$fill %||% "grey80", angle = 30,
-                                density = 0.2, spacing = 0.05, xoffset = 0, yoffset = 0,
+                                density = 0.2, spacing = 0.05, xoffset = 0, yoffset = 0, units = "snpc",
                                 amplitude = 0.5 * spacing, frequency = 1 / spacing,
                                 alpha = gp$alpha %||% NA_real_,
                                 linetype = gp$lty %||% 1,
@@ -36,7 +37,7 @@ grid.pattern_wave <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1L, ...
     if (missing(colour) && hasName(l <- list(...), "color")) colour <- l$color
     grid.pattern("wave", x, y, id,
                  colour = colour, fill = fill, angle = angle,
-                 density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset,
+                 density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset, units = units,
                  amplitude = amplitude, frequency = frequency,
                  alpha = alpha, linetype = linetype, linewidth = linewidth,
                  grid = grid, type = type,
@@ -57,7 +58,7 @@ create_pattern_wave_via_sf <- function(params, boundary_df, aspect_ratio,
     vpm <- get_vp_measurements(default.units)
 
     # create grid of points large enough to cover viewport no matter the angle
-    grid_xy <- get_xy_grid(params, vpm)
+    grid_xy <- get_xy_grid(params, vpm, wavelength = TRUE)
 
     fill <- update_alpha(params$pattern_fill, params$pattern_alpha)
     col  <- update_alpha(params$pattern_colour, params$pattern_alpha)

diff --git a/R/utils-params.R b/R/utils-params.R
@@ -39,8 +39,10 @@ get_params <- function(..., pattern = "none", prefix = "pattern_", gp = gpar())
     l$pattern_type <- l$pattern_type %||% default_pattern_type(pattern)
     if (is.na(l$pattern_type))
         l$pattern_type <- default_pattern_type(pattern)
+    l$pattern_units <- l$pattern_units %||% "snpc"
     l$pattern_xoffset <- l$pattern_xoffset %||% 0
     l$pattern_yoffset <- l$pattern_yoffset %||% 0
+
     l$pattern_gravity <- l$pattern_gravity %||%
         switch(l$pattern_type, tile = "southwest", "center")
     if (is.na(l$pattern_gravity))
@@ -89,11 +91,12 @@ get_R4.1_params <- function(l) {
 }
 
 convert_params_units <- function(params, units = "bigpts") {
-    params$pattern_amplitude <- convertX(unit(params$pattern_amplitude, "snpc"), units, valueOnly = TRUE)
-    params$pattern_spacing <- convertX(unit(params$pattern_spacing, "snpc"), units, valueOnly = TRUE)
-    params$pattern_xoffset <- convertX(unit(params$pattern_xoffset, "snpc"), units, valueOnly = TRUE)
-    params$pattern_yoffset <- convertX(unit(params$pattern_yoffset, "snpc"), units, valueOnly = TRUE)
-    params$pattern_wavelength <- convertX(unit(1/params$pattern_frequency, "snpc"), units, valueOnly = TRUE)
+    p_units <- params$pattern_units
+    params$pattern_amplitude <- convertX(unit(params$pattern_amplitude, p_units), units, valueOnly = TRUE)
+    params$pattern_spacing <- convertX(unit(params$pattern_spacing, p_units), units, valueOnly = TRUE)
+    params$pattern_xoffset <- convertX(unit(params$pattern_xoffset, p_units), units, valueOnly = TRUE)
+    params$pattern_yoffset <- convertX(unit(params$pattern_yoffset, p_units), units, valueOnly = TRUE)
+    params$pattern_wavelength <- convertX(unit(1/params$pattern_frequency, p_units), units, valueOnly = TRUE)
     params
 }
 

diff --git a/README.Rmd b/README.Rmd
@@ -129,7 +129,7 @@ grid.pattern_text(x_hex, y_hex,
 grid.pattern_wave(x_hex, y_hex, colour = "black", type = "sine",
                   fill = c("red", "blue"), density = 0.4,
                   spacing = 0.15, angle = 0,
-                  amplitude = 0.05, frequency = 1 / 0.20)
+                  amplitude = 0.05, frequency = 1 / 0.15)
 ```
 ```{r weave}
 grid.pattern_weave(x_hex, y_hex, type = "satin",

diff --git a/README.md b/README.md
@@ -151,7 +151,7 @@ grid.pattern_text(x_hex, y_hex,
 grid.pattern_wave(x_hex, y_hex, colour = "black", type = "sine",
                   fill = c("red", "blue"), density = 0.4,
                   spacing = 0.15, angle = 0,
-                  amplitude = 0.05, frequency = 1 / 0.20)
+                  amplitude = 0.05, frequency = 1 / 0.15)
 ```
 
 ![](man/figures/README-wave-1.png)

diff --git a/man/grid.pattern_circle.Rd b/man/grid.pattern_circle.Rd
diff --git a/man/grid.pattern_crosshatch.Rd b/man/grid.pattern_crosshatch.Rd