jpeg/0000755000175100001440000000000014076763134011230 5ustar hornikusersjpeg/NAMESPACE0000644000175100001440000000007714076651534012453 0ustar hornikusersuseDynLib(jpeg, read_jpeg, write_jpeg) exportPattern(".*JPEG") jpeg/man/0000755000175100001440000000000014076651534012003 5ustar hornikusersjpeg/man/writeJPEG.Rd0000644000175100001440000001022514076651534014072 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.Rd0000644000175100001440000000422614076651534013657 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/DESCRIPTION0000644000175100001440000000111314076763134012732 0ustar hornikusersPackage: jpeg Version: 0.1-9 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/ NeedsCompilation: yes Packaged: 2021-07-23 23:40:17 UTC; svnuser Repository: CRAN Date/Publication: 2021-07-24 10:07:24 UTC jpeg/tests/0000755000175100001440000000000014076651534012372 5ustar hornikusersjpeg/tests/jpeg.R0000644000175100001440000000723114076651534013445 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/0000755000175100001440000000000014076651534012017 5ustar hornikusersjpeg/src/read.c0000644000175100001440000001210014076651534013070 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/reg.c0000644000175100001440000000100314076651534012732 0ustar hornikusers#include #include #include /* read.c */ extern SEXP read_jpeg(SEXP sFn, SEXP sNative); /* write.c */ extern SEXP write_jpeg(SEXP image, SEXP sFn, SEXP sQuality, SEXP sBg, SEXP sColorsp); static const R_CallMethodDef CAPI[] = { {"read_jpeg", (DL_FUNC) &read_jpeg , 2}, {"write_jpeg", (DL_FUNC) &write_jpeg, 5}, {NULL, NULL, 0} }; void R_init_jpeg(DllInfo *dll) { R_registerRoutines(dll, NULL, CAPI, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } jpeg/src/write.c0000644000175100001440000002224214076651534013317 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) /* we could jsut use (int*)DATAPTR(x) but this is safer */ static int *D_INTEGER(SEXP x) { if (TYPEOF(x) == INTSXP) return INTEGER(x); if (TYPEOF(x) == RAWSXP) return (int*) RAW(x); Rf_error("Invalid native image, must be integer or raw vector"); } /* 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*) D_INTEGER(image), rowbytes * height); } else if (planes == 4) { /* RGBA */ int x, y, *idata = D_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 = D_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 = D_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 = D_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.h0000644000175100001440000000475614076651534014030 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/Makevars0000644000175100001440000000006714076651534013516 0ustar hornikusersPKG_LIBS=$(JPEG_LIBS) -ljpeg PKG_CFLAGS=$(JPEG_CFLAGS) jpeg/src/jcompat.h0000644000175100001440000000431214076651534013625 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.win0000644000175100001440000000025714076651534014313 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.win0000644000175100001440000000012314076651534014717 0ustar hornikusers## This Makevars is used on Windows when system jpeg is to be used PKG_LIBS=-ljpeg jpeg/NEWS0000644000175100001440000000215414076651534011731 0ustar hornikusersNEWS/Changelog 0.1-9 2021-07-24 o use R_ClearExternalPtr() instead of CAR()=0 to be more API-compliant o minor R API compliance cleanup o added native symbol registration 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.win0000644000175100001440000000415714076651534013737 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/0000755000175100001440000000000014076651534011431 5ustar hornikusersjpeg/R/read.R0000644000175100001440000000017314076651534012470 0ustar hornikusersreadJPEG <- function(source, native=FALSE) .Call(read_jpeg, if (is.raw(source)) source else path.expand(source), native) jpeg/R/write.R0000644000175100001440000000066414076651534012714 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) writeBin(r, target) invisible(NULL) } else invisible(.Call(write_jpeg, image, if (is.raw(target)) target else path.expand(target), quality, bg, color.space)) } jpeg/MD50000644000175100001440000000152114076763134011537 0ustar hornikusersf18872056fdff8f64a5b06fc0fd9b5c5 *DESCRIPTION efd924d2c07a277082649f44b471bffc *NAMESPACE 3050695b8439fe56b7a469079f5cd219 *NEWS 3c81d0eaf477a356eef18b910c542af0 *R/read.R 0a8c799423bb29247336584e1d38a7c3 *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 4e36dcf2185c4be759540592a6ddbe3a *src/reg.c 0ab7635a186677ec0b73617c6583a672 *src/rjcommon.h 7f4ff93dcdce8faab1d11d68cc44edf3 *src/write.c 60da0126c521ad4227df2d3d01d99f43 *tests/jpeg.R jpeg/inst/0000755000175100001440000000000014076651534012205 5ustar hornikusersjpeg/inst/img/0000755000175100001440000000000014076651534012761 5ustar hornikusersjpeg/inst/img/Rlogo.jpg0000644000175100001440000001206214076651534014546 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^!