Skip to content

support mesh3d #33

@dcooley

Description

@dcooley
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 )

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type
    No fields configured for issues without a type.

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions