quadmesh icon indicating copy to clipboard operation
quadmesh copied to clipboard

globe texture example

Open mdsumner opened this issue 7 years ago • 0 comments

Here's etopo2 with recent sst textured on, and the north and southern ice edge.

(uses lazyraster because impatience)

rasterRGB <- function(x, col = palr::sstPal(26), breaks = NULL) {
  if (is.null(breaks)) breaks <- seq(raster::cellStats(x, min), raster::cellStats(x, max), 
                                     length.out = length(col) + 1)
  if (!length(breaks) == length(col) + 1) stop("must be one more breaks than col")
  cols <- col2rgb(col[scales::rescale(raster::values(x), c(1, length(col)))])
  raster::setValues(raster::brick(raster::raster(x), raster::raster(x), raster::raster(x)), t(cols))
}
library(raadtools)
library(lazyraster)
topo <- as_raster(lazyraster(filename(readtopo("etopo2"))))
sst <- rasterRGB(readsst(latest = TRUE))
qm <- quadmesh(topo * 50, texture = sst)

ice <- silicate::SC(rasterToContour(readice(latest = TRUE), level = 15))
ice$vertex$z_ <- 10000
ice <- anglr::globe(ice)
ice$object$color_ <- "white"

nice <- silicate::SC(rasterToContour(readice(latest = TRUE, hemisphere = "north"), level = 15))
nice$vertex$z_ <- 50000
nice <- anglr::globe(nice)
nice$object$color_ <- "white"


pts <- t(qm$vb[1:3, ])
pts <- quadmesh:::llh2xyz(pts, exag = 1)
qm$vb[1:3, ] <- t(pts)
library(rgl)
rgl.clear()
shade3d(qm, specular = "black")                 
plot3d(nice, add = TRUE)
plot3d(ice, add = TRUE)

image

image

mdsumner avatar Nov 13 '18 01:11 mdsumner