R/make_wallpapr.R

Defines functions save_wallpapr make_wallpapr

Documented in make_wallpapr save_wallpapr

#' Make Calendar Background
#'
#' @param img character. Location of a background image.
#' @param filename character. File name of the output.
#' @param month either a date or name of a month in the current locale.
#' @param resolution "auto" to use the resolution of the input image or vector
#'   of length two with width and height of the output image.
#' @param position position of calendar in the image. Possible values are:
#'   "center", "bottom", "top", "right", "left", "bottomright", "bottomleft",
#'   "topright", "topleft" and a numeric vector of length 4 .
#' @param scale if resolution is provided, should the image be scaled down/up
#'   before cropping to the provided resolution?
#' @param colour colour of the font.
#' @param fill a colour to fill the background.
#' @param family font.
#' @param text_size size of the text in the image.
#' @param headline_factor the factor by which the name of the month is larger
#'   then the remaining text (2 means twice the size).
#' @param start_monday If TRUE the week starts on Monday, otherwise starts on
#'   Sunday.
#' @param return_plot Instead of saving to a file, return a ggplot2 plot object.
#' @param locale provide locale if you want to use non English names for months
#'   and days.
#'
#' @return saves image in file location
#' @export
#'
#' @examples
#' \dontrun{
#' make_calendar_background(
#'   system.file("extdata", "mull.jpg", package = "wallpapr")
#' )
#'
#' # put dates in upper right corner
#' make_calendar_background(
#'   system.file("extdata", "zima.png", package = "wallpapr"),
#'   position = c(2, 0, 2, 0)
#' )
#' }
#' @import ggplot2
#' @importFrom magick image_read image_scale geometry_area image_info image_crop
#' @importFrom graphics text
#' @importFrom grid rasterGrob
#' @importFrom stringi stri_datetime_symbols stri_datetime_parse
make_wallpapr <- function(img,
                          filename,
                          month = Sys.Date(),
                          resolution = "auto",
                          position = "center",
                          scale = c("width", "height"),
                          colour = "white",
                          fill = "grey",
                          family = "",
                          text_size = 9,
                          headline_factor = 2,
                          start_monday = TRUE,
                          return_plot = FALSE,
                          locale = NULL) {

  plot_data <- calender_data(
    month = month,
    headline_factor = headline_factor,
    locale = locale,
    start_monday = start_monday
  )

  imgage <- image_read(img)

  dpi <- text_size * 100

  if (isTRUE(resolution == "auto")) {
    width <- image_info(imgage)[[2]]
    height <- image_info(imgage)[[3]]
  } else if (length(resolution) >= 2) {
    width <- resolution[1]
    height <- resolution[2]
    if (!is.null(scale)) {
      if (isTRUE(scale)) {
        scale  <-  "width"
      }
      scale = match.arg(scale)
      if (isTRUE(scale == "width")) {
        scl <- image_scale(imgage, geometry_area(width = width))
        if (image_info(scl)[[3]] < height) {
          scl <- image_scale(imgage,
                             geometry_area(width = width,
                                           height = height))
        }
        imgage <- scl
      } else if (isTRUE(scale == "height")) {
        scl <- image_scale(imgage, geometry_area(height = height))
        if (image_info(scl)[[3]] < width) {
          scl <- image_scale(imgage,
                             geometry_area(width = width,
                                           height = height))
        }
        imgage <- scl
      }
    }
    imgage <- image_crop(imgage, geometry_area(width = width, height = height))
  }

  # position
  if (is.character(position)) {
    pos <- switch (position,
                   center      = c(1, 1, 1, 1),
                   bottom      = c(1, 1, 0.1, 1.9),
                   top         = c(1, 1, 1.9, 0.1),
                   right       = c(1.9, 0.1, 1, 1),
                   left        = c(0.1, 1.9, 1, 1),
                   bottomright = c(1.9, 0.1, 0.1, 1.9),
                   bottomleft  = c(0.1, 1.9, 0.1, 1.9),
                   topright    = c(1.9, 0.1, 1.9, 0.1),
                   topleft     = c(0.1, 1.9, 1.9, 0.1)
    )
  } else if (is.numeric(position)) {
    pos <- position
  }

  plot <- ggplot(
    plot_data,
    aes_string(
      x = "day",
      y = "week",
      label = "text",
      size = "size"
    )
  ) +
    annotation_custom(grid::rasterGrob(imgage)) +
    geom_text(colour = colour, family = family, show.legend = FALSE) +
    scale_size_identity() +
    scale_x_discrete(expand = expansion(mult = c(pos[1], pos[2]))) +
    scale_y_reverse(expand = expansion(mult = c(pos[3], pos[4]))) +
    theme_void() +
    theme(panel.background = element_rect(fill = fill))

  attr(plot, "dims") <- list(
    dpi = dpi,
    width = width,
    height = height
  )
  class(plot) <- c("wallpapr", class(plot))

  if (!return_plot) {
    if (missing(filename)) {
      filename <- paste0(format(
        plot_data$date[1],
        format = "%B-%Y"
      ), ".", tools::file_ext(img))
    }
    save_wallpapr(plot, filename)
    return(invisible(filename))
  } else {
    return(plot)
  }
}


#' Save wallpapr as a file
#'
#' Export the plot created with make_wallpapr to an image file.
#'
#' @param plot plot created with make_wallpapr.
#' @inheritParams make_wallpapr
#'
#' @export
save_wallpapr <- function(plot, filename) {

  dims <- attr(plot, "dims")

  ggplot2::ggsave(
    filename = filename,
    dpi = dims$dpi,
    width = dims$width / dims$dpi,
    height = dims$height / dims$dpi,
    units = "in",
    plot = plot
  )
  message("wallpaper saved as ", filename)
  return(invisible(filename))

}
JBGruber/wallpapr documentation built on Oct. 7, 2022, 1:32 p.m.