game-raycaster.RmdNavigate a “3d” environment using the cursor keys.
This is not an instructive example on how to write a raycast engine,
but more a demonstration of how far {eventloop} can go.
Note: No wall collisions. No handling of out-of-bound navigation
library(eventloop)
library(grid)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Generate a random N*N map
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
N <- 9
set.seed(1)
map <- matrix(sample(c(0L, 1L), N*N, replace = TRUE, prob = c(0.85, 0.3)), N, N)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Ensure there are walls at each edge
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
map[1,] <- 1L
map[N,] <- 1L
map[,1] <- 1L
map[,N] <- 1L
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Data.frame representation of points so I have total control on how
# the map is rendered later
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
map_df <- expand.grid(y = seq(N)-0.5, x = seq(N)-0.5)
map_df$val <- as.vector(map)
map_df$col <- ifelse(map_df$val == 1, 'grey70', 'white')
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Raycast into a map returning a vector of distances and types
#
# @param x0,y0 user position
# @param direction viewing angle in degrees
#
# @return list(dists, types)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
raycast <- function(x0, y0, direction, fov = 60, Nrays = 100) {
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Calculate all the rays to encompass the given field-of-view
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ray_spread <- seq(-fov/2, fov/2, length.out = Nrays)
angle_deg <- direction + ray_spread
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Calculate angle (in radians) and the quadrant this is in
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
theta_orig <- angle_deg * pi/180
theta <- rep(theta_orig, each = N)
quadrant <- as.integer( (angle_deg %% 360) / 90) + 1L
quadrant <- rep(quadrant, each=N)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Intercepts with horizontal walls
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
yfrac <- 1 - (y0 - floor(y0))
yfrac <- rep(yfrac, N)
dx <- 1/tan(theta)
dx <- rep(dx, N)
dy <- ifelse(quadrant %in% 1:2, 1, -1)
yfrac <- ifelse(quadrant %in% 1:2, yfrac, 1 - yfrac)
dx <- ifelse(quadrant %in% 1:2, dx, -dx)
mults <- yfrac + rep(seq.int(0, N-1L), times = Nrays)
horx <- x0 + mults * dx
hory <- y0 + mults * dy
# If outside the boundary, then set to NA
idx <- horx > 0 & horx < N & hory > 0 & hory < N
horx[!idx] <- NA_real_
hory[!idx] <- NA_real_
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Intercepts with vertical walls
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
xfrac <- 1 - (x0 - floor(x0))
xfrac <- rep(xfrac, N)
dy <- tan(theta)
dy <- rep(dy, N)
dx <- ifelse(quadrant %in% c(1L, 4L), 1, -1)
xfrac <- ifelse(quadrant %in% c(1L, 4L), xfrac, 1 - xfrac)
dy <- ifelse(quadrant %in% c(1L, 4L), dy, -dy)
mults <- xfrac + rep(seq.int(0, N-1L), times = Nrays)
verx = x0 + mults * dx
very = y0 + mults * dy
# If outside the boundary, then set to NA
idx <- verx > 0 & verx < N & very > 0 & very < N
verx[!idx] <- NA_real_
very[!idx] <- NA_real_
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# - Find the closest hit of the horizontal and vertical intercepts which intersect
# with a square containing a '1'
# - Calculate the distance to the eye at (x0, y0)
# - Determine whether the intersection was a horitonatl or vertical intercept
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
hhits_y <- ifelse(quadrant %in% 1:2, hory + 1, hory)
hhits_x <- ceiling(horx)
vhits_y <- ceiling(very)
vhits_x <- ifelse(quadrant %in% c(1L, 4L), verx + 1, verx)
hhits <- map[cbind(hhits_y, hhits_x)]
vhits <- map[cbind(vhits_y, vhits_x)]
hray <- rep(seq(Nrays), each = N)
vray <- rep(seq(Nrays), each = N)
htype <- rep(1L, length(hory))
vtype <- rep(2L, length(very))
hidx <- which(hhits == 1)
vidx <- which(vhits == 1)
fhorx <- horx[hidx]
fhory <- hory[hidx]
fhray <- hray[hidx]
fverx <- verx[vidx]
fvery <- very[vidx]
fvray <- vray[vidx]
x <- c(fhorx, fverx)
y <- c(fhory, fvery)
ray <- c(fhray, fvray)
type <- c(htype[hidx], vtype[vidx])
raw_dists <- sqrt( (x - x0)^2 + (y - y0)^2 )
dists <- aggregate(raw_dists, by = list(ray = ray), min)$x
# Correct for fish eye / lens distortion
dists0 <- dists
dists <- dists * cos(ray_spread * pi/180)
# Precalculate some heights
heights <- 0.75 * 1/dists
# work out the type of ray. was this a vertical or horitonal intercept?
# I think this is wrong, but it works somehow???
sray <- sort(ray)
types <- type[order(ray, raw_dists)]
types <- aggregate(types, list(ray = sray), head, 1)$x
list(
dists0 = dists0,
dists = dists,
heights = heights,
types = types,
Nrays = Nrays,
theta = theta_orig
)
}
plot_raycast <- function(res, show_map = FALSE) {
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Plot the DDA view
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
dunit <- 'cm'
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Sky and ground
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
grid.rect(gp = gpar(fill='lightblue'))
grid.rect(y = 0.25, height = 0.5, gp = gpar(fill = 'grey30'))
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Draw the walls
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
fill <- c('#004588', '#002366')[res$types]
grid.rect(
x = ((res$Nrays:1)-0.5)/res$Nrays,
width = 1/res$Nrays,
# height = (N - dists2)/15,
height = res$heights,
gp = gpar(col=NA, fill=fill)
)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Overhead view of the map
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (show_map) {
grid.rect(x = map_df$x, y = map_df$y, width = 1, height = 1, default.units = dunit,
gp = gpar(fill = map_df$col, col = 'grey50', alpha = 0.5))
grid.points(x0, y0, default.units = dunit)
xh <- x0 + res$dists0 * cos(res$theta)
yh <- y0 + res$dists0 * sin(res$theta)
grid.polyline(
x = c(rbind(x0, xh)),
y = c(rbind(y0, yh)),
default.units = dunit,
gp = gpar(
col = 'darkgreen',
lwd = 1,
alpha = 0.5
),
id = rep(seq(res$Nrays), each = 2)
)
}
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Globals- starting user position and direction
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
x0 <- 4.7
y0 <- 3.4
angle <- 0
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Update the view within the eventloop depending on users control using
#' the arrow keys
#'
#' Press ESC to quit.
#'
#' @param event The event from the graphics device. Is NULL when no event
#' occurred. Otherwise has `type` element set to:
#' `event$type = 'mouse_down'`
#' - an event in which a mouse button was pressed
#' - `event$button` gives the index of the button
#' `event$type = 'mouse_up'`
#' - a mouse button was released
#' `event$type = 'mouse_move'`
#' - mouse was moved
#' `event$type = 'key_press'`
#' - a key was pressed
#' - `event$str` String describing which key was pressed.
#' See \code{grDevices::setGraphicsEventHandlers} for more information.
#' @param mouse_x,mouse_y current location of mouse within window in normalised
#' coordinates in the range [0, 1]. If mouse is
#' not within window, this will be set to the last available coordinates
#' @param frame_num Current frame number (integer)
#' @param fps_actual,fps_target the curent framerate and the framerate specified
#' by the user
#' @param dev_width,dev_height the width and height of the output device. Note:
#' this does not cope well if you resize the window
#' @param ... any extra arguments ignored
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
wolf <- function(event, mouse_x, mouse_y, frame_num, fps_actual,
fps_target, dev_width, dev_height, ...) {
grid::grid.rect(gp = grid::gpar(fill = 'black'))
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Keyboard control Left/Right/Up
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (!is.null(event) && event$type == 'key_press') {
if (event$str == 'Left') {
angle <<- angle + 3
} else if (event$str == 'Right') {
angle <<- angle - 3
} else if (event$str == 'Up') {
x0 <<- x0 + cos(angle * pi/180)/10
y0 <<- y0 + sin(angle * pi/180)/10
} else if (event$str == 'Down') {
x0 <<- x0 - cos(angle * pi/180)/10
y0 <<- y0 - sin(angle * pi/180)/10
}
}
res <- raycast(x0, y0, angle)
plot_raycast(res, show_map = TRUE)
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Start the event loop. Press ESC to quit
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
eventloop::run_loop(wolf, fps_target = 30)Since an interactive window cannot be captured in a vignette, a video screen capture has been taken of the window and included below.