Merge commit '60d692811c12788ed4468d5ff680633304e8f641' as 'tkimg'

1 files changed, 1181 insertions, 0 deletions

diff --git a/tkimg/jpeg/jpeg.c b/tkimg/jpeg/jpeg.c
new file mode 100755
index 0000000..0188444
--- /dev/null
+++ b/tkimg/jpeg/jpeg.c
@@ -0,0 +1,1181 @@
+/*

+ * jpeg.c --

+ *

+ *  JPEG photo image type, Tcl/Tk package

+ *

+ * Copyright (c) 2002 Andreas Kupries <andreas_kupries@users.sourceforge.net>

+ *

+ * This Tk image format handler reads and writes JPEG files in the standard

+ * JFIF file format.  ("JPEG" should be the format name.)  It can also read

+ * and write strings containing base64-encoded JPEG data.

+ *

+ * Several options can be provided in the format string, for example:

+ *

+ *	imageObject read input.jpg -shrink -format "jpeg -grayscale"

+ *	imageObject write output.jpg -format "jpeg -quality 50 -progressive"

+ *

+ * The supported options for reading are:

+ *	-fast:        Fast, low-quality processing

+ *	-grayscale:   Force incoming image to grayscale

+ * The supported options for writing are:

+ *	-quality N:   Compression quality (0..100; 5-95 is useful range)

+ *	              Default value: 75

+ *	-smooth N:    Perform smoothing (10-30 is enough for most GIF's)

+ *		      Default value: 0

+ *	-grayscale:   Create monochrome JPEG file

+ *	-optimize:    Optimize Huffman table

+ *	-progressive: Create progressive JPEG file

+ *

+ *

+ * Copyright (c) 1996-1997 Thomas G. Lane.

+ * This file is based on tkImgPPM.c from the Tk 4.2 distribution.

+ * That file is

+ *	Copyright (c) 1994 The Australian National University.

+ *	Copyright (c) 1994-1996 Sun Microsystems, Inc.

+ *

+ * See the file "license.terms" for information on usage and redistribution

+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

+ *

+ * You will need a copy of the IJG JPEG library, version 5 or later,

+ * to use this file.  If you didn't receive it with this package, see

+ *	ftp://ftp.uu.net/graphics/jpeg/

+ *

+ * Author: Tom Lane (tgl@sss.pgh.pa.us)

+ *

+ * Modified for dynamical loading, reading from channels and Tcl_Obj's by:

+ *	Jan Nijtmans (nijtmans@users.sourceforge.net)

+ *

+ * $Id: jpeg.c 395 2016-04-02 19:47:57Z obermeier $

+ */

+

+/*

+ * Generic initialization code, parameterized via CPACKAGE and PACKAGE.

+ */

+#ifdef _WIN32

+#   define HAVE_BOOLEAN

+#endif

+

+#ifndef FALSE

+#define FALSE   0

+#endif

+#ifndef TRUE

+#define TRUE    1

+#endif

+

+#include "tkimg.h"

+#include "jpegtcl.h"

+

+static int SetupJPegLibrary(Tcl_Interp *interp);

+

+#define MORE_INITIALIZATION \

+    if (SetupJPegLibrary (interp) != TCL_OK) { return TCL_ERROR; }

+

+#include "init.c"

+

+/* system includes */

+#include <stdlib.h>

+#include <string.h>

+#include <setjmp.h>

+

+/*

+ * The format record for the JPEG file format:

+ */

+

+

+/*

+ * Declarations for libjpeg source and destination managers to handle

+ * reading and writing base64-encoded strings and Tcl_Channel's.

+ */

+

+#define STRING_BUF_SIZE  4096	/* choose any convenient size */

+

+typedef struct source_mgr {	/* Source manager for reading from string */

+  struct jpeg_source_mgr pub;	/* public fields */

+

+  tkimg_MFile handle;			/* base64 stream */

+  JOCTET buffer[STRING_BUF_SIZE]; /* buffer for a chunk of decoded data */

+} *src_ptr;

+

+typedef struct destination_mgr { /* Manager for string output */

+  struct jpeg_destination_mgr pub; /* public fields */

+

+  tkimg_MFile handle;			/* base64 stream */

+  JOCTET buffer[STRING_BUF_SIZE]; /* buffer for a chunk of decoded data */

+} *dest_ptr;

+

+/*

+ * Other declarations

+ */

+

+struct my_error_mgr {		/* Extended libjpeg error manager */

+  struct jpeg_error_mgr pub;	/* public fields */

+  jmp_buf setjmp_buffer;	/* for return to caller from error exit */

+};

+

+/*

+ * Prototypes for local procedures defined in this file:

+ */

+

+static int CommonMatch(tkimg_MFile *handle,

+	int *widthPtr, int *heightPtr);

+

+static int CommonRead(Tcl_Interp *interp,

+	j_decompress_ptr cinfo, Tcl_Obj *format,

+	Tk_PhotoHandle imageHandle, int destX, int destY,

+	int width, int height, int srcX, int srcY);

+

+static int CommonWrite(Tcl_Interp *interp,

+	j_compress_ptr cinfo, Tcl_Obj *format,

+	Tk_PhotoImageBlock *blockPtr);

+

+static void	my_jpeg_obj_src(j_decompress_ptr, Tcl_Obj *);

+static void	my_jpeg_channel_src(j_decompress_ptr, Tcl_Channel);

+static boolean	fill_input_buffer(j_decompress_ptr);

+static void	skip_input_data(j_decompress_ptr, long);

