fixed #818 for regular stars

R/onLoad.R

@@ -1,6 +1,6 @@
 # envir = environment()
 .onLoad = function(...) {
- options(tmap.style = "white", tmap.mode = "plot", tmap.design.mode = FALSE, 
+ options(tmap.style = "white", tmap.mode = "view", tmap.design.mode = FALSE, 
  tmap.devel.mode = FALSE)
  assign("tmapOptions", .defaultTmapOptions, envir = .TMAP)
 

R/step1_rearrange.R

@@ -131,7 +131,7 @@ step1_rearrange = function(tmel) {
 
  # get main crs (used in step 3, not necessarily in the plot (e.g. view mode will use 4326/3857))
  crs_main = if (any_data_layer) get_crs(tms) else NA
-
+ 
  if (inherits(crs_option, "leaflet_crs")) {
  crs_leaflet = crs_option
  crs = leaflet2crs(crs_leaflet)
@@ -152,7 +152,6 @@ step1_rearrange = function(tmel) {
  main_class = "stars" # basemaps
  }
 
-
  if (dev) timing_add(s2 = "facet meta")
 
 
@@ -196,6 +195,7 @@ step1_rearrange = function(tmel) {
  o$crs_leaflet = crs_leaflet
  o$crs_main = crs_main
 
+
  o = c(o, tmf)
  # process shapes: put non-spatial data in data.table, keep spatial data separately 
 

R/step3_trans.R

@@ -47,6 +47,7 @@ step3_trans = function(tm) {
  if (al$trans_isglobal) shpDT = trans_shp(al, shpDT)
  }
 
+
  adi$layers = lapply(adi$layers, function(al) {
  # step 3.c1: apply non global transformation function
  if (al$trans_isglobal) {
@@ -68,7 +69,6 @@ step3_trans = function(tm) {
  adi
  })
 
-
  list(tmo = bd, aux = aux, cmp = cmp, o = o)
 }
 

R/tmapGrid_layers.R

@@ -287,8 +287,19 @@ tmapGridRaster <- function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page,
 
  m <- matrix(color, ncol=nrow(shp), nrow=ncol(shp), byrow = TRUE)
 
- y_is_neg <- all(diff(stars::st_get_dimension_values(shp, "y")) < 0)
- if (!y_is_neg) {
+ y_is_pos <- local({
+ vals = stars::st_get_dimension_values(shp, "y")
+ if (!is.null(vals)) {
+ !all(diff(vals) < 0)
+ } else {
+ rst = attr(shp, "raster")
+ name_y = names(get_xy_dim(shp))[2]
+ delta = shp[[name_y]]$delta
+ delta > 0
+ }
+ })
+
+ if (y_is_pos) {
  m <- m[nrow(m):1L, ]
  }
  m[is.na(m)] = NA #"#0000FF"

R/tmapLeafletInit.R

@@ -68,69 +68,7 @@ tmapLeafletInit = function(o, return.asp = FALSE, vp) {
  lf
  })
  })
-
-
 
-
- # bases = if ("bases" %in% ls(envir = .TMAP_LEAFLET)) get("bases", envir = .TMAP_LEAFLET) else NA
- # overlays = if ("overlays" %in% ls(envir = .TMAP_LEAFLET)) get("overlays", envir = .TMAP_LEAFLET) else NA
- # overlays_tiles = if ("overlays_tiles" %in% ls(envir = .TMAP_LEAFLET)) get("overlays_tiles", envir = .TMAP_LEAFLET) else character(0)
- # 
- # layerIds = list()
- # start_pane_id = 401
- # 
- # # should the layer control include base layers? TRUE if |basemaps| > 1 || names/groups are specified
- # basename.specified = FALSE
- # 
- # 
- # 
- # ### find z indeces and create tmapXXX panes
- # zids <- lapply(gp, function(gpl) {
- # po <- gpl$plot.order
- # 
- # po2 <- substr(po, 4, nchar(po))
- # po2[po2 == "symbols"] <- "symbol"
- # po2[po2 == "tiles"] <- "tile"
- # po2[po2 == "lines"] <- "line"
- # 
- # zi <- sapply(po2, function(p) {
- # if (p == "grid") gt$grid.zindex else gpl[[paste0(p, ".zindex")]]
- # })
- # 
- # if (!is.null(gpl$tile.gtype) && gpl$tile.gtype == "base") {
- # zi[names(zi) == "tile"] <- 0
- # }
- # zi
- # })
- # zids_vec <- unlist(zids, use.names = FALSE)
- # 
- # # For tmapProxy: only use pane with a higher z number than existing ones
- # # Only use free panes: every layer must be in a different pane
- # z_free <- setdiff(start_pane_id:(start_pane_id+length(zids_vec)*2-1), na.omit(zids_vec))
- # zids_vec[is.na(zids_vec)] <- rep(z_free, length.out = sum(is.na(zids_vec)))
- # zids_len <- sapply(zids, length)
- # zindices <- split(zids_vec, unlist(mapply(rep, 1:length(zids), each = zids_len, SIMPLIFY = FALSE), use.names = FALSE))
- # tmap_zindices <- sort(unique(unname(setdiff(zids_vec, 0))))
- # 
- # ## get/set existing panes
- # if (!proxy) {
- # assign("pane_ids", tmap_zindices, envir = .TMAP_CACHE)
- # z_panes <- integer()
- # } else {
- # z_panes <- get("pane_ids", envir = .TMAP_CACHE)
- # assign("pane_ids", union(tmap_zindices, z_panes), envir = .TMAP_CACHE)
- # }
- # 
- # # add new panes
- # for (z in setdiff(tmap_zindices, z_panes)) {
- # lf <- addMapPane(lf, paneName(z), zIndex = z)
- # }
- # 
- # 
- # 
- # 
- # 
- # 
  .TMAP_LEAFLET$lfs = lfs
  .TMAP_LEAFLET$nrow = o$nrows
  .TMAP_LEAFLET$ncol = o$ncols

R/tmapLeaflet_layers.R

@@ -234,18 +234,38 @@ tmapLeafletRaster = function(shpTM, dt, gp, pdt, popup.format, hdt, idt, bbx, fa
 
  m <- matrix(col_ids, ncol = ncol(shp))
 
+ #matrix(color, ncol = ncol(shp))
+
+ #m <- matrix(tmapID, ncol = ncol(shp))
+
+
+ #m = tmapID
+
+ #m[1,5] = 4
+
  shp2 = st_as_stars(m, dimensions = shp)
 
  lf = get_lf(facet_row, facet_col, facet_page)
 
- #shp2 = transwarp(shp, crs = st_crs(3857), raster.warp = TRUE)
-
  lf |> 
  leafem::addStarsImage(shp2, band = 1, colors = pal_col, opacity = pal_opacity, group = group) |> 
  assign_lf(facet_row, facet_col, facet_page)
  } else {
- shpTM <- shapeTM(sf::st_as_sf(shp), tmapID)
- tmapLeafletPolygons(shpTM, dt, facet_row, facet_col, facet_page, id, pane, group, o)
+ #shp2 = st_as_stars(list(values = tmapID), dimensions = shp)
+ #shpTM <- shapeTM(sf::st_geometry(sf::st_as_sf(shp2)), as.vector(tmapID))
+
+ m = matrix(tmapID, nrow = nrow(shp), ncol = ncol(shp))
+ shp2 = structure(list(tmapID = m), class = "stars", dimensions = shp)
+
+ shp3 = sf::st_geometry(sf::st_as_sf(shp2))
+
+ crs = get_option_class(tmap_options_mode("view")$crs, "sf")
+
+ shpTM = shapeTM(sf::st_transform(shp3, crs), tmapID)
+
+
+ gp$lty = "solid"
+ tmapLeafletPolygons(shpTM, dt, pdt, popup.format = NULL, hdt = NULL, idt = NULL, gp, bbx, facet_row, facet_col, facet_page, id, pane, group, o)
  #grid.shape(s, gp=gpar(fill=color, col=NA), bg.col=NA, i, k)
  }
  NULL

R/tmapScaleDiscrete.R

@@ -98,7 +98,9 @@ tmapScaleDiscrete = function(x1, scale, legend, o, aes, layer, layer_args, sortR
 
  na.show = update_na.show(label.show, legend$na.show, anyNA)
 
- if (is.na(sortRev)) {
+ if (is.null(sortRev)) {
+ ids = NULL
+ } else if (is.na(sortRev)) {
  ids[] = 1L
  } else if (sortRev) {
  ids = (as.integer(n) + 1L) - ids

R/tmapShape.R

@@ -5,7 +5,6 @@ tmapReproject = function(...) {
 #' @method tmapReproject stars
 #' @export
 tmapReproject.stars = function(shp, tmapID, bbox = NULL, ..., crs) {
-
  shp[[1]] = tmapID
 
  shp2 = transwarp(shp, crs, raster.warp = TRUE)
@@ -249,8 +248,12 @@ tmapShape.stars = function(shp, is.main, crs, bbox, unit, filter, shp_name, smet
 
 
  shpclass = "sfc"
- } else {
+ } else { 
+ shp0 = shp
+ dt0 = as.data.table(shp0, center = FALSE)
+
  shp = downsample_stars(shp, max.raster = o$raster.max.cells / (o$fn[1] * o$fn[2]))
+
  if (!is.null(crs) && sf::st_crs(shp) != crs) {
  shp = transwarp(shp, crs, raster.warp = TRUE)
  }
@@ -267,10 +270,18 @@ tmapShape.stars = function(shp, is.main, crs, bbox, unit, filter, shp_name, smet
  attr(shp3, "dimensions")[[rst$dimensions[2]]]$values = 1L:ncol(shp)
  attr(attr(shp3, "dimensions"), "raster")$curvilinear = FALSE
  } else {
- shp2 = stars::st_set_dimensions(shp, rst$dimensions[1], values = {if (dimsxy[[1]]$delta > 0) 1L:nrow(shp) else nrow(shp):1L})
- shp3 = stars::st_set_dimensions(shp2, rst$dimensions[2], values = {if (dimsxy[[2]]$delta < 0) 1L:ncol(shp) else ncol(shp):1L})
+ #shp2 = stars::st_set_dimensions(shp, rst$dimensions[1], values = {if (dimsxy[[1]]$delta > 0) 1L:nrow(shp) else nrow(shp):1L})
+ #shp3 = stars::st_set_dimensions(shp2, rst$dimensions[2], values = {if (dimsxy[[2]]$delta < 0) 1L:ncol(shp2) else ncol(shp2):1L})
+
+ shp2 = stars::st_set_dimensions(shp, rst$dimensions[1], values = 1L:nrow(shp))
+ shp3 = stars::st_set_dimensions(shp2, rst$dimensions[2], values = 1L:ncol(shp))
+
+ #shp3 = shp
  }
 
+ shp0b = shp3
+
+
  dt = as.data.table(shp3, center = FALSE)
  # Circumvent bug in tests on Windows
  tryCatch(
@@ -290,6 +301,8 @@ tmapShape.stars = function(shp, is.main, crs, bbox, unit, filter, shp_name, smet
 
  shp = dimsxy
  shpclass = "stars"
+
+
  shpTM = shapeTM(shp = shp, tmapID = 1L:(nrow(shp) * ncol(shp)), bbox = bbox)
 
  }