support mesh3d #33
Description
library(quadmesh)
library(raster)
## dummy raster
rr <- setExtent(raster::raster(matrix(sample(1:12), 3)), raster::extent(0, 4, 0, 3))
qm <- quadmesh(rr * 10000) ## something suitably exaggerated
## convert a 3-column matrix to text embedded triples in json arrays
coord_to_json <- function(x) paste0(unlist(lapply(split(t(x), rep(seq_len(nrow(x)), each = ncol(x))), function(cds) sprintf("[%f,%f,%f]", cds[1], cds[2], cds[3]))), collapse = ",")
## add that first coordinate to the end
coord1 <- function(x) rbind(x, x[1, ])
format_mesh <- function(x, ...) {
UseMethod("format_mesh")
}
#' format mesh3d into JSON suitable for mapdeck ... WIP
format_mesh.mesh3d <- function(x, ...) {
## switch on x$primitivetype == "quad"/"triangle"
stopifnot(x$primitivetype == "quad")
feature_template <- '[{"type":"Feature","properties":{"elevation":0,"fill_colour":"#440154FF","stroke_colour":"#440154FF"},%s}]'
polygon_template <- '"geometry":{"geometry":{"type":"Polygon","coordinates":[[%s]]}}'
## assume the expanded coords for each primitive
coords <- sprintf(polygon_template, unlist(lapply(seq_len(ncol(qm$ib)), function(iquad) coord_to_json(coord1(t(qm$vb[1:3, qm$ib[, iquad] ]))))))
paste0(sprintf(feature_template, coords, collapse = ","), collapse = ",")
}
format_mesh( qm )
spatialwidget:::rcpp_geojson_mesh( qm )