+static void	dummy_source(j_decompress_ptr);

+static void	my_jpeg_string_dest(j_compress_ptr, Tcl_DString*);

+static void	my_jpeg_channel_dest(j_compress_ptr, Tcl_Channel);

+static void	my_init_destination(j_compress_ptr);

+static boolean	my_empty_output_buffer(j_compress_ptr);

+static void	my_term_destination(j_compress_ptr);

+static void	my_error_exit(j_common_ptr cinfo);

+static void	my_output_message(j_common_ptr cinfo);

+static void	append_jpeg_message(Tcl_Interp *interp,

+		    j_common_ptr cinfo);

+

+

+

+static int

+SetupJPegLibrary (interp)

+    Tcl_Interp *interp;

+{

+    struct jpeg_compress_struct *cinfo; /* libjpeg's parameter structure */

+    struct my_error_mgr jerror;	/* for controlling libjpeg error handling */

+    int i;

+

+    if (Jpegtcl_InitStubs(interp, JPEGTCL_VERSION, 0) == NULL) {

+        return TCL_ERROR;

+    }

+

+    /* The followin code tries to determine if the JPEG library is

+       valid at all. The library might be configured differently,

+       which will produce core dumps. Also it might be that

+       fields appear in different places in jpeg_compress_struct

+       or jpeg_decompress_struct. This will make the library totally

+       unusable. In stead of a core-dump, we better have a proper

+       error message */

+

+    /* overallocat size, so we don't get a core-dump if the library

+       thinks that the structure is much larger */

+

+    cinfo = (struct jpeg_compress_struct *) ckalloc(8*sizeof(struct jpeg_compress_struct));

+    cinfo->err = jpeg_std_error(&jerror.pub);

+    jerror.pub.error_exit = my_error_exit;

+    jerror.pub.output_message = my_output_message;

+    /* Establish the setjmp return context for my_error_exit to use. */

+    if (setjmp(jerror.setjmp_buffer)) {

+      /* If we get here, the JPEG library is invalid. */

+      jpeg_destroy_compress(cinfo);

+      ckfree((char *)cinfo);

+

+      if (interp) {

+	Tcl_AppendResult(interp, "couldn't use \"", "jpegtcl",

+		"\": please upgrade to at least version 6a", (char *) NULL);

+      }

+      return TCL_ERROR;

+    }

+

+    /* Now we can initialize libjpeg. */

+    ((char *) cinfo)[sizeof(struct jpeg_compress_struct)] = 53;

+    jpeg_create_compress(cinfo);

+    if (((char *) cinfo)[sizeof(struct jpeg_compress_struct)] != 53) {

+	/* Oops. The library changed this value, which is outside the

+	 * structure. Definitely, the library is invalid!!!! */

+	ERREXIT(cinfo, JMSG_NOMESSAGE);

+    }

+

+    /* Set up JPEG compression parameters. */

+    cinfo->image_width = 16;

+    cinfo->image_height = 16;

+    cinfo->input_components = 3;

+    cinfo->in_color_space = JCS_RGB;

+    cinfo->data_precision = -1;

+    cinfo->optimize_coding = TRUE;

+    cinfo->dct_method = -1;

+    cinfo->X_density = 0;

+    cinfo->Y_density = 0;

+    jpeg_set_defaults(cinfo);

+

+    if ((cinfo->data_precision != BITS_IN_JSAMPLE) ||

+	    (cinfo->optimize_coding != FALSE) ||

+	    (cinfo->dct_method != JDCT_DEFAULT) ||

+	    (cinfo->X_density != 1) ||

+	    (cinfo->Y_density != 1)) {

+	ERREXIT(cinfo, JMSG_NOMESSAGE);

+    }

+    for (i = 0; i < NUM_ARITH_TBLS; i++) {

+	if ((cinfo->arith_dc_L[i] != 0) ||

+		(cinfo->arith_dc_U[i] != 1) ||

+		(cinfo->arith_ac_K[i] != 5)) {

+	    ERREXIT(cinfo, JMSG_NOMESSAGE);

+	}

+    }

+    jpeg_destroy_compress(cinfo);

+    ckfree((char *) cinfo);

+    return TCL_OK;

+}

+

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * ChnMatch --

+ *

+ *	This procedure is invoked by the photo image type to see if

+ *	a channel contains image data in JPEG format.

+ *

+ * Results:

+ *	The return value is >0 if the first characters in channel "chan"

+ *	look like JPEG data, and 0 otherwise.  For a valid file, the

+ *	image dimensions are determined.

+ *

+ * Side effects:

