[med-svn] [r-cran-png] 05/07: New upstream version 0.1-7
Andreas Tille
tille at debian.org
Fri Oct 20 09:35:49 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-png.
commit 5b8d0fcc032cd0078b4df361201b5ee7ca114f2b
Author: Andreas Tille <tille at debian.org>
Date: Fri Oct 20 11:34:24 2017 +0200
New upstream version 0.1-7
---
DESCRIPTION | 14 +++
MD5 | 13 ++
NAMESPACE | 2 +
NEWS | 69 +++++++++++
R/read.R | 11 ++
R/write.R | 12 ++
configure.win | 72 +++++++++++
debian/changelog | 5 -
debian/compat | 1 -
debian/control | 23 ----
debian/copyright | 26 ----
debian/docs | 2 -
debian/rules | 4 -
debian/source/format | 1 -
debian/watch | 3 -
inst/img/Rlogo.png | Bin 0 -> 11782 bytes
man/readPNG.Rd | 86 +++++++++++++
man/writePNG.Rd | 105 ++++++++++++++++
src/Makevars | 2 +
src/Makevars.win | 8 ++
src/read.c | 334 +++++++++++++++++++++++++++++++++++++++++++++++++++
src/write.c | 308 +++++++++++++++++++++++++++++++++++++++++++++++
22 files changed, 1036 insertions(+), 65 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..85a4bbd
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,14 @@
+Package: png
+Version: 0.1-7
+Title: Read and write PNG images
+Author: Simon Urbanek <Simon.Urbanek at r-project.org>
+Maintainer: Simon Urbanek <Simon.Urbanek at r-project.org>
+Depends: R (>= 2.9.0)
+Description: This package provides an easy and simple way to read, write and display bitmap images stored in the PNG format. It can read and write both files and in-memory raw vectors.
+License: GPL-2 | GPL-3
+SystemRequirements: libpng
+URL: http://www.rforge.net/png/
+Packaged: 2013-12-03 20:09:14 UTC; svnuser
+NeedsCompilation: yes
+Repository: CRAN
+Date/Publication: 2013-12-03 22:25:05
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..242f296
--- /dev/null
+++ b/MD5
@@ -0,0 +1,13 @@
+c9b6ac3cd888b98fa0d875308eb6f5ce *DESCRIPTION
+d674f0b464da3777a68d03b3030a5083 *NAMESPACE
+3eef6f3624b5f41bad7e27d6f5f50708 *NEWS
+517d1c2ed74f8175ac738fa752a61045 *R/read.R
+ffed5973ae4ecb0056f0619ca62a0a5b *R/write.R
+351b3c99336c44dc0ef13d6f6b503db4 *configure.win
+7381224c65138a2acdf3a8346f8275c4 *inst/img/Rlogo.png
+0ee7cd3abffb5dd15a5785a694246a8a *man/readPNG.Rd
+653b98a2f5c34e372796df456f220933 *man/writePNG.Rd
+7fc91ecfbf95133433e23f2e50b4a66d *src/Makevars
+6c1ccc946d45a3351a32f63d8498f712 *src/Makevars.win
+99e46bd4b410b68b8fb9c1f3d66c859a *src/read.c
+b03bb7476f2872fef94827c1af6c8c13 *src/write.c
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..62de467
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,2 @@
+useDynLib(png, write_png, read_png)
+exportPattern(".*PNG")
diff --git a/NEWS b/NEWS
new file mode 100644
index 0000000..ba98db9
--- /dev/null
+++ b/NEWS
@@ -0,0 +1,69 @@
+NEWS/Changelog
+
+0.1-7 2013-12-03
+ o fix endianness issue in writePNG() on big-endian machines
+ when using nativeRaster
+
+0.1-6 2013-07-02
+ o add support for text tags as well as R object metadata
+ which is serialized into the text field
+ (Thanks to Duncan Temple Lang for the idea)
+
+
+0.1-5 2013-06-03
+ o add dpi and asp to writePNG() which allows to store the
+ image resolution or aspect ratio (via the sPHYs PNG tag).
+
+ o add info flag to readPNG() which interprets some optional
+ tags to return additional information such as dpi, asp
+ or gamma if stored.
+
+ o try to detect local libpng via LOCAL_SOFT on Windows.
+ Note that if you use LOCAL_SOFT, you are taking full
+ responsibility over the libraries that png will be linked
+ against.
+
+
+0.1-4 2011-12-10
+ o writePNG() now supports binary connection as target and the
+ default target is now raw()
+
+
+0.1-3 2011-09-02
+ o remove debugging output
+
+ o added a missing call to png_set_interlace_handling to allow
+ libpng to de-interlace images
+
+ o prevent warnings in readPNG() example for the windows device
+ which is incapable of any transparency
+
+
+0.1-2 2011-01-19
+ o support raw array as input to writePNG (RGBA only)
+
+ o do not truncate 16-bit images in readPNG() if the resulting
+ output is not nativeRaster
+
+ o Windows binary on RForge has been updated to libpng 1.5.0
+
+
+0.1-1 2010-04-06
+ o add tolerance to writePNG() to avoid shifts by one in
+ color because of numerical representation of discretized
+ values
+
+ o adapt to a last-minute change in R 2.11.0 from raster() to
+ rasterImage()
+
+ o add support for more efficient nativeRaster format
+
+
+0.1-0 2010-03-17
+ o first release on CRAN, supports readPNG() and writePNG()
+ for files and raw vectors. readPNG() supports any input
+ color type but will convert to 1-4 planes with 8-bit
+ accuracy each. writePNG() will write out 1-4 planes
+ 8-bit each. writePNG() has currenty no provision for
+ generating or stroring a palette.
+
diff --git a/R/read.R b/R/read.R
new file mode 100644
index 0000000..813eb55
--- /dev/null
+++ b/R/read.R
@@ -0,0 +1,11 @@
+readPNG <- function(source, native=FALSE, info=FALSE)
+ if (info) { ## extra processing to interpret R.metadata
+ if (!is.raw(source)) source <- path.expand(source)
+ x <- .Call(read_png, source, native, TRUE)
+ txt <- attr(x, "info")$text
+ if ("R.metadata" %in% names(txt)) {
+ attr(x, "metadata") <- unserialize(charToRaw(txt["R.metadata"]))
+ attr(x, "info")$text <- txt[-which(names(txt) == "R.metadata")]
+ }
+ x
+ } else .Call(read_png, if (is.raw(source)) source else path.expand(source), native, FALSE)
diff --git a/R/write.R b/R/write.R
new file mode 100644
index 0000000..a46e6ee
--- /dev/null
+++ b/R/write.R
@@ -0,0 +1,12 @@
+writePNG <- function(image, target = raw(), dpi = NULL, asp = NULL, text = NULL, metadata = NULL) {
+ if (!is.null(text) && !is.character(text)) text <- sapply(text, as.character)
+ if (!is.null(metadata)) {
+ rmd <- rawToChar(serialize(metadata, NULL, TRUE))
+ text <- if (is.null(text)) c(R.metadata=rmd) else c(text, R.metadata=rmd)
+ }
+ if (inherits(target, "connection")) {
+ r <- .Call(write_png, image, raw(), dpi, asp, text)
+ writeBin(r, target)
+ invisible(NULL)
+ } else invisible(.Call(write_png, image, if (is.raw(target)) target else path.expand(target), dpi, asp, text))
+}
diff --git a/configure.win b/configure.win
new file mode 100644
index 0000000..8b6e070
--- /dev/null
+++ b/configure.win
@@ -0,0 +1,72 @@
+#!/bin/sh
+
+echo " checking PNG headers and libraries"
+allok=yes
+use_local=no
+
+## In the future we should be able to use
+## local=`${R_HOME}/bin/R CMD config LOCAL_SOFT`
+## but up to at least R 3.0.1 that doesn't work
+if [ -z "$MAKE" ]; then
+ MAKE=`${R_HOME}/bin/R CMD config MAKE`
+ if [ -z "$MAKE" ]; then
+ MAKE=make
+ fi
+fi
+makefiles="-f ${R_HOME}/etc${R_ARCH}/Makeconf -f ${R_SHARE_DIR}/make/config.mk"
+local=`${MAKE} -s ${makefiles} print R_HOME=${R_HOME} VAR=LOCAL_SOFT`
+
+if [ -e $local/lib ]; then
+ if ls $local/lib/libpng.* 2>/dev/null; then
+ echo " found libpng in LOCAL_SOFT: $local/lib"
+ use_local=yes
+ elif ls $local/lib${R_ARCH}/libpng.* 2>/dev/null; then
+ echo " found libpng in LOCAL_SOFT: $local/lib${R_ARCH}"
+ use_local=yes
+ else
+ echo " LOCAL_SOFT does not contain libpng, fall back to external png"
+ fi
+else
+ echo " LOCAL_SOFT does not exist, fall back to external png"
+fi
+
+if [ ${use_local} = no ]; then
+ if [ ! -e src/win32/libz.a ]; then
+ if [ ! -e src/libpng-current-win.tar.gz ]; then
+ echo " cannot find current PNG files"
+ echo " attempting to download them"
+ echo 'download.file("http://www.rforge.net/png/files/libpng-current-win.tar.gz","src/libpng-current-win.tar.gz",mode="wb",quiet=TRUE)'|${R_HOME}/bin/R --vanilla --slave
+ fi
+ if [ ! -e src/libpng-current-win.tar.gz ]; then
+ allok=no
+ else
+ echo " unpacking current PNG"
+ tar fxz src/libpng-current-win.tar.gz -C src
+ if [ ! -e src/win32/libz.a ]; then
+ allok=no
+ fi
+ fi
+ fi
+
+ if [ ! -e src/win32/libz.a ]; then
+ allok=no
+ fi
+fi
+
+if [ ${allok} != yes ]; then
+ echo ""
+ echo " *** ERROR: unable to find PNG files"
+ echo ""
+ echo " They must be either in src/win32, in a tar-ball"
+ echo " src/libpng-current-win.tar.gz or"
+ echo " available via the LOCAL_SOFT R make setting."
+ echo ""
+ echo " You can get the latest binary tar ball from"
+ echo " http://www.rforge.net/png/files/"
+ echo ""
+ exit 1
+fi
+
+echo " seems ok, ready to go"
+
+exit 0
diff --git a/debian/changelog b/debian/changelog
deleted file mode 100644
index 66391b8..0000000
--- a/debian/changelog
+++ /dev/null
@@ -1,5 +0,0 @@
-r-cran-png (0.1-7-1) unstable; urgency=medium
-
- * Initial release (Closes: #837345)
-
- -- Andreas Tille <tille at debian.org> Sat, 10 Sep 2016 22:00:00 +0200
diff --git a/debian/compat b/debian/compat
deleted file mode 100644
index ec63514..0000000
--- a/debian/compat
+++ /dev/null
@@ -1 +0,0 @@
-9
diff --git a/debian/control b/debian/control
deleted file mode 100644
index e4c0735..0000000
--- a/debian/control
+++ /dev/null
@@ -1,23 +0,0 @@
-Source: r-cran-png
-Maintainer: Debian Med Packaging Team <debian-med-packaging at lists.alioth.debian.org>
-Uploaders: Andreas Tille <tille at debian.org>
-Section: gnu-r
-Priority: optional
-Build-Depends: debhelper (>= 9),
- cdbs,
- r-base-dev,
- libpng-dev,
-Standards-Version: 3.9.8
-Vcs-Browser: https://anonscm.debian.org/viewvc/debian-med/trunk/packages/R/r-cran-png/trunk/
-Vcs-Svn: svn://anonscm.debian.org/debian-med/trunk/packages/R/r-cran-png/trunk/
-Homepage: http://cran.r-project.org/web/packages/png
-
-Package: r-cran-png
-Architecture: any
-Depends: ${R:Depends},
- ${misc:Depends},
- ${shlibs:Depends}
-Description: GNU R package to read and write PNG images
- This package provides an easy and simple way to read, write and display
- bitmap images stored in the PNG format. It can read and write both
- files and in-memory raw vectors.
diff --git a/debian/copyright b/debian/copyright
deleted file mode 100644
index c2fcb4b..0000000
--- a/debian/copyright
+++ /dev/null
@@ -1,26 +0,0 @@
-Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
-Upstream-Contact: Simon Urbanek <Simon.Urbanek at r-project.org>
-Source: https://cran.r-project.org/web/packages/png
-
-Files: *
-Copyright: 2003-2013 of Simon Urbanek <Simon.Urbanek at r-project.org>
-License: GPL-2+
-
-Files: debian/*
-Copyright: 2014 Steffen Moeller <moeller at debian.org>
- 2016 Andreas Tille <tille at debian.org>
-License: GPL-2+
-
-License: GPL-2+
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- .
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- .
- On a Debian system the GNU General Public License version 2 is
- included in the file ‘/usr/share/common-licenses/GPL-2’.
diff --git a/debian/docs b/debian/docs
deleted file mode 100644
index 68509d9..0000000
--- a/debian/docs
+++ /dev/null
@@ -1,2 +0,0 @@
-NEWS
-DESCRIPTION
diff --git a/debian/rules b/debian/rules
deleted file mode 100755
index 0cf1cb2..0000000
--- a/debian/rules
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/usr/bin/make -f
-export DEB_BUILD_HARDENING=1
-export DEB_BUILD_MAINT_OPTIONS = hardening=+all
-include /usr/share/R/debian/r-cran.mk
diff --git a/debian/source/format b/debian/source/format
deleted file mode 100644
index 163aaf8..0000000
--- a/debian/source/format
+++ /dev/null
@@ -1 +0,0 @@
-3.0 (quilt)
diff --git a/debian/watch b/debian/watch
deleted file mode 100644
index 525fb63..0000000
--- a/debian/watch
+++ /dev/null
@@ -1,3 +0,0 @@
-version=3
-http://cran.r-project.org/src/contrib/png_([-0-9\.]*)\.tar\.gz
-
diff --git a/inst/img/Rlogo.png b/inst/img/Rlogo.png
new file mode 100644
index 0000000..9ae25fa
Binary files /dev/null and b/inst/img/Rlogo.png differ
diff --git a/man/readPNG.Rd b/man/readPNG.Rd
new file mode 100644
index 0000000..ec1a774
--- /dev/null
+++ b/man/readPNG.Rd
@@ -0,0 +1,86 @@
+\name{readPNG}
+\alias{readPNG}
+\title{
+Read a bitmap image stored in the PNG format
+}
+\description{
+Reads an image from a PNG file/content into a raster array.
+}
+\usage{
+readPNG(source, native = FALSE, info = FALSE)
+}
+\arguments{
+ \item{source}{Either name of the file to read from or a raw vector
+ representing the PNG file content.}
+ \item{native}{determines the image representation - if \code{FALSE}
+ (the default) then the result is an array, if \code{TRUE} then the
+ result is a native raster representation.}
+ \item{info}{logical, if \code{TRUE} additional \code{"info"} attribute
+ is attached to the result containing information from optional tags
+ in the file (such as bit depth, resolution, gamma, text etc.). If
+ the PNG file contains R metadata, it will also contain a
+ \code{"metadata"} attribute with the unserialized R object.}
+}
+%\details{
+%}
+\value{
+If \code{native} is \code{FALSE} then an array of the dimensions height
+x width x channels. If there is only one channel the result is a
+matrix. The values are reals between 0 and 1. If \code{native} is
+\code{TRUE} then an object of the class \code{nativeRaster} is
+returned instead. The latter cannot be easily computed on but is the
+most efficient way to draw using \code{rasterImage}.
+
+Most common files decompress into RGB (3 channels), RGBA (4 channels),
+Grayscale (1 channel) or GA (2 channels). Note that G and GA images
+cannot be directly used in \code{\link{rasterImage}} unless
+\code{native} is set to \code{TRUE} because \code{rasterImage} requires
+RGB or RGBA format (\code{nativeRaster} is always 8-bit RGBA).
+
+As of png 0.1-2 files with 16-bit channels are converted in full
+resolution to the array format, but the \code{nativeRaster} format only
+supports 8-bit and therefore a truncation is performed (eight least
+significant bits are dropped) with a warning if \code{native} is
+\code{TRUE}.
+}
+%\references{
+%}
+%\author{
+%}
+%\note{
+%}
+
+\seealso{
+\code{\link{rasterImage}}, \code{\link{writePNG}}
+}
+\examples{
+# read a sample file (R logo)
+img <- readPNG(system.file("img", "Rlogo.png", package="png"))
+
+# read it also in native format
+img.n <- readPNG(system.file("img", "Rlogo.png", package="png"), TRUE)
+
+# if your R supports it, we'll plot it
+if (exists("rasterImage")) { # can plot only in R 2.11.0 and higher
+ plot(1:2, type='n')
+
+ if (names(dev.cur()) == "windows") {
+ # windows device doesn't support semi-transparency so we'll need
+ # to flatten the image
+ transparent <- img[,,4] == 0
+ img <- as.raster(img[,,1:3])
+ img[transparent] <- NA
+
+ # interpolate must be FALSE on Windows, otherwise R will
+ # try to interpolate transparency and fail
+ rasterImage(img, 1.2, 1.27, 1.8, 1.73, interpolate=FALSE)
+
+ } else {
+ # any reasonable device will be fine using alpha
+ rasterImage(img, 1.2, 1.27, 1.8, 1.73)
+ rasterImage(img.n, 1.5, 1.5, 1.9, 1.8)
+
+ }
+}
+}
+\keyword{IO}
diff --git a/man/writePNG.Rd b/man/writePNG.Rd
new file mode 100644
index 0000000..35d4a0d
--- /dev/null
+++ b/man/writePNG.Rd
@@ -0,0 +1,105 @@
+\name{writePNG}
+\alias{writePNG}
+\title{
+Write a bitmap image in PNG format
+}
+\description{
+Create a PNG image from an array or matrix.
+}
+\usage{
+writePNG(image, target = raw(), dpi = NULL, asp = NULL,
+ text = NULL, metadata = NULL)
+}
+\arguments{
+ \item{image}{image represented by a real matrix or array with values
+ in the range of 0 to 1. Values outside this range will be
+ clipped. The object must be either two-dimensional (grayscale
+ matrix) or three dimensional array (third dimension specifying the
+ plane) and must have either one (grayscale), two (grayscale +
+ alpha), three (RGB) or four (RGB + alpha) planes. (For alternative
+ image specifications see deatils)}
+ \item{target}{Either name of the file to write, a binary connection or
+ a raw vector (\code{raw()} - the default - is good enough)
+ indicating that the output should be a raw vector.}
+ \item{dpi}{optional, if set, must be a numeric vector of length 1 or 2
+ specifying the resolution of the image in DPI (dots per inch) for x
+ and y (in that order) - it is recycled to length 2.}
+ \item{asp}{optional, if set, must be a numeric scalar specifying the
+ aspect ratio (\code{x / y}). \code{dpi} and \code{asp} are mututally
+ exclusive, speciyfing both is an error.}
+ \item{text}{optional, named character vector of entries that will be
+ saved in the text chunk of the PNG. Names are used as keys. Note
+ that the \code{"R.metadata"} key is reserved for internal use - see
+ below}
+ \item{metadata}{optional, an R object that will be serialized
+ into the \code{"R.metadata"} text key}
+}
+\value{
+ Either \code{NULL} if the target is a file or a raw vector containing
+ the compressed PNG image if the target was a raw vector.
+}
+\details{
+ \code{writePNG} takes an image as input and compresses it into PNG
+ format. The image input is usually a matrix (for grayscale images -
+ dimensions are width, height) or an array (for color and alpha
+ images - dimensions are width, height, planes) of reals. The planes
+ are interpreted in the sequence red, green, blue, alpha.
+
+ Alternative representation of an image is of \code{nativeRaster} class
+ which is an integer matrix with each entry representing one pixel in
+ binary encoded RGBA format (as used internally by R). It can be
+ obtained from \code{\link{readPNG}} using \code{native = TRUE}.
+
+ Finally, \code{writePNG} also supports raw array containing the RGBA
+ image as bytes. The dimensions of the raw array have to be planes,
+ width, height (because the storage is interleaved). Currently only 4
+ planes (RGBA) are supported and the processing is equivalent to that
+ of a native raster.
+
+ The result is either stored in a file (if \code{target} is a file
+ name), in a raw vector (if \code{target} is a raw vector) or sent to a
+ binary connection.
+
+ If either \code{dpi} or \code{asp} is set, the \code{sPHy} chunk is
+ generated based on that information. Note that not all image viewers
+ interpret this setting, and even fewer support non-square pixels.
+}
+%\references{
+%}
+\author{
+ Simon Urbanek
+}
+\note{
+ Currently \code{writePNG} only produces 8-bit, deflate-compressed,
+ non-quantized, non-interlaced images. Note in particular that
+ \code{\link{readPNG}} can read 16-bit channels but storing them
+ back using \code{writePNG} will strip the 8 LSB (irrelevant for
+ display purposes but possibly relevant for use of PNG in
+ signal-processing if the input is truly 16-bit wide).
+}
+\seealso{
+\code{\link{readPNG}}
+}
+\examples{
+# read a sample file (R logo)
+img <- readPNG(system.file("img","Rlogo.png",package="png"))
+# write the image into a raw vector
+r <- writePNG(img)
+# read it back again
+img2 <- readPNG(r)
+# it better be the same
+identical(img, img2)
+# try to write a native raster
+img3 <- readPNG(system.file("img","Rlogo.png",package="png"), TRUE)
+r2 <- writePNG(img3)
+img4 <- readPNG(r2, TRUE)
+identical(img3, img4)
+
+## text and metadata
+r <- writePNG(img, text=c(source=R.version.string),
+ metadata=sessionInfo())
+img5 <- readPNG(r, info=TRUE)
+attr(img5, "info")
+attr(img5, "metadata")
+}
+\keyword{IO}
diff --git a/src/Makevars b/src/Makevars
new file mode 100644
index 0000000..4ed3d3f
--- /dev/null
+++ b/src/Makevars
@@ -0,0 +1,2 @@
+PKG_LIBS=$(PNG_LIBS) `libpng-config --static --ldflags`
+PKG_CFLAGS=$(PNG_CFLAGS) `libpng-config --cflags`
diff --git a/src/Makevars.win b/src/Makevars.win
new file mode 100644
index 0000000..2b642ac
--- /dev/null
+++ b/src/Makevars.win
@@ -0,0 +1,8 @@
+## detect 64-bit Windows
+ifeq ($(strip $(shell $(R_HOME)/bin/R --slave -e 'cat(.Machine$$sizeof.pointer)')),8)
+PKG_CPPFLAGS=-Iwin64
+PKG_LIBS=-Lwin64 -lpng -lz
+else
+PKG_CPPFLAGS=-Iwin32
+PKG_LIBS=-Lwin32 -lpng -lz
+endif
diff --git a/src/read.c b/src/read.c
new file mode 100644
index 0000000..8bbddd7
--- /dev/null
+++ b/src/read.c
@@ -0,0 +1,334 @@
+#include <stdio.h>
+#include <string.h>
+#include <png.h>
+
+#include <Rinternals.h>
+/* for R_RGB / R_RGBA */
+#include <R_ext/GraphicsEngine.h>
+
+typedef struct read_job {
+ FILE *f;
+ int ptr, len;
+ char *data;
+} read_job_t;
+
+static void user_error_fn(png_structp png_ptr, png_const_charp error_msg) {
+ read_job_t *rj = (read_job_t*)png_get_error_ptr(png_ptr);
+ if (rj->f) fclose(rj->f);
+ Rf_error("libpng error: %s", error_msg);
+}
+
+static void user_warning_fn(png_structp png_ptr, png_const_charp warning_msg) {
+ Rf_warning("libpng warning: %s", warning_msg);
+}
+
+static void user_read_data(png_structp png_ptr, png_bytep data, png_size_t length) {
+ read_job_t *rj = (read_job_t*) png_get_io_ptr(png_ptr);
+ png_size_t to_read = length;
+ if (to_read > (rj->len - rj->ptr))
+ to_read = (rj->len - rj->ptr);
+ if (to_read > 0) {
+ memcpy(data, rj->data + rj->ptr, to_read);
+ rj->ptr += to_read;
+ }
+ if (to_read < length)
+ memset(data + length - to_read, 0, length - to_read);
+}
+
+#if USE_R_MALLOC
+static png_voidp malloc_fn(png_structp png_ptr, png_alloc_size_t size) {
+ return (png_voidp) R_alloc(1, size);
+}
+
+static void free_fn(png_structp png_ptr, png_voidp ptr) {
+ /* this is a no-op because R releases the memory at the end of the call */
+}
+#endif
+
+#define RX_swap32(X) (X) = (((unsigned int)X) >> 24) | ((((unsigned int)X) >> 8) & 0xff00) | (((unsigned int)X) << 24) | ((((unsigned int)X) & 0xff00) << 8)
+
+SEXP read_png(SEXP sFn, SEXP sNative, SEXP sInfo) {
+ SEXP res = R_NilValue, info_list = R_NilValue, info_tail = R_NilValue;
+ const char *fn;
+ char header[8];
+ int native = asInteger(sNative), info = (asInteger(sInfo) == 1);
+ FILE *f;
+ read_job_t rj;
+ png_structp png_ptr;
+ png_infop info_ptr;
+
+ if (TYPEOF(sFn) == RAWSXP) {
+ rj.data = (char*) RAW(sFn);
+ rj.len = LENGTH(sFn);
+ rj.ptr = 0;
+ rj.f = f = 0;
+ } else {
+ if (TYPEOF(sFn) != STRSXP || LENGTH(sFn) < 1) Rf_error("invalid filename");
+ fn = CHAR(STRING_ELT(sFn, 0));
+ f = fopen(fn, "rb");
+ if (!f) Rf_error("unable to open %s", fn);
+ if (fread(header, 1, 8, f) < 1 || png_sig_cmp((png_bytep) header, 0, 8)) {
+ fclose(f);
+ Rf_error("file is not in PNG format");
+ }
+ rj.f = f;
+ }
+
+ /* use our own error hanlding code and pass the fp so it can be closed on error */
+ png_ptr = png_create_read_struct(PNG_LIBPNG_VER_STRING, (png_voidp)&rj, user_error_fn, user_warning_fn);
+ if (!png_ptr) {
+ if (f) fclose(f);
+ Rf_error("unable to initialize libpng");
+ }
+
+ info_ptr = png_create_info_struct(png_ptr);
+ if (!info_ptr) {
+ if (f) fclose(f);
+ png_destroy_read_struct(&png_ptr, (png_infopp)NULL, (png_infopp)NULL);
+ Rf_error("unable to initialize libpng");
+ }
+
+ if (f) {
+ png_init_io(png_ptr, f);
+ png_set_sig_bytes(png_ptr, 8);
+ } else
+ png_set_read_fn(png_ptr, (png_voidp) &rj, user_read_data);
+
+#define add_info(K, V) { info_tail = SETCDR(info_tail, CONS(V, R_NilValue)); SET_TAG(info_tail, install(K)); }
+
+ /* png_read_png(png_ptr, info_ptr, PNG_TRANSFORM_STRIP_16 | PNG_TRANSFORM_EXPAND, NULL); */
+ png_read_info(png_ptr, info_ptr);
+ {
+ png_uint_32 width, height;
+ png_bytepp row_pointers;
+ char *img_memory;
+ SEXP dim;
+ int bit_depth, color_type, interlace_type, compression_type, filter_method, rowbytes;
+ int need_swap = 0;
+ png_get_IHDR(png_ptr, info_ptr, &width, &height,
+ &bit_depth, &color_type, &interlace_type,
+ &compression_type, &filter_method);
+ rowbytes = png_get_rowbytes(png_ptr, info_ptr);
+#if VERBOSE_INFO
+ Rprintf("png: %d x %d [%d], %d bytes, 0x%x, %d, %d\n", (int) width, (int) height, bit_depth, rowbytes,
+ color_type, interlace_type, compression_type, filter_method);
+#endif
+
+ if (info) {
+ SEXP dv;
+ double d;
+ png_uint_32 rx, ry;
+ int ut, num_text = 0;
+ png_textp text_ptr;
+
+ info_tail = info_list = PROTECT(CONS((dv = allocVector(INTSXP, 2)), R_NilValue));
+ INTEGER(dv)[0] = (int) width;
+ INTEGER(dv)[1] = (int) height;
+ SET_TAG(info_list, install("dim"));
+ add_info("bit.depth", ScalarInteger(bit_depth));
+ switch(color_type) {
+ case PNG_COLOR_TYPE_GRAY: add_info("color.type", mkString("gray")); break;
+ case PNG_COLOR_TYPE_GRAY_ALPHA: add_info("color.type", mkString("gray + alpha")); break;
+ case PNG_COLOR_TYPE_PALETTE: add_info("color.type", mkString("palette")); break;
+ case PNG_COLOR_TYPE_RGB: add_info("color.type", mkString("RGB")); break;
+ case PNG_COLOR_TYPE_RGB_ALPHA: add_info("color.type", mkString("RGBA")); break;
+ default: add_info("color.type", ScalarInteger(color_type));
+ }
+ if (png_get_gAMA(png_ptr, info_ptr, &d)) add_info("gamma", ScalarReal(d));
+#ifdef PNG_pHYs_SUPPORTED
+ if (png_get_pHYs(png_ptr, info_ptr, &rx, &ry, &ut)) {
+ if (ut == PNG_RESOLUTION_METER) {
+ dv = allocVector(REALSXP, 2);
+ REAL(dv)[0] = ((double)rx) / 39.37008;
+ REAL(dv)[1] = ((double)ry) / 39.37008;
+ add_info("dpi", dv);
+ } else if (ut == PNG_RESOLUTION_UNKNOWN)
+ add_info("asp", ScalarReal(rx / ry));
+ }
+ if (png_get_text(png_ptr, info_ptr, &text_ptr, &num_text)) {
+ SEXP txt_key, txt_val = PROTECT(allocVector(STRSXP, num_text));
+ if (num_text) {
+ int i;
+ setAttrib(txt_val, R_NamesSymbol, txt_key = allocVector(STRSXP, num_text));
+ for (i = 0; i < num_text; i++) {
+ SET_STRING_ELT(txt_val, i, text_ptr[i].text ? mkChar(text_ptr[i].text) : NA_STRING);
+ SET_STRING_ELT(txt_key, i, text_ptr[i].key ? mkChar(text_ptr[i].key) : NA_STRING);
+ }
+ }
+ add_info("text", txt_val);
+ UNPROTECT(1);
+ }
+#endif
+ }
+
+ /* on little-endian machines it's all well, but on big-endian ones we'll have to swap */
+#if ! defined (__BIG_ENDIAN__) && ! defined (__LITTLE_ENDIAN__) /* old compiler so have to use run-time check */
+ {
+ char bo[4] = { 1, 0, 0, 0 };
+ int bi;
+ memcpy(&bi, bo, 4);
+ if (bi != 1)
+ need_swap = 1;
+ }
+#endif
+#ifdef __BIG_ENDIAN__
+ need_swap = 1;
+#endif
+
+ /*==== set any transforms that we desire: ====*/
+ /* palette->RGB - no discussion there */
+ if (color_type == PNG_COLOR_TYPE_PALETTE)
+ png_set_palette_to_rgb(png_ptr);
+ /* expand gray scale to 8 bits */
+ if (color_type == PNG_COLOR_TYPE_GRAY &&
+ bit_depth < 8) png_set_expand_gray_1_2_4_to_8(png_ptr);
+ /* this should not be necessary but it's in the docs to guarantee 8-bit */
+ if (bit_depth < 8)
+ png_set_packing(png_ptr);
+ /* convert tRNS chunk into alpha */
+ if (png_get_valid(png_ptr, info_ptr, PNG_INFO_tRNS))
+ png_set_tRNS_to_alpha(png_ptr);
+ /* native format doesn't allow for 16-bit so it needs to be truncated */
+ if (bit_depth == 16 && native) {
+ Rf_warning("Image uses 16-bit channels but R native format only supports 8-bit, truncating LSB.");
+ png_set_strip_16(png_ptr);
+ }
+ /* for native output we need to a) convert gray to RGB, b) add alpha */
+ if (native) {
+ if (color_type == PNG_COLOR_TYPE_GRAY || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
+ png_set_gray_to_rgb(png_ptr);
+ if (!(color_type & PNG_COLOR_MASK_ALPHA)) /* if there is no alpha, add it */
+ png_set_add_alpha(png_ptr, 0xFF, PNG_FILLER_AFTER);
+ }
+#if 0 /* we use native (network) endianness since we read each byte anyway */
+ /* on little-endian machines we need to swap 16-bit values - this is the inverse of need_swap as used for R! */
+ if (!need_swap && bit_depth == 16)
+ png_set_swap(png_ptr);
+#endif
+
+ /* PNG wants up to call png_set_interlace_handling so it can get ready to de-interlace images */
+ png_set_interlace_handling(png_ptr);
+
+ /* all transformations are in place, so it's time to update the info structure so we can allocate stuff */
+ png_read_update_info(png_ptr, info_ptr);
+
+ /* re-read some important bits from the updated structure */
+ rowbytes = png_get_rowbytes(png_ptr, info_ptr);
+ bit_depth = png_get_bit_depth(png_ptr, info_ptr);
+ color_type = png_get_color_type(png_ptr, info_ptr);
+
+#if VERBOSE_INFO
+ Rprintf(" -filter-> %d-bits, %d bytes, 0x%x\n", bit_depth, rowbytes, color_type);
+#endif
+
+ /* allocate data fro row pointers and the image using R's allocation */
+ row_pointers = (png_bytepp) R_alloc(height, sizeof(png_bytep));
+ img_memory = R_alloc(height, rowbytes);
+ { /* populate the row pointers */
+ char *i_ptr = img_memory;
+ int i;
+ for (i = 0; i < height; i++, i_ptr += rowbytes)
+ row_pointers[i] = (png_bytep) i_ptr;
+ }
+
+ /* do the reading work */
+ png_read_image(png_ptr, row_pointers);
+
+ if (f) {
+ rj.f = 0;
+ fclose(f);
+ }
+
+ /* native output - vector of integers */
+ if (native) {
+ int pln = rowbytes / width;
+ if (pln < 1 || pln > 4) {
+ png_destroy_read_struct(&png_ptr, &info_ptr, (png_infopp)NULL);
+ Rf_error("native output for %d planes is not possible.", pln);
+ }
+
+ res = PROTECT(allocVector(INTSXP, width * height));
+ if (pln == 4) { /* 4 planes - efficient - just copy it all */
+ int y, *idata = INTEGER(res);
+ for (y = 0; y < height; idata += width, y++)
+ memcpy(idata, row_pointers[y], width * sizeof(int));
+
+ if (need_swap) {
+ int *ide = idata;
+ idata = INTEGER(res);
+ for (; idata < ide; idata++)
+ RX_swap32(*idata);
+ }
+ } else if (pln == 3) { /* RGB */
+ int x, y, *idata = INTEGER(res);
+ for (y = 0; y < height; y++)
+ for (x = 0; x < rowbytes; x += 3)
+ *(idata++) = R_RGB((unsigned int) row_pointers[y][x],
+ (unsigned int) row_pointers[y][x + 1],
+ (unsigned int) row_pointers[y][x + 2]);
+ } else if (pln == 2) { /* GA */
+ int x, y, *idata = INTEGER(res);
+ for (y = 0; y < height; y++)
+ for (x = 0; x < rowbytes; x += 2)
+ *(idata++) = R_RGBA((unsigned int) row_pointers[y][x],
+ (unsigned int) row_pointers[y][x],
+ (unsigned int) row_pointers[y][x],
+ (unsigned int) row_pointers[y][x + 1]);
+ } else { /* gray */
+ int x, y, *idata = INTEGER(res);
+ for (y = 0; y < height; y++)
+ for (x = 0; x < rowbytes; x++)
+ *(idata++) = R_RGB((unsigned int) row_pointers[y][x],
+ (unsigned int) row_pointers[y][x],
+ (unsigned int) row_pointers[y][x]);
+ }
+ dim = allocVector(INTSXP, 2);
+ INTEGER(dim)[0] = height;
+ INTEGER(dim)[1] = width;
+ setAttrib(res, R_DimSymbol, dim);
+ setAttrib(res, R_ClassSymbol, mkString("nativeRaster"));
+ setAttrib(res, install("channels"), ScalarInteger(pln));
+ UNPROTECT(1);
+ } else {
+ int x, y, p, pln = rowbytes / width, pls = width * height;
+ double * data;
+ if (bit_depth == 16) {
+ res = PROTECT(allocVector(REALSXP, (rowbytes * height) / 2));
+ pln /= 2;
+ } else
+ res = PROTECT(allocVector(REALSXP, rowbytes * height));
+
+ data = REAL(res);
+ if (bit_depth == 16)
+ for(y = 0; y < height; y++)
+ for (x = 0; x < width; x++)
+ for (p = 0; p < pln; p++)
+ data[y + x * height + p * pls] = ((double)(
+ (((unsigned int)(((unsigned char *)row_pointers[y])[2 * (x * pln + p)])) << 8) |
+ ((unsigned int)(((unsigned char *)row_pointers[y])[2 * (x * pln + p) + 1]))
+ )) / 65535.0;
+ else
+ for(y = 0; y < height; y++)
+ for (x = 0; x < width; x++)
+ for (p = 0; p < pln; p++)
+ data[y + x * height + p * pls] = ((double)row_pointers[y][x * pln + p]) / 255.0;
+ dim = allocVector(INTSXP, (pln > 1) ? 3 : 2);
+ INTEGER(dim)[0] = height;
+ INTEGER(dim)[1] = width;
+ if (pln > 1)
+ INTEGER(dim)[2] = pln;
+ setAttrib(res, R_DimSymbol, dim);
+ UNPROTECT(1);
+ }
+ }
+
+ if (info) {
+ PROTECT(res);
+ setAttrib(res, install("info"), info_list);
+ UNPROTECT(2);
+ }
+
+ png_destroy_read_struct(&png_ptr, &info_ptr, (png_infopp)NULL);
+
+ return res;
+}
diff --git a/src/write.c b/src/write.c
new file mode 100644
index 0000000..ef9444a
--- /dev/null
+++ b/src/write.c
@@ -0,0 +1,308 @@
+#include <stdio.h>
+#include <string.h>
+#include <png.h>
+
+#include <Rinternals.h>
+/* for R_RED, ..., R_ALPHA */
+#include <R_ext/GraphicsEngine.h>
+
+typedef struct write_job {
+ FILE *f;
+ int ptr, len;
+ char *data;
+ SEXP rvlist, rvtail;
+ int rvlen;
+} write_job_t;
+
+/* default size of a raw vector chunk when collecting the image result */
+#define INIT_SIZE (1024*256)
+
+static void user_error_fn(png_structp png_ptr, png_const_charp error_msg) {
+ write_job_t *rj = (write_job_t*)png_get_error_ptr(png_ptr);
+ if (rj->f) fclose(rj->f);
+ Rf_error("libpng error: %s", error_msg);
+}
+
+static void user_warning_fn(png_structp png_ptr, png_const_charp warning_msg) {
+ Rf_warning("libpng warning: %s", warning_msg);
+}
+
+static void user_write_data(png_structp png_ptr, png_bytep data, png_size_t length) {
+ write_job_t *rj = (write_job_t*) png_get_io_ptr(png_ptr);
+ png_size_t to_write = length;
+ while (length) { /* use iteration instead of recursion */
+ if (to_write > (rj->len - rj->ptr))
+ to_write = (rj->len - rj->ptr);
+ if (to_write > 0) {
+ memcpy(rj->data + rj->ptr, data, to_write);
+ rj->ptr += to_write;
+ length -= to_write;
+ data += to_write;
+ rj->rvlen += to_write;
+ }
+ if (length) { /* more to go -- need next buffer */
+ SEXP rv = allocVector(RAWSXP, INIT_SIZE);
+ SETCDR(rj->rvtail, CONS(rv, R_NilValue));
+ rj->rvtail = CDR(rj->rvtail);
+ rj->len = LENGTH(rv);
+ rj->data = (char*) RAW(rv);
+ rj->ptr = 0;
+ to_write = length;
+ }
+ }
+}
+
+static void user_flush_data(png_structp png_ptr) {
+}
+
+#if USE_R_MALLOC
+static png_voidp malloc_fn(png_structp png_ptr, png_alloc_size_t size) {
+ return (png_voidp) R_alloc(1, size);
+}
+
+static void free_fn(png_structp png_ptr, png_voidp ptr) {
+ /* this is a no-op because R releases the memory at the end of the call */
+}
+#endif
+
+#define RX_swap32(X) (X) = (((unsigned int)(X)) >> 24) | ((((unsigned int)(X)) >> 8) & 0xff00) | (((unsigned int)(X)) << 24) | ((((unsigned int)(X)) & 0xff00) << 8)
+
+SEXP write_png(SEXP image, SEXP sFn, SEXP sDPI, SEXP sAsp, SEXP sText) {
+ SEXP res = R_NilValue, dims;
+ const char *fn;
+ int planes = 1, width, height, native = 0, raw_array = 0, use_dpi = 0;
+ double dpi_x = 0, dpi_y = 0;
+ FILE *f;
+ write_job_t rj;
+ png_structp png_ptr;
+ png_infop info_ptr;
+
+ if (inherits(image, "nativeRaster") && TYPEOF(image) == INTSXP)
+ native = 1;
+
+ if (TYPEOF(image) == RAWSXP)
+ raw_array = 1;
+
+ if (!native && !raw_array && TYPEOF(image) != REALSXP)
+ Rf_error("image must be a matrix or array of raw or real numbers");
+
+ if (TYPEOF(sDPI) == REALSXP || TYPEOF(sDPI) == INTSXP) {
+ if (LENGTH(sDPI) < 1 || LENGTH(sDPI) > 2) Rf_error("invalid dpi specification - must be NULL or a numeric vector of length 1 or 2");
+ if (TYPEOF(sDPI) == REALSXP) {
+ dpi_x = REAL(sDPI)[0];
+ dpi_y = (LENGTH(sDPI) > 1) ? REAL(sDPI)[1] : dpi_x;
+ } else {
+ dpi_x = INTEGER(sDPI)[0];
+ dpi_y = (LENGTH(sDPI) > 1) ? INTEGER(sDPI)[1] : dpi_x;
+ }
+ use_dpi = 1;
+ } else if (sDPI != R_NilValue)
+ Rf_error("invalid `dpi' specification - must be NULL or a numeric vector of length 1 or 2");
+
+ if (((TYPEOF(sAsp) == REALSXP || TYPEOF(sAsp) == INTSXP) && LENGTH(sAsp) != 1) ||
+ (sAsp != R_NilValue && TYPEOF(sAsp) != REALSXP && TYPEOF(sAsp) != INTSXP))
+ Rf_error("invalid `asp' specification - must be NULL or a numeric scalar");
+ if (use_dpi && sAsp != R_NilValue)
+ Rf_error("`asp' and `dpi' are mutually exclusive");
+ if (sAsp != R_NilValue) {
+ dpi_x = asReal(sAsp);
+ dpi_y = 1.0;
+ use_dpi = 2;
+ }
+
+ dims = Rf_getAttrib(image, R_DimSymbol);
+ if (dims == R_NilValue || TYPEOF(dims) != INTSXP || LENGTH(dims) < 2 || LENGTH(dims) > 3)
+ Rf_error("image must be a matrix or an array of two or three dimensions");
+
+ if (raw_array && LENGTH(dims) == 3) { /* raw arrays have either bpp, width, height or width, height dimensions */
+ planes = INTEGER(dims)[0];
+ width = INTEGER(dims)[1];
+ height = INTEGER(dims)[2];
+ } else { /* others have width, height[, bpp] */
+ width = INTEGER(dims)[1];
+ height = INTEGER(dims)[0];
+ if (LENGTH(dims) == 3)
+ planes = INTEGER(dims)[2];
+ }
+
+ if (planes < 1 || planes > 4)
+ Rf_error("image must have either 1 (grayscale), 2 (GA), 3 (RGB) or 4 (RGBA) planes");
+
+ if (native && planes > 1)
+ Rf_error("native raster must be a matrix");
+
+ if (native) { /* nativeRaster should have a "channels" attribute if it has anything else than 4 channels */
+ SEXP cha = getAttrib(image, install("channels"));
+ if (cha != R_NilValue) {
+ planes = asInteger(cha);
+ if (planes < 1 || planes > 4)
+ planes = 4;
+ } else
+ planes = 4;
+ }
+ if (raw_array) {
+ if (planes != 4)
+ Rf_error("Only RGBA format is supported as raw data");
+ native = 1; /* from now on we treat raw arrays like native */
+ }
+
+ if (TYPEOF(sFn) == RAWSXP) {
+ SEXP rv = allocVector(RAWSXP, INIT_SIZE);
+ rj.rvtail = rj.rvlist = PROTECT(CONS(rv, R_NilValue));
+ rj.data = (char*) RAW(rv);
+ rj.len = LENGTH(rv);
+ rj.ptr = 0;
+ rj.rvlen = 0;
+ rj.f = f = 0;
+ } else {
+ if (TYPEOF(sFn) != STRSXP || LENGTH(sFn) < 1) Rf_error("invalid filename");
+ fn = CHAR(STRING_ELT(sFn, 0));
+ f = fopen(fn, "wb");
+ if (!f) Rf_error("unable to create %s", fn);
+ rj.f = f;
+ }
+
+ /* use our own error hanlding code and pass the fp so it can be closed on error */
+ png_ptr = png_create_write_struct(PNG_LIBPNG_VER_STRING, (png_voidp)&rj, user_error_fn, user_warning_fn);
+ if (!png_ptr) {
+ if (f) fclose(f);
+ Rf_error("unable to initialize libpng");
+ }
+
+ info_ptr = png_create_info_struct(png_ptr);
+ if (!info_ptr) {
+ if (f) fclose(f);
+ png_destroy_write_struct(&png_ptr, (png_infopp)NULL);
+ Rf_error("unable to initialize libpng");
+ }
+
+ if (f)
+ png_init_io(png_ptr, f);
+ else
+ png_set_write_fn(png_ptr, (png_voidp) &rj, user_write_data, user_flush_data);
+
+ png_set_IHDR(png_ptr, info_ptr, width, height, 8,
+ (planes == 1) ? PNG_COLOR_TYPE_GRAY : ((planes == 2) ? PNG_COLOR_TYPE_GRAY_ALPHA : ((planes == 3) ? PNG_COLOR_TYPE_RGB : PNG_COLOR_TYPE_RGB_ALPHA)),
+ PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
+
+#ifdef PNG_pHYs_SUPPORTED
+ if (use_dpi == 1)
+ png_set_pHYs(png_ptr, info_ptr, dpi_x * 39.37008, dpi_y * 39.37008, PNG_RESOLUTION_METER);
+ else if (use_dpi == 2)
+ png_set_pHYs(png_ptr, info_ptr, dpi_x * 10000.0, dpi_y * 10000.0, PNG_RESOLUTION_UNKNOWN);
+#else
+ if (use_dpi) Rf_warning("pHYs is unsupported in your build of libpng, cannot set dpi/asp");
+#endif
+
+ if (TYPEOF(sText) == STRSXP && LENGTH(sText)) {
+ SEXP nam = getAttrib(sText, R_NamesSymbol);
+ int i, n = LENGTH(sText);
+ {
+ png_text text_ptr[n]; /* text_ptr can be transient but the char* pointers must be valid until info is written! */
+ for (i = 0; i < n; i++) {
+ text_ptr[i].compression = PNG_TEXT_COMPRESSION_NONE;
+ text_ptr[i].key = (char*) ((nam == R_NilValue || i >= LENGTH(nam)) ? "" : CHAR(STRING_ELT(nam, i)));
+ text_ptr[i].text = (char*) CHAR(STRING_ELT(sText, i));
+ }
+ png_set_text(png_ptr, info_ptr, text_ptr, n);
+ }
+ }
+
+ {
+ int rowbytes = width * planes, i;
+ png_bytepp row_pointers;
+ png_bytep flat_rows;
+
+ row_pointers = (png_bytepp) R_alloc(height, sizeof(png_bytep));
+ flat_rows = (png_bytep) R_alloc(height, width * planes);
+ for(i = 0; i < height; i++)
+ row_pointers[i] = flat_rows + (i * width * planes);
+
+ if (!native) {
+ int x, y, p, pls = width * height;
+ double *data = REAL(image);
+ for(y = 0; y < height; y++)
+ for (x = 0; x < width; x++)
+ for (p = 0; p < planes; p++) {
+ double v = data[y + x * height + p * pls];
+ if (v < 0) v = 0;
+ if (v > 255.0) v = 1.0;
+ row_pointers[y][x * planes + p] = (unsigned char)(v * 255.0 + 0.5);
+ }
+ } else {
+ if (planes == 4) { /* 4 planes - efficient - just copy it all */
+ int y, *idata = raw_array ? ((int*) RAW(image)) : INTEGER(image), need_swap = 0;
+ for (y = 0; y < height; idata += width, y++)
+ memcpy(row_pointers[y], idata, width * sizeof(int));
+
+ /* on little-endian machines it's all well, but on big-endian ones we'll have to swap */
+#if ! defined (__BIG_ENDIAN__) && ! defined (__LITTLE_ENDIAN__) /* old compiler so have to use run-time check */
+ {
+ char bo[4] = { 1, 0, 0, 0 };
+ int bi;
+ memcpy(&bi, bo, 4);
+ if (bi != 1)
+ need_swap = 1;
+ }
+#endif
+#ifdef __BIG_ENDIAN__
+ need_swap = 1;
+#endif
+ if (need_swap) {
+ unsigned int *idp = (unsigned int*) flat_rows, *ide = idp + (height * width);
+ for (; idp < ide; idp++)
+ RX_swap32(*idp);
+ }
+ } else if (planes == 3) { /* RGB */
+ int x, y, *idata = INTEGER(res);
+ for (y = 0; y < height; y++)
+ for (x = 0; x < rowbytes; idata++) {
+ row_pointers[y][x++] = R_RED(*idata);
+ row_pointers[y][x++] = R_GREEN(*idata);
+ row_pointers[y][x++] = R_BLUE(*idata);
+ }
+ } else if (planes == 2) { /* GA */
+ int x, y, *idata = INTEGER(res);
+ for (y = 0; y < height; y++)
+ for (x = 0; x < rowbytes; idata++) {
+ row_pointers[y][x++] = R_RED(*idata);
+ row_pointers[y][x++] = R_ALPHA(*idata);
+ }
+ } else { /* gray */
+ int x, y, *idata = INTEGER(res);
+ for (y = 0; y < height; y++)
+ for (x = 0; x < rowbytes; idata++)
+ row_pointers[y][x++] = R_RED(*idata);
+ }
+ }
+
+ png_set_rows(png_ptr, info_ptr, row_pointers);
+ }
+
+ png_write_png(png_ptr, info_ptr, PNG_TRANSFORM_IDENTITY, NULL);
+
+ png_destroy_write_struct(&png_ptr, &info_ptr);
+
+ if (f) { /* if it is a file, just return */
+ fclose(f);
+ return R_NilValue;
+ }
+
+ /* otherwise collect the vector blocks into one vector */
+ res = allocVector(RAWSXP, rj.rvlen);
+ {
+ int to_go = rj.rvlen;
+ unsigned char *data = RAW(res);
+ while (to_go && rj.rvlist != R_NilValue) {
+ SEXP ve = CAR(rj.rvlist);
+ int this_len = (to_go > LENGTH(ve)) ? LENGTH(ve) : to_go;
+ memcpy(data, RAW(ve), this_len);
+ to_go -= this_len;
+ data += this_len;
+ rj.rvlist = CDR(rj.rvlist);
+ }
+ }
+
+ UNPROTECT(1);
+ return res;
+}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-png.git
More information about the debian-med-commit
mailing list