R/play_tetris.R

In darrennn/gamer: Classic Video Games Implemented with R

#' Tetris Game
#'
#' This function is an implementation of Tetris based on X window system.
#'
#' @export
#' @import grDevices graphics
#' @importFrom scales hue_pal
#' @importFrom stats setNames aggregate
#'
#' @param nhint the number of hint squares on the right
#' @param speed the level of speed at which block is falling
#' @param bg the initial background color. Default "skyblue".
#' @param color a named character vector representing the colors of seven tetrominoes
#' @param ... optional arguments to \code{\link[grDevices]{x11}}, except for width and height
#' @examples
#' \dontrun{
#' play_tetris()
#' }
#'
play_tetris <- function(nhint = 5, speed = 1, bg = "#a9e0f9", ...,
                        color = setNames(hue_pal()(7), c('I', 'J', 'L', 'O', 'S', 'T', 'Z'))){

  if(!is.numeric(nhint) || nhint < 0 || nhint > 5 || round(nhint) != nhint)
    stop("nhint must be an integer between 0 and 5")
  if(!is.numeric(speed) || speed < 1 || speed > 9 || round(speed) != speed)
    stop("speed must be a number between 1 and 9")
  if(length(color) != 7)
    stop("color must be a character vector of length 7")
  if(Sys.info()["sysname"] != "Windows" & !capabilities("X11"))
    stop("X Window System(X11) is not available")

  message(paste("\nKeyboard Event", "Left, Right, Down : Move",
                sprintf("%26s", "Up : Rotate"),
                sprintf("%24s", "Space : Fall"),
                sprintf("%24s", "A : Hold"),
                sprintf("%24s", "Q : Quit"),
                sep = "\n"))
  readline("\nType  <Return>\t to start : ")

  env <- new.env(parent = emptyenv())
  env$color <- list(
    BLOCK = color,
    BG = bg
  )

  grDevices::X11(width = 7, height = 7, bg = bg, ...)
  op <- par(mai = rep(0, 4))
  on.exit(par(op), add = TRUE)
  .stage0(env, nhint)
  getGraphicsEvent(prompt = "Tetris Remake",
                   onKeybd = function(key) .keydown(key, env, nhint, speed),
                   onIdle = function() .idle(env, nhint))
}