Skip to content

DRAFT mesh_plot examples with (approx) texture

Jump to bottom
Michael Sumner edited this page May 15, 2020 · 3 revisions 
  library(anglr)  ## remotes::install_github("hypertidy/anglr")

  xx <- silicate::inlandwaters[c(3, 4, 6), ]
tri_waters <- DEL(xx)
tri_waters$vertex <-   tri_waters$vertex %>%
  dplyr::mutate(x_ = scales::rescale(x_, c(0, ncol(volcano))),
                y_ = scales::rescale(y_, c(0, nrow(volcano))))

r <- palr::image_raster(volcano)
tri_mesh <- as.mesh3d(tri_waters, image_texture = r)
#> writing texture image to C:\Users\MICHAE~1\AppData\Local\Temp\RtmpiuF67y\file1bfc53f33e27.png
## todo test file path, clean up file, png sanity, range of texcoords, color of material (not black) etc
mesh_plot(tri_mesh)
#> Warning in mesh_plot.mesh3d(tri_mesh): mesh object has a texture path, but
#> cannot be displayed natively in 2D graphics (try plot3d)
#> mesh plot will be displayed with an approximate colouring from the texture image

del_waters <- DEL0(xx, max_area = 4e9)
del_waters$vertex <-   del_waters$vertex %>%
  dplyr::mutate(x_ = scales::rescale(x_, c(0, ncol(volcano)+20)),
                y_ = scales::rescale(y_, c(-10, nrow(volcano)+5)))

del_mesh <- as.mesh3d(del_waters, image_texture = r)
#> writing texture image to C:\Users\MICHAE~1\AppData\Local\Temp\RtmpiuF67y\file1bfc1abe75a5.png
mesh_plot(del_mesh)
#> Warning in mesh_plot.mesh3d(del_mesh): mesh object has a texture path, but
#> cannot be displayed natively in 2D graphics (try plot3d)
#> mesh plot will be displayed with an approximate colouring from the texture image

suppressWarnings({
cc <- ceramic::cc_location(cbind(131.037, -25.3456562), buffer = c(1800, 1200))
el <- ceramic::cc_elevation(cc)
})
#> Preparing to download: 12 tiles at zoom = 15 from 
#> https://api.mapbox.com/v4/mapbox.satellite/
#> Preparing to download: 12 tiles at zoom = 15 from 
#> https://api.mapbox.com/v4/mapbox.terrain-rgb/
mesh <- as.mesh3d(el, image_texture = cc, triangles = TRUE)
#> writing texture image to C:\Users\MICHAE~1\AppData\Local\Temp\RtmpiuF67y\file1bfc24833299.png
mesh_plot(mesh)
#> Warning in mesh_plot.mesh3d(mesh): mesh object has a texture path, but cannot be
#> displayed natively in 2D graphics (try plot3d)
#> mesh plot will be displayed with an approximate colouring from the texture image

mesh2 <- as.mesh3d(el, image_texture = cc, triangles = TRUE, 
                   max_triangles = ncol(mesh$it) * 4)
#> writing texture image to C:\Users\MICHAE~1\AppData\Local\Temp\RtmpiuF67y\file1bfc54b27585.png
mesh_plot(mesh2)
#> Warning in mesh_plot.mesh3d(mesh2): mesh object has a texture path, but cannot
#> be displayed natively in 2D graphics (try plot3d)
#> mesh plot will be displayed with an approximate colouring from the texture image

suppressWarnings({
cc <- ceramic::cc_location(raster::extent(100, 120, -50, -10))
})
#> Preparing to download: 15 tiles at zoom = 5 from 
#> https://api.mapbox.com/v4/mapbox.satellite/
g <- as.mesh3d(raster::crop(gebco, raster::extent(70, 160, -70, 10)), 
               image_texture = cc, max_triangles = 80000)
#> writing texture image to C:\Users\MICHAE~1\AppData\Local\Temp\RtmpiuF67y\file1bfc3b412d41.png
mesh_plot(g)
#> Warning in mesh_plot.mesh3d(g): mesh object has a texture path, but cannot be
#> displayed natively in 2D graphics (try plot3d)
#> mesh plot will be displayed with an approximate colouring from the texture image

Created on 2020-05-15 by the reprex package (v0.3.0)

Clone this wiki locally