jpeg/0000755000175100001440000000000014767303656011236 5ustar hornikusersjpeg/tests/0000755000175100001440000000000014767153534012376 5ustar hornikusersjpeg/tests/jpeg.R0000644000175100001440000000723114767153534013451 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/MD50000644000175100001440000000152114767303656011545 0ustar hornikusers67c8826030a840768f3b1437523d42f7 *DESCRIPTION efd924d2c07a277082649f44b471bffc *NAMESPACE 39dcc9e9473c12305be4bfb225e4bd82 *NEWS 3c81d0eaf477a356eef18b910c542af0 *R/read.R 0a8c799423bb29247336584e1d38a7c3 *R/write.R 869a42cb680b694523368c286ba88e60 *configure.win 4f1f424a918784bceb429c6b1108c5fb *inst/img/Rlogo.jpg d7261e2d809f8d40d2f8f55c89c2bbf2 *man/readJPEG.Rd cd23e9c533cae81a5a3107e712cd8e0c *man/writeJPEG.Rd a0c542696d4f975a4f61346ead2bfd98 *src/Makevars bbfa80bde014b20888edcd08976ca1f9 *src/Makevars-ls.win 6201cf8791b496212d4151fee8666dec *src/Makevars.win bf091b2575217fd8054b15f788947b20 *src/jcompat.h d8e01757cbf1ff82874d58ad8458de90 *src/read.c 4e36dcf2185c4be759540592a6ddbe3a *src/reg.c c6a0d61fcc163729a1469b7ad8157bbd *src/rjcommon.h 7f4ff93dcdce8faab1d11d68cc44edf3 *src/write.c 60da0126c521ad4227df2d3d01d99f43 *tests/jpeg.R jpeg/configure.win0000644000175100001440000000415714767153534013743 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/0000755000175100001440000000000014767153534011435 5ustar hornikusersjpeg/R/write.R0000644000175100001440000000066414767153534012720 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/R/read.R0000644000175100001440000000017314767153534012474 0ustar hornikusersreadJPEG <- function(source, native=FALSE) .Call(read_jpeg, if (is.raw(source)) source else path.expand(source), native) jpeg/NEWS0000644000175100001440000000260414767153534011735 0ustar hornikusersNEWS/Changelog 0.1-11 2025-03-21 o turn jpeg messages to warnings (#4) o work around missing bool in R 4.5.0 (#12, #13) o mention EXIT orientation (#1) o use pkg-config on Windows (#11) 0.1-10 2022-11-29 o minor cleanup to avoid strict prototype and protect warnings 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/src/0000755000175100001440000000000014767153534012023 5ustar hornikusersjpeg/src/Makevars-ls.win0000644000175100001440000000030014767153534014720 0ustar hornikusers## This Makevars is used on Windows when system jpeg is to be used ifeq (,$(shell pkg-config --version 2>/dev/null)) PKG_LIBS=-ljpeg else PKG_LIBS=$(shell pkg-config --libs libjpeg) endif jpeg/src/Makevars.win0000644000175100001440000000025714767153534014317 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/jcompat.h0000644000175100001440000000431214767153534013631 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/Makevars0000644000175100001440000000006714767153534013522 0ustar hornikusersPKG_LIBS=$(JPEG_LIBS) -ljpeg PKG_CFLAGS=$(JPEG_CFLAGS) jpeg/src/read.c0000644000175100001440000001211114767153534013076 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"), PROTECT(Rf_ScalarInteger(pln))); UNPROTECT(2); } 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.c0000644000175100001440000002224214767153534013323 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/reg.c0000644000175100001440000000100314767153534012736 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/rjcommon.h0000644000175100001440000000546014767153534014025 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 */ /* R 4.5.0 also requires bool from stdbool.h (and C99) */ #include #if R_VERSION >= R_Version(4,5,0) #if defined __STDC_VERSION__ && __STDC_VERSION__ > 202000L /* in C23 bool is a keyword to not needed */ #else /* otherwise it is needed */ #include #endif /* ! C23 */ #endif /* R 4.5.0+ */ #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); Rf_warning("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(void) { 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/NAMESPACE0000644000175100001440000000007714767153534012457 0ustar hornikusersuseDynLib(jpeg, read_jpeg, write_jpeg) exportPattern(".*JPEG") jpeg/inst/0000755000175100001440000000000014767153534012211 5ustar hornikusersjpeg/inst/img/0000755000175100001440000000000014767153534012765 5ustar hornikusersjpeg/inst/img/Rlogo.jpg0000644000175100001440000001206214767153534014552 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^!jpeg/man/0000755000175100001440000000000014767153534012007 5ustar hornikusersjpeg/man/writeJPEG.Rd0000644000175100001440000001022514767153534014076 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.Rd0000644000175100001440000000471014767153534013661 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. Some images use EXIF to indicate that the image is stored in one orientation, but should be viewed in another. \code{readJPEG} will return the image as it was stored, so refer to EXIF's "orientation" property for more details (e.g., see the \code{read_exif} function in the \code{exifr} package). } \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/DESCRIPTION0000644000175100001440000000152514767303656012747 0ustar hornikusersPackage: jpeg Version: 0.1-11 Title: Read and write JPEG images Author: Simon Urbanek [aut, cre, cph] (https://urbanek.org, ) Authors@R: person("Simon", "Urbanek", role=c("aut","cre","cph"), email="Simon.Urbanek@r-project.org", comment=c("https://urbanek.org", ORCID="0000-0003-2297-1732")) 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: https://www.rforge.net/jpeg/ BugReports: https://github.com/s-u/jpeg/issues NeedsCompilation: yes Packaged: 2025-03-21 03:05:05 UTC; rforge Repository: CRAN Date/Publication: 2025-03-21 15:37:18 UTC