R/utils-magick-fill.R

In gridpattern: 'grid' Pattern Grobs

fill_types <- c('fit', 'expand', 'squish', 'none', 'tile')

#' Resize image, preserving aspect, such that one of target width or height is achieved without distoring or cropping.
#'
#' The canvas of the image will be expanded to cover the full width/height but
#' will be transparent.
#'
#' @inheritParams fill_area_with_img
#'
#' @return magick image of the required dimensions
#'
#' @examples
#' try({
#'   filename <- system.file("img", "Rlogo.png", package="png")
#'   img <- magick::image_read(filename)
#'   fill_area_with_img_fit(img, 100, 400)
#' })
#' @noRd
fill_area_with_img_fit <- function(img, width, height, gravity = 'Center', filter = 'lanczos') {

  geometry <- magick::geometry_size_pixels(width = width, height = height, preserve_aspect = TRUE)
  img      <- magick::image_resize(img, geometry = geometry, filter=filter)
  img      <- magick::image_extent(img, geometry, gravity = gravity)

  img
}

#' Resize image, ignoring aspect, such that both the target width and height is achieved.
#'
#' Unless the width and height are carefully chosen, this operation will distort
#' the image to force it to fit the dimensions
#'
#' @inheritParams fill_area_with_img
#'
#' @return magick image of the required dimensions
#'
#' @examples
#' try({
#'   filename <- system.file("img", "Rlogo.png", package="png")
#'   img <- magick::image_read(filename)
#'   fill_area_with_img_squish(img, 100, 400)
#' })
#' @noRd
fill_area_with_img_squish <- function(img, width, height, filter='lanczos') {
  geometry <- magick::geometry_size_pixels(width = width, height = height,
                                           preserve_aspect = FALSE)
  img <- magick::image_resize(img, geometry = geometry, filter=filter)
  img
}


#' Resize image, preserving aspect, such that when cropped, the target width and height is achieved.
#'
#' Unless the width and height are carefully chosen, this operation will distort
#' the image to force it to fit the dimensions
#'
#' @inheritParams fill_area_with_img
#'
#' @return magick image of the required dimensions
#'
#' @examples
#' try({
#'   filename <- system.file("img", "Rlogo.png", package="png")
#'   img <- magick::image_read(filename)
#'   fill_area_with_img_expand(img, 100, 400)
#' })
#' @noRd
fill_area_with_img_expand <- function(img, width, height, gravity = 'Center', filter='lanczos') {
  img_info   <- magick::image_info(img)
  img_aspect <- img_info$width/img_info$height
  area_aspect <- width/height
  if (area_aspect > img_aspect) {
    scale_width  <- width
    scale_height <- width / img_aspect
  } else if (area_aspect < img_aspect) {
    scale_height <- height
    scale_width  <- height * img_aspect
  } else {
    scale_height <- height
    scale_width  <- width
  }

  # expand
  geometry <- magick::geometry_size_pixels(width = scale_width, height = scale_height, preserve_aspect = FALSE)
  img      <- magick::image_resize(img, geometry = geometry, filter=filter)

  # crop
  geometry <- magick::geometry_size_pixels(width = width, height = height, preserve_aspect = FALSE)
  img      <- magick::image_crop(img, geometry = geometry, gravity = gravity)

  img
}


#' Resize image canvas to the target width/height, and use gravity to place the undistorted image
#'
#' Unless the width and height are carefully chosen, this operation will distort
#' the image to force it to fit the dimensions
#'
#' @inheritParams fill_area_with_img
#'
#' @return magick image of the required dimensions
#'
#' @examples
#' try({
#'   filename <- system.file("img", "Rlogo.png", package="png")
#'   img <- magick::image_read(filename)
#'   fill_area_with_img_none(img, 100, 400)
#' })
#' @noRd
fill_area_with_img_none <- function(img, width, height, gravity = 'Center',
                                    filter = 'lanczos', scale = 1) {


  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Scale if requested
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  scale <- update_scale(scale, img, width, height)
  if (scale != 1) {
    geometry <- magick::geometry_size_percent(width = scale * 100)
    img      <- magick::image_resize(img, geometry, filter = filter)
  }


  geometry <- magick::geometry_size_pixels(width = width, height = height, preserve_aspect = TRUE)
  img      <- magick::image_extent(img, geometry, gravity = gravity)

  img
}

