coolbutuseless

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Simple function to create a plot with N overlapping rectangles with 
# each having an alpha of 1/N
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
stack_alpha <- function(N) {
  plot_df <- tibble(
    x = seq(0.45, 0.55, length.out = N),
    y = seq(0.45, 0.55, length.out = N), 
    alpha = 1/N
  )

coolbutuseless

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # A bunch of points
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  N <- 10
  point_coords <- cbind(
    rep(seq(0, 1, length.out = N), times = N),
    rep(seq(0, 1, length.out = N), each  = N)
  )

  points <- sf::st_multipoint(point_coords)

coolbutuseless

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Detect special characters in a character vector of args
#'
#' This is implemented as a whitelist of characters to accept. The presence
#' of anything outside this whitelist is considered a 'special character'
#'
#' @param args character vector of args to check
#'

coolbutuseless

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Create a list with a default value
#'
#' This behaves exactly like a 'list()' object, except if the requested value
#' does not exist, a default value is returned (instead of NULL).
#'
#' Similar to a `defaultdict` in Python
#'
#' @param value default value to return if item not in list
#'

coolbutuseless

#remotes::install_cran(c("anglr", "silicate"))

library(silicate)
library(anglr)
library(rgl)
## volcano is heightmap, doesn't exist in geo-space in R so we map it do the extent of
## these spatial polygons 
poly <- silicate::minimal_mesh
# xmin : 0 

coolbutuseless

library(terrainmeshr)
library(rgl)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Create triangles from heigh-map
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
tris <- terrainmeshr::triangulate_matrix(
  volcano, maxError = 30, verbose = TRUE, y_up = FALSE
)

coolbutuseless

df <- as.data.frame(installed.packages(fields = c("RemoteType", "Repository")))
to_reinstall <- df[df$Repository %in% "CRAN", "Package"]
install.packages(to_reinstall)

coolbutuseless

require(ggplot2)

ggplot() + annotate(x = -10, y=1, xend = -1.38, yend=3, geom='segment', col='white') + 
  geom_segment(data = data.frame(x = -1.38, y = seq(3.0, 3.0, len=30), 
                             xend = seq(1.4, 1.1, len=30), yend = seq(3.0, 3.5, len=30)), 
               aes(x, y, xend=xend, yend=yend), col='#ffffff10') + 
  geom_segment(data = data.frame(id=1:30, x = seq(1.1, 1.35, len=30), y = seq(3.5, 3.0, len=30), 
                             xend = seq(10, 10, len=30), yend = seq(2.0, 1.0, len=30)),
               aes(x, y, xend = xend, yend = yend, col = factor(id))) + 
  geom_path(data=NULL, aes(c(-3, 0, 3, -3), y = c(0,5.5,0,0)), col='white') + 

coolbutuseless

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Define the extents of the image
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
roi <- raster::extent(110, 160, -45, -12)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Grab the satellite image and the elevation map
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
im  <- ceramic::cc_location(roi)
el  <- ceramic::cc_elevation(roi)

coolbutuseless

library(rgl)


pan3d <- function(button, dev = rgl.cur(), subscene = currentSubscene3d(dev)) {
  start <- list()

  begin <- function(x, y) {
    activeSubscene <- par3d("activeSubscene", dev = dev)
    start$listeners <<- par3d("listeners", dev = dev, subscene = activeSubscene)
    for (sub in start$listeners) {