Last active
June 22, 2024 16:56
-
-
Save matt-dray/dcbd5cd2f4bdc471921e5c741a1233c0 to your computer and use it in GitHub Desktop.
Build a dungeon from isometric cubes with {isocubes} and {r.oguelike} and explore it interactively thanks to {eventloop}
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Using {isocubes}, {eventloop} and {r.oguelike} to move a cube around an | |
# isometric 'dungeon' | |
# Matt Dray, June 2022 | |
# Builds to a later Gist that includes an enemy: | |
# https://gist.github.com/matt-dray/a2db654bc7c09a7be1f1d32cdc3e1a45 | |
# 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) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment