##' @title termbox constants
##' @export
##' @format a locked environment
##' @useDynLib boxr, .registration = TRUE
tb <- new.env(hash=TRUE, parent=emptyenv())
## keys ----------------------------------
tb$KEY_F1 <- as.integer(0xFFFF - 0L)
tb$KEY_F2 <- as.integer(0xFFFF - 1L)
tb$KEY_F3 <- as.integer(0xFFFF - 2L)
tb$KEY_F4 <- as.integer(0xFFFF - 3L)
tb$KEY_F5 <- as.integer(0xFFFF - 4L)
tb$KEY_F6 <- as.integer(0xFFFF - 5L)
tb$KEY_F7 <- as.integer(0xFFFF - 6L)
tb$KEY_F8 <- as.integer(0xFFFF - 7L)
tb$KEY_F9 <- as.integer(0xFFFF - 8L)
tb$KEY_F10 <- as.integer(0xFFFF - 9L)
tb$KEY_F11 <- as.integer(0xFFFF - 10L)
tb$KEY_F12 <- as.integer(0xFFFF - 11L)
tb$KEY_INSERT <- as.integer(0xFFFF - 12L)
tb$KEY_DELETE <- as.integer(0xFFFF - 13L)
tb$KEY_HOME <- as.integer(0xFFFF - 14L)
tb$KEY_END <- as.integer(0xFFFF - 15L)
tb$KEY_PGUP <- as.integer(0xFFFF - 16L)
tb$KEY_PGDN <- as.integer(0xFFFF - 17L)
tb$KEY_ARROW_UP <- as.integer(0xFFFF - 18L)
tb$KEY_ARROW_DOWN <- as.integer(0xFFFF - 19L)
tb$KEY_ARROW_LEFT <- as.integer(0xFFFF - 20L)
tb$KEY_ARROW_RIGHT <- as.integer(0xFFFF - 21L)
tb$KEY_MOUSE_LEFT <- as.integer(0xFFFF - 22L)
tb$KEY_MOUSE_RIGHT <- as.integer(0xFFFF - 23L)
tb$KEY_MOUSE_MIDDLE <- as.integer(0xFFFF - 24L)
tb$KEY_MOUSE_RELEASE <- as.integer(0xFFFF - 25L)
tb$KEY_MOUSE_WHEEL_UP <- as.integer(0xFFFF - 26L)
tb$KEY_MOUSE_WHEEL_DOWN <- as.integer(0xFFFF - 27L)
tb$KEY_CTRL_TILDE <- as.integer(0x00)
tb$KEY_CTRL_2 <- as.integer(0x00)
tb$KEY_CTRL_A <- as.integer(0x01)
tb$KEY_CTRL_B <- as.integer(0x02)
tb$KEY_CTRL_C <- as.integer(0x03)
tb$KEY_CTRL_D <- as.integer(0x04)
tb$KEY_CTRL_E <- as.integer(0x05)
tb$KEY_CTRL_F <- as.integer(0x06)
tb$KEY_CTRL_G <- as.integer(0x07)
tb$KEY_BACKSPACE <- as.integer(0x08)
tb$KEY_CTRL_H <- as.integer(0x08)
tb$KEY_TAB <- as.integer(0x09)
tb$KEY_CTRL_I <- as.integer(0x09)
tb$KEY_CTRL_J <- as.integer(0x0A)
tb$KEY_CTRL_K <- as.integer(0x0B)
tb$KEY_CTRL_L <- as.integer(0x0C)
tb$KEY_ENTER <- as.integer(0x0D)
tb$KEY_CTRL_M <- as.integer(0x0D)
tb$KEY_CTRL_N <- as.integer(0x0E)
tb$KEY_CTRL_O <- as.integer(0x0F)
tb$KEY_CTRL_P <- as.integer(0x10)
tb$KEY_CTRL_Q <- as.integer(0x11)
tb$KEY_CTRL_R <- as.integer(0x12)
tb$KEY_CTRL_S <- as.integer(0x13)
tb$KEY_CTRL_T <- as.integer(0x14)
tb$KEY_CTRL_U <- as.integer(0x15)
tb$KEY_CTRL_V <- as.integer(0x16)
tb$KEY_CTRL_W <- as.integer(0x17)
tb$KEY_CTRL_X <- as.integer(0x18)
tb$KEY_CTRL_Y <- as.integer(0x19)
tb$KEY_CTRL_Z <- as.integer(0x1A)
tb$KEY_ESC <- as.integer(0x1B)
tb$KEY_CTRL_LSQ_BRACKET <- as.integer(0x1B)
tb$KEY_CTRL_3 <- as.integer(0x1B)
tb$KEY_CTRL_4 <- as.integer(0x1C)
tb$KEY_CTRL_BACKSLASH <- as.integer(0x1C)
tb$KEY_CTRL_5 <- as.integer(0x1D)
tb$KEY_CTRL_RSQ_BRACKET <- as.integer(0x1D)
tb$KEY_CTRL_6 <- as.integer(0x1E)
tb$KEY_CTRL_7 <- as.integer(0x1F)
tb$KEY_CTRL_SLASH <- as.integer(0x1F)
tb$KEY_CTRL_UNDERSCORE <- as.integer(0x1F)
tb$KEY_SPACE <- as.integer(0x20)
tb$KEY_BACKSPACE2 <- as.integer(0x7F)
tb$KEY_CTRL_8 <- as.integer(0x7F)
tb$MOD_ALT <- as.integer(0x01)
## attributes ----------------------
tb$DEFAULT <- as.integer(0x00)
tb$BLACK <- as.integer(0x01)
tb$RED <- as.integer(0x02)
tb$GREEN <- as.integer(0x03)
tb$YELLOW <- as.integer(0x04)
tb$BLUE <- as.integer(0x05)
tb$MAGENTA <- as.integer(0x06)
tb$CYAN <- as.integer(0x07)
tb$WHITE <- as.integer(0x08)
tb$BOLD <- as.integer(0x100)
tb$UNDERLINE <- as.integer(0x200)
tb$REVERSE <- as.integer(0x400)
## misc ----------------------------
tb$HIDE_CURSOR <- -1L
tb$INPUT_CURRENT <- 0L
tb$INPUT_ESC <- 1L
tb$INPUT_ALT <- 2L
tb$OUTPUT_CURRENT <- 0L
tb$OUTPUT_NORMAL <- 1L
tb$OUTPUT_256 <- 2L
tb$OUTPUT_216 <- 3L
tb$OUTPUT_GRAYSCALE <- 4L
tb$EVENT_KEY <- 1L
tb$EVENT_RESIZE <- 2L
tb$EVENT_MOUSE <- 3L
lockEnvironment(tb, bindings=TRUE)
##' These are a direct mapping of the termbox functions. Things
##' should be built on top of these as they're very primitive.
##' @title Termbox low level interface
##' @rdname termbox
##' @export
tb_init <- function() {
ok <- .Call(C_tb_init)
if (ok < 0) {
## From termbox.h:
TB_EUNSUPPORTED_TERMINAL <- -1L
TB_EFAILED_TO_OPEN_TTY <- -2L
TB_EPIPE_TRAP_ERROR <- -3L
msg <- switch(ok,
TB_EUNSUPPORTED_TERMINAL="unsupported terminal",
TB_EFAILED_TO_OPEN_TTY="failed to open tty",
TB_EPIPE_TRAP_ERROR="pipe trap error")
stop("Failed to initialise termbox: ", msg)
}
invisible(TRUE)
}
##' @rdname termbox
##' @export
tb_shutdown <- function() {
.Call(C_tb_shutdown)
}
##' @rdname termbox
##' @export
tb_width <- function() {
.Call(C_tb_width)
}
##' @rdname termbox
##' @export
tb_height <- function() {
.Call(C_tb_height)
}
##' @rdname termbox
##' @export
tb_clear <- function() {
.Call(C_tb_clear)
}
##' @rdname termbox
##' @export
##' @param fg,bg foregreound and background colours (see \code{\link{tb}}
##' for a set of values)
tb_set_clear_attributes <- function(fg, bg) {
.Call(C_tb_set_clear_attributes, fg, bg)
}
##' @rdname termbox
##' @export
tb_present <- function() {
.Call(C_tb_present)
}
##' @rdname termbox
##' @export
##' @param cx,cy x and y position of the cursor
tb_set_cursor <- function(cx, cy) {
.Call(C_tb_set_cursor, cx, cy)
}
##' @rdname termbox
##' @export
##' @param x,y x and y position of the cell
##' @param ch A single character code
tb_change_cell <- function(x, y, ch, fg, bg) {
.Call(C_tb_change_cell, x, y, ch, fg, bg)
}
##' @rdname termbox
##' @export
tb_cell_buffer <- function() {
.Call(C_tb_cell_buffer)
}
##' @rdname termbox
##' @export
##' @param mode input or output mode (see \code{tb$INPUT_*} and
##' \code{tb$INPUT_*} for possible values.
tb_select_input_mode <- function(mode) {
.Call(C_tb_select_input_mode, mode)
}
##' @rdname termbox
##' @export
tb_select_output_mode <- function(mode) {
.Call(C_tb_select_input_mode, mode)
}
##' @rdname termbox
##' @export
##' @param timeout timeout in milliseconds
tb_peek_event <- function(timeout) {
e <- .Call(C_tb_peek_event, timeout)
if (is.null(e)) NULL else tb_event(e)
}
##' @rdname termbox
##' @export
tb_poll_event <- function() {
tb_event(.Call(C_tb_poll_event))
}
## This might move into C if I can be fussed with the effort. But I
## don't see a situation where I wouldn't want to use the peek/poll
## things and *not* process the event like this.
tb_event <- function(e) {
if (e[[1]] == 0L) {
NULL
} else if (e[[1]] == tb$EVENT_KEY) {
list(type="KEY", mod=e[[2]], key=e[[3]], ch=e[[4]])
} else if (e[[2]] == tb$EVENT_RESIZE) {
list(type="RESIZE", w=e[[5]], h=e[[6]])
} else if (e[[3]] == tb$EVENT_MOUSE) {
list(type="MOUSE", w=e[[7]], h=e[[8]])
} else {
stop(sprintf("Unknown event: {%s}", paste(e, collapse=", ")))
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.