R/singleTile.R

In waternumbers/wmts: A Web Map Tile Server written in R

#' Function to generate a single tile
#' @param rst a SpatRaster object to generate tiles from
#' @param fcol function to convert raster values into an hex colour scheme
#' @param Z zoom level
#' @param X value of the tile
#' @param Y value of the tile
#' @param w width of tiles in pixels
#' @param h height of tiles in pixels
#' @param ... passed to terra project or terra resample
#'
#' @return a raw vector containing the png image
#' 
#' @details This uses the terra library to project \code{rst} onto the correct tile area. Tiles are then generated by applying the function fcol. fcol should take a vector of n values and return an n hex colour values which should include transparency.
#' 
#' @export
singleTile <- function(rst,fcol,Z,X,Y,w=512,h=w,...){

    if(!("SpatRaster" %in% class(rst))){
        stop("rst is not a SpatRaster object")
    }

    ## get wkt string for the desired projection
    wkt <- terra::crs(terra::rast(crs="EPSG:3857"))
    resample_flag <- terra::crs(rst)==wkt

    ## project/sample raster to correct shape
    step <- (20037508*2)/(2^Z)
    p <- terra::rast(nrows=w, ncols=h, nlyrs=1,
                     xmin=-20037508 + X*step,
                     xmax=-20037508 + (X+1)*step,
                     ymin=20037508 - (Y+1)*step,
                     ymax=20037508 - Y*step,
                     crs = "EPSG:3857"
                     )
    if( resample_flag ){
        pp <- terra::resample(rst,p,...)
    }else{                   
        pp <- terra::project(rst,p,...)
    }
    ## convert to numeric vector (in standard R order..
    v <- as.vector( terra::as.matrix(pp,wide=TRUE) )
    ## generate image if required
    out <- NULL
    if( any(is.finite(v)) ){
        tmp <- fcol(v) ## vector of hex colours
        pal <- t(grDevices::col2rgb(tmp,alpha=TRUE)) ## RGB colour matrix
        pal <- array(pal,c(h,w,4)) ## rearrange
        out <- png::writePNG(pal/255) #conver to binary image - want values in 0-1
    }
    return(out)
}