stop raster output from being resampled

R/tikzInternal.R

@@ -16,63 +16,77 @@ getTikzDeviceVersion <- function() {
   as.character(packageVersion('tikzDevice'))
 }
 
-tikz_writeRaster <-
-function(
-  fileName, rasterCount, rasterData, nrows, ncols,
-  finalDims, interpolate
-){
-
-  raster_file <- basename(tools::file_path_sans_ext(fileName))
-  raster_file <- file.path(dirname(fileName),
-    paste(raster_file, '_ras', rasterCount, '.png', sep = '')
-  )
-
+tikz_writeRaster <- function(fileName, rasterCount, rasterData,
+                             nrows, ncols, finalDims, interpolate) {
   # Convert the 4 vectors of RGBA data contained in rasterData to a raster
   # image.
   rasterData[['maxColorValue']] = 255
   rasterData = do.call( grDevices::rgb, rasterData )
   rasterData = as.raster(
     matrix( rasterData, nrow = nrows, ncol = ncols, byrow = TRUE ) )
 
+  raster_file <- paste0(
+      tools::file_path_sans_ext(fileName),
+      '_ras', rasterCount, '.png')
+
+  res = getOption('tikzRasterResolution')
+  if (is.null(res)) res = NA;
+  if (is.na(res)) interpolate = FALSE;
+
   # Write the image to a PNG file.
 
   # On OS X there is a problem with png() not respecting antialiasing options.
   # So, we have to use quartz instead.  Also, we cannot count on X11 or Cairo
   # being compiled into OS X binaries.  Technically, cannot count on Aqua/Quartz
   # either but you would have to be a special kind of special to leave it out.
   # Using type='Xlib' also causes a segfault for me on OS X 10.6.4
-  if ( Sys.info()['sysname'] == 'Darwin' && capabilities('aqua') ){
-
-    grDevices::quartz( file = raster_file, type = 'png',
-      width = finalDims$width, height = finalDims$height, antialias = FALSE,
-      dpi = getOption('tikzRasterResolution') )
-
+  if ( Sys.info()['sysname'] == 'Darwin' && capabilities('aqua') ) {
+    if (is.na(res)) {
+        grDevices::quartz(
+            file = raster_file, type = 'png',
+            width = ncols, height = nrows,
+            antialias = FALSE, dpi = 1 )
+    } else {
+        grDevices::quartz(
+            file = raster_file, type = 'png',
+            width = finalDims$width, height = finalDims$height,
+            antialias = FALSE, dpi = res )
+    }
   } else if (Sys.info()['sysname'] == 'Windows') {
-
-    png( filename = raster_file, width = finalDims$width, height = finalDims$height,
-      units = 'in', res = getOption('tikzRasterResolution') )
-
+    if (is.na(res)) {
+        # we can create very small PNGs with this code, so suppress
+        # warnings about this
+        suppressWarnings(png(filename = raster_file,
+            width = ncols, height = nrows, units = 'px'))
+    } else {
+        png(filename = raster_file,
+            width = finalDims$width, height = finalDims$height,
+            units = 'in', res = res )
+    }
   } else {
-
     # Linux/UNIX and OS X without Aqua.
-    png( filename = raster_file, width = finalDims$width, height = finalDims$height,
-      type = 'Xlib', units = 'in', antialias = 'none',
-      res = getOption('tikzRasterResolution') )
-
+    if (is.na(res)) {
+        # we can create very small PNGs with this code, so suppress
+        # warnings about this
+        suppressWarnings(png(filename = raster_file,
+            width = ncols, height = nrows, units = 'px',
+            type = 'Xlib', antialias = 'none' ))
+    } else {
+        png(filename = raster_file,
+            width = finalDims$width, height = finalDims$height,
+            type = 'Xlib', antialias = 'none',
+            units = 'in', res=res )
+    }
   }
 
-  par( mar = c(0,0,0,0) )
+  par(mar=c(0,0,0,0))
   plot.new()
-
   plotArea = par('usr')
-
   rasterImage(rasterData, plotArea[1], plotArea[3],
-    plotArea[2], plotArea[4], interpolate = interpolate )
-
+    plotArea[2], plotArea[4], interpolate = interpolate)
   dev.off()
 
   return(
     basename(tools::file_path_sans_ext(raster_file))
   )
-
 }

inst/tests/test_graphics.R

@@ -484,6 +484,18 @@ test_graphs <- list(
     })
   ),
 
+  list(
+    short_name = 'base_raster_noresample',
+    description = 'Test noresampling raster support in base graphics',
+    tags = c('base', 'raster'),
+    graph_options = list(
+      tikzRasterResolution = NA),
+    graph_code = quote({
+      plot.new()
+      rasterImage(as.raster(matrix(seq(0,1,len=9),3)),0,0,1,1,interpolate=TRUE)
+    })
+  ),
+
   # New pdfLaTeX tests go here
   #list(
   #  short_name = 'something_suitable_as_a_filename',