## ----include = FALSE----------------------------------------------------------
knitr::opts_knit$set(purl = FALSE)

ggwebgl_truthy <- function(x) {
  tolower(x) %in% c("1", "true", "yes", "y")
}

ggwebgl_ci_vars <- c(
  "CI",
  "GITHUB_ACTIONS",
  "GITLAB_CI",
  "BUILDKITE",
  "TRAVIS",
  "APPVEYOR",
  "CIRCLECI",
  "JENKINS_URL"
)
ggwebgl_is_ci <- any(vapply(Sys.getenv(ggwebgl_ci_vars), ggwebgl_truthy, logical(1)))
ggwebgl_is_check <- nzchar(Sys.getenv("_R_CHECK_PACKAGE_NAME_"))
ggwebgl_eval_code <- !ggwebgl_is_ci &&
  !ggwebgl_is_check &&
  (
    ggwebgl_truthy(Sys.getenv("NOT_CRAN")) ||
      ggwebgl_truthy(Sys.getenv("GGWEBGL_EVAL_COVERAGE_VIGNETTE"))
  )
ggwebgl_eval_widgets <- ggwebgl_eval_code &&
  ggwebgl_truthy(Sys.getenv("GGWEBGL_EVAL_LIVE_WIDGETS"))

knitr::opts_chunk$set(collapse = TRUE, comment = "#>", eval = ggwebgl_eval_code)
if (file.exists("../DESCRIPTION") && requireNamespace("pkgload", quietly = TRUE)) {
  pkgload::load_all("..", export_all = FALSE, helpers = FALSE, quiet = TRUE)
} else {
  library(ggWebGL)
}

boids4r_available <- requireNamespace("boids4R", quietly = TRUE)

## ----eval = ggwebgl_eval_code-------------------------------------------------
# if (!boids4r_available) {
#   cat("boids4R is unavailable, so live custom corridor widgets are skipped.\n")
# } else if (!ggwebgl_eval_widgets) {
#   cat("boids4R is available, but live custom corridor widgets are skipped because live widget evaluation is disabled.\n")
# } else {
#   cat("boids4R is available; live custom corridor widgets will be rendered below.\n")
# }

## ----include = FALSE, eval = ggwebgl_eval_code--------------------------------
# simulate_custom_corridor <- function(stronger_avoidance = FALSE, seed = 221L) {
#   bounds <- matrix(
#     c(-2.4, -1.35, 2.4, 1.35),
#     ncol = 2,
#     dimnames = list(c("x", "y"), c("min", "max"))
#   )
# 
#   n_school <- 96L
#   n_scout <- 32L
#   n_boids <- n_school + n_scout
#   school_axis <- seq(0, 1, length.out = n_school)
#   scout_axis <- seq(0, 1, length.out = n_scout)
#   positions <- rbind(
#     cbind(-2.18 + 0.83 * school_axis, -0.70 + 0.95 * abs(sin(pi * school_axis))),
#     cbind(-2.22 + 0.77 * scout_axis, 0.28 + 0.64 * abs(cos(pi * scout_axis)))
#   )
#   velocity_phase <- seq(0, 2 * pi, length.out = n_boids)
#   velocities <- cbind(
#     0.35 + 0.20 * cos(velocity_phase),
#     0.08 * sin(velocity_phase)
#   )
# 
#   custom_state <- boids4R::boids_state(
#     n_boids,
#     "2d",
#     bounds = bounds,
#     positions = positions,
#     velocities = velocities,
#     species = c(rep("school", n_school), rep("scout", n_scout))
#   )
# 
#   custom_world <- boids4R::boids_world(
#     "2d",
#     bounds = bounds,
#     boundary = "reflect",
#     obstacles = data.frame(
#       x = c(-0.82, -0.05, 0.72),
#       y = c(0.42, -0.36, 0.48),
#       radius = c(0.30, 0.36, 0.31)
#     ),
#     predators = data.frame(
#       x = -0.25,
#       y = 0.92,
#       radius = 0.58,
#       strength = 1.2
#     ),
#     attractors = data.frame(
#       x = 2.08,
#       y = -0.86,
#       strength = 0.95
#     )
#   )
# 
#   params <- boids4R::boids_params(
#     "2d",
#     separation_weight = 1.35,
#     alignment_weight = 0.94,
#     cohesion_weight = 0.62,
#     obstacle_weight = if (isTRUE(stronger_avoidance)) 2.8 else 2.5,
#     predator_weight = if (isTRUE(stronger_avoidance)) 3.2 else 2.3,
#     goal_weight = if (isTRUE(stronger_avoidance)) 0.20 else 0.16,
#     max_speed = 1.18,
#     max_force = 0.12,
#     noise = 0.001
#   )
# 
#   boids4R::simulate_boids(
#     custom_state,
#     custom_world,
#     params,
#     steps = 240L,
#     record_every = 3L,
#     seed = seed
#   )
# }
# 
# render_custom_corridor <- function(name, stronger_avoidance = FALSE, seed = 221L) {
#   sim <- simulate_custom_corridor(stronger_avoidance = stronger_avoidance, seed = seed)
#   spec <- ggWebGL:::ggwebgl_boids_display_spec(
#     sim,
#     boid_size = 4.4,
#     prey_size = 5.0,
#     predator_size = 8.0,
#     current_alpha = 0.96,
#     trail_alpha = 0.18,
#     vector_mode = "current",
#     vector_colour_mode = "species",
#     vector_every = 1L,
#     vector_alpha = 0.68,
#     vector_width = 1.25,
#     vector_scale = 0.14,
#     obstacle_mode = "ring",
#     obstacle_segments = 48L,
#     obstacle_alpha = 0.9,
#     trail = "recent",
#     trail_length = 32L,
#     shader = "default",
#     speed = 1.5,
#     fps = 24L
#   )
#   spec$labels$title <- paste("boids4R custom corridor:", name)
#   ggWebGL::ggWebGL(spec, height = 500)
# }

## ----baseline-corridor, eval = ggwebgl_eval_widgets---------------------------
# if (!boids4r_available) {
#   cat("Baseline corridor widget skipped.\n")
# } else {
#   render_custom_corridor("baseline", stronger_avoidance = FALSE, seed = 221L)
# }

## ----stronger-avoidance-corridor, eval = ggwebgl_eval_widgets-----------------
# if (!boids4r_available) {
#   cat("Stronger avoidance corridor widget skipped.\n")
# } else {
#   render_custom_corridor("stronger_avoidance", stronger_avoidance = TRUE, seed = 222L)
# }