1 2 3setMethod ("coltab" , "SpatRaster", 4 function(x) { 5 hascols <- x@ptr$hasColors() 6 if (any(hascols)) { 7 d <- x@ptr$getColors() 8 d <- lapply(d, .getSpatDF) 9 } else { 10 d <- vector("list", length(hascols)) 11 } 12 d 13 } 14) 15 16 17setMethod ("coltab<-" , "SpatRaster", 18 function(x, layer=1, value) { 19 stopifnot(hasValues(x)) 20 if (missing(value)) { 21 value <- layer 22 layer <- 1 23 } 24 layer <- layer[1]-1 25 26 if (is.null(value)) { 27 x@ptr$removeColors(layer) 28 return(x) 29 } 30 31 if (inherits(value, "list")) { 32 value <- value[[1]] 33 } 34 if (inherits(value, "character")) { 35 value <- t(grDevices::col2rgb(value, alpha=TRUE)) 36 } 37 if (inherits(value, "character")) { 38 value <- data.frame(t(grDevices::col2rgb(value, alpha=TRUE))) 39 } else if (inherits(value, "matrix")) { 40 value <- data.frame(value) 41 } 42 43 stopifnot(inherits(value, "data.frame")) 44 45 value <- value[1:256,] 46 value[is.na(value)] <- 255 47 value <- data.frame(sapply(value, function(i) as.integer(clamp(i, 0, 255)))) 48 if (ncol(value) == 3) { 49 value <- cbind(value, alpha=255) 50 } 51 52 d <- .makeSpatDF(value) 53 if (x@ptr$setColors(layer, d)) { 54 return(x) 55 } else { 56 error("coltab<-", "cannot set these values") 57 } 58 } 59) 60 61