support fastpng raw

DESCRIPTION

@@ -1,8 +1,9 @@
 Package: ximage
 Title: Draw Images of Raster Data and Related Adornments
-Version: 0.0.0.9010
+Version: 0.0.0.9011
 Authors@R: 
-    person("Michael D.", "Sumner", , "mdsumner@gmail.com", role = c("aut", "cre"))
+    c(person("Michael D.", "Sumner", , "mdsumner@gmail.com", role = c("aut", "cre")), 
+      person("Chrsi", "Toney", role = "ctb"))
 Description: Draw images easily and as if doing that was considered desirable or  
  even essential to be able to do. Set up 
  a plot with an image, specify where that image should be placed. Image plot by default

NAMESPACE

@@ -6,6 +6,7 @@ S3method(ximage,default)
 S3method(ximage,list)
 S3method(ximage,nativeRaster)
 S3method(ximage,raster)
+S3method(ximage,raw)
 export(xcontour)
 export(ximage)
 export(xrect)

NEWS.md

@@ -1,6 +1,8 @@
 # ximage 0.0
 
-* Now support {gdalraster} output of `read_ds(, as_list = TRUE)`. 
+* Now support raw output of fastpng. 
+
+* Now support {gdalraster} output of `read_ds(, as_list = TRUE)` or raw numeric, thanks to Chris Toney. 
 
 * `ximage()` now handles `breaks` argument to go with `col` (for numeric input). 
 

R/ximage.R

@@ -156,15 +156,22 @@ ximage.list <- function(x, extent = NULL, zlim = NULL, add = FALSE, ..., xlab =
   ## return the materialized data
   invisible(x)
 }
-
+#' @export
+ximage.raw <- function(x, extent = NULL, zlim = NULL, add = FALSE, ..., xlab = NULL, ylab = NULL,  col = hcl.colors(96, "YlOrRd", rev = TRUE), breaks = NULL) {
+  if (all(c("width", "height", "depth") %in% names(attributes(x)))) {
+    attrs <- attributes(x)
+    x <- aperm(array(x, c(attrs$depth, attrs$width, attrs$height)), c(3, 2, 1))
+  }
+  ximage.default(x, extent = extent, zlim = zlim, add = add, ..., xlab = xlab, ylab = ylab, col = col)
+}
 #' @export
 ximage.default <- function(x, extent = NULL, zlim = NULL, add = FALSE, ..., xlab = NULL, ylab = NULL,  col = hcl.colors(96, "YlOrRd", rev = TRUE), breaks = NULL) {
 
   if (is.list(x)) {
     ximage.list(x, extent = extent, zlim = zlim, add = add, ..., xlab = xlab, ylab = ylab, col = col)
     return(invisible(x))
   }
-  
+
   if (is.numeric(x) && "gis" %in% names(attributes(x))) {
     ## vector output from gdalraster
     gis <- attr(x, "gis")
@@ -173,7 +180,13 @@ ximage.default <- function(x, extent = NULL, zlim = NULL, add = FALSE, ..., xlab
     ximage.list(x_list, extent = extent, zlim = zlim, add = add, ..., xlab = xlab, ylab = ylab, col = col)
     return(invisible(x_list))
   }
-
+
+  ## fastpng raw output
+  # if (is.raw(x) && all(c("width", "height", "depth") %in% names(attributes(x)))) {
+  #   attrs <- attributes(x)
+  #   x <- aperm(array(x, c(attrs$depth, attrs$width, attrs$height)), c(3, 2, 1))
+  # }
+
   stopifnot(inherits(x, "array"))
 
    if (is.raw(x)) {