R/pattern-array-image.R

In gridpattern: 'grid' Pattern Grobs

#' Image patterned grobs
#'
#' `grid.pattern_image()` draws an image pattern onto the graphic device.
#'
#' Here is a description of the `type` arguments:
#' \describe{
#'   \item{expand}{Scale the image beyond the bounding box and crop it such that
#'                 the image fully covers the width and the height of the region.}
#'   \item{fit}{Scale the image such that either the width or the height of the image fits in the bounding box.
#'              Affected by `gravity`}
#'   \item{none}{Position a single image in the region without attempting to scale to the bounding box size.
#'               Affected by `scale` and `gravity`.}
#'   \item{squish}{Distort the image to cover the bounding box of the region.}
#'   \item{tile}{Repeat the image to cover the bounding box.  Affected by `tile`.}
#'  }
#'
#' @inheritParams grid.pattern_plasma
#' @param filename Image of filename or URL
#' @param type Image scaling type
#' @param gravity Position of image within area.  `magick::gravity_types()` returns a vector of supported values.
#' @param filter Filter to use when scaling. `magick::filter_types()` returns a vector of supported values.
#' @return A grid grob object invisibly.  If `draw` is `TRUE` then also draws to the graphic device as a side effect.
#' @examples
#'   \donttest{# May emit a "CPU time > 2.5 times elapsed time" NOTE in a CRAN check
#'   if (requireNamespace("magick")) {
#'     x_hex <- 0.5 + 0.5 * cos(seq(2 * pi / 4, by = 2 * pi / 6, length.out = 6))
#'     y_hex <- 0.5 + 0.5 * sin(seq(2 * pi / 4, by = 2 * pi / 6, length.out = 6))
#'     logo_filename <- system.file("img", "Rlogo.png" , package = "png")
#'     grid.pattern_image(x_hex, y_hex, filename = logo_filename, type = "fit")
#'   }
#'   if (requireNamespace("magick")) {
#'     # "tile" `type` image pattern depends on `magick` functionality
#'     # which is not reliable across platforms
#'     grid::grid.newpage()
#'     try(grid.pattern_image(x_hex, y_hex, filename = logo_filename,
#'                            type = "tile"))
#'   }
#'   }
#' @seealso [grid.pattern_placeholder()] is an image pattern that uses images
#'          downloaded from the internet.
#'          [reset_image_cache()] resets the image cache used by `grid.pattern_image()`
#'          and [grid.pattern_placeholder()].
#' @export
grid.pattern_image <- function(
	x = c(0, 0, 1, 1),
	y = c(1, 0, 0, 1),
	id = 1L,
	...,
	filename = "",
	type = "fit",
	scale = 1,
	gravity = switch(type, tile = "southwest", "center"),
	filter = "lanczos",
	alpha = gp$alpha %||% NA_real_,
	aspect_ratio = 1,
	key_scale_factor = 1,
	res = getOption("ggpattern_res", 72),
	default.units = "npc",
	name = NULL,
	gp = gpar(),
	draw = TRUE,
	vp = NULL
) {
	grid.pattern(
		"gridpattern::image",
		x,
		y,
		id,
		filename = filename,
		type = type,
		scale = scale,
		gravity = gravity,
		filter = filter,
		alpha = alpha,
		aspect_ratio = aspect_ratio,
		key_scale_factor = key_scale_factor,
		res = res,
		default.units = default.units,
		name = name,
		gp = gp,
		draw = draw,
		vp = vp
	)
}

#' Read a user specified filename/URL as an image
#'
#' @inheritParams create_gradient_as_array
#'
#' @return array
#'
#' @noRd
img_read_as_array_wrapper <- function(width, height, params, legend) {
	assert_suggested("magick", "image")

	filename <- as.character(params$pattern_filename)

	fill_type <- tolower(as.character(params$pattern_type))
	fill_type <- check_default(fill_type, options = fill_types)

	gravity <- tolower(as.character(params$pattern_gravity))
	gravity <- check_default(gravity, tolower(magick::gravity_types()), 'center')

	filter <- tolower(as.character(params$pattern_filter))
	filter <- check_default(filter, tolower(magick::filter_types()), 'lanczos')

	scale <- params$pattern_scale
	scale <- check_default(scale, default = 1, type = 'numeric')

	img_read_as_array(
		filename = filename,
		width = width,
		height = height,
		fill_type = fill_type,
		gravity = gravity,
		filter = filter,
		scale = scale
	)
}