Skip to content

Instantly share code, notes, and snippets.

@mdsumner
Last active April 13, 2020 06:03
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save mdsumner/81be7955ab19c052cea753230d91a20c to your computer and use it in GitHub Desktop.
Save mdsumner/81be7955ab19c052cea753230d91a20c to your computer and use it in GitHub Desktop.
using the anglr package in a gif https://github.com/hypertidy/anglr
## according to mapview
maxll <- cbind(174.76448,-36.87812)
prj <- "+proj=nzmg +datum=WGS84"
maxnz <- rgdal::project(maxll, prj)
library(raster)
r <- raster::raster(volcano[nrow(volcano):1,ncol(volcano):1])
plot(r)
wm <- which.max(r)
xmn <- maxnz[1,1] - 10 * colFromCell(r, wm)
xmx <- maxnz[1,1] + 10 * (ncol(r) - colFromCell(r, wm))
ymn <- maxnz[1,2] - 10 * (nrow(r) - rowFromCell(r, wm))
ymx <- maxnz[1,2] + 10 * rowFromCell(r, wm)
rr <- setExtent(r, extent(xmn, xmx, ymn, ymx))
projection(rr) <- prj
plot(rr)
abline(v = maxnz[1,1], h = maxnz[1,2])
#mapview::mapview(rasterToContour(rr))
im <- ceramic::cc_location(rr, zoom = 18) ## hardcode zoom
plotRGB(im)
plot(spTransform(rasterToContour(rr), projection(im)), add = TRUE,
lwd = 3, col = "lightgrey")
mesh <- anglr::as.mesh3d(rr, image_texture = im)
anglr::plot3d(mesh, axes = FALSE, xlab = "", ylab = "", zlab = "", lit = FALSE);rgl::aspect3d("iso")
rgl::bg3d("darkgrey")
cl <- rasterToContour(rr)
cl$level <- as.numeric(levels(cl$level)[cl$level]) + 1 #(add a fudge to elevate)
anglr::plot3d(anglr::copy_down(silicate::SC(cl), "level"), add = TRUE, lwd = 3,
alpha = 0.5)
#rgl::movie3d( rgl::spin3d(), duration = 10, movie = "anglr" )
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment