Build a dungeon from isometric cubes with {isocubes} and {r.oguelike} and explore it interactively thanks to {eventloop}

explore-isodungeon-eventloop.R

# Using {isocubes}, {eventloop} and {r.oguelike} to move a cube around an 
# isometric 'dungeon', featuring an enemy that chases you down
# Matt Dray, June 2022

# Builds on an earlier Gist that doesn't include an enemy:
# https://gist.github.com/matt-dray/dcbd5cd2f4bdc471921e5c741a1233c0


# Move actors -------------------------------------------------------------


# Based on keypress, move player-character cube
.move_player <- function(room, kp = c("Up", "Down", "Left", "Right")) {
  
  player_loc <- which(room == "@")
  enemy_loc <- which(room == "E")
  if (length(player_loc) == 0) {
    player_loc <- enemy_loc
  }
  room[player_loc] <- "."
  
  room_y_max <- nrow(room)
  
  if (kp %in% c("Up", "Down", "Left", "Right")) {
    
    if (kp == "Up") move_to <- player_loc - 1
    if (kp == "Down") move_to <- player_loc + 1
    if (kp == "Right") move_to <- player_loc + room_y_max
    if (kp == "Left") move_to <- player_loc - room_y_max
    if (room[move_to] != "#") player_loc <- move_to
    
  }
  
  room[player_loc] <- "@"
  
  return(room)
  
}

.move_enemy <- function(room, dist) {
  
  en_loc <- which(room == "E")
  player_loc <- which(room == "@")
  n_rows <- nrow(room)
  
  ind <- c(
    n = en_loc - 1,
    s = en_loc + 1,
    e = en_loc + n_rows,
    w = en_loc - n_rows
  )
  
  tiles <- c(
    n = room[ind["n"]],
    s = room[ind["s"]],
    e = room[ind["e"]],
    w = room[ind["w"]]
  )
  
  dist <- c(
    n = if (tiles["n"] %in% c(".", "@")) dist[ind["n"]],
    s = if (tiles["s"] %in% c(".", "@")) dist[ind["s"]],
    e = if (tiles["e"] %in% c(".", "@")) dist[ind["e"]],
    w = if (tiles["w"] %in% c(".", "@")) dist[ind["w"]]
  )
  
  
  direction <- sample(names(dist[dist == min(dist)]), 1)
  en_loc_new <- ind[names(ind) == direction]
  
  room[en_loc] <- "."
  room[en_loc_new] <- "E"
  
  room
  
}


# Get distance map --------------------------------------------------------


.initiate_distance_map <- function(room) {
  
  dist <- room
  dist[which(dist != "#")] <- 0
  dist[which(dist == "#")] <- Inf
  matrix(as.numeric(dist), nrow(dist), ncol(dist))
  
}

.get_neighbours <- function(room, current) {
  
  n_rows <- nrow(room)
  
  c(
    if (room[current - n_rows] != "#") { current - n_rows },
    if (room[current - 1] != "#") { current - 1 },
    if (room[current + 1] != "#") { current + 1 },
    if (room[current + n_rows] != "#") { current + n_rows }
  )
  
}

.get_distance_map <- function(room) {
  
  dist <- .initiate_distance_map(room)
  
  start <- which(room == "@")
  frontier <- start
  visited <- c()
  
  while (length(frontier) > 0) {
    
    current  <- frontier[1]  # set first tile of frontier as current
    frontier <- frontier[!frontier == current]  # remove current tile from frontier
    visited  <- append(visited, current)  # mark current as visited
    
    neighbours <- .get_neighbours(room, current)  # get vector of neighbour indices
    neighbours <- neighbours[!neighbours %in% visited]
    
    for (neighbour in neighbours) {
      if (!neighbour %in% visited) {  # only assign distance to unvisited neighbours
        dist[neighbour] <- dist[current] + 1  # assign distance, one more than parent
      }
    }
    
    frontier <- append(frontier, neighbours)  # add neighbour to the frontier
    
  }
  
  dist
  
}


# Print map ---------------------------------------------------------------


# Print the dungeon to the viewer
.print_isodungeon <- function(room) {
  
  dungeon_h <- room
  dungeon_h[which(dungeon_h == ".")] <- 1
  dungeon_h[which(dungeon_h %in% c("#", "@", "E"))] <- 2
  dungeon_h <- matrix(as.numeric(dungeon_h), ncol = ncol(room))
  
  dungeon_c <- dungeon_h
  dungeon_c[which(dungeon_c == 1)] <- "#000000"
  
  player_loc <- which(room == "@")
  enemy_loc <- which(room == "E")
  
  if (length(player_loc) == 0 | length(enemy_loc) == 0) {
    dungeon_c[which(room == "@")] <- "#86DC3D"
    dungeon_c[which(room == "E")] <- "#86DC3D"
  } else {
    dungeon_c[which(room == "@")] <- "#0000FF"
    dungeon_c[which(room == "E")] <- "#FFFF00"
  }
  
  
  dungeon_c[which(dungeon_c == 2)] <- "#964B00"
  
  coords <- coords_heightmap(dungeon_h, col = dungeon_c)
  
  cubes  <- isocubesGrob(
    coords,
    max_y = ncol(dungeon_h) + 0.1 * ncol(dungeon_h),
    fill = coords$col,
    xo = 0.7
  )
  
  grid::grid.newpage()
  grid::grid.draw(cubes)
  
}


# Setup eventloop ---------------------------------------------------------


# Loop through keypresses and player movement
explore_isodungeon <- function(event, mouse_x, mouse_y, frame_num, fps_actual,
                               fps_target, dev_width, dev_height, ...) {
  
  .print_isodungeon(room_mat)
  
  if (!is.null(event)) {
    
    if (event$type == 'key_press') {
      kp <- event$str
      cat("Pressed", event$str, "\n")
      room_mat <<- .move_player(room_mat, kp)
      distance_mat <<- .get_distance_map(room_mat)
      enemy_loc <- which(room_mat == "E")
      if (length(enemy_loc) == 1) {
        room_mat <<- .move_enemy(room_mat, distance_mat)
      }
      .print_isodungeon(room_mat)
    }
    
    
  }
  
}


# Run eventloop -----------------------------------------------------------


# Install required packages if not already installed
# remotes::install_github("coolbutuseless/isocubes")
# remotes::install_github("coolbutuseless/eventloop")
# remotes::install_github("matt-dray/r.oguelike")
# install.packages("purrr")

# Attach required packages
library(purrr)
library(isocubes)
library(eventloop)

# Prepare procedural dungeon-room_mat matrix using {r.oguelke}
room_mat <- r.oguelike::generate_dungeon(n_col = 20, n_row = 15)
room_mat[sample(which(room_mat == "."), 1)] <- "@"
room_mat[sample(which(room_mat == "." & room_mat != "@"), 1)] <- "E"

# Prepare a breadth-first distance map to player character
distance_mat <- .get_distance_map(room_mat)

# Run loop
eventloop::run_loop(explore_isodungeon)