+ *	The access position in f may change.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int ChnMatch(

+    Tcl_Channel chan,		/* The image channel, open for reading. */

+    const char *fileName,	/* The name of the image file. */

+    Tcl_Obj *format,		/* User-specified format string, or NULL. */

+    int *widthPtr,			/* The dimensions of the image are */

+	int *heightPtr,			/* returned here if the file is a valid

+				 * JPEG file. */

+    Tcl_Interp *interp

+) {

+    tkimg_MFile handle;

+

+    handle.data = (char *) chan;

+    handle.state = IMG_CHAN;

+    return CommonMatch(&handle, widthPtr, heightPtr);

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * ObjMatch --

+ *

+ *	This procedure is invoked by the photo image type to see if

+ *	a string contains image data in JPEG format.

+ *

+ * Results:

+ *	The return value is >0 if the first characters in the string look

+ *	like JPEG data, and 0 otherwise.  For a valid image, the image

+ *	dimensions are determined.

+ *

+ * Side effects:

+ *  the size of the image is placed in widthPtr and heightPtr.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int ObjMatch(

+    Tcl_Obj *data,		/* the object containing the image data */

+    Tcl_Obj *format,		/* User-specified format object, or NULL. */

+    int *widthPtr,		/* The dimensions of the image are */

+	int *heightPtr,		/* returned here if the string is a valid

+				 * JPEG image. */

+    Tcl_Interp *interp

+) {

+    tkimg_MFile handle;

+

+    tkimg_ReadInit(data, '\377', &handle);

+    return CommonMatch(&handle, widthPtr, heightPtr);

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * CommonMatch --

+ *

+ *	This procedure is invoked by the photo image type to see if

+ *	a string contains image data in JPEG format.

+ *

+ * Results:

+ *	The return value is >0 if the first characters in the string look

+ *	like JPEG data, and 0 otherwise.  For a valid image, the image

+ *	dimensions are determined.

+ *

+ * Side effects:

+ *  the size of the image is placed in widthPtr and heightPtr.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+CommonMatch(handle, widthPtr, heightPtr)

+    tkimg_MFile *handle;		/* the "file" handle */

+    int *widthPtr, *heightPtr;	/* The dimensions of the image are

+				 * returned here if the string is a valid

+				 * JPEG image. */

+{

+    char buf[256];

+    int i;

+

+    i = tkimg_Read(handle, buf, 3);

+    if ((i != 3)||strncmp(buf,"\377\330\377", 3)) {

+	return 0;

+    }

+

+    buf[0] = buf[2];

+    /* at top of loop: have just read first FF of a marker into buf[0] */

+    for (;;) {

+	/* get marker type byte, skipping any padding FFs */

+	while (buf[0] == (char) 0xff) {

+	    if (tkimg_Read(handle, buf,1) != 1) {

+		return 0;

+	    }

+	}

+	/* look for SOF0, SOF1, or SOF2, which are the only JPEG variants

+	 * currently accepted by libjpeg.

+	 */

+	if (buf[0] == (char) 0xc0 || buf[0] == (char) 0xc1

+		|| buf[0] == (char) 0xc2)

+	    break;

+	/* nope, skip the marker parameters */

+	if (tkimg_Read(handle, buf, 2) != 2) {

+	    return 0;

+	}

+	i = ((buf[0] & 0x0ff)<<8) + (buf[1] & 0x0ff) - 1;

+	while (i>256) {

+	    tkimg_Read(handle, buf, 256);

+	    i -= 256;

+	}

+	if ((i<1) || (tkimg_Read(handle, buf, i)) != i) {

+	    return 0;

+	}

+	buf[0] = buf[i-1];

+	/* skip any inter-marker junk (there shouldn't be any, really) */

+	while (buf[0] != (char) 0xff) {

+	    if (tkimg_Read(handle, buf,1) != 1) {

+		return 0;

+	    }

+	}

+    }

+    /* Found the SOFn marker, get image dimensions */

+    if (tkimg_Read(handle, buf, 7) != 7) {

+	return 0;

+    }

+    *heightPtr = ((buf[3] & 0x0ff)<<8) + (buf[4] & 0x0ff);

+    *widthPtr = ((buf[5] & 0x0ff)<<8) + (buf[6] & 0x0ff);

+

+    return 1;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * ChnRead --

+ *

+ *	This procedure is called by the photo image type to read

+ *	JPEG format data from a channel, and give it to

+ *	the photo image.

+ *

+ * Results:

+ *	A standard TCL completion code.  If TCL_ERROR is returned

+ *	then an error message is left in interp->result.

+ *

+ * Side effects:

+ *	New data is added to the image given by imageHandle.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+ChnRead(interp, chan, fileName, format, imageHandle, destX, destY,

+	width, height, srcX, srcY)

+    Tcl_Interp *interp;		/* Interpreter to use for reporting errors. */

+    Tcl_Channel chan;		/* The image channel, open for reading. */

+    const char *fileName;	/* The name of the image file. */

+    Tcl_Obj *format;		/* User-specified format string, or NULL. */

+    Tk_PhotoHandle imageHandle;	/* The photo image to write into. */

+    int destX, destY;		/* Coordinates of top-left pixel in

+				 * photo image to be written to. */

+    int width, height;		/* Dimensions of block of photo image to

+				 * be written to. */

+    int srcX, srcY;		/* Coordinates of top-left pixel to be used

+				 * in image being read. */

+{

+    struct jpeg_decompress_struct cinfo; /* libjpeg's parameter structure */

+    struct my_error_mgr jerror;	/* for controlling libjpeg error handling */

+    int result;

+

+    /* Initialize JPEG error handler */

+    /* We set up the normal JPEG error routines, then override error_exit. */

+    cinfo.err = jpeg_std_error(&jerror.pub);

+    jerror.pub.error_exit = my_error_exit;

+    jerror.pub.output_message = my_output_message;

+

+    /* Establish the setjmp return context for my_error_exit to use. */

+    if (setjmp(jerror.setjmp_buffer)) {

+      /* If we get here, the JPEG code has signaled an error. */

+      Tcl_AppendResult(interp, "couldn't read JPEG string: ", (char *) NULL);

+      append_jpeg_message(interp, (j_common_ptr) &cinfo);

+      jpeg_destroy_decompress(&cinfo);

+      return TCL_ERROR;

+    }

+

+    /* Now we can initialize libjpeg. */

+    jpeg_CreateDecompress(&cinfo, JPEG_LIB_VERSION,

+			(size_t) sizeof(struct jpeg_decompress_struct));

+    my_jpeg_channel_src(&cinfo, chan);

+

+    /* Share code with ObjRead. */

+    result = CommonRead(interp, &cinfo, format, imageHandle,

+			    destX, destY, width, height, srcX, srcY);

+

+    /* Reclaim libjpeg's internal resources. */

+    jpeg_destroy_decompress(&cinfo);

+

+    return result;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * ObjRead --

+ *

+ *	This procedure is called by the photo image type to read

+ *	JPEG format data from a base64 encoded string, and give it to

+ *	the photo image.

+ *

+ * Results:

+ *	A standard TCL completion code.  If TCL_ERROR is returned

+ *	then an error message is left in interp->result.

+ *

+ * Side effects:

+ *	New data is added to the image given by imageHandle.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+ObjRead(interp, data, format, imageHandle, destX, destY,

+	width, height, srcX, srcY)

+    Tcl_Interp *interp;		/* Interpreter to use for reporting errors. */

+    Tcl_Obj *data;		/* Object containing the image data. */

+    Tcl_Obj *format;		/* User-specified format object, or NULL. */

+    Tk_PhotoHandle imageHandle;	/* The photo image to write into. */

+    int destX, destY;		/* Coordinates of top-left pixel in

+				 * photo image to be written to. */

+    int width, height;		/* Dimensions of block of photo image to

+				 * be written to. */

+    int srcX, srcY;		/* Coordinates of top-left pixel to be used

+				 * in image being read. */

+{

+    struct jpeg_decompress_struct cinfo; /* libjpeg's parameter structure */

+    struct my_error_mgr jerror;	/* for controlling libjpeg error handling */

+    int result;

+

+    /* Initialize JPEG error handler */

+    /* We set up the normal JPEG error routines, then override error_exit. */

+    cinfo.err = jpeg_std_error(&jerror.pub);

+    jerror.pub.error_exit = my_error_exit;

+    jerror.pub.output_message = my_output_message;

+

+    /* Establish the setjmp return context for my_error_exit to use. */

+    if (setjmp(jerror.setjmp_buffer)) {

+      /* If we get here, the JPEG code has signaled an error. */

+      Tcl_AppendResult(interp, "couldn't read JPEG string: ", (char *) NULL);

+      append_jpeg_message(interp, (j_common_ptr) &cinfo);

+      jpeg_destroy_decompress(&cinfo);

+      return TCL_ERROR;

+    }

+

+    /* Now we can initialize libjpeg. */

+    jpeg_CreateDecompress(&cinfo, JPEG_LIB_VERSION,

+			(size_t) sizeof(struct jpeg_decompress_struct));

+    my_jpeg_obj_src(&cinfo, data);

+

+    /* Share code with ChnRead. */

+    result = CommonRead(interp, &cinfo, format, imageHandle,

+			    destX, destY, width, height, srcX, srcY);

+

+    /* Reclaim libjpeg's internal resources. */

+    jpeg_destroy_decompress(&cinfo);

+

+    return result;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * CommonRead --

+ *

+ *	The common guts of ChnRead and ObjRead.

+ *	The decompress struct has already been set up and the

+ *	appropriate data source manager initialized.

+ *	The caller should do jpeg_destroy_decompress upon return.

+ *

+ *----------------------------------------------------------------------

+ */

+static int

+CommonRead(interp, cinfo, format, imageHandle, destX, destY,

+	width, height, srcX, srcY)

+    Tcl_Interp *interp;		/* Interpreter to use for reporting errors. */

+    j_decompress_ptr cinfo;	/* Already-constructed decompress struct. */

+    Tcl_Obj *format;		/* User-specified format string, or NULL. */

+    Tk_PhotoHandle imageHandle;	/* The photo image to write into. */

+    int destX, destY;		/* Coordinates of top-left pixel in

+				 * photo image to be written to. */

+    int width, height;		/* Dimensions of block of photo image to

+				 * be written to. */

+    int srcX, srcY;		/* Coordinates of top-left pixel to be used

+				 * in image being read. */

+{

+    static const char *const jpegReadOptions[] = {"-fast", "-grayscale", NULL};

+    int fileWidth, fileHeight, stopY, curY, outY, outWidth, outHeight;

+    Tk_PhotoImageBlock block;

+    JSAMPARRAY buffer;		/* Output row buffer */

+    int objc, i, index;

+    Tcl_Obj **objv = (Tcl_Obj **) NULL;

+

+    /* Ready to read header data. */

+    jpeg_read_header(cinfo, TRUE);

+

+    /* This code only supports 8-bit-precision JPEG files. */

+    if ((cinfo->data_precision != 8) ||

+	    (sizeof(JSAMPLE) != sizeof(unsigned char))) {

+	Tcl_AppendResult(interp, "Unsupported JPEG precision", (char *) NULL);

+	return TCL_ERROR;

+    }

+

+    /* Process format parameters. */

+    if (tkimg_ListObjGetElements(interp, format, &objc, &objv) != TCL_OK) {

+	return TCL_ERROR;

+    }

+    if (objc) {

+	for (i=1; i<objc; i++) {

+	    if (Tcl_GetIndexFromObj(interp, objv[i], (CONST84 char *CONST86 *)jpegReadOptions,

+		    "format option", 0, &index)!=TCL_OK) {

+		return TCL_ERROR;

+	    }

+	    switch (index) {

+		case 0: {

+		    /* Select fast processing mode. */

+		    cinfo->two_pass_quantize = FALSE;

+		    cinfo->dither_mode = JDITHER_ORDERED;

+		    cinfo->dct_method = JDCT_FASTEST;

+		    cinfo->do_fancy_upsampling = FALSE;

+		    break;

+		}

+		case 1: {

+		    /* Force monochrome output. */

+		    cinfo->out_color_space = JCS_GRAYSCALE;

+		    break;

+		}

+	    }

+	}

+    }

+

+    jpeg_start_decompress(cinfo);

+

+    /* Check dimensions. */

+    fileWidth = (int) cinfo->output_width;

+    fileHeight = (int) cinfo->output_height;

+    if ((srcX + width) > fileWidth) {

+	outWidth = fileWidth - srcX;

+    } else {

+	outWidth = width;

+    }

+    if ((srcY + height) > fileHeight) {

+	outHeight = fileHeight - srcY;

+    } else {

+	outHeight = height;

+    }

+    if ((outWidth <= 0) || (outHeight <= 0)

+	|| (srcX >= fileWidth) || (srcY >= fileHeight)) {

+	return TCL_OK;

+    }

+

+    /* Check colorspace. */

+    switch (cinfo->out_color_space) {

+    case JCS_GRAYSCALE:

+	/* a single-sample grayscale pixel is expanded into equal R,G,B values */

+	block.pixelSize = 1;

+	block.offset[0] = 0;

+	block.offset[1] = 0;

+	block.offset[2] = 0;

+	break;

+    case JCS_RGB:

+	/* note: this pixel layout assumes default configuration of libjpeg. */

+	block.pixelSize = 3;

+	block.offset[0] = 0;

+	block.offset[1] = 1;

+	block.offset[2] = 2;

+	break;

+    default:

+	Tcl_AppendResult(interp, "Unsupported JPEG color space", (char *) NULL);

+	return TCL_ERROR;

+    }

+    block.width = outWidth;

+    block.height = 1;

+    block.pitch = block.pixelSize * fileWidth;

+    block.offset[3] = block.offset[0];

+

+    if (tkimg_PhotoExpand(interp, imageHandle, destX + outWidth, destY + outHeight) == TCL_ERROR) {

+	jpeg_abort_decompress(cinfo);

+	return TCL_ERROR;

+    }

+

+    /* Make a temporary one-row-high sample array */

+    buffer = (*cinfo->mem->alloc_sarray)

+		((j_common_ptr) cinfo, JPOOL_IMAGE,

+		 cinfo->output_width * cinfo->output_components, 1);

+    block.pixelPtr = (unsigned char *) buffer[0] + srcX * block.pixelSize;

+

+    /* Read as much of the data as we need to */

+    stopY = srcY + outHeight;

+    outY = destY;

+    for (curY = 0; curY < stopY; curY++) {

+      jpeg_read_scanlines(cinfo, buffer, 1);

+      if (curY >= srcY) {

+	if (tkimg_PhotoPutBlock(interp, imageHandle, &block, destX, outY, outWidth, 1, TK_PHOTO_COMPOSITE_SET) == TCL_ERROR) {

+	    jpeg_abort_decompress(cinfo);

+	    return TCL_ERROR;

+	}

+	outY++;

+      }

+    }

+

+    /* Do normal cleanup if we read the whole image; else early abort */

+    if (cinfo->output_scanline == cinfo->output_height)

+	jpeg_finish_decompress(cinfo);

+    else

+	jpeg_abort_decompress(cinfo);

+

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * ChnWrite --

+ *

+ *	This procedure is invoked to write image data to a file in JPEG

+ *	format.

+ *

+ * Results:

+ *	A standard TCL completion code.  If TCL_ERROR is returned

+ *	then an error message is left in interp->result.

+ *

+ * Side effects:

+ *	Data is written to the file given by "fileName".

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+ChnWrite(interp, fileName, format, blockPtr)

+    Tcl_Interp *interp;

+    const char *fileName;

+    Tcl_Obj *format;

+    Tk_PhotoImageBlock *blockPtr;

+{

+    struct jpeg_compress_struct cinfo; /* libjpeg's parameter structure */

+    struct my_error_mgr jerror;	/* for controlling libjpeg error handling */

+    Tcl_Channel chan;

+    int result;

+

+    chan = tkimg_OpenFileChannel(interp, fileName, 0644);

+    if (!chan) {

+	return TCL_ERROR;

+    }

+

+    /* Initialize JPEG error handler */

+    /* We set up the normal JPEG error routines, then override error_exit. */

+    cinfo.err = jpeg_std_error(&jerror.pub);

+    jerror.pub.error_exit = my_error_exit;

+    jerror.pub.output_message = my_output_message;

+

+    /* Establish the setjmp return context for my_error_exit to use. */

+    if (setjmp(jerror.setjmp_buffer)) {

+      /* If we get here, the JPEG code has signaled an error. */

+      Tcl_AppendResult(interp, "couldn't write JPEG file \"", fileName,

+		       "\": ", (char *) NULL);

+      append_jpeg_message(interp, (j_common_ptr) &cinfo);

+      jpeg_destroy_compress(&cinfo);

+      Tcl_Close(interp, chan);

+      return TCL_ERROR;

+    }

+

+    /* Now we can initialize libjpeg. */

+    jpeg_create_compress(&cinfo);

+    my_jpeg_channel_dest(&cinfo, chan);

+

+    /* Share code with StringWrite. */

+    result = CommonWrite(interp, &cinfo, format, blockPtr);

+

+    jpeg_destroy_compress(&cinfo);

+    if (Tcl_Close(interp, chan) == TCL_ERROR) {

+	return TCL_ERROR;

+    }

+    return result;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * StringWrite --

+ *

+ *	This procedure is called by the photo image type to write

+ *	JPEG format data to a base-64 encoded string from the photo block.

+ *

+ * Results:

+ *	A standard TCL completion code.  If TCL_ERROR is returned

+ *	then an error message is left in interp->result.

+ *

+ * Side effects:

+ *	None.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int StringWrite(

+    Tcl_Interp *interp,

+    Tcl_Obj *format,

+    Tk_PhotoImageBlock *blockPtr

+) {

+    struct jpeg_compress_struct cinfo; /* libjpeg's parameter structure */

+    struct my_error_mgr jerror;	/* for controlling libjpeg error handling */

+    int result;

+    Tcl_DString data;

+

+    Tcl_DStringInit(&data);

+

+    /* Initialize JPEG error handler */

+    /* We set up the normal JPEG error routines, then override error_exit. */

+    cinfo.err = jpeg_std_error(&jerror.pub);

+    jerror.pub.error_exit = my_error_exit;

+    jerror.pub.output_message = my_output_message;

+

+    /* Establish the setjmp return context for my_error_exit to use. */

+    if (setjmp(jerror.setjmp_buffer)) {

+      /* If we get here, the JPEG code has signaled an error. */

+      Tcl_AppendResult(interp, "couldn't write JPEG string: ", (char *) NULL);

+      append_jpeg_message(interp, (j_common_ptr) &cinfo);

+      result = TCL_ERROR;

+      goto writeend;

+    }

+

+    /* Now we can initialize libjpeg. */

+    jpeg_create_compress(&cinfo);

+    my_jpeg_string_dest(&cinfo, &data);

+

+    /* Share code with ChnWrite. */

+    result = CommonWrite(interp, &cinfo, format, blockPtr);

+

+writeend:

+

+    jpeg_destroy_compress(&cinfo);

+    if (result == TCL_OK) {

+	Tcl_DStringResult(interp, &data);

+    } else {

+	Tcl_DStringFree(&data);

+    }

+

+    return result;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * CommonWrite --

+ *

+ *	The common guts of ChnWrite and StringWrite.

+ *	The compress struct has already been set up and the

+ *	appropriate data destination manager initialized.

+ *	The caller should do jpeg_destroy_compress upon return,

+ *	and also close the destination as necessary.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+CommonWrite(interp, cinfo, format, blockPtr)

+    Tcl_Interp *interp;

+    j_compress_ptr cinfo;

+    Tcl_Obj *format;

+    Tk_PhotoImageBlock *blockPtr;

+{

+    static const char *const jpegWriteOptions[] = {"-grayscale", "-optimize",

+	"-progressive", "-quality", "-smooth", NULL};

+    JSAMPROW row_pointer[1];	/* pointer to original data scanlines */

+    JSAMPARRAY buffer;		/* Intermediate row buffer */

+    JSAMPROW bufferPtr;

+    int w, h;

+    int greenOffset, blueOffset, alphaOffset;

+    unsigned char *pixelPtr, *pixLinePtr;

+    int objc, i, index, grayscale = 0;

+    Tcl_Obj **objv = (Tcl_Obj **) NULL;

+

+    greenOffset = blockPtr->offset[1] - blockPtr->offset[0];

+    blueOffset = blockPtr->offset[2] - blockPtr->offset[0];

+    alphaOffset = blockPtr->offset[0];

+    if (alphaOffset < blockPtr->offset[2]) {

+        alphaOffset = blockPtr->offset[2];

+    }

+    if (++alphaOffset < blockPtr->pixelSize) {

+	alphaOffset -= blockPtr->offset[0];

+    } else {

+	alphaOffset = 0;

+    }

+

+    /* Set up JPEG compression parameters. */

+    cinfo->image_width = blockPtr->width;

+    cinfo->image_height = blockPtr->height;

+    cinfo->input_components = 3;

+    cinfo->in_color_space = JCS_RGB;

+

+    jpeg_set_defaults(cinfo);

+

+    /* Parse options, if any, and alter default parameters */

+

+    if (tkimg_ListObjGetElements(interp, format, &objc, &objv) != TCL_OK) {

+	return TCL_ERROR;

+    }

+    if (objc) {

+	for (i=1; i<objc; i++) {

+	    if (Tcl_GetIndexFromObj(interp, objv[i], (CONST84 char *CONST86 *)jpegWriteOptions,

+		    "format option", 0, &index)!=TCL_OK) {

+		return TCL_ERROR;

+	    }

+	    switch (index) {

+		case 0: {

+		    grayscale = 1;

+		    break;

+		}

+		case 1: {

+		    cinfo->optimize_coding = TRUE;

+		    break;

+		}

+		case 2: {

+		    if (jpeg_simple_progression != NULL) {

+			/* Select simple progressive mode. */

+			jpeg_simple_progression(cinfo);

+		    }

+		    break;

+		}

+		case 3: {

+		    int quality = 0;

+		    if (++i >= objc) {

+			Tcl_AppendResult(interp, "No value for option \"",

+				Tcl_GetStringFromObj(objv[--i], (int *) NULL), "\"", (char *) NULL);

+			return TCL_ERROR;

+		    }

+		    if (Tcl_GetIntFromObj(interp, objv[i], &quality) != TCL_OK) {

+			return TCL_ERROR;

+		    }

+		    jpeg_set_quality(cinfo, quality, FALSE);

+		    break;

+		}

+		case 4: {

+		    int smooth = 0;

+		    if (++i >= objc) {

+			Tcl_AppendResult(interp, "No value for option \"",

+				Tcl_GetStringFromObj(objv[--i], (int *) NULL), "\"", (char *) NULL);

+			return TCL_ERROR;

+		    }

+		    if (Tcl_GetIntFromObj(interp, objv[i], &smooth) != TCL_OK) {

+			return TCL_ERROR;

+		    }

+		    cinfo->smoothing_factor = smooth;

+		    break;

+		}

+	    }

+	}

+    }

+

+    pixLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];

+    greenOffset = blockPtr->offset[1] - blockPtr->offset[0];

+    blueOffset = blockPtr->offset[2] - blockPtr->offset[0];

+    if ((jpeg_set_colorspace != NULL) &&

+	    (grayscale || (!greenOffset && !blueOffset))) {

+	/* Generate monochrome JPEG file if source block is grayscale. */

+	jpeg_set_colorspace(cinfo, JCS_GRAYSCALE);

+    }

+

+    jpeg_start_compress(cinfo, TRUE);

+

+    /* note: we assume libjpeg is configured for standard RGB pixel order. */

+    if ((greenOffset == 1) && (blueOffset == 2)

+	&& (blockPtr->pixelSize == 3)) {

+	/* No need to reformat pixels before passing data to libjpeg */

+	for (h = blockPtr->height; h > 0; h--) {

+	    row_pointer[0] = (JSAMPROW) pixLinePtr;

+	    jpeg_write_scanlines(cinfo, row_pointer, 1);

+	    pixLinePtr += blockPtr->pitch;

+	}

+    } else {

+	/* Must convert data format.  Create a one-scanline work buffer. */

+	buffer = (*cinfo->mem->alloc_sarray)

+	  ((j_common_ptr) cinfo, JPOOL_IMAGE,

+	   cinfo->image_width * cinfo->input_components, 1);

+	for (h = blockPtr->height; h > 0; h--) {

+	    pixelPtr = pixLinePtr;

+	    bufferPtr = buffer[0];

+	    for (w = blockPtr->width; w > 0; w--) {

+		if (alphaOffset && !pixelPtr[alphaOffset]) {

+		    /* if pixel is transparant, better use gray

+		     * than the default black.

+		     */

+		    *bufferPtr++ = 0xd9;

+		    *bufferPtr++ = 0xd9;

+		    *bufferPtr++ = 0xd9;

+		} else {

+		    *bufferPtr++ = pixelPtr[0];

+		    *bufferPtr++ = pixelPtr[greenOffset];

+		    *bufferPtr++ = pixelPtr[blueOffset];

+		}

+		pixelPtr += blockPtr->pixelSize;

+	    }

+	    jpeg_write_scanlines(cinfo, buffer, 1);

+	    pixLinePtr += blockPtr->pitch;

+	}

+    }

+

+    jpeg_finish_compress(cinfo);

+    return TCL_OK;

+}

+

+/*

+ * libjpeg source manager for reading from base64-encoded strings

+ * and from Tcl_Channels.

+ */

+

+static void

+my_jpeg_obj_src (cinfo, dataObj)

+    j_decompress_ptr cinfo;

+    Tcl_Obj *dataObj;

+{

+  src_ptr src;

+

+  src = (src_ptr)

+      (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,

+				  sizeof(struct source_mgr));

+  cinfo->src = (struct jpeg_source_mgr *) src;

+

+  src->pub.init_source = dummy_source;

+  src->pub.fill_input_buffer = fill_input_buffer;

+  src->pub.skip_input_data = skip_input_data;

+  src->pub.resync_to_restart = jpeg_resync_to_restart; /* use default method */

+  src->pub.term_source = dummy_source;

+

+  tkimg_ReadInit(dataObj, '\377', &src->handle);

+

+  src->pub.bytes_in_buffer = 0; /* forces fill_input_buffer on first read */

+  src->pub.next_input_byte = NULL; /* until buffer loaded */

+}

+

+static boolean

+fill_input_buffer(cinfo)

+    j_decompress_ptr cinfo;

+{

+  src_ptr src = (src_ptr) cinfo->src;

+  int nbytes;

+

+  nbytes = tkimg_Read(&src->handle, (char *) src->buffer, STRING_BUF_SIZE);

+

+  if (nbytes <= 0) {

+    /* Insert a fake EOI marker */

+    src->buffer[0] = (JOCTET) 0xFF;

+    src->buffer[1] = (JOCTET) JPEG_EOI;

+    nbytes = 2;

+  }

+

+  src->pub.next_input_byte = src->buffer;

+  src->pub.bytes_in_buffer = nbytes;

+

+  return TRUE;

+}

+

+static void

+skip_input_data(cinfo, num_bytes)

+    j_decompress_ptr cinfo;

+    long num_bytes;

+{

+  src_ptr src = (src_ptr) cinfo->src;

+

+  if (num_bytes > 0) {

+    while (num_bytes > (long) src->pub.bytes_in_buffer) {

+      num_bytes -= (long) src->pub.bytes_in_buffer;

+      fill_input_buffer(cinfo);

+    }

+    src->pub.next_input_byte += (size_t) num_bytes;

+    src->pub.bytes_in_buffer -= (size_t) num_bytes;

+  }

+}

+

+static void

+dummy_source(cinfo)

+    j_decompress_ptr cinfo;

+{

+  /* no work necessary here */

+}

+

+/*

+ * libjpeg source manager for reading from channels.

+ */

+static void

+my_jpeg_channel_src (cinfo, chan)

+    j_decompress_ptr cinfo;

+    Tcl_Channel chan;

+{

+  src_ptr src;

+

+  src = (src_ptr)

+      (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,

+				  sizeof(struct source_mgr));

+  cinfo->src = (struct jpeg_source_mgr *) src;

+

+  src->pub.init_source = dummy_source;

+  src->pub.fill_input_buffer = fill_input_buffer;

+  src->pub.skip_input_data = skip_input_data;

+  src->pub.resync_to_restart = jpeg_resync_to_restart; /* use default method */

+  src->pub.term_source = dummy_source;

+

+  src->handle.data = (char *) chan;

+  src->handle.state = IMG_CHAN;

+

+  src->pub.bytes_in_buffer = 0; /* forces fill_input_buffer on first read */

+  src->pub.next_input_byte = NULL; /* until buffer loaded */

+}

+

+

+/*

+ * libjpeg destination manager for writing to base64-encoded strings

+ * and Tcl_Channel's.

+ */

+

+static void

+my_jpeg_string_dest (cinfo, dstring)

+    j_compress_ptr cinfo;

+    Tcl_DString* dstring;

+{

+  dest_ptr dest;

+

+  if (cinfo->dest == NULL) {	/* first time for this JPEG object? */

+    cinfo->dest = (struct jpeg_destination_mgr *)

+      (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,

+				  sizeof(struct destination_mgr));

+  }

+

+  dest = (dest_ptr) cinfo->dest;

+  dest->pub.init_destination = my_init_destination;

+  dest->pub.empty_output_buffer = my_empty_output_buffer;

+  dest->pub.term_destination = my_term_destination;

+  Tcl_DStringSetLength(dstring, dstring->spaceAvl);

+  dest->handle.buffer = dstring;

+  dest->handle.data = Tcl_DStringValue(dstring);

+  dest->handle.state = 0;

+  dest->handle.length = 0;

+}

+

+static void

+my_jpeg_channel_dest (cinfo, chan)

+    j_compress_ptr cinfo;

+    Tcl_Channel chan;

+{

+  dest_ptr dest;

+

+  if (cinfo->dest == NULL) {	/* first time for this JPEG object? */

+    cinfo->dest = (struct jpeg_destination_mgr *)

+      (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,

+				  sizeof(struct destination_mgr));

+  }

+

+  dest = (dest_ptr) cinfo->dest;

+  dest->pub.init_destination = my_init_destination;

+  dest->pub.empty_output_buffer = my_empty_output_buffer;

+  dest->pub.term_destination = my_term_destination;

+  dest->handle.data = (char *) chan;

+  dest->handle.state = IMG_CHAN;

+}

+

+static void

+my_init_destination (cinfo)

+    j_compress_ptr cinfo;

+{

+  dest_ptr dest = (dest_ptr) cinfo->dest;

+  dest->pub.next_output_byte = dest->buffer;

+  dest->pub.free_in_buffer = STRING_BUF_SIZE;

+}

+

+static boolean

+my_empty_output_buffer (cinfo)

+    j_compress_ptr cinfo;

+{

+  dest_ptr dest = (dest_ptr) cinfo->dest;

+  if (tkimg_Write(&dest->handle, (char *) dest->buffer, STRING_BUF_SIZE)

+  	!= STRING_BUF_SIZE)

+    ERREXIT(cinfo, JERR_FILE_WRITE);

+

+  dest->pub.next_output_byte = dest->buffer;

+  dest->pub.free_in_buffer = STRING_BUF_SIZE;

+

+  return TRUE;

+}

+

+static void

+my_term_destination (cinfo)

+    j_compress_ptr cinfo;

+{

+  dest_ptr dest = (dest_ptr) cinfo->dest;

+  int datacount = STRING_BUF_SIZE - (int) dest->pub.free_in_buffer;

+

+  /* Write any data remaining in the buffer */

+  if (datacount > 0) {

+    if (tkimg_Write(&dest->handle, (char *) dest->buffer, datacount)

+	!= datacount)

+      ERREXIT(cinfo, JERR_FILE_WRITE);

+  }

+  /* Empty any partial-byte from the base64 encoder */

+  tkimg_Putc(IMG_DONE, &dest->handle);

+}

+

+

+/*

+ * Error handler to replace (or extend, really) libjpeg's default handler

+ */

+

+static void

+my_error_exit (cinfo)

+    j_common_ptr cinfo;

+{

+  struct my_error_mgr *myerr = (struct my_error_mgr *) cinfo->err;

+  /* Exit back to outer level */

+  longjmp(myerr->setjmp_buffer, 1);

+}

+

+static void

+append_jpeg_message (interp, cinfo)

+    Tcl_Interp *interp;

+    j_common_ptr cinfo;

+{

+  /* Append libjpeg error message to interp->result */

+  char buffer[JMSG_LENGTH_MAX];

+  (*cinfo->err->format_message) (cinfo, buffer);

+  Tcl_AppendResult(interp, buffer, (char *) NULL);

+}

+

+static void

+my_output_message (cinfo)

+    j_common_ptr cinfo;

+{

+  /* Override libjpeg's output_message to do nothing.

+   * This ensures that warning messages will not appear on stderr,

+   * even for a corrupted JPEG file.  Too bad there's no way

+   * to report a "warning" message to the calling Tcl script.

+   */

+}