R/g-boy-demo.R

In cj-holmes/gameboyr:

#' Game Boy image simulator
#'
#' \code{gboy_demo()} shows the original (in greyscale), the cropped (in greyscale) and the Game Boy version of the image
#'
#' @param file Path to image file or array returned by \code{png::readPNG()} or \code{read::JPEG{}}
#' @param res Horizontal resolution of output (default = 160). Vertical resolution will be computed to match the output aspect ratio. Set to NULL for original image horizontal resolution.
#' @param crop Should the image be cropped to match the original Game Boy screen aspect ratio (default = TRUE)
#' @param ncols The number of 'greenscale' colours to use (default = 4, the original Game Boy specification)
#' @param cols The colours used in the fill scale (passed to \code{ggplot2::scale_fill_gradientn()}) defaults to an approximation of the original Game Boy shades of greem
#'
#' @return A ggplot2 plot
#' @export
gboy_demo <- function(file,
                      res=160,
                      crop=TRUE,
                      ncols=4,
                      cols=c("#0f380f", "#306230", "#8bac0f", "#9bbc0f")){

  # Read in image file or array
  if(is.matrix(file) | is.array(file)){
    raw <- file
  } else {
    if(grepl('.png', tolower(file))) raw <- png::readPNG(file)
    if(grepl('.jpg|.jpeg', tolower(file))) raw <- jpeg::readJPEG(file)
  }

  # If image has three channels (rgb) average them to get greyscale
  if(length(dim(raw)) == 3) raw <- rowMeans(raw, dims=2)

  # Extract dimensions and centre pixel of raw image
  im_y <- dim(raw)[1]
  im_x <- dim(raw)[2]
  mid_y <- round(im_y/2)
  mid_x <- round(im_x/2)


  original <-
    expand.grid(y = im_y:1, x = 1:im_x) %>%
    dplyr::mutate(g = as.vector(raw)) %>%
    dplyr::mutate(facet = "original")


  # If crop (default) to original Game Boy screen aspect ratio (160 x 140)
  if(crop){
    # Set crop aspect (default is original Game Boy screen aspect)
    asp <- 140/160

    if(im_y/im_x < asp){
      # if image is landscape, subset to full height and height/asp width
      x_crop <- floor((im_y/asp)/2)

      raw <- raw[,(mid_x-x_crop):(mid_x+x_crop)]
    } else {
      # if image is portrait or square, subset to full width and width*asp height
      y_crop <- floor((im_x*asp)/2)

      raw <-raw[(mid_y-y_crop):(mid_y+y_crop),]
    }

    # Recompute x and y dimensions of cropped image
    im_y <- dim(raw)[1]
    im_x <- dim(raw)[2]
  }


  cropped <-
    expand.grid(y = im_y:1, x = 1:im_x) %>%
    dplyr::mutate(g = as.vector(raw)) %>%
    dplyr::mutate(facet = "cropped")


  # Compute number of pixels to group by in height
  asp <- im_y/im_x
  if(is.null(res)){res <- im_x}
  height <- res * asp

  # Compute dataframe
  d <-
    expand.grid(y = im_y:1, x = 1:im_x) %>%
    dplyr::mutate(g = as.vector(raw)) %>%
    dplyr::mutate(xbin = cut(x, res, labels = FALSE, include.lowest = T),
                  ybin = cut(y, height, labels = FALSE, include.lowest = T)) %>%
    dplyr::group_by(xbin, ybin) %>%
    dplyr::summarise(g = mean(g), .groups = "drop") %>%
    dplyr::mutate(g = cut(g, ncols, labels = FALSE))

  converted <-
    d %>%
    dplyr::select(y=ybin, x=xbin, g) %>%
    dplyr::mutate(facet="converted")



  patchwork::wrap_plots(

    original %>%
      ggplot2::ggplot(ggplot2::aes(x, y))+
      ggplot2::geom_raster(ggplot2::aes(fill=g))+
      ggplot2::coord_equal()+
      ggplot2::theme_void()+
      ggplot2::theme(legend.position = "")+
      ggplot2::scale_fill_gradientn(colours = c("black", "white"))+
      ggplot2::labs(title = "Original",
                    subtitle = "Greyscale"),

    cropped %>%
      ggplot2::ggplot(ggplot2::aes(x, y))+
      ggplot2::geom_raster(ggplot2::aes(fill=g))+
      ggplot2::coord_equal()+
      ggplot2::theme_void()+
      ggplot2::theme(legend.position = "")+
      ggplot2::scale_fill_gradientn(colours = c("black", "white"))+
      ggplot2::labs(title = "Original cropped",
                    subtitle = "Greyscale"),

    converted %>%
      ggplot2::ggplot(ggplot2::aes(x, y))+
      ggplot2::geom_raster(ggplot2::aes(fill=g))+
      ggplot2::coord_equal()+
      ggplot2::theme_void()+
      ggplot2::theme(legend.position = "")+
      ggplot2::scale_fill_gradientn(colours = cols)+
      ggplot2::labs(title="Game Boy!",
                    subtitle="160x140 4 green shades")
  )
}