From 261398639910a560b6f2fc2ef4a296b05e0c2cc3 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 13 Mar 2024 11:37:54 +0100 Subject: [PATCH] Add switch etc --- DESCRIPTION | 2 +- NEWS.md | 2 ++ R/agg_dev.R | 41 ++++++++++++++++++++++--------------- man/agg_capture.Rd | 5 +++++ man/agg_jpeg.Rd | 5 +++++ man/agg_png.Rd | 5 +++++ man/agg_ppm.Rd | 5 +++++ man/agg_supertransparent.Rd | 5 +++++ man/agg_tiff.Rd | 5 +++++ src/AggDevice.h | 9 +++++--- src/AggDevice16.h | 4 ++-- src/AggDeviceCapture.h | 4 ++-- src/AggDeviceJpeg.h | 4 ++-- src/AggDevicePng.h | 8 ++++---- src/AggDevicePpm.h | 4 ++-- src/AggDeviceTiff.h | 8 ++++---- src/capture_dev.cpp | 5 +++-- src/init.cpp | 12 +++++------ src/jpeg_dev.cpp | 3 ++- src/png_dev.cpp | 19 +++++++++++------ src/ppm_dev.cpp | 5 +++-- src/ragg.h | 13 ++++++------ src/tiff_dev.cpp | 6 +++++- 23 files changed, 118 insertions(+), 61 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9fd752cd..21cbaee2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,6 +37,6 @@ LinkingTo: Config/Needs/website: ggplot2, devoid, magick, bench, tidyr, ggridges, hexbin, sessioninfo, pkgdown, tidyverse/tidytemplate Encoding: UTF-8 -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 SystemRequirements: freetype2, libpng, libtiff, libjpeg Config/testthat/edition: 3 diff --git a/NEWS.md b/NEWS.md index d430711a..7b8f2b91 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,8 @@ * Added supported for new graphics enigine features: Groups, paths, luminance masks, and glyphs +* Add a switch (defaults to on) to snapping rectangles to the pixel grid when + they are only drawn with fill (no stroke) * Silence a bug in clang-ASAN that incorrectly reported sanitiser issues # ragg 1.2.7 diff --git a/R/agg_dev.R b/R/agg_dev.R index 25d3acf9..e8caa54c 100644 --- a/R/agg_dev.R +++ b/R/agg_dev.R @@ -26,6 +26,9 @@ #' into a layout, but you find that the result appears to small, you can #' increase the `scaling` argument to make everything appear bigger at the #' same resolution. +#' @param snap_rect Should axis-aligned rectangles drawn with only fill snap to +#' the pixel grid. This will prevent anti-aliasing artifacts when two +#' rectangles are touching at their border. #' @param bg Same as `background` for compatibility with old graphic device APIs #' #' @export @@ -38,7 +41,7 @@ #' agg_ppm <- function(filename = 'Rplot%03d.ppm', width = 480, height = 480, units = 'px', pointsize = 12, background = 'white', - res = 72, scaling = 1, bg) { + res = 72, scaling = 1, snap_rect = TRUE, bg) { if (environmentName(parent.env(parent.frame())) == "knitr" && deparse(sys.call(), nlines = 1, width.cutoff = 500) == 'dev(filename = filename, width = dim[1], height = dim[2], ...)') { units <- 'in' @@ -47,7 +50,8 @@ agg_ppm <- function(filename = 'Rplot%03d.ppm', width = 480, height = 480, dim <- get_dims(width, height, units, res) background <- if (missing(bg)) background else bg .Call("agg_ppm_c", file, dim[1], dim[2], as.numeric(pointsize), background, - as.numeric(res), as.numeric(scaling), PACKAGE = 'ragg') + as.numeric(res), as.numeric(scaling), as.logical(snap_rect), + PACKAGE = 'ragg') invisible() } @@ -78,7 +82,7 @@ agg_ppm <- function(filename = 'Rplot%03d.ppm', width = 480, height = 480, #' agg_png <- function(filename = 'Rplot%03d.png', width = 480, height = 480, units = 'px', pointsize = 12, background = 'white', - res = 72, scaling = 1, bitsize = 8, bg) { + res = 72, scaling = 1, snap_rect = TRUE, bitsize = 8, bg) { if (environmentName(parent.env(parent.frame())) == "knitr" && deparse(sys.call(), nlines = 1, width.cutoff = 500) == 'dev(filename = filename, width = dim[1], height = dim[2], ...)') { units <- 'in' @@ -90,8 +94,8 @@ agg_png <- function(filename = 'Rplot%03d.png', width = 480, height = 480, dim <- get_dims(width, height, units, res) background <- if (missing(bg)) background else bg .Call("agg_png_c", file, dim[1], dim[2], as.numeric(pointsize), background, - as.numeric(res), as.numeric(scaling), as.integer(bitsize), - PACKAGE = 'ragg') + as.numeric(res), as.numeric(scaling), as.logical(snap_rect), + as.integer(bitsize), PACKAGE = 'ragg') invisible() } #' Draw to a TIFF file @@ -132,7 +136,8 @@ agg_png <- function(filename = 'Rplot%03d.png', width = 480, height = 480, #' agg_tiff <- function(filename = 'Rplot%03d.tiff', width = 480, height = 480, units = 'px', pointsize = 12, background = 'white', - res = 72, scaling = 1, compression = 'none', bitsize = 8, bg) { + res = 72, scaling = 1, snap_rect = TRUE, + compression = 'none', bitsize = 8, bg) { if (environmentName(parent.env(parent.frame())) == "knitr" && deparse(sys.call(), nlines = 1, width.cutoff = 500) == 'dev(filename = filename, width = dim[1], height = dim[2], ...)') { units <- 'in' @@ -155,8 +160,8 @@ agg_tiff <- function(filename = 'Rplot%03d.tiff', width = 480, height = 480, dim <- get_dims(width, height, units, res) background <- if (missing(bg)) background else bg .Call("agg_tiff_c", file, dim[1], dim[2], as.numeric(pointsize), background, - as.numeric(res), as.numeric(scaling), as.integer(bitsize), compression, - encoding, PACKAGE = 'ragg') + as.numeric(res), as.numeric(scaling), as.logical(snap_rect), + as.integer(bitsize), compression, encoding, PACKAGE = 'ragg') invisible() } #' Draw to a JPEG file @@ -196,8 +201,8 @@ agg_tiff <- function(filename = 'Rplot%03d.tiff', width = 480, height = 480, #' agg_jpeg <- function(filename = 'Rplot%03d.jpeg', width = 480, height = 480, units = 'px', pointsize = 12, background = 'white', - res = 72, scaling = 1, quality = 75, smoothing = FALSE, - method = 'slow', bg) { + res = 72, scaling = 1, snap_rect = TRUE, quality = 75, + smoothing = FALSE, method = 'slow', bg) { if (environmentName(parent.env(parent.frame())) == "knitr" && deparse(sys.call(), nlines = 1, width.cutoff = 500) == 'dev(filename = filename, width = dim[1], height = dim[2], ...)') { units <- 'in' @@ -211,8 +216,8 @@ agg_jpeg <- function(filename = 'Rplot%03d.jpeg', width = 480, height = 480, dim <- get_dims(width, height, units, res) background <- if (missing(bg)) background else bg .Call("agg_jpeg_c", file, dim[1], dim[2], as.numeric(pointsize), background, - as.numeric(res), as.numeric(scaling), as.integer(quality), - as.integer(smoothing), method, PACKAGE = 'ragg') + as.numeric(res), as.numeric(scaling), as.logical(snap_rect), + as.integer(quality), as.integer(smoothing), method, PACKAGE = 'ragg') invisible() } #' Draw to a PNG file, modifying transparency on the fly @@ -237,7 +242,7 @@ agg_jpeg <- function(filename = 'Rplot%03d.jpeg', width = 480, height = 480, agg_supertransparent <- function(filename = 'Rplot%03d.png', width = 480, height = 480, units = 'px', pointsize = 12, background = 'white', res = 72, scaling = 1, - alpha_mod = 1, bg) { + snap_rect = TRUE, alpha_mod = 1, bg) { if (environmentName(parent.env(parent.frame())) == "knitr" && deparse(sys.call(), nlines = 1, width.cutoff = 500) == 'dev(filename = filename, width = dim[1], height = dim[2], ...)') { units <- 'in' @@ -246,8 +251,8 @@ agg_supertransparent <- function(filename = 'Rplot%03d.png', width = 480, dim <- get_dims(width, height, units, res) background <- if (missing(bg)) background else bg .Call("agg_supertransparent_c", file, dim[1], dim[2], as.numeric(pointsize), - background, as.numeric(res), as.numeric(scaling), as.double(alpha_mod), - PACKAGE = 'ragg') + background, as.numeric(res), as.numeric(scaling), as.logical(snap_rect), + as.double(alpha_mod), PACKAGE = 'ragg') invisible() } @@ -286,7 +291,8 @@ agg_supertransparent <- function(filename = 'Rplot%03d.png', width = 480, #' plot(as.raster(raster)) #' agg_capture <- function(width = 480, height = 480, units = 'px', pointsize = 12, - background = 'white', res = 72, scaling = 1, bg) { + background = 'white', res = 72, scaling = 1, + snap_rect = TRUE, bg) { if (environmentName(parent.env(parent.frame())) == "knitr" && deparse(sys.call(), nlines = 1, width.cutoff = 500) == 'dev(filename = filename, width = dim[1], height = dim[2], ...)') { units <- 'in' @@ -295,7 +301,8 @@ agg_capture <- function(width = 480, height = 480, units = 'px', pointsize = 12, background <- if (missing(bg)) background else bg name <- paste0('agg_capture_', sample(.Machine$integer.max, 1)) .Call("agg_capture_c", name, dim[1], dim[2], as.numeric(pointsize), - background, as.numeric(res), as.numeric(scaling), PACKAGE = 'ragg') + background, as.numeric(res), as.numeric(scaling), as.logical(snap_rect), + PACKAGE = 'ragg') cap <- function(native = FALSE) { current_dev = dev.cur() if (names(current_dev)[1] == name) { diff --git a/man/agg_capture.Rd b/man/agg_capture.Rd index e8e5fe0e..58c32e75 100644 --- a/man/agg_capture.Rd +++ b/man/agg_capture.Rd @@ -12,6 +12,7 @@ agg_capture( background = "white", res = 72, scaling = 1, + snap_rect = TRUE, bg ) } @@ -38,6 +39,10 @@ into a layout, but you find that the result appears to small, you can increase the `scaling` argument to make everything appear bigger at the same resolution.} +\item{snap_rect}{Should axis-aligned rectangles drawn with only fill snap to +the pixel grid. This will prevent anti-aliasing artifacts when two +rectangles are touching at their border.} + \item{bg}{Same as `background` for compatibility with old graphic device APIs} } \value{ diff --git a/man/agg_jpeg.Rd b/man/agg_jpeg.Rd index 9235089e..0755b3ae 100644 --- a/man/agg_jpeg.Rd +++ b/man/agg_jpeg.Rd @@ -13,6 +13,7 @@ agg_jpeg( background = "white", res = 72, scaling = 1, + snap_rect = TRUE, quality = 75, smoothing = FALSE, method = "slow", @@ -46,6 +47,10 @@ into a layout, but you find that the result appears to small, you can increase the `scaling` argument to make everything appear bigger at the same resolution.} +\item{snap_rect}{Should axis-aligned rectangles drawn with only fill snap to +the pixel grid. This will prevent anti-aliasing artifacts when two +rectangles are touching at their border.} + \item{quality}{An integer between `0` and `100` defining the quality/size tradeoff. Setting this to `100` will result in no compression.} diff --git a/man/agg_png.Rd b/man/agg_png.Rd index 84a8076e..075a93c8 100644 --- a/man/agg_png.Rd +++ b/man/agg_png.Rd @@ -13,6 +13,7 @@ agg_png( background = "white", res = 72, scaling = 1, + snap_rect = TRUE, bitsize = 8, bg ) @@ -44,6 +45,10 @@ into a layout, but you find that the result appears to small, you can increase the `scaling` argument to make everything appear bigger at the same resolution.} +\item{snap_rect}{Should axis-aligned rectangles drawn with only fill snap to +the pixel grid. This will prevent anti-aliasing artifacts when two +rectangles are touching at their border.} + \item{bitsize}{Should the device record colour as 8 or 16bit} \item{bg}{Same as `background` for compatibility with old graphic device APIs} diff --git a/man/agg_ppm.Rd b/man/agg_ppm.Rd index 4b19f6b7..5e843ee6 100644 --- a/man/agg_ppm.Rd +++ b/man/agg_ppm.Rd @@ -13,6 +13,7 @@ agg_ppm( background = "white", res = 72, scaling = 1, + snap_rect = TRUE, bg ) } @@ -43,6 +44,10 @@ into a layout, but you find that the result appears to small, you can increase the `scaling` argument to make everything appear bigger at the same resolution.} +\item{snap_rect}{Should axis-aligned rectangles drawn with only fill snap to +the pixel grid. This will prevent anti-aliasing artifacts when two +rectangles are touching at their border.} + \item{bg}{Same as `background` for compatibility with old graphic device APIs} } \description{ diff --git a/man/agg_supertransparent.Rd b/man/agg_supertransparent.Rd index a949be2a..8404bb6c 100644 --- a/man/agg_supertransparent.Rd +++ b/man/agg_supertransparent.Rd @@ -13,6 +13,7 @@ agg_supertransparent( background = "white", res = 72, scaling = 1, + snap_rect = TRUE, alpha_mod = 1, bg ) @@ -44,6 +45,10 @@ into a layout, but you find that the result appears to small, you can increase the `scaling` argument to make everything appear bigger at the same resolution.} +\item{snap_rect}{Should axis-aligned rectangles drawn with only fill snap to +the pixel grid. This will prevent anti-aliasing artifacts when two +rectangles are touching at their border.} + \item{alpha_mod}{A numeric between 0 and 1 that will be multiplied to the alpha channel of all transparent colours} diff --git a/man/agg_tiff.Rd b/man/agg_tiff.Rd index 32095ea7..3bd78097 100644 --- a/man/agg_tiff.Rd +++ b/man/agg_tiff.Rd @@ -13,6 +13,7 @@ agg_tiff( background = "white", res = 72, scaling = 1, + snap_rect = TRUE, compression = "none", bitsize = 8, bg @@ -45,6 +46,10 @@ into a layout, but you find that the result appears to small, you can increase the `scaling` argument to make everything appear bigger at the same resolution.} +\item{snap_rect}{Should axis-aligned rectangles drawn with only fill snap to +the pixel grid. This will prevent anti-aliasing artifacts when two +rectangles are touching at their border.} + \item{compression}{The compression type to use for the image data. The standard options from the [grDevices::tiff()] function are available under the same name.} diff --git a/src/AggDevice.h b/src/AggDevice.h index 1bbf5969..e9ee0f74 100644 --- a/src/AggDevice.h +++ b/src/AggDevice.h @@ -75,6 +75,7 @@ class AggDevice { double res_real; double res_mod; double lwd_mod; + bool snap_rect; double x_trans; double y_trans; @@ -102,7 +103,7 @@ class AggDevice { // Lifecycle methods AggDevice(const char* fp, int w, int h, double ps, int bg, double res, - double scaling); + double scaling, bool snap); virtual ~AggDevice(); virtual void newPage(unsigned int bg); void close(); @@ -467,7 +468,8 @@ class AggDevice { */ template AggDevice::AggDevice(const char* fp, int w, int h, double ps, - int bg, double res, double scaling) : + int bg, double res, double scaling, + bool snap) : converter(), width(w), height(h), @@ -483,6 +485,7 @@ AggDevice::AggDevice(const char* fp, int w, int h, dou res_real(res), res_mod(scaling * res / 72.0), lwd_mod(scaling * res / 96.0), + snap_rect(snap), x_trans(0.0), y_trans(0.0), t_ren(), @@ -1154,7 +1157,7 @@ void AggDevice::drawRect(double x0, double y0, double x1 += x_trans; y0 += y_trans; y1 += y_trans; - if (draw_fill && !draw_stroke) { + if (snap_rect && draw_fill && !draw_stroke) { x0 = std::round(x0); x1 = std::round(x1); y0 = std::round(y0); diff --git a/src/AggDevice16.h b/src/AggDevice16.h index caa01ddc..8f34add0 100644 --- a/src/AggDevice16.h +++ b/src/AggDevice16.h @@ -29,8 +29,8 @@ class AggDevice16 : public AggDevice { double alpha_mod; AggDevice16(const char* fp, int w, int h, double ps, int bg, double res, - double scaling, double alpha_mod = 1.0) : - AggDevice(fp, w, h, ps, bg, res, scaling), + double scaling, bool snap, double alpha_mod = 1.0) : + AggDevice(fp, w, h, ps, bg, res, scaling, snap), alpha_mod(alpha_mod) { this->background = convertColour(this->background_int); diff --git a/src/AggDeviceCapture.h b/src/AggDeviceCapture.h index 638bfba4..1f65d9e7 100644 --- a/src/AggDeviceCapture.h +++ b/src/AggDeviceCapture.h @@ -9,8 +9,8 @@ class AggDeviceCapture : public AggDevice { bool can_capture = true; AggDeviceCapture(const char* fp, int w, int h, double ps, int bg, double res, - double scaling) : - AggDevice(fp, w, h, ps, bg, res, scaling) + double scaling, bool snap) : + AggDevice(fp, w, h, ps, bg, res, scaling, snap) { } diff --git a/src/AggDeviceJpeg.h b/src/AggDeviceJpeg.h index e06d7d7b..1e71eb93 100644 --- a/src/AggDeviceJpeg.h +++ b/src/AggDeviceJpeg.h @@ -15,8 +15,8 @@ class AggDeviceJpeg : public AggDevice { int smoothing; int method; public: - AggDeviceJpeg(const char* fp, int w, int h, double ps, int bg, double res, double scaling, int qual, int smooth, int meth) : - AggDevice(fp, w, h, ps, bg, res, scaling), + AggDeviceJpeg(const char* fp, int w, int h, double ps, int bg, double res, double scaling, bool snap, int qual, int smooth, int meth) : + AggDevice(fp, w, h, ps, bg, res, scaling, snap), quality(qual), smoothing(smooth), method(meth) diff --git a/src/AggDevicePng.h b/src/AggDevicePng.h index 7c312e59..d4b40842 100644 --- a/src/AggDevicePng.h +++ b/src/AggDevicePng.h @@ -12,8 +12,8 @@ extern "C" { template class AggDevicePng : public AggDevice { public: - AggDevicePng(const char* fp, int w, int h, double ps, int bg, double res, double scaling) : - AggDevice(fp, w, h, ps, bg, res, scaling) + AggDevicePng(const char* fp, int w, int h, double ps, int bg, double res, double scaling, bool snap) : + AggDevice(fp, w, h, ps, bg, res, scaling, snap) { } @@ -81,8 +81,8 @@ typedef AggDevicePng AggDevicePngAlpha; template class AggDevicePng16 : public AggDevice16 { public: - AggDevicePng16(const char* fp, int w, int h, double ps, int bg, double res, double scaling, double alpha_mod = 1.0) : - AggDevice16(fp, w, h, ps, bg, res, scaling, alpha_mod) + AggDevicePng16(const char* fp, int w, int h, double ps, int bg, double res, double scaling, bool snap, double alpha_mod = 1.0) : + AggDevice16(fp, w, h, ps, bg, res, scaling, snap, alpha_mod) { } diff --git a/src/AggDevicePpm.h b/src/AggDevicePpm.h index 75525353..40579f6a 100644 --- a/src/AggDevicePpm.h +++ b/src/AggDevicePpm.h @@ -7,8 +7,8 @@ template class AggDevicePpm : public AggDevice { public: - AggDevicePpm(const char* fp, int w, int h, double ps, int bg, double res, double scaling) : - AggDevice(fp, w, h, ps, bg, res, scaling) + AggDevicePpm(const char* fp, int w, int h, double ps, int bg, double res, double scaling, bool snap) : + AggDevice(fp, w, h, ps, bg, res, scaling, snap) { } diff --git a/src/AggDeviceTiff.h b/src/AggDeviceTiff.h index 63a82ee8..2696706a 100644 --- a/src/AggDeviceTiff.h +++ b/src/AggDeviceTiff.h @@ -12,8 +12,8 @@ class AggDeviceTiff : public AggDevice { int encoding; public: AggDeviceTiff(const char* fp, int w, int h, double ps, int bg, double res, - double scaling, int comp = 0, int enc = 0) : - AggDevice(fp, w, h, ps, bg, res, scaling), + double scaling, bool snap, int comp = 0, int enc = 0) : + AggDevice(fp, w, h, ps, bg, res, scaling, snap), compression(comp), encoding(enc) { @@ -83,8 +83,8 @@ class AggDeviceTiff16 : public AggDevice16 { int encoding; public: AggDeviceTiff16(const char* fp, int w, int h, double ps, int bg, double res, - double scaling, int comp = 0, int enc = 0) : - AggDevice16(fp, w, h, ps, bg, res, scaling), + double scaling, bool snap, int comp = 0, int enc = 0) : + AggDevice16(fp, w, h, ps, bg, res, scaling, snap), compression(comp), encoding(enc) { diff --git a/src/capture_dev.cpp b/src/capture_dev.cpp index 5fcf4cda..ff7b6a26 100644 --- a/src/capture_dev.cpp +++ b/src/capture_dev.cpp @@ -4,7 +4,7 @@ #include "AggDeviceCapture.h" // [[export]] -SEXP agg_capture_c(SEXP name, SEXP width, SEXP height, SEXP pointsize, SEXP bg, SEXP res, SEXP scaling) { +SEXP agg_capture_c(SEXP name, SEXP width, SEXP height, SEXP pointsize, SEXP bg, SEXP res, SEXP scaling, SEXP snap) { int bgCol = RGBpar(bg, 0); BEGIN_CPP @@ -15,7 +15,8 @@ SEXP agg_capture_c(SEXP name, SEXP width, SEXP height, SEXP pointsize, SEXP bg, REAL(pointsize)[0], bgCol, REAL(res)[0], - REAL(scaling)[0] + REAL(scaling)[0], + LOGICAL(snap)[0] ); makeDevice(device, CHAR(STRING_ELT(name, 0))); END_CPP diff --git a/src/init.cpp b/src/init.cpp index 6a9cdb2a..9ee43947 100644 --- a/src/init.cpp +++ b/src/init.cpp @@ -7,12 +7,12 @@ #include "ragg.h" static const R_CallMethodDef CallEntries[] = { - {"agg_ppm_c", (DL_FUNC) &agg_ppm_c, 7}, - {"agg_png_c", (DL_FUNC) &agg_png_c, 8}, - {"agg_supertransparent_c", (DL_FUNC) &agg_supertransparent_c, 8}, - {"agg_tiff_c", (DL_FUNC) &agg_tiff_c, 10}, - {"agg_jpeg_c", (DL_FUNC) &agg_jpeg_c, 10}, - {"agg_capture_c", (DL_FUNC) &agg_capture_c, 7}, + {"agg_ppm_c", (DL_FUNC) &agg_ppm_c, 8}, + {"agg_png_c", (DL_FUNC) &agg_png_c, 9}, + {"agg_supertransparent_c", (DL_FUNC) &agg_supertransparent_c, 9}, + {"agg_tiff_c", (DL_FUNC) &agg_tiff_c, 11}, + {"agg_jpeg_c", (DL_FUNC) &agg_jpeg_c, 11}, + {"agg_capture_c", (DL_FUNC) &agg_capture_c, 8}, {NULL, NULL, 0} }; diff --git a/src/jpeg_dev.cpp b/src/jpeg_dev.cpp index 42ed6834..eabfd883 100644 --- a/src/jpeg_dev.cpp +++ b/src/jpeg_dev.cpp @@ -5,7 +5,7 @@ // [[export]] SEXP agg_jpeg_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, - SEXP res, SEXP scaling, SEXP quality, SEXP smoothing, + SEXP res, SEXP scaling, SEXP snap, SEXP quality, SEXP smoothing, SEXP method) { int bgCol = RGBpar(bg, 0); @@ -18,6 +18,7 @@ SEXP agg_jpeg_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, bgCol, REAL(res)[0], REAL(scaling)[0], + LOGICAL(snap)[0], INTEGER(quality)[0], INTEGER(smoothing)[0], INTEGER(method)[0] diff --git a/src/png_dev.cpp b/src/png_dev.cpp index 7bb6fc28..019e28bd 100644 --- a/src/png_dev.cpp +++ b/src/png_dev.cpp @@ -5,7 +5,7 @@ // [[export]] SEXP agg_png_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, - SEXP res, SEXP scaling, SEXP bit) { + SEXP res, SEXP scaling, SEXP snap, SEXP bit) { bool bit8 = INTEGER(bit)[0] == 8; int bgCol = RGBpar(bg, 0); @@ -19,7 +19,8 @@ SEXP agg_png_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, REAL(pointsize)[0], bgCol, REAL(res)[0], - REAL(scaling)[0] + REAL(scaling)[0], + LOGICAL(snap)[0] ); makeDevice(device, "agg_png"); } else { @@ -30,7 +31,8 @@ SEXP agg_png_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, REAL(pointsize)[0], bgCol, REAL(res)[0], - REAL(scaling)[0] + REAL(scaling)[0], + LOGICAL(snap)[0] ); makeDevice(device, "agg_png"); } @@ -43,7 +45,8 @@ SEXP agg_png_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, REAL(pointsize)[0], bgCol, REAL(res)[0], - REAL(scaling)[0] + REAL(scaling)[0], + LOGICAL(snap)[0] ); makeDevice(device, "agg_png"); } else { @@ -54,7 +57,8 @@ SEXP agg_png_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, REAL(pointsize)[0], bgCol, REAL(res)[0], - REAL(scaling)[0] + REAL(scaling)[0], + LOGICAL(snap)[0] ); makeDevice(device, "agg_png"); } @@ -65,7 +69,8 @@ SEXP agg_png_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, } SEXP agg_supertransparent_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, - SEXP bg, SEXP res, SEXP scaling, SEXP alpha_mod) { + SEXP bg, SEXP res, SEXP scaling, SEXP snap, + SEXP alpha_mod) { int bgCol = RGBpar(bg, 0); BEGIN_CPP @@ -78,6 +83,7 @@ SEXP agg_supertransparent_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, bgCol, REAL(res)[0], REAL(scaling)[0], + LOGICAL(snap)[0], REAL(alpha_mod)[0] ); makeDevice(device, "agg_png"); @@ -90,6 +96,7 @@ SEXP agg_supertransparent_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, bgCol, REAL(res)[0], REAL(scaling)[0], + LOGICAL(snap)[0], REAL(alpha_mod)[0] ); makeDevice(device, "agg_png"); diff --git a/src/ppm_dev.cpp b/src/ppm_dev.cpp index c47fb388..c360274c 100644 --- a/src/ppm_dev.cpp +++ b/src/ppm_dev.cpp @@ -5,7 +5,7 @@ // [[export]] SEXP agg_ppm_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, - SEXP res, SEXP scaling) { + SEXP res, SEXP scaling, SEXP snap) { int bgCol = RGBpar(bg, 0); if (R_TRANSPARENT(bgCol)) { bgCol = R_TRANWHITE; @@ -19,7 +19,8 @@ SEXP agg_ppm_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, REAL(pointsize)[0], bgCol, REAL(res)[0], - REAL(scaling)[0] + REAL(scaling)[0], + LOGICAL(snap)[0] ); makeDevice(device, "agg_ppm"); END_CPP diff --git a/src/ragg.h b/src/ragg.h index b6a88396..71da4a5c 100644 --- a/src/ragg.h +++ b/src/ragg.h @@ -62,16 +62,17 @@ inline void demultiply(pixfmt_type_64* pixfmt) { } SEXP agg_ppm_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, - SEXP res, SEXP scaling); + SEXP res, SEXP scaling, SEXP snap); SEXP agg_png_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, - SEXP res, SEXP scaling, SEXP bit); + SEXP res, SEXP scaling, SEXP snap, SEXP bit); SEXP agg_supertransparent_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, - SEXP bg, SEXP res, SEXP scaling, SEXP alpha_mod); + SEXP bg, SEXP res, SEXP scaling, SEXP snap, + SEXP alpha_mod); SEXP agg_tiff_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, - SEXP res, SEXP scaling, SEXP bit, SEXP compression, + SEXP res, SEXP scaling, SEXP snap, SEXP bit, SEXP compression, SEXP encoding); SEXP agg_jpeg_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, - SEXP res, SEXP scaling, SEXP quality, SEXP smoothing, + SEXP res, SEXP scaling, SEXP snap, SEXP quality, SEXP smoothing, SEXP method); SEXP agg_capture_c(SEXP name, SEXP width, SEXP height, SEXP pointsize, SEXP bg, - SEXP res, SEXP scaling); + SEXP res, SEXP scaling, SEXP snap); diff --git a/src/tiff_dev.cpp b/src/tiff_dev.cpp index 08ddfd7c..12f6d271 100644 --- a/src/tiff_dev.cpp +++ b/src/tiff_dev.cpp @@ -5,7 +5,7 @@ // [[export]] SEXP agg_tiff_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, - SEXP res, SEXP scaling, SEXP bit, SEXP compression, + SEXP res, SEXP scaling, SEXP snap, SEXP bit, SEXP compression, SEXP encoding) { bool bit8 = INTEGER(bit)[0] == 8; int bgCol = RGBpar(bg, 0); @@ -21,6 +21,7 @@ SEXP agg_tiff_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, bgCol, REAL(res)[0], REAL(scaling)[0], + LOGICAL(snap)[0], INTEGER(compression)[0], INTEGER(encoding)[0] ); @@ -34,6 +35,7 @@ SEXP agg_tiff_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, bgCol, REAL(res)[0], REAL(scaling)[0], + LOGICAL(snap)[0], INTEGER(compression)[0], INTEGER(encoding)[0] ); @@ -49,6 +51,7 @@ SEXP agg_tiff_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, bgCol, REAL(res)[0], REAL(scaling)[0], + LOGICAL(snap)[0], INTEGER(compression)[0], INTEGER(encoding)[0] ); @@ -62,6 +65,7 @@ SEXP agg_tiff_c(SEXP file, SEXP width, SEXP height, SEXP pointsize, SEXP bg, bgCol, REAL(res)[0], REAL(scaling)[0], + LOGICAL(snap)[0], INTEGER(compression)[0], INTEGER(encoding)[0] );