diff --git a/NEWS.md b/NEWS.md index 5475e73..83d0d5a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,7 @@ - Fix regression in set_layer_visibility (#101) - Rescalers no longer require `center` to be inside input domain (#103) - All layers now support geometry vectors which {wk} can read (#104) +- Feature editor accepts geometry vectors which {wk} can read (#105) # rdeck 0.5.2 diff --git a/R/controls.R b/R/controls.R index 7b399be..a85a8a6 100644 --- a/R/controls.R +++ b/R/controls.R @@ -11,7 +11,8 @@ #' - `linestring`: draw linestrings by clicking each vertex #' - `polygon`: draw polygons by clicking each vertex #' - `lasso`: freehand polygon draw by click-dragging -#' @param features <`sf` | `sfc`> Features with which to initialise the editor +#' @param features <[`wk-geometry`]> Features with which to initialise the editor. +#' Requires CRS [EPSG:4326](http://epsg.io/4326). #' @export editor_options <- function(mode = cur_value(), features = cur_value()) { tidyassert::assert( @@ -22,14 +23,17 @@ editor_options <- function(mode = cur_value(), features = cur_value()) { ) tidyassert::assert( - is.null(features) || - is_cur_value(features) || - (is_sf(features) || is_sfc(features)) && is_wgs84(features), + is.null(features) || is_cur_value(features) || + wk::is_handleable(features) && is_wgs84(features), error_message = c( - "x" = "{.arg features} must be a {.emph WGS84} {.cls sf/sfc}" + "x" = "{.arg features} must be a {.emph WGS84} {.cls wk-geometry}" ) ) + if (inherits(features, "data.frame")) { + features <- purrr::detect(features, wk::is_handleable) + } + structure( list( mode = mode, @@ -51,6 +55,7 @@ editor_modes <- function() { is_editor_options <- function(object) inherits(object, "editor_options") as_editor_options <- function(object) UseMethod("as_editor_options") -as_editor_options.default <- function(object) object +as_editor_options.editor_options <- function(object) object +as_editor_options.cur_value <- function(object) object as_editor_options.NULL <- function(object) NULL as_editor_options.logical <- function(object) if (isTRUE(object)) editor_options() else NULL diff --git a/R/geometry.R b/R/geometry.R index c2e6032..7d3fbae 100644 --- a/R/geometry.R +++ b/R/geometry.R @@ -41,6 +41,18 @@ is_sfc <- function(object) inherits(object, "sfc") # is object a simple features column is_sf <- function(object) inherits(object, "sf") +# create a new sf object +new_sf <- function(x = list(), n = NULL, ...) { + handleable <- purrr::keep(x, wk::is_handleable) + vctrs::new_data_frame( + x, + n %??% length(x[[1]]), + ..., + sf_column = names(handleable[1]), + class = "sf" + ) +} + # is crs = epsg:4326 is_wgs84 <- function(object) { obj_proj <- wk::wk_crs_proj_definition(wk::wk_crs(object)) diff --git a/R/globals.R b/R/globals.R index 8e61688..e2938a2 100644 --- a/R/globals.R +++ b/R/globals.R @@ -38,7 +38,6 @@ utils::globalVariables(c( "text", # "position", # "position", # - "features", # "scale_type", # "get_breaks", # "get_palette", # diff --git a/R/json.R b/R/json.R index 5953591..636a577 100644 --- a/R/json.R +++ b/R/json.R @@ -95,22 +95,24 @@ as_json.wk_rct <- function(object, ...) { #' @autoglobal #' @noRd as_json.editor_options <- function(object, ...) { - options <- mutate(select(object, -where(is_cur_value))) + options <- purrr::discard(object, is_cur_value) # features to geojson if (rlang::has_name(options, "features")) { rlang::check_installed("geojsonsf") - options <- mutate( - options, - geojson = geojsonsf::sf_geojson( - sf::st_sf(features %??% sf::st_sfc()), - simplify = FALSE, - digits = 6L - ) + features <- wk::wk_handle( + options$features %??% wk::xy(), + wk::sfc_writer() ) - options <- select(options, -features) + options$geojson <- geojsonsf::sf_geojson( + new_sf(list(geometry = features)), + simplify = FALSE, + digits = 6L + ) + + options$features <- NULL } json_stringify( diff --git a/man/editor_options.Rd b/man/editor_options.Rd index d84ab63..87f2e91 100644 --- a/man/editor_options.Rd +++ b/man/editor_options.Rd @@ -19,7 +19,8 @@ editor_options(mode = cur_value(), features = cur_value()) \item \code{lasso}: freehand polygon draw by click-dragging }} -\item{features}{<\code{sf} | \code{sfc}> Features with which to initialise the editor} +\item{features}{<\code{\link{wk-geometry}}> Features with which to initialise the editor. +Requires CRS \href{http://epsg.io/4326}{EPSG:4326}.} } \description{ Options for the polygon editor diff --git a/tests/testthat/test-editor.R b/tests/testthat/test-editor.R new file mode 100644 index 0000000..afb81d7 --- /dev/null +++ b/tests/testthat/test-editor.R @@ -0,0 +1,85 @@ +test_that("editor_options works", { + # cur_value + expect_equal( + editor_options(), + structure(list(mode = cur_value(), features = cur_value()), class = "editor_options") + ) + + # can set mode, or features, or both + expect_equal( + editor_options(mode = "lasso"), + structure(list(mode = "lasso", features = cur_value()), class = "editor_options") + ) + + expect_equal( + editor_options(features = wk::wkt("POINT EMPTY", "OGC:CRS84")), + structure(list(mode = cur_value(), features = wk::wkt("POINT EMPTY", "OGC:CRS84")), class = "editor_options") + ) + + expect_equal( + editor_options(mode = "transform", features = wk::wkt("POINT (1 1)", "OGC:CRS84")), + structure(list(mode = "transform", features = wk::wkt("POINT (1 1)", "OGC:CRS84")), class = "editor_options") + ) + + # strips off data frame + expect_equal( + editor_options( + mode = "polygon", + features = vctrs::data_frame(features = wk::wkt("POLYGON ((1 1))", "OGC:CRS84")) + ), + structure( + list( + mode = "polygon", + features = wk::wkt("POLYGON ((1 1))", "OGC:CRS84") + ), + class = "editor_options" + ) + ) +}) + +test_that("as_editor_options works", { + expect_equal( + as_editor_options(NULL), + NULL + ) + + expect_equal( + as_editor_options(TRUE), + editor_options() + ) + + expect_equal( + as_editor_options(FALSE), + NULL + ) + + expect_equal( + as_editor_options(cur_value()), + cur_value() + ) + + expect_equal( + as_editor_options(editor_options("modify")), + editor_options("modify") + ) +}) + +test_that("editor_options json works", { + expect_equal( + as_json(editor_options()), + structure("{}", class = "json") + ) + + expect_equal( + as_json(editor_options(mode = "lasso")), + structure('{"mode":"lasso"}', class = "json") + ) + + expect_equal( + as_json(editor_options(features = wk::wkt("LINESTRING (1 1)", "OGC:CRS84"))), + structure( + '{"geojson":{"type":"FeatureCollection","features":[{"type":"Feature","properties":{},"geometry":{"type":"LineString","coordinates":[[1.0,1.0]]}}]}}', # nolint + class = "json" + ) + ) +})