jpeg/0000755000175100001440000000000013554335210011216 5ustar hornikusersjpeg/NAMESPACE0000644000175100001440000000005012270263732012433 0ustar hornikusersuseDynLib(jpeg) exportPattern(".*JPEG") jpeg/man/0000755000175100001440000000000012270263732011774 5ustar hornikusersjpeg/man/writeJPEG.Rd0000644000175100001440000001022512270263732014063 0ustar hornikusers\name{writeJPEG} \alias{writeJPEG} \title{ Write a bitmap image in JPEG format } \description{ Create a JPEG image from an array or matrix. } \usage{ writeJPEG(image, target = raw(), quality = 0.7, bg = "white", color.space) } \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 to, or a binary connection, or a raw vector (\code{raw()} - the default - is good enough) indicating that the output should be a raw vector.} \item{quality}{JPEG quality - a real number between 0 (lowest) and 1 (highest) controlling the quality of the output. Lower quality produces smaller, but more lossy files.} \item{bg}{background color - used only if the input contains alpha channel since JPEG does not support storage of the alpha channel and thus the image needs to be flattened as if it was placed over the background of this color.} \item{color.space}{color space in which the image data is to be interpreted. Defaults to the \code{"color.space"} attribute of the image and \code{NULL} is interpreted as the default color space. The color space specified here must match the image array dimensions, no conversions are performed. Currently the only supported non-default color space is \code{"CMYK"} for four-channel images (which would be interpreted as \code{"RGBA"} if the color space is not specified).} } \value{ \code{NULL} if the target is either a file or connection, or a raw vector containing the compressed JPEG image if the target was a raw vector. } \details{ \code{writeJPEG} takes an image as input and compresses it into JPEG 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. For convenience \code{writeJPEG} allows the source to include alpha channel, but JPEG does NOT support alpha channel so it will be blended against the specified background. 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{readJPEG}} using \code{native = TRUE}. Finally, \code{writeJPEG} also supports raw array containing the RGBA (or CMYK) 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 and CMYK) are supported and the processing of RGBA is equivalent to that of a native raster. The result is either stored in a file (if \code{target} is a file name), send to a binary connection (if \code{target} is a connection) or stored in a raw vector (if \code{target} is a raw vector). } %\references{ %} %\author{ %} \note{ Currently \code{writeJPEG} only produces 8-bit, non-progressive JPEG format with no additional tags. } \seealso{ \code{\link{readJPEG}} } \examples{ # read a sample file (R logo) img <- readJPEG(system.file("img","Rlogo.jpg",package="jpeg")) # write the image into a raw vector - using a low quality r <- writeJPEG(img, raw(), quality=0.3) # read it back again img2 <- readJPEG(r) # it will be slightly different since JPEG is a lossy format # in particular at the low quality max(abs(img - img2)) stopifnot(max(abs(img - img2)) < 0.4) # try to write a native raster img3 <- readJPEG(system.file("img","Rlogo.jpg",package="jpeg"), TRUE) r2 <- writeJPEG(img3, raw()) img4 <- readJPEG(r2, TRUE) # comparing nativeRaster values is not easy, so let's do write/read again img5 <- readJPEG(writeJPEG(img4, raw())) max(abs(img - img5)) stopifnot(max(abs(img - img5)) < 0.3) } \keyword{IO} jpeg/man/readJPEG.Rd0000644000175100001440000000422612270263732013650 0ustar hornikusers\name{readJPEG} \alias{readJPEG} \title{ Read a bitmap image stored in the JPEG format } \description{ Reads an image from a JPEG file/content into a raster array. } \usage{ readJPEG(source, native = FALSE) } \arguments{ \item{source}{Either name of the file to read from or a raw vector representing the JPEG 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.} } %\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) or Grayscale (1 channel). Note that Grayscale 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). JPEG doesn't support alpha channel, you may want to use PNG instead in such situations. } %\references{ %} %\author{ %} \note{ CMYK JPEG images saved by Adobe Photoshop may have inverted ink values due to a bug in Photoshop. Unfortunately this includes some sample CMYK images that are floating around, so beware of the source when converting the result to other color spaces. \code{readJPEG} will preserve values exactly as they are encoded in the file. } \seealso{ \code{\link{rasterImage}}, \code{\link{writeJPEG}} } \examples{ # read a sample file (R logo) img <- readJPEG(system.file("img", "Rlogo.jpg", package="jpeg")) # read it also in native format img.n <- readJPEG(system.file("img", "Rlogo.jpg", package="jpeg"), 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') rasterImage(img, 1.2, 1.27, 1.8, 1.73) rasterImage(img.n, 1.5, 1.5, 1.9, 1.8) } } \keyword{IO} jpeg/DESCRIPTION0000644000175100001440000000111413554335210012721 0ustar hornikusersPackage: jpeg Version: 0.1-8.1 Title: Read and write JPEG images Author: Simon Urbanek Maintainer: Simon Urbanek Depends: R (>= 2.9.0) Description: This package provides an easy and simple way to read, write and display bitmap images stored in the JPEG format. It can read and write both files and in-memory raw vectors. License: GPL-2 | GPL-3 SystemRequirements: libjpeg URL: http://www.rforge.net/jpeg/ Packaged: 2019-10-24 14:50:27 UTC; hornik NeedsCompilation: yes Repository: CRAN Date/Publication: 2019-10-24 14:51:52 UTC jpeg/tests/0000755000175100001440000000000012270263732012363 5ustar hornikusersjpeg/tests/jpeg.R0000644000175100001440000000723112270263732013436 0ustar hornikuserslibrary(jpeg) ## grayscale s0 <- matrix(0:9999/9999, 100) j0 <- writeJPEG(s0, raw()) i0 <- readJPEG(j0) # allow 2% tolerance when comparing uncompressed and compressed images # since JPEG is lossy (the default quality is 0.7 which should be good enough) tolerance <- 0.02 stopifnot(identical(dim(i0), dim(s0))) # JPEG is lossy so there will be differences but they should not be too big stopifnot(max(abs(s0 - i0)) < tolerance) n0 <- readJPEG(j0, native=TRUE) stopifnot(identical(dim(i0), dim(s0))) stopifnot(inherits(n0, "nativeRaster") && identical(attr(n0, "channels"), 1L)) # check the native result for sanity - it should be XXXA # the 8 MSB must be 1 since the alpha is 1.0 (-16777216L .. 0L) stopifnot(all(n0 < 0L & n0 >= -16777216L)) # remove the MSB y <- n0 + 16777216L x <- as.integer(s0 * 255 + 0.5) stopifnot(max(abs(x - t(y %% 256L))) < tolerance * 255) stopifnot(all(as.integer(y / 256L) %% 256L == y %% 256L)) stopifnot(all(as.integer(y / 65536L) %% 256L == y %% 256L)) # check file vs in-memory writeJPEG(s0, "image0.jpeg") s <- file.info("image0.jpeg")$size stopifnot(all(s == length(j0))) f <- file("image0.jpeg", "rb") j0f <- readBin(f, raw(), s) close(f) stopifnot(identical(c(j0f), c(j0))) i0f <- readJPEG("image0.jpeg") stopifnot(identical(i0f, i0)) n0f <- readJPEG("image0.jpeg", native=TRUE) stopifnot(identical(n0f, n0)) ## GA + alpha mixing a1 <- array(c(s0, rev(s0)), c(100L, 100L, 2L)) j1 <- writeJPEG(a1, raw(), bg="black") i1 <- readJPEG(j1) # since JPEG flattens alpha it will have the dimensions of s0 instead of a1 stopifnot(identical(dim(i1), dim(s0))) s1 <- s0 * rev(s0) ## this should be the result of alpha blending with black stopifnot(max(abs(s1 - i1)) < tolerance) i1.1 <- readJPEG(writeJPEG(a1, raw(), bg="white")) s1.1 <- s0 * rev(s0) + (1 - rev(s0)) stopifnot(max(abs(s1.1 - i1.1)) < tolerance) ## RGB a2 <- array(c(s0, t(s0), rev(s0)), c(100L, 100L, 3L)) j2 <- writeJPEG(a2, raw()) i2 <- readJPEG(j2) stopifnot(identical(dim(a2), dim(i2))) # more tolerance since we have 3x more data to compress stopifnot(max(abs(a2 - i2)) < tolerance * 3) # since RGB is most frequently used, check file vs raw as well writeJPEG(a2, "image2.jpeg") s <- file.info("image2.jpeg")$size stopifnot(all(s == length(j2))) f <- file("image2.jpeg", "rb") j2f <- readBin(f, raw(), s) close(f) stopifnot(identical(c(j2f), c(j2))) i2f <- readJPEG("image2.jpeg") stopifnot(identical(i2f, i2)) n2f <- readJPEG("image2.jpeg", native=TRUE) n2 <- readJPEG(j2, native=TRUE) stopifnot(identical(n2f, n2)) ## RGB + alpha mixing a3 <- array(c(s0, t(s0), rev(s0), t(rev(s0))), c(100L, 100L, 4L)) j3 <- writeJPEG(a3, raw(), bg="black") i3 <- readJPEG(j3) # we use a2 to compare to we just added alpha stopifnot(max(abs(i3 - a2 * rev(s0))) < tolerance * 3) j3.1 <- writeJPEG(a3, raw(), bg="white") i3.1 <- readJPEG(j3.1) stopifnot(max(abs(i3.1 - a2 * rev(s0) - (1 - rev(s0)))) < tolerance * 3) ## external file checks ## those are already used in examples so it's not really necessary .. fn <- system.file("img", "Rlogo.jpg", package="jpeg") i4 <- readJPEG(fn) s <- file.info(fn)$size f <- file(fn, "rb") j4 <- readBin(f, raw(), s) close(f) i4.1 <- readJPEG(fn) stopifnot(identical(i4, i4.1)) ## large RGB check s5 <- matrix(0:999999/999999, 1000) a5 <- array(c(s5, t(s5), rev(s5)), c(1000L, 1000L, 3L)) # produce larger files j5 <- writeJPEG(a5, raw(), quality=0.9) writeJPEG(a5, "image5.jpeg", quality=0.9) s <- file.info("image5.jpeg")$size stopifnot(all(s == length(j5))) f <- file("image5.jpeg", "rb") j5f <- readBin(f, raw(), s) close(f) stopifnot(identical(c(j5f), c(j5))) i5 <- readJPEG(j5, native=TRUE) i5f <- readJPEG("image5.jpeg", native=TRUE) stopifnot(identical(i5, i5f)) ## Wohoo! all tests passed! jpeg/src/0000755000175100001440000000000013554335046012014 5ustar hornikusersjpeg/src/read.c0000644000175100001440000001210012270263737013066 0ustar hornikusers#include "rjcommon.h" /* compatibility implementation of jpeg_mem_src() if not provided by jpeg */ #include "jcompat.h" /* create an R object containing the initialized decompression structure. The object will ensure proper release of the jpeg struct. */ static SEXP Rjpeg_decompress(struct jpeg_decompress_struct **cinfo_ptr) { SEXP dco; struct jpeg_decompress_struct *cinfo = (struct jpeg_decompress_struct*) malloc(sizeof(struct jpeg_decompress_struct)); if (!cinfo) Rf_error("Unable to allocate jpeg decompression structure"); cinfo->err = Rjpeg_new_err(); jpeg_create_decompress(cinfo); *cinfo_ptr = cinfo; dco = PROTECT(R_MakeExternalPtr(cinfo, R_NilValue, R_NilValue)); R_RegisterCFinalizerEx(dco, Rjpeg_fin, TRUE); UNPROTECT(1); return dco; } #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_jpeg(SEXP sFn, SEXP sNative) { const char *fn; SEXP res = R_NilValue, dim, dco; int native = Rf_asInteger(sNative); FILE *f = 0; J_COLOR_SPACE color_space; struct jpeg_decompress_struct *cinfo; dco = PROTECT(Rjpeg_decompress(&cinfo)); if (TYPEOF(sFn) == RAWSXP) jpeg_mem_src(cinfo, (unsigned char*) RAW(sFn), (unsigned long) LENGTH(sFn)); 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); jpeg_stdio_src(cinfo, f); } jpeg_read_header(cinfo, TRUE); color_space = cinfo->out_color_space; jpeg_start_decompress(cinfo); { int need_swap = 0; int width = cinfo->output_width, height = cinfo->output_height, pln = cinfo->output_components; int rowbytes = width * pln; unsigned char *image; JSAMPROW line; #if VERBOSE_INFO Rprintf("jpeg: %d x %d [%d], %d bytes (color space: %d -> %d)\n", width, height, pln, rowbytes, cinfo->jpeg_color_space, color_space); #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 /* allocate data for row pointers and the image using R's allocation */ image = (unsigned char *) R_alloc(rowbytes, height); while (cinfo->output_scanline < cinfo->output_height) { line = image + rowbytes * cinfo->output_scanline; jpeg_read_scanlines(cinfo, &line, 1); } /* native output - vector of integers */ if (native) { if (pln < 1 || pln > 4 || pln == 2) { Rf_error("native output for %d planes is not possible.", pln); } res = PROTECT(Rf_allocVector(INTSXP, width * height)); if (pln == 4) { /* 4 planes - efficient - just copy it all */ int *idata = INTEGER(res); memcpy(idata, image, rowbytes * height); if (need_swap) { int *ide = idata; idata = INTEGER(res); for (; idata < ide; idata++) RX_swap32(*idata); } } else if (pln == 3) { /* RGB */ int i, n = width * height, *idata = INTEGER(res); unsigned char *c = image; for (i = 0; i < n; i++) { *(idata++) = R_RGB((unsigned int) c[0], (unsigned int) c[1], (unsigned int) c[2]); c += 3; } } else { /* gray */ int i, n = width * height, *idata = INTEGER(res); unsigned char *c = image; for (i = 0; i < n; i++) { *(idata++) = R_RGB((unsigned int) *c, (unsigned int) *c, (unsigned int) *c); c++; } } dim = Rf_allocVector(INTSXP, 2); INTEGER(dim)[0] = height; INTEGER(dim)[1] = width; Rf_setAttrib(res, R_DimSymbol, dim); Rf_setAttrib(res, R_ClassSymbol, Rf_mkString("nativeRaster")); Rf_setAttrib(res, Rf_install("channels"), Rf_ScalarInteger(pln)); UNPROTECT(1); } else { int x, y, p, pls = width * height; double *data; res = PROTECT(Rf_allocVector(REALSXP, height * rowbytes)); data = REAL(res); 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)image[y * rowbytes + x * pln + p]) / 255.0; dim = Rf_allocVector(INTSXP, (pln > 1) ? 3 : 2); INTEGER(dim)[0] = height; INTEGER(dim)[1] = width; if (pln > 1) INTEGER(dim)[2] = pln; Rf_setAttrib(res, R_DimSymbol, dim); UNPROTECT(1); } } if (f) fclose(f); /* call the finalizer directly so we don't need to wait for the garbage collection */ Rjpeg_fin(dco); UNPROTECT(1); if (color_space != JCS_GRAYSCALE && color_space != JCS_RGB) { SEXP cs0, cs1; const char *csn = "unknown"; PROTECT(res); cs0 = Rf_install("color.space"); if (color_space == JCS_YCbCr) csn = "YCbCr"; if (color_space == JCS_CMYK) csn = "CMYK"; if (color_space == JCS_YCCK) csn = "YCbCrK"; cs1 = PROTECT(Rf_mkString(csn)); Rf_setAttrib(res, cs0, cs1); UNPROTECT(2); } return res; } jpeg/src/write.c0000644000175100001440000002162012270263737013314 0ustar hornikusers#include "rjcommon.h" /* alpha - blending: X * A + (1 - X) * BG */ #define ABLEND(X, A, BG) (JSAMPLE) ((((unsigned int)X) * ((unsigned int)A) + ((unsigned int)BG) * (255 - ((unsigned int)A))) / 255) /* create an R object containing the initialized compression structure. The object will ensure proper release of the jpeg struct. */ static SEXP Rjpeg_compress(struct jpeg_compress_struct **cinfo_ptr) { SEXP dco; struct jpeg_compress_struct *cinfo = (struct jpeg_compress_struct*) malloc(sizeof(struct jpeg_compress_struct)); if (!cinfo) Rf_error("Unable to allocate jpeg decompression structure"); cinfo->err = Rjpeg_new_err(); jpeg_create_compress(cinfo); *cinfo_ptr = cinfo; dco = PROTECT(R_MakeExternalPtr(cinfo, R_NilValue, R_NilValue)); R_RegisterCFinalizerEx(dco, Rjpeg_fin, TRUE); UNPROTECT(1); return dco; } METHODDEF(void) dst_noop_fn (struct jpeg_compress_struct *cinfo) { } METHODDEF(boolean) empty_output_buffer (struct jpeg_compress_struct *cinfo) { JSAMPLE *buf = (JSAMPLE*) Rjpeg_mem_ptr(cinfo); unsigned long size = Rjpeg_mem_size(cinfo); size *= 2; buf = realloc(buf, size); if (!buf) Rf_error("Unable to enlarge output buffer to %lu bytes.", size); cinfo->dest->next_output_byte = buf + size / 2; cinfo->dest->free_in_buffer = size / 2; Rjpeg_mem_ptr(cinfo) = buf; Rjpeg_mem_size(cinfo) = size; return TRUE; } /* size of the initial buffer; it is doubled when exceeded */ #define INIT_SIZE 65536 #include /* for R_RED, ..., R_ALPHA */ #include #define RX_swap32(X) (X) = (((unsigned int)X) >> 24) | ((((unsigned int)X) >> 8) & 0xff00) | (((unsigned int)X) << 24) | ((((unsigned int)X) & 0xff00) << 8) static unsigned int clip_alpha(double v) { if (v < 0.0) v = 0.0; if (v > 1.0) v = 1.0; return (unsigned int)(v * 255.0); } SEXP write_jpeg(SEXP image, SEXP sFn, SEXP sQuality, SEXP sBg, SEXP sColorsp) { SEXP res = R_NilValue, dims, dco; const char *fn; double quality = Rf_asReal(sQuality); int planes = 1, width, height, native = 0, raw_array = 0, outpl, bg, cmyk = 0; FILE *f = 0; struct jpeg_compress_struct *cinfo; if (Rf_length(sBg) < 1) Rf_error("invalid background color specification"); bg = RGBpar(sBg, 0); if (Rf_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"); 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 (TYPEOF(sColorsp) == STRSXP && LENGTH(sColorsp) == 1 && !strcmp(CHAR(STRING_ELT(sColorsp, 0)), "CMYK")) cmyk = 1; 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 (cmyk && planes != 4) Rf_error("CMYK image must have exactly 4 planes"); 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 = Rf_getAttrib(image, Rf_install("channels")); if (cmyk) Rf_error("CMYK cannot be represented by nativeRaster"); if (cha != R_NilValue) { planes = Rf_asInteger(cha); if (planes < 1 || planes > 4) planes = 4; } else planes = 4; } /* FIXME: for JPEG 3-channel raw array may also make sense ...*/ 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 */ } dco = PROTECT(Rjpeg_compress(&cinfo)); if (TYPEOF(sFn) == RAWSXP) { JSAMPLE *buf = (JSAMPLE*) malloc(INIT_SIZE); if (!buf) Rf_error("Unable to allocate output buffer"); if (!cinfo->dest) cinfo->dest = (struct jpeg_destination_mgr *) (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT, sizeof(struct jpeg_destination_mgr)); cinfo->dest->init_destination = dst_noop_fn; cinfo->dest->empty_output_buffer = empty_output_buffer; /* unfortunately the design of dest is flawed (to say it mildly) since it doesn't call term on error/abort so it's useless */ cinfo->dest->term_destination = dst_noop_fn; cinfo->dest->next_output_byte = buf; cinfo->dest->free_in_buffer = INIT_SIZE; Rjpeg_mem_ptr(cinfo) = buf; Rjpeg_mem_size(cinfo) = INIT_SIZE; } 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); jpeg_stdio_dest(cinfo, f); } /* JPEG only supports RGB or G (apart from CMYK) */ outpl = cmyk ? 4 : ((planes > 2) ? 3 : 1); cinfo->image_width = width; cinfo->image_height = height; cinfo->input_components = outpl; cinfo->in_color_space = cmyk ? JCS_CMYK : ((outpl == 3) ? JCS_RGB : JCS_GRAYSCALE); jpeg_set_defaults(cinfo); if (quality < 0.0) quality = 0.0; if (quality > 1.0) quality = 1.0; if (isnan(quality)) quality = 0.7; jpeg_set_quality(cinfo, (int) (quality * 100.0 + 0.49), FALSE); /* jpeg_simple_progression(cinfo); optional */ jpeg_start_compress(cinfo, TRUE); { int rowbytes = width * outpl; JSAMPROW row_pointer; JSAMPLE * flat_rows; flat_rows = (JSAMPLE*) R_alloc(height, width * outpl); 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 < outpl; p++) { double v = data[y + x * height + p * pls]; if (v < 0) v = 0; if (v > 255.0) v = 1.0; flat_rows[y * rowbytes + x * outpl + p] = (unsigned char)(v * 255.0 + 0.5); } /* if there is alpha, we need to blend the background */ if (planes == 2) { for(y = 0; y < height; y++) for (x = 0; x < width; x++) { unsigned int a = clip_alpha(data[y + x * height + pls]); if (a != 255) flat_rows[y * rowbytes + x] = ABLEND(flat_rows[y * rowbytes + x], a, R_RED(bg)); } } else if (planes == 4 && !cmyk) { for(y = 0; y < height; y++) for (x = 0; x < width; x++) { unsigned int a = clip_alpha(data[y + x * height + 3 * pls]); if (a != 255) { flat_rows[y * rowbytes + x * 3] = ABLEND(flat_rows[y * rowbytes + x * 3] , a, R_RED(bg)); flat_rows[y * rowbytes + x * 3 + 1] = ABLEND(flat_rows[y * rowbytes + x * 3 + 1], a, R_GREEN(bg)); flat_rows[y * rowbytes + x * 3 + 2] = ABLEND(flat_rows[y * rowbytes + x * 3 + 2], a, R_BLUE(bg)); } } } } else { if (planes == 4 && cmyk) { /* CMYK - from raw input, not really native */ memcpy(flat_rows, (char*) INTEGER(image), rowbytes * height); } else if (planes == 4) { /* RGBA */ int x, y, *idata = INTEGER(image); for (y = 0; y < height; y++) for (x = 0; x < rowbytes; idata++) { flat_rows[y * rowbytes + x++] = ABLEND(R_RED(*idata), R_ALPHA(*idata), R_RED(bg)); flat_rows[y * rowbytes + x++] = ABLEND(R_GREEN(*idata), R_ALPHA(*idata), R_GREEN(bg)); flat_rows[y * rowbytes + x++] = ABLEND(R_BLUE(*idata), R_ALPHA(*idata), R_BLUE(bg)); } } else if (planes == 3) { /* RGB */ int x, y, *idata = INTEGER(image); for (y = 0; y < height; y++) for (x = 0; x < rowbytes; idata++) { flat_rows[y * rowbytes + x++] = R_RED(*idata); flat_rows[y * rowbytes + x++] = R_GREEN(*idata); flat_rows[y * rowbytes + x++] = R_BLUE(*idata); } } else if (planes == 2) { /* GA */ int x, y, *idata = INTEGER(image); for (y = 0; y < height; y++) for (x = 0; x < rowbytes; idata++) flat_rows[y * rowbytes + x++] = ABLEND(R_RED(*idata), R_ALPHA(*idata), R_RED(bg)); } else { /* gray */ int x, y, *idata = INTEGER(image); for (y = 0; y < height; y++) for (x = 0; x < rowbytes; idata++) flat_rows[y * rowbytes + x++] = R_RED(*idata); } } while (cinfo->next_scanline < cinfo->image_height) { row_pointer = flat_rows + cinfo->next_scanline * rowbytes; jpeg_write_scanlines(cinfo, &row_pointer, 1); } } jpeg_finish_compress(cinfo); if (f) { /* if it is a file, just return */ fclose(f); Rjpeg_fin(dco); UNPROTECT(1); return R_NilValue; } { unsigned long len = (char*)cinfo->dest->next_output_byte - (char*)Rjpeg_mem_ptr(cinfo); res = Rf_allocVector(RAWSXP, len); memcpy(RAW(res), Rjpeg_mem_ptr(cinfo), len); } UNPROTECT(1); return res; } jpeg/src/rjcommon.h0000644000175100001440000000475613554335046014025 0ustar hornikusers/* R-related tools (mapping of jpeg error handling to R) common to all tasks */ #ifndef R_J_COMMON_H #define R_J_COMMON_H #include #include #include #include /* R defines TRUE/FALSE enum unconditionally, undefining TRUE/FALSE in the process. jpeg may or may not define boolean with TRUE/FALSE but it also does undefine it so there is no good way around. Since we know what R is doing, the only way to solve this is to prevent R from defining it */ #define R_EXT_BOOLEAN_H_ /* prevent inclusion of R_ext/Boolean.h */ /* define the enum with R_ prefix */ typedef enum { R_FALSE = 0, R_TRUE, } Rboolean; /* R headers don't use TRUE/FALSE so we shoudl notneed to worry about those */ #define USE_RINTERNALS 1 #define R_NO_REMAP 1 #include /* for R_RGB / R_RGBA */ #include #if (BITS_IN_JSAMPLE != 8) #error "Sorry, only 8-bit libjpeg is supported" #endif METHODDEF(void) Rjpeg_error_exit(j_common_ptr cinfo) { char buffer[JMSG_LENGTH_MAX]; (*cinfo->err->format_message) (cinfo, buffer); Rf_error("JPEG decompression error: %s", buffer); } METHODDEF(void) Rjpeg_output_message (j_common_ptr cinfo) { char buffer[JMSG_LENGTH_MAX]; (*cinfo->err->format_message) (cinfo, buffer); REprintf("JPEG decompression: %s", buffer); } struct Rjpeg_error_mgr { struct jpeg_error_mgr api; void *mem; /* additional memory that will be free()d eventually */ unsigned long size; /* arbitrary value that is usually used as buffer size */ }; #define Rjpeg_mem_ptr(CINFO) (((struct Rjpeg_error_mgr*)(CINFO->err))->mem) #define Rjpeg_mem_size(CINFO) (((struct Rjpeg_error_mgr*)(CINFO->err))->size) static void Rjpeg_fin(SEXP dco) { struct jpeg_common_struct *cinfo = (struct jpeg_common_struct*) R_ExternalPtrAddr(dco); if (cinfo) { struct Rjpeg_error_mgr *jerr; jpeg_destroy(cinfo); if ((jerr = (struct Rjpeg_error_mgr *) cinfo->err)) { if (jerr->mem) free(jerr->mem); free(jerr); } free(cinfo); } /* make it a NULL ptr in case this was not a finalizer call */ R_ClearExternalPtr(dco); } static struct jpeg_error_mgr *Rjpeg_new_err() { struct jpeg_error_mgr *jerr = (struct jpeg_error_mgr*) calloc(sizeof(struct Rjpeg_error_mgr), 1); if (!jerr) Rf_error("Unable to allocate jpeg error management structure"); jpeg_std_error(jerr); jerr->error_exit = Rjpeg_error_exit; jerr->output_message = Rjpeg_output_message; return jerr; } #endif jpeg/src/Makevars0000644000175100001440000000006712270263732013507 0ustar hornikusersPKG_LIBS=$(JPEG_LIBS) -ljpeg PKG_CFLAGS=$(JPEG_CFLAGS) jpeg/src/jcompat.h0000644000175100001440000000431212270263737013623 0ustar hornikusers/* compatibility functions for older libjpeg versions */ #ifndef J_COMPAT_H #define J_COMPAT_H #include #include /* memory-based source is new in v8 so we need to provide it for older jpeglib versions since they are still quite common */ #if (JPEG_LIB_VERSION < 80) METHODDEF(void) noop_fn (struct jpeg_decompress_struct *cinfo) { } static JOCTET eoi_buf[2] = { 255, JPEG_EOI }; METHODDEF(boolean) /* attempt to read beyond EOF - respond with EOI */ fill_input_buffer (struct jpeg_decompress_struct *cinfo) { WARNMS(cinfo, JWRN_JPEG_EOF); cinfo->src->next_input_byte = eoi_buf; cinfo->src->bytes_in_buffer = sizeof(eoi_buf); return TRUE; } METHODDEF(void) skip_input_data (struct jpeg_decompress_struct *cinfo, long num_bytes) { struct jpeg_source_mgr * src = cinfo->src; if (num_bytes > 0) { /* is the skip beyond the buffer ? */ if (num_bytes > (long) src->bytes_in_buffer) { fill_input_buffer(cinfo); /* it's an error anyway so bail out */ return; } src->next_input_byte += (size_t) num_bytes; src->bytes_in_buffer -= (size_t) num_bytes; } } /* libjpeg-turbo 1.2.90 reportedly breaks as it is doing something nasty with the JPEG_LIB_VERSION and it defines jpeg_mem_src even though it masquarades as jpeg < 8 ... strange, but to work around it we make sure that our compatibility layer uses a different symbol name */ #ifdef jpeg_mem_src #undef jpeg_mem_src #endif #define jpeg_mem_src jcompat_jpeg_mem_src static void jpeg_mem_src (struct jpeg_decompress_struct *cinfo, unsigned char *inbuffer, unsigned long insize) { struct jpeg_source_mgr *src; if (!insize) ERREXIT(cinfo, JERR_INPUT_EMPTY); if (!cinfo->src) src = cinfo->src = (struct jpeg_source_mgr *) (*cinfo->mem->alloc_small) ((struct jpeg_common_struct*) cinfo, JPOOL_PERMANENT, sizeof(struct jpeg_source_mgr)); else src = cinfo->src; src->init_source = noop_fn; src->fill_input_buffer = fill_input_buffer; src->skip_input_data = skip_input_data; src->resync_to_restart = jpeg_resync_to_restart; src->term_source = noop_fn; src->bytes_in_buffer = (size_t) insize; src->next_input_byte = (JOCTET *) inbuffer; } #endif #endif jpeg/src/Makevars.win0000644000175100001440000000025712270263732014304 0ustar hornikusers# for backwards compatibility (new R versions have WIN defined) ifeq ($(WIN),) WIN=32 endif # use the supplied binaries PKG_CPPFLAGS=-Iwin$(WIN) PKG_LIBS=win$(WIN)/libjpeg.a jpeg/src/Makevars-ls.win0000644000175100001440000000012312270263732014710 0ustar hornikusers## This Makevars is used on Windows when system jpeg is to be used PKG_LIBS=-ljpeg jpeg/NEWS0000644000175100001440000000167712270263732011733 0ustar hornikusersNEWS/Changelog 0.1-8 2014-01-23 o more compatibility fixes for jpeg versions that have broken header files 0.1-6 2013-06-03 o fix LOCAL_SOFT support on Windows 0.1-5 2013-06-03 o work around issues in jpeg-9 which re-defines boolean o add support for LOCAL_SOFT on Windows 0.1-4 2013-04-26 o use PKG_CPPFLAGS on Windows such that the presence of external jpeg headers does not conflict with the internal ones. 0.1-3 2013-04-18 o work around a problem in libjpeg-turbo 1.2.90 o fix a bug in writeJPEG() for nativeRaster 0.1-2 2011-12-10 o allow conections as target for writeJPEG() o make raw() the default target in writeJPEG() o support CMYK JPEG images both in readJPEG() and writeJPEG(). Images in color spaces other than RGB and Grayscale will have a "color.space" attribute attached designating the image color space. 0.1-1 2011-09-03 o initial release (based on the png 0.1-3 package) jpeg/configure.win0000644000175100001440000000415712270263732013730 0ustar hornikusers#!/bin/sh echo " checking JPEG 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/libjpeg.* 2>/dev/null; then echo " found libjpeg in LOCAL_SOFT: $local/lib" use_local=yes elif ls $local/lib${R_ARCH}/libjpeg.* 2>/dev/null; then echo " found libjpeg in LOCAL_SOFT: $local/lib${R_ARCH}" use_local=yes else echo " LOCAL_SOFT does not contain libjpeg, fall back to external jpeg" fi else echo " LOCAL_SOFT does not exist, fall back to external jpeg" fi if [ ${use_local} = yes ]; then mv src/Makevars.win src/Makevars-in.win mv src/Makevars-ls.win src/Makevars.win else if [ ! -e src/win32/libjpeg.a ]; then if [ ! -e src/libjpeg-current-win.tar.gz ]; then echo " cannot find current JPEG files" echo " attempting to download them" echo 'download.file("http://www.rforge.net/jpeg/files/libjpeg-current-win.tar.gz","src/libjpeg-current-win.tar.gz",mode="wb",quiet=TRUE)'|${R_HOME}/bin/R --vanilla --slave fi if [ ! -e src/libjpeg-current-win.tar.gz ]; then allok=no else echo " unpacking current JPEG" tar fxz src/libjpeg-current-win.tar.gz -C src if [ ! -e src/win32/libjpeg.a ]; then allok=no fi fi fi if [ ! -e src/win32/libjpeg.a ]; then allok=no fi fi if [ ${allok} != yes ]; then echo "" echo " *** ERROR: unable to find JPEG files" echo "" echo " They must be either in src/win32, in a tar-ball" echo " src/libjpeg-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/jpeg/files/" echo "" exit 1 fi echo " seems ok, ready to go" exit 0 jpeg/R/0000755000175100001440000000000012270263732011422 5ustar hornikusersjpeg/R/read.R0000644000175100001440000000021512270263732012456 0ustar hornikusersreadJPEG <- function(source, native=FALSE) .Call("read_jpeg", if (is.raw(source)) source else path.expand(source), native, PACKAGE="jpeg") jpeg/R/write.R0000644000175100001440000000073012270263732012677 0ustar hornikuserswriteJPEG <- function(image, target = raw(), quality = 0.7, bg = "white", color.space) { if (missing(color.space)) color.space <- attr(image, "color.space") if (inherits(target, "connection")) { r <- .Call("write_jpeg", image, raw(), quality, bg, color.space, PACKAGE="jpeg") writeBin(r, target) invisible(NULL) } else invisible(.Call("write_jpeg", image, if (is.raw(target)) target else path.expand(target), quality, bg, color.space, PACKAGE="jpeg")) } jpeg/MD50000644000175100001440000000144513554335210011532 0ustar hornikusers8cb17f396a3739451a051270e57e9f69 *DESCRIPTION 18fca2e3611a1d45bb4515180aa970b3 *NAMESPACE 74db3cb33358e3bd08c1eb4604317ca2 *NEWS 014c5333cbf8f040896aba930a4c75dd *R/read.R 19d426fe9c35f01df9cd04767efc33b4 *R/write.R 869a42cb680b694523368c286ba88e60 *configure.win 4f1f424a918784bceb429c6b1108c5fb *inst/img/Rlogo.jpg 32b3eab4e404f9c9790935aa863e09aa *man/readJPEG.Rd cd23e9c533cae81a5a3107e712cd8e0c *man/writeJPEG.Rd a0c542696d4f975a4f61346ead2bfd98 *src/Makevars 7e01a6728a62d8b8d08c65c9b65a0734 *src/Makevars-ls.win 6201cf8791b496212d4151fee8666dec *src/Makevars.win bf091b2575217fd8054b15f788947b20 *src/jcompat.h 8c4e01ea99616c0db098ca17282d2414 *src/read.c 0ab7635a186677ec0b73617c6583a672 *src/rjcommon.h aab11804ef6fb7eeb08d987bf7bdb123 *src/write.c 60da0126c521ad4227df2d3d01d99f43 *tests/jpeg.R jpeg/inst/0000755000175100001440000000000012270263732012176 5ustar hornikusersjpeg/inst/img/0000755000175100001440000000000012270263732012752 5ustar hornikusersjpeg/inst/img/Rlogo.jpg0000644000175100001440000001206212270263732014537 0ustar hornikusersJFIF,,ExifMM*JR(iZu/du/ddLC      C  Ld" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?;u1: ֪%ՇTy㜹ʮ:7c2~>  Z妜.m2]\ g/+y<y {9bg~2~ĿL'e+u:4ֱKqNæ#}t/ik~> O inƟܯ\yJGoc7&:ݿ@zm$Gb՞- 2i+L:2jЫOG+SO'ݎ]ZKJ%/Yu^/ɏS4r~k/~ܰc>Yv 3ѼptOx~dڠھYN 7_|8&!G tcoU{%w~ i.|i?HZE58ֵ_cHxWP GJ( =`Rw3[曩[k:|7zEv($h\IFC+#EO_ 'ԣ/)/5}+fR~fTnW}d/W^1hXCi[&|d2ߒ2AfRW*>j~ do(YkvmSFʃ+t$x ~̎^&֭_SݷY?(мS-SMYt3I*A"o?g/|7Լu²Ųdadwc72~/ IxK)|E p۹E|YWԴRiWFV=ڹLQ!6|*ɹIk\ A?w6:,ڌ78{upșํv~| @'-B𿆭V(䳷WسY$N1W>:q ^Y}5 `@ \Gl'Rֹ?fEGI>hڀ+S[αh:޾ξ )%;/?i_b)־%S|M[_KG*2^O?:~:IqCχ_gK-gWOkgVITB]T_!?&H-Uᔼx pjaq1_ɖ*'7?ğM/ 4S 6"f??_>;x{źk` Ki']A lcWs߾L~3|7м[5 Ė06 -a#AE~b1 ~4\H etw9noEr]\7ZNxM/BMۡг_n?/?b+_6Q28)Ϗ4&>W䷾T } =O+i}cS喦kFqB]7 WmVZ?Ihd!K/4{o K`X\|Ae[9WʜtmIHM~|(t|-][;NVD=ꬤe8*Vޖ.=:`Ж&e^^L{ɝ|ASK_2|@/ .?s/;m` c8%ߏ^oxÚA;nx#5YH xw޿6ߴGG,uyW<]w4oBFGyoZ\GaA;1| <CA"hmSFAvd2G99>5ΥӏW<؞>m-普Xv|y#Eyݿ_u ~}_V}4^4 c oYzwons,MGwyOxgផnNEGwG%c_ѤLl%R9L{'PV9N^tD1k41 [sD$wK?߶v#$^% 6:^h7\duRVυS5P]]чu`y 2AØm\O? ] Gyʆgò1g?N|hjPZǬyHgN8\zK0?nu؋^MN&OF]ݟ` dc_Wf`h LͱSTxLRQ3 ;kOQ6 ` kRDY;'OَH+> חy݇ůhƞAH z$r?iӆOO+0w9ڳg hKkizZ?:qqFKz w>4noǏxo>}{qCج꣓1$k(75z`[7z}FpLAXo.@#YxMak? -F0;y#vgfUpxEؼ% u)^KS㟎)i=}.ok7鐳, qŢb(9?a8fOQ׼kgvC?R40jR:F~'i~?[66+P3f~H@$ec宿~*xZ=grj2X20va <{y/hG2,,QUpYi)"ՠC ql0%,P'5?b?eED.g7~ e .YJGQQ͌V(lxIo r:_/ Y^QGLN1qiNLpAg*ܫzFXzҟQEQEU/oNv6 -NmG#E|_q4xw৊s} ѯ,&J u'B+]3>=ӬɴADI$I 3흠'?eo\=\223wj g]\'O<ڍOoc{F::zμ}?P|+}ſ|;%$e 8W9A#C_1jt|XPUI[S?NdMg<:mEwyl;z[FpGWk^8#l-/cV|iS(~h߳k!>߄I#9s,E,blXZrwGQ^!