# if `scale == -1` scale to img width, if `scale == -2` scale to img height
update_scale <- function(scale, img, width, height) {
  if (scale == -1) {
    info   <- magick::image_info(img)
    width/info$width
  } else if (scale == -2) {
    info   <- magick::image_info(img)
    height/info$height
  } else {
    scale
  }
}

#' Tile image to fill the specified area
#'
#' @return magick image of the required dimensions
#' @noRd
fill_area_with_img_tile <- function(img, width, height, gravity = "SouthWest", filter = filter, scale = 1) {

  scale <- update_scale(scale, img, width, height)
  if (scale != 1) {
    geometry <- magick::geometry_size_percent(width = scale * 100)
    img      <- magick::image_resize(img, geometry, filter = filter)
  }

  img_info <- magick::image_info(img)
  n_width <- width %/% img_info$width + as.integer(width %% img_info$width > 0)
  n_height <- height %/% img_info$height + as.integer(height %% img_info$height > 0)
  rows <- magick::image_append(rep(img, n_width))
  tiled <- magick::image_append(rep(rows, n_height), stack=TRUE)

  geometry <- magick::geometry_size_pixels(width = width, height = height, preserve_aspect = FALSE)

  cropped <- magick::image_crop(tiled, geometry = geometry, gravity = gravity)

  cropped
}

#' Fill an area with a magick image
#'
#' Support fill types
#'
#' \itemize{
#' \item{\code{fit   }}{ - Fill image canvas, preserving aspect, such that one of target width or height is achieved without distoring or cropping.}
#' \item{\code{squish}}{ - Fill image canvas, ignoring aspect, such that both the target width and height is achieved.}
#' \item{\code{expand}}{ - Fill image canvas, by scaling image and preserving aspect, such that when cropped, the target width and height is achieved.}
#' \item{\code{none  }}{ - Fill image canvas canvas to the target width/height, and use gravity to place the undistorted image}
#' \item{\code{tile  }}{ - Tile the image canvas with image.}
#' }
#'
#' @param img magick image
#' @param width,height target dimensions for final image
#' @param type how to resize the image. 'none', 'fit', 'squish', 'expand' or 'tile'. default: squish
#' @param gravity how to anchor the image during the operation. See \code{magick::gravity_types()}
#' @param filter magick filter type. default: lanczos. See \code{magick::filter_types()}
#'        for more information.  This option has no effect for \code{type = 'none'}.
#' @param scale scale the source image before tiling. default: 1
#' @param filter default: lanczos
#'
#' @return magick image of the required dimensions
#'
#' @examples
#' try({
#'   filename <- system.file("img", "Rlogo.png", package="png")
#'   img <- magick::image_read(filename)
#'   fill_area_with_img(img, 100, 400, type = 'squish')
#' })
#' @noRd
fill_area_with_img <- function(img, width, height, type='squish',
                               gravity = 'Center', filter='lanczos',
                               scale = 1) {

  if (length(width) != 1 || length(height) != 1 ||
      is.na(width) || is.na(height) ||
      width <= 0 || height <= 0) {
    return(img)
  }

  type <- check_default(type, fill_types)

  switch(
    type,
    fit    = fill_area_with_img_fit   (img, width, height, gravity = gravity, filter = filter),
    expand = fill_area_with_img_expand(img, width, height, gravity = gravity, filter = filter),
    squish = fill_area_with_img_squish(img, width, height                   , filter = filter),
    none   = fill_area_with_img_none  (img, width, height, gravity = gravity, filter = filter, scale = scale),
    tile   = fill_area_with_img_tile  (img, width, height, gravity = gravity, filter = filter, scale = scale),
    {
      warn("fill_area_with_img(): resize not understood: '", type,
           "', using 'squish'")
      fill_area_with_img_squish(img, width, height)
    }
  )
}