IBCSO digital chart textured across a wide meriodional range to Mercator.
library(anglr) ## hypertidy/anglr
library(raster)
library(curl)
library(rgl)
## download IBCSO
ibcso_url <- "https://github.com/mdsumner/ibcso-cog/raw/refs/heads/main/IBCSO_v2_digital_chart.tif"
ibcso <- basename(ibcso_url)
if (!file.exists(ibcso)) curl::curl_download(ibcso_url, ibcso)
## make a mesh in Mercator
ex <- c(-2, 2, -1, 0) * pi * 6378137
dm <- c(256, 256)
merc <- setValues(raster(extent(ex), ncols = dm[1], nrows = dm[2], crs = "EPSG:3857"), rnorm(prod(dm)))
img <- brick(ibcso)
makedim <- function(x, dm = dim(x)[1:2] %/% 10) {
x <- terra::rast(terra::rast(x))
dim(x) <- c(dm, 3)
x
}
## this is just a resize of the image so it doesn't bloat our html widget with Base64 so much
tex <- terra::project(terra::rast(img), makedim(img, c(1024, 1024) ), method = "bilinear")
tex[is.nan(tex)] <- 255
dd <- DEL0(merc, max_triangles = 1e5)
dd$meta$proj <- as.character(crs(merc))
pts <- do.call(cbind, maps::map(plot = F)[1:2])
pts <- pts[!is.na(pts[,1]), ]
bad <- (pts[, 2] < -85 | pts[,2] > 0)
xy <- reproj::reproj(pts[!bad, ], "EPSG:3857", source = "EPSG:4326")
mesh <- as.mesh3d(dd, image_texture = brick(tex), color = "white", specular = "black")
mesh$vb[3, ] <- 0
clear3d()
plot3d(mesh)
plot3d(cbind(xy, 100), add = TRUE)
aspect3d("iso")
rglwidget(width = 800, height = 800)
