Reference implementation of TIP 166, rev. 1.9

3 files changed, 1347 insertions, 225 deletions

diff --git a/doc/photo.n b/doc/photo.n
index 84cf618..287ed02 100644
--- a/doc/photo.n
+++ b/doc/photo.n
@@ -276,8 +276,8 @@ information. All pixel data will be transformed into grayscale.
 \fIimageName \fBget\fR \fIx y\fR
 .
 Returns the color of the pixel at coordinates (\fIx\fR,\fIy\fR) in the
-image as a list of three integers between 0 and 255, representing the
-red, green and blue components respectively.
+image as a list of four integers between 0 and 255, representing the
+red, green, blue and alpha components respectively.
 .TP
 \fIimageName \fBput\fR \fIdata\fR ?\fIoption value(s) ...\fR?
 .
@@ -287,11 +287,58 @@ a handler that can interpret the data in \fIdata\fR, and then reads
 the image encoded within into \fIimageName\fR (the destination image).
 If \fIdata\fR does not match any known format, an attempt to interpret
 it as a (top-to-bottom) list of scan-lines is made, with each
-scan-line being a (left-to-right) list of pixel colors (see
-\fBTk_GetColor\fR for a description of valid colors.)  Every scan-line
-must be of the same length.  Note that when \fIdata\fR is a single
-color name, you are instructing Tk to fill a rectangular region with
-that color.  The following options may be specified:
+scan-line being a (left-to-right) list of pixel data. Every scan-line
+must be of the same length. Pixel data is a color specification 
+optionally followed by a suffix giving the pixel's alpha value.
+The color of a pixel may be specified in any of these forms:
+.RS
+.IP \(bu 3
+The empty string - the pixel shall be fully transparent. In this case
+no alpha suffix is allowed.
+.IP \(bu 3
+Any value accepted by \fBTk_GetColor\fR.
+.IP \(bu 3
+A Tcl list with three or four integers in the range 0 to 255, 
+specifying the values for the red, green, bule and (optionally) 
+alpha channels respectively.
+.IP \(bu 3
+\fB#\fR\fIARGB\fR format: a \fB#\fR followed by four hexadecimal digits,
+where each digit is the value for the alpha, red, green and blue 
+channels respectively. Each digit will be expanded internally to 
+8-bits by multiplication by 0x11.
+.IP \(bu 3
+\fB#\fR\fIAARRGGBB\fR format: \fB#\fR followed by eight hexadecimal digits,
+where two subsequent digits represent the value for the alpha, red, green
+and blue channels respectively.
+.RE
+.sp
+The alpha value of a pixel can be specified by appending a prefix to the color
+specification. If no value for alpha is passed, the pixel is made fully 
+opaque. It is an error to append an alpha suffix to a color format that 
+already specifies an alpha value. The alpha suffix can have one of these 
+forms:
+.RS
+.TP
+\fB@\fR\fIA\fR
+.
+The alpha value \fIA\fR must be a fractional value in the range  0.0 
+(fully transparent) to 1.0 (fully opaque).
+.TP
+\fB#\fR\fIX\fR
+.
+The alpha value \fIX\fR is a hexadecimal digit that specifies an integer
+alpha value in the range 0 (fully transparent) to 255 (fully opaque). 
+This is expanded in range from 4 bits wide to 8 bits wide by 
+multiplication by 0x11.
+.TP
+\fB#\fR\fIXX\fR
+.
+The alpha value \fIXX\fR is passed as two hexadecimal digits that 
+specify an integer alpha value in the range 0 (fully transparent) to 255 
+(fully opaque). 
+.RE
+.sp
+The following options may be specified:
 .RS
 .TP
 \fB\-format \fIformat-name\fR
@@ -308,7 +355,9 @@ of the region of \fIimageName\fR into which the image data will be
 copied.  The default position is (0,0).  If \fIx2\fR,\fIy2\fR is given
 and \fIdata\fR is not large enough to cover the rectangle specified by
 this option, the image data extracted will be tiled so it covers the
-entire destination rectangle.  Note that if \fIdata\fR specifies a
+entire destination rectangle. If the region specified with this opion
+is smaller than the supplied \fIdata\fR, the exceeding data is silently
+discarded. Note that if \fIdata\fR specifies a
 single color value, then a region extending to the bottom-right corner
 represented by (\fIx2\fR,\fIy2\fR) will be filled with that color.
 .RE
@@ -372,15 +421,41 @@ Allows examination and manipulation of the transparency information in
 the photo image.  Several subcommands are available:
 .RS
 .TP
-\fIimageName \fBtransparency get \fIx y\fR
+\fIimageName \fBtransparency get \fIx y\fR ?\fIoption\fR?
 .
-Returns a boolean indicating if the pixel at (\fIx\fR,\fIy\fR) is
+Returns information about the transparency of the pixel at (\fIx\fR,\fIy\fR).
+At most one of the following options may be specified. If no option is
+passed, \fB-boolean\fR is implied:
+.RS
+.TP
+\fB-alpha\fR
+.
+The return value is the integral alpha value (in the range 0 to 255) for 
+the specified pixel.
+.TP
+\fB-boolean\fR
+.
+The return value is a boolean indicating if the specified pixel is fully
 transparent.
+.RE
 .TP
-\fIimageName \fBtransparency set \fIx y boolean\fR
+\fIimageName \fBtransparency set \fIx y\fR ?\fIoption\fR? \fInewVal\fR
 .
-Makes the pixel at (\fIx\fR,\fIy\fR) transparent if \fIboolean\fR is
-true, and makes that pixel opaque otherwise.
+Change the transparency of the pixel at (\fIx\fR,\fIy\fR).
+At most one of the following options may be specified. If no option is 
+passed, \fB-boolean\fR is implied:
+.RS
+.TP
+\fB-alpha\fR
+.
+Set the transparency of the specified pixel to \fInewVal\fR, which must be
+an integral value in the range 0 to 255.
+.TP
+\fB-boolean\fR
+.
+\fInewVal\fR will be interpreted as a boolean. If true, make the specified 
+pixel fully transparent, opaque otherwise.
+.RE
 .RE
 .TP
 \fIimageName \fBwrite \fIfilename\fR ?\fIoption value(s) ...\fR?
diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c
index 1bd0142..2eb674e 100644
--- a/generic/tkImgPhoto.c
+++ b/generic/tkImgPhoto.c
@@ -182,9 +182,19 @@ static int		ImgPhotoConfigureMaster(Tcl_Interp *interp,
 static int		ToggleComplexAlphaIfNeeded(PhotoMaster *mPtr);
 static int		ImgPhotoSetSize(PhotoMaster *masterPtr, int width,
 			    int height);
+static int		ImgStringMatch(Tcl_Obj *data, Tcl_Obj *format,
+			    int *widthPtr, int *heightPtr, Tcl_Interp *interp);
+static int		ImgStringRead(Tcl_Interp *interp, Tcl_Obj *data,
+			    Tcl_Obj *format, Tk_PhotoHandle imageHandle,
+			    int destX, int destY, int width, int height,
+			    int srcX, int srcY);
 static int		ImgStringWrite(Tcl_Interp *interp,
 			    Tcl_Obj *formatString,
 			    Tk_PhotoImageBlock *blockPtr);
+static int		ImgPhotoParseColor(Tcl_Interp *interp, 
+			    Tcl_Obj *specObj, unsigned char *redPtr, 
+			    unsigned char *greenPtr, unsigned char *bluePtr,
+			    unsigned char *alphaPtr);
 static char *		ImgGetPhoto(PhotoMaster *masterPtr,
 			    Tk_PhotoImageBlock *blockPtr,
 			    struct SubcommandOptions *optPtr);
@@ -402,12 +412,10 @@ ImgPhotoCmd(
     };
 
     PhotoMaster *masterPtr = clientData;
-    int result, index, x, y, width, height, dataWidth, dataHeight, listObjc;
+    int result, index, x, y, width, height;
     struct SubcommandOptions options;
-    Tcl_Obj **listObjv, **srcObjv;
     unsigned char *pixelPtr;
     Tk_PhotoImageBlock block;
-    Tk_Window tkwin;
     Tk_PhotoImageFormat *imageFormat;
     size_t length;
     int imageWidth, imageHeight, matched, oldformat = 0;
@@ -782,7 +790,7 @@ ImgPhotoCmd(
 	 * photo get command - first parse and check parameters.
 	 */
 
-	Tcl_Obj *channels[3];
+	Tcl_Obj *channels[4];
 
 	if (objc != 4) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "x y");
@@ -803,14 +811,15 @@ ImgPhotoCmd(
 	}
 
 	/*
-	 * Extract the value of the desired pixel and format it as a string.
+	 * Extract the value of the desired pixel and format it as a list.
 	 */
 
 	pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4;
 	channels[0] = Tcl_NewIntObj(pixelPtr[0]);
 	channels[1] = Tcl_NewIntObj(pixelPtr[1]);
 	channels[2] = Tcl_NewIntObj(pixelPtr[2]);
-	Tcl_SetObjResult(interp, Tcl_NewListObj(3, channels));
+	channels[3] = Tcl_NewIntObj(pixelPtr[3]);
+	Tcl_SetObjResult(interp, Tcl_NewListObj(4, channels));
 	return TCL_OK;
     }
 
@@ -830,6 +839,10 @@ ImgPhotoCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, "data ?-option value ...?");
 	    return TCL_ERROR;
 	}
+	
+	/*
+	 * See if there's a format that can read the data
+	 */
 
 	if (MatchStringFormat(interp, options.name ? objv[2]:NULL,
 		options.format, &imageFormat, &imageWidth,
@@ -854,150 +867,44 @@ ImgPhotoCmd(
 		}
 		data = (Tcl_Obj *) Tcl_GetString(data);
 	    }
+
 	    if (imageFormat->stringReadProc(interp, data, format,
 		    (Tk_PhotoHandle) masterPtr, options.toX, options.toY,
 		    imageWidth, imageHeight, 0, 0) != TCL_OK) {
 		return TCL_ERROR;
 	    }
+	    /*
+	     * SB: is the next line really needed? The stringReadProc 
+	     * writes image data with Tk_PhotoPutBlock(), which in turn
+	     * takes care to notify the changed image.
+	     */
 	    masterPtr->flags |= IMAGE_CHANGED;
 	    return TCL_OK;
 	}
+	
+	/*
+	 * Try with the default format
+	 */
 	if (options.options & OPT_FORMAT) {
 	    return TCL_ERROR;
 	}
 	Tcl_ResetResult(interp);
-	if (Tcl_ListObjGetElements(interp, options.name,
-		&dataHeight, &srcObjv) != TCL_OK) {
-	    return TCL_ERROR;
+	if ( ! ImgStringMatch(objv[2], NULL, &imageWidth, &imageHeight,
+		interp)) {
+	    return TCL_ERROR;	    
 	}
-	tkwin = Tk_MainWindow(interp);
-	block.pixelPtr = NULL;
-	dataWidth = 0;
-	pixelPtr = NULL;
-	for (y = 0; y < dataHeight; ++y) {
-	    if (Tcl_ListObjGetElements(interp, srcObjv[y],
-		    &listObjc, &listObjv) != TCL_OK) {
-		break;
-	    }
-
-	    if (y == 0) {
-		if (listObjc == 0) {
-		    /*
-		     * Lines must be non-empty...
-		     */
-
-		    break;
-		}
-		dataWidth = listObjc;
-		/*
- 		 * Memory allocation overflow protection.
- 		 * May not be able to trigger/ demo / test this.
- 		 */
-
-		if (dataWidth > (int)((UINT_MAX/3) / dataHeight)) {
-		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"photo image dimensions exceed Tcl memory limits", -1));
-		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
-			"OVERFLOW", NULL);
-		    break;
-		}
-
-		pixelPtr = ckalloc(dataWidth * dataHeight * 3);
-		block.pixelPtr = pixelPtr;
-	    } else if (listObjc != dataWidth) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"all elements of color list must have the same"
-			" number of elements", -1));
-		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
-			"NON_RECTANGULAR", NULL);
-		break;
-	    }
-
-	    for (x = 0; x < dataWidth; ++x) {
-		const char *colorString = Tcl_GetString(listObjv[x]);
-		XColor color;
-		int tmpr, tmpg, tmpb;
-
-		/*
-		 * We do not use Tk_GetColorFromObj() because we absolutely do
-		 * not want to invoke the fallback code.
-		 */
-
-		if (colorString[0] == '#') {
-		    if (isxdigit(UCHAR(colorString[1])) &&
-			    isxdigit(UCHAR(colorString[2])) &&
-			    isxdigit(UCHAR(colorString[3]))) {
-			if (colorString[4] == '\0') {
-			    /* Got #rgb */
-			    sscanf(colorString+1, "%1x%1x%1x",
-				    &tmpr, &tmpg, &tmpb);
-			    *pixelPtr++ = tmpr * 0x11;
-			    *pixelPtr++ = tmpg * 0x11;
-			    *pixelPtr++ = tmpb * 0x11;
-			    continue;
-			} else if (isxdigit(UCHAR(colorString[4])) &&
-				isxdigit(UCHAR(colorString[5])) &&
-				isxdigit(UCHAR(colorString[6])) &&
-				colorString[7] == '\0') {
-			    /* Got #rrggbb */
-			    sscanf(colorString+1, "%2x%2x%2x",
-				    &tmpr, &tmpg, &tmpb);
-			    *pixelPtr++ = tmpr;
-			    *pixelPtr++ = tmpg;
-			    *pixelPtr++ = tmpb;
-			    continue;
-			}
-		    }
-		}
-
-		if (!TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin),
-			colorString, &color)) {
-		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			    "can't parse color \"%s\"", colorString));
-		    Tcl_SetErrorCode(interp, "TK", "VALUE", "COLOR", NULL);
-		    break;
-		}
-		*pixelPtr++ = color.red >> 8;
-		*pixelPtr++ = color.green >> 8;
-		*pixelPtr++ = color.blue >> 8;
-	    }
-	    if (x < dataWidth) {
-		break;
-	    }
+	if (!(options.options & OPT_TO) || (options.toX2 < 0)) {
+	    options.toX2 = options.toX + imageWidth;
+	    options.toY2 = options.toY + imageHeight;
 	}
-	if (y < dataHeight || dataHeight == 0 || dataWidth == 0) {
-	    if (block.pixelPtr != NULL) {
-		ckfree(block.pixelPtr);
-	    }
-	    if (y < dataHeight) {
-		return TCL_ERROR;
-	    }
-	    return TCL_OK;
+	if (ImgStringRead(interp, objv[2], NULL, (Tk_PhotoHandle) masterPtr,
+		options.toX, options.toY, 
+		options.toX2 - options.toX, 
+		options.toY2 - options.toY, 0, 0) != TCL_OK) {
+	    return TCL_ERROR;
 	}
-
-	/*
-	 * Fill in default values for the -to option, then copy the block in
-	 * using Tk_PhotoPutBlock.
-	 */
-
-	if (!(options.options & OPT_TO) || (options.toX2 < 0)) {
-	    options.toX2 = options.toX + dataWidth;
-	    options.toY2 = options.toY + dataHeight;
-	}
-	block.width = dataWidth;
-	block.height = dataHeight;
-	block.pitch = dataWidth * 3;
-	block.pixelSize = 3;
-	block.offset[0] = 0;
-	block.offset[1] = 1;
-	block.offset[2] = 2;
-	block.offset[3] = 0;
-	result = Tk_PhotoPutBlock(interp, masterPtr, &block,
-		options.toX, options.toY, options.toX2 - options.toX,
-		options.toY2 - options.toY,
-		TK_PHOTO_COMPOSITE_SET);
-	ckfree(block.pixelPtr);
-	return result;
+	
+	return TCL_OK;
 
     case PHOTO_READ: {
 	Tcl_Obj *format;
@@ -1168,17 +1075,32 @@ ImgPhotoCmd(
 
 	switch ((enum transOptions) index) {
 	case PHOTO_TRANS_GET: {
-	    XRectangle testBox;
-	    TkRegion testRegion;
-
-	    if (objc != 5) {
-		Tcl_WrongNumArgs(interp, 3, objv, "x y");
+	    const char *arg;
+	    int boolMode, strLength;
+	    
+	    if (objc > 6 || objc < 5) {
+		Tcl_WrongNumArgs(interp, 3, objv, "x y ?-option?");
 		return TCL_ERROR;
 	    }
 	    if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
 		    || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)) {
 		return TCL_ERROR;
 	    }
+	    boolMode = 1;
+	    if (objc == 6) {
+		arg = Tcl_GetStringFromObj(objv[5], &strLength);
+		if (strncmp(arg, "-boolean", (unsigned)strLength) == 0) {
+		    boolMode = 1;
+		} else if (strncmp(arg, "-alpha", (unsigned)strLength) == 0) {
+		    boolMode = 0;
+		} else {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"unknown option \"%s\": must be -alpha or -boolean",
+			Tcl_GetString(objv[5])));
+		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL);
+		    return TCL_ERROR;
+		}
+	    }
 	    if ((x < 0) || (x >= masterPtr->width)
 		    || (y < 0) || (y >= masterPtr->height)) {
 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -1189,36 +1111,70 @@ ImgPhotoCmd(
 		return TCL_ERROR;
 	    }
 
-	    testBox.x = x;
-	    testBox.y = y;
-	    testBox.width = 1;
-	    testBox.height = 1;
 	    /* What a way to do a test! */
-	    testRegion = TkCreateRegion();
-	    TkUnionRectWithRegion(&testBox, testRegion, testRegion);
-	    TkIntersectRegion(testRegion, masterPtr->validRegion, testRegion);
-	    TkClipBox(testRegion, &testBox);
-	    TkDestroyRegion(testRegion);
-
-	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
-		    testBox.width==0 && testBox.height==0));
+	    /* SB: indeed! Why don't we just get the information from image data? */
+	    /*
+		testRegion = TkCreateRegion();
+		TkUnionRectWithRegion(&testBox, testRegion, testRegion);
+		TkIntersectRegion(testRegion, masterPtr->validRegion, testRegion);
+		TkClipBox(testRegion, &testBox);
+		TkDestroyRegion(testRegion);
+	    */
+	    pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4;
+	    if (boolMode) {
+		Tcl_SetObjResult(interp, Tcl_NewBooleanObj( ! pixelPtr[3]));
+	    } else {
+		Tcl_SetObjResult(interp, Tcl_NewIntObj(pixelPtr[3]));
+	    }
 	    return TCL_OK;
 	}
 
 	case PHOTO_TRANS_SET: {
-	    int transFlag;
+	    int newVal, boolMode, strLength;
+	    const char *arg;
 	    XRectangle setBox;
+	    TkRegion modRegion;
 
-	    if (objc != 6) {
-		Tcl_WrongNumArgs(interp, 3, objv, "x y boolean");
+	    if (objc < 6 || objc > 7) {
+		Tcl_WrongNumArgs(interp, 3, objv, "x y ?-option? newVal");
 		return TCL_ERROR;
 	    }
 	    if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
-		    || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)
-		    || (Tcl_GetBooleanFromObj(interp, objv[5],
-		    &transFlag) != TCL_OK)) {
+		    || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)) {
 		return TCL_ERROR;
 	    }
+	    boolMode = 1;
+	    if (objc == 7) {
+		arg = Tcl_GetStringFromObj(objv[5], &strLength);
+		if (strncmp(arg, "-boolean", (unsigned) strLength) == 0) {
+		    boolMode = 1;
+		} else if (strncmp(arg, "-alpha", (unsigned) strLength) == 0) {
+		    boolMode = 0;
+		} else {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"unknown option \"%s\": must be -alpha or -boolean",
+			Tcl_GetString(objv[5])));
+		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL);
+		    return TCL_ERROR;
+		}
+	    }
+	    if (boolMode) {
+		if (Tcl_GetBooleanFromObj(interp, objv[objc-1], &newVal) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    } else {
+		if (Tcl_GetIntFromObj(interp, objv[objc-1], &newVal) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		if (newVal < 0 || newVal > 255) {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"invalid alpha value \"%d\": must be integer between 0 and 255",
+			newVal));
+		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_VALUE", NULL);
+		    return TCL_ERROR;
+		}
+	    }
+	    
 	    if ((x < 0) || (x >= masterPtr->width)
 		|| (y < 0) || (y >= masterPtr->height)) {
 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -1229,38 +1185,33 @@ ImgPhotoCmd(
 		return TCL_ERROR;
 	    }
 
+	    /*
+	     * Set new alpha value for the pixel
+	     */
+	    pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4;
+	    if (boolMode) {
+		pixelPtr[3] = newVal ? 0 : 255;
+	    } else {
+		pixelPtr[3] = newVal;
+	    }
+	    
+	    /*
+	     * Update the validRegion of the image
+	     */
 	    setBox.x = x;
 	    setBox.y = y;
 	    setBox.width = 1;
 	    setBox.height = 1;
-	    pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4;
-
-	    if (transFlag) {
-		/*
-		 * Make pixel transparent.
-		 */
-
-		TkRegion clearRegion = TkCreateRegion();
-
-		TkUnionRectWithRegion(&setBox, clearRegion, clearRegion);
-		TkSubtractRegion(masterPtr->validRegion, clearRegion,
+	    modRegion = TkCreateRegion();
+	    TkUnionRectWithRegion(&setBox, modRegion, modRegion);
+	    if (pixelPtr[3]) {
+		TkUnionRectWithRegion(&setBox, masterPtr->validRegion,
 			masterPtr->validRegion);
-		TkDestroyRegion(clearRegion);
-
-		/*
-		 * Set the alpha value correctly.
-		 */
-
-		pixelPtr[3] = 0;
 	    } else {
-		/*
-		 * Make pixel opaque.
-		 */
-
-		TkUnionRectWithRegion(&setBox, masterPtr->validRegion,
+		TkSubtractRegion(masterPtr->validRegion, modRegion,
 			masterPtr->validRegion);
-		pixelPtr[3] = 255;
 	    }
+	    TkDestroyRegion(modRegion);
 
 	    /*
 	     * Inform the generic image code that the image
@@ -3848,6 +3799,233 @@ ImgGetPhoto(
     return NULL;
 }
 
+/*
+ *----------------------------------------------------------------------
+ * 
+ * Default Photo Image Format
+ * ===========================
+ * 
+ * We have a default (or fallback) image format that is used for the 
+ * "<img> put", "<img> get", and "<img> data" commands. Image data is
+ * specified as a list of lists of pixel data. For details see the description
+ * of the "<img> put" command in the documentation of photo(n). 
+ * 
+ * This default image format cannot read/write files, it is meant for string
+ * data only. 
+ * 
+ * The default format is not registerd with Tk_CreatePhotoImageFromat()
+ * 
+ *----------------------------------------------------------------------
+ */
+ 
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgStringMatch --
+ *
+ *	Default string match function. Test if image data in string form 
+ * 	appears to be in the default list-of-list-of-pixel-data format
+ * 	accepted by the "<img> put" command.
+ *
+ * Results:
+ *	If thte data is in the default format, writes the size of the image 
+ *	to widthPtr and heightPtr and returns 1. Otherwise, leaves an error 
+ * 	messate in interp (if not NULL) and returns 0.
+ *	Note that this function does not parse all data points. A return 
+ *	value of 1 does not guarantee that the data can be read without 
+ * 	errors.
+ *
+ * Side effects:
+ *	None
+ *----------------------------------------------------------------------
+ */
+static int
+ImgStringMatch(
+    Tcl_Obj *data,	/* The data to check */
+    Tcl_Obj *format, 	/* Value of the -format option, - NULL for this format */
+    int *widthPtr, 
+    int *heightPtr,	/* Size of the image in *data is written here */
+    Tcl_Interp *interp) /* ... */
+{
+    int y, rowCount, colCount, curColCount;
+    Tcl_Obj **rowListPtr;
+
+    /*
+     * See if data is a nonempty list and if each element has the same 
+     * length.
+     */
+
+    if (Tcl_ListObjGetElements(interp, data, &rowCount, &rowListPtr) 
+	    != TCL_OK) {
+	return 0;
+    }
+    if (rowCount == 0) {
+	/* empty list is actually valid data */
+	*widthPtr = 0; 
+	*heightPtr = 0;
+	return 1;
+    }
+    colCount = -1;
+    for (y = 0; y < rowCount; y++) {
+	if (Tcl_ListObjLength(interp, rowListPtr[y], &curColCount) != TCL_OK) {
+	    return 0;
+	}
+	if (colCount < 0) {
+	    colCount = curColCount;
+	} else if (curColCount != colCount) {
+	    if (interp != NULL) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid row # %d: "
+			"all rows must have the same number of elements", y));
+		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
+			"INVALID_DATA", NULL);
+	    }
+	    return 0;
+	}
+    }
+    
+    /*
+     * Looks like we have valid data for this format.
+     * We do not check any pixel values - that's the job of ImgStringRead()
+     */
+    
+    *widthPtr = colCount;
+    *heightPtr = rowCount;
+    
+    return 1;
+	    
+}
+ 
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgStringRead --
+ *
+ *	Default string read function. The data is formatted in the default
+ *	format as accepted by the "<img> put" command.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ * 	If the data has valid format, write it to the image identified by 
+ * 	imageHandle.
+ * 	If the image data cannot be parsed, an error message is left in 
+ *	interp.
+ * 	See documentation for Tk_CreatePhotoImageFormat for further details.
+ *
+ *----------------------------------------------------------------------
+*/
+
+static int
+ImgStringRead(
+    Tcl_Interp *interp,			/* leave error messages here */
+    Tcl_Obj *data,			/* the data to parse */
+    Tcl_Obj *format, 			/* value of the -format option */
+    Tk_PhotoHandle imageHandle,		/* write data to this image */
+    int destX, int destY,		/* start writing data at this point
+					 * in destination image*/
+    int width, int height,		/* dimensions of area to write to */
+    int srcX, int srcY)			/* start reading source data at these
+					 * coordinates */ 
+{
+    Tcl_Obj **rowListPtr, **colListPtr;
+    unsigned char *curPixelPtr;
+    int x, y, rowCount, colCount, curColCount;
+    Tk_PhotoImageBlock srcBlock;
+   
+    /*
+     * Check if we have valid input data
+     */
+    
+    if (Tcl_ListObjGetElements(interp, data, &rowCount, &rowListPtr)
+	    != TCL_OK ) {
+	return TCL_ERROR;
+    }
+    if ( rowCount > 0 && Tcl_ListObjLength(interp, rowListPtr[0], &colCount) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (width <= 0 || height <= 0 || colCount == 0 || rowCount == 0) {
+	/*
+	 * No changes with zero sized input or zero sized output region
+	 */
+	return TCL_OK;
+    }
+    if (srcX < 0 || srcY < 0 || srcX >= rowCount || srcY >= colCount) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("source coordinates out of range"));
+	Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", NULL);
+	return TCL_ERROR;
+    }
+    
+    /*
+     * Memory allocation overflow protection.
+     * May not be able to trigger/ demo / test this.
+     */
+    
+    if (colCount > (int)(UINT_MAX / 4 / rowCount)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"photo image dimensions exceed Tcl memory limits"));
+	Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+		"OVERFLOW", NULL);
+	return TCL_OK;
+    }
+    
+    /*
+     * Read data and put it to imageHandle
+     */
+    
+    srcBlock.width = colCount - srcX;
+    srcBlock.height = rowCount - srcY;
+    srcBlock.pixelSize = 4;
+    srcBlock.pitch = srcBlock.width * 4;
+    srcBlock.offset[0] = 0;
+    srcBlock.offset[1] = 1;
+    srcBlock.offset[2] = 2;
+    srcBlock.offset[3] = 3;
+    srcBlock.pixelPtr = attemptckalloc(srcBlock.pitch * srcBlock.height);
+    if (srcBlock.pixelPtr == NULL) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(TK_PHOTO_ALLOC_FAILURE_MESSAGE));
+	Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
+	return TCL_ERROR;
+    }
+    curPixelPtr = srcBlock.pixelPtr;
+    for (y = srcY; y < rowCount; y++) {
+	/*
+	 * We don't test the length of row, as that's been done in
+	 * ImgStringMatch()
+	 */
+	if (Tcl_ListObjGetElements(interp, rowListPtr[y], &curColCount, 
+		&colListPtr) != TCL_OK) {
+	    goto errorExit;
+	}
+	for (x = srcX; x < colCount; x++) {
+	    if (ImgPhotoParseColor(interp, colListPtr[x], curPixelPtr, 
+		    curPixelPtr + 1, curPixelPtr + 2, curPixelPtr + 3) 
+		    != TCL_OK) {
+		goto errorExit;
+	    }
+	    curPixelPtr += 4;
+	}
+    }
+    
+    /*
+     * Write image data to destHandle
+     */
+    
+    if (Tk_PhotoPutBlock(interp, imageHandle, &srcBlock, destX, destY,
+	    width, height, TK_PHOTO_COMPOSITE_SET) != TCL_OK) {
+	goto errorExit;
+    }
+    
+    ckfree(srcBlock.pixelPtr);
+    
+    return TCL_OK;		    
+	    
+  errorExit:
+    ckfree(srcBlock.pixelPtr);
+    
+    return TCL_ERROR;
+}
+ 
 /*
  *----------------------------------------------------------------------
  *
@@ -3857,10 +4035,11 @@ ImgGetPhoto(
  *	format as accepted by the "<img> put" command.
  *
  * Results:
- *	A standard Tcl result.
+ *	The converted data is set as the result of interp. Returns a standard 
+ * 	Tcl result.
  *
  * Side effects:
- *	See the user documentation.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
@@ -3898,7 +4077,271 @@ ImgStringWrite(
     Tcl_SetObjResult(interp, data);
     return TCL_OK;
 }
-
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoParseColor --
+ *
+ *	This function extracts color and alpha values from a string. It 
+ *	understands standard Tk color formats, alpha suffixes and the color 
+ *	formats specific to photo images, which include alpha data.
+ *
+ * Results:
+ *	On success, writes red, green, blue and alpha values to the 
+ *	corresponding pointers. If the color spec contains no alpha 
+ *	information, 255 is taken as transparency value. 
+ * 	If the input cannot be parsed, leaves an error message in 
+ *	interp. Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ImgPhotoParseColor(
+    Tcl_Interp *interp,		/* error messages go there */
+    Tcl_Obj *specObj,		/* the color data to parse */
+    unsigned char *redPtr, 	/* the result is written to these pointers */
+    unsigned char *greenPtr,
+    unsigned char *bluePtr,
+    unsigned char *alphaPtr)
+{
+    const char *specString, *suffixString, *colorString;
+    Tcl_Obj *colorObj = NULL;
+    char *tmpString;
+    unsigned int i, charCount;
+    double fracAlpha;
+    unsigned int colorAlpha, suffixAlpha;
+    XColor parsedColor;
+    Display *display;
+    Colormap colormap;
+    enum FormatType {
+	PHOTO_COLORFORMAT_TKCOLOR,
+	PHOTO_COLORFORMAT_EMPTYSTRING,
+	PHOTO_COLORFORMAT_LIST,
+	PHOTO_COLORFORMAT_ARGB1,
+	PHOTO_COLORFORMAT_ARGB2
+    } formatType;
+
+    /*
+     * Split color data string in color and suffix parts
+     */
+    
+    specString = Tcl_GetString(specObj);
+    if ((suffixString = strrchr(specString, '@')) == NULL
+	    && ((suffixString = strrchr(specString, '#')) == NULL
+	    || suffixString == specString)) {
+	suffixString = specString + strlen(specString);
+    }
+    colorObj = Tcl_NewStringObj(specString, suffixString - specString);
+    colorString = Tcl_GetString(colorObj);
+    
+    /*
+     * Parse the color.
+     * 
+     * We don't use Tk_GetColor() et al. here, as those functions
+     * migth return a color that does not exaxtly match the given name
+     * if the colormap is full. Also, we don't really want the color to be 
+     * added to the colormap.
+     */
+    
+    display = Tk_Display(Tk_MainWindow(interp));
+    colormap = Tk_Colormap(Tk_MainWindow(interp));
+    if (TkParseColor(display, colormap, colorString, &parsedColor)) {
+	formatType = PHOTO_COLORFORMAT_TKCOLOR;
+	parsedColor.red >>= 8;
+	parsedColor.green >>= 8;
+	parsedColor.blue >>= 8;
+    } else if (colorString[0] == '#') {
+	charCount = strlen(colorString);
+	if (charCount - 1 != 4 && charCount - 1 != 8) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "invalid color name \"%s\"", colorString));
+	    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
+		    "INVALID_COLOR", NULL);
+	    goto errorExit;
+	}
+	for (i = 1; i < charCount; i++) {
+	    if ( ! isxdigit(UCHAR(colorString[i]))) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"invalid color name \"%s\"", colorString));
+		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
+			"INVALID_COLOR", NULL);
+		goto errorExit;
+	    }
+	}
+	switch (charCount - 1) {
+	    case 4:
+		/* #ARGB format */
+		formatType = PHOTO_COLORFORMAT_ARGB1;
+		sscanf(colorString, "#%1x%1hx%1hx%1hx", &colorAlpha,
+			&parsedColor.red, &parsedColor.green, 
+			&parsedColor.blue);
+		parsedColor.red *= 0x11;
+		parsedColor.green *= 0x11;
+		parsedColor.blue *= 0x11;
+		colorAlpha *= 0x11;
+		break;
+	    case 8:
+		/* #AARRGGBB format */
+		formatType = PHOTO_COLORFORMAT_ARGB2;
+		sscanf(colorString, "#%2x%2hx%2hx%2hx", &colorAlpha,
+			&parsedColor.red, &parsedColor.green, 
+			&parsedColor.blue);
+		break;
+	    default:
+		Tcl_Panic("unexpected switch fallthrough");
+	}
+    } else if (strlen(colorString) == 0) {
+	formatType = PHOTO_COLORFORMAT_EMPTYSTRING;
+	parsedColor.red = 0;
+	parsedColor.green = 0;
+	parsedColor.blue = 0;
+	colorAlpha = 0;
+    } else {
+	int listLen;
+	int values[4];
+	Tcl_Obj *curValue;
+	
+	/* 
+	 * Last, try to interpret color as a tcl list 
+	 */
+	
+	if (Tcl_ListObjLength(interp, colorObj, &listLen) != TCL_OK
+		|| listLen < 3 || listLen > 4) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "can't parse color \"%s\"", colorString));
+	    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
+		    "INVALID_COLOR", NULL);
+	    goto errorExit;
+	}
+	values[3] = -1;
+	for (i = 0; i < (unsigned)listLen; i++) {
+	    if (Tcl_ListObjIndex(interp, colorObj, i, &curValue) != TCL_OK) {
+		goto errorExit;
+	    }
+	    if (Tcl_GetIntFromObj(interp, curValue, values + i) != TCL_OK) {
+		goto errorExit;
+	    }
+	    if (values[i] < 0 || values[i] > 255) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"invalid color \"%s\": expected integers "
+			"in the range from 0 to 255", colorString));
+		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
+			"INVALID_COLOR", NULL);
+		goto errorExit;
+	    }
+	}
+	formatType = PHOTO_COLORFORMAT_LIST;
+	parsedColor.red = values[0];
+	parsedColor.green = values[1];
+	parsedColor.blue = values[2];
+	if (values[3] != -1) {
+	    colorAlpha = values[3];
+	} else {
+	    colorAlpha = 255;
+	}
+    }
+    
+    /*
+     * parse the Suffix
+     */
+    if (formatType != PHOTO_COLORFORMAT_TKCOLOR
+	    && suffixString[0] != '\0') {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid color \"%s\": "
+		"format does not allow alpha suffix", specString));
+	Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
+		"INVALID_COLOR", NULL);
+	goto errorExit;
+    }
+    switch (suffixString[0]) {
+	case '\0': 
+	    suffixAlpha = 255;
+	    break;
+	case '@':
+	    fracAlpha = strtod(suffixString + 1, &tmpString);
+	    if (*tmpString != '\0') {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid alpha "
+			"suffix \"%s\": expected floating-point value", 
+			suffixString));
+		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
+			"INVALID COLOR", NULL);
+		goto errorExit;
+	    }
+	    if (fracAlpha < 0 || fracAlpha > 1) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid alpha suffix" 
+			" \"%s\": value must be in the range from 0 to 1", 
+			suffixString));
+		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+			"INVALID_COLOR", NULL);
+		goto errorExit;
+	    }
+	    suffixAlpha = round(fracAlpha * 255);
+	    break;
+	case '#':
+	    if (strlen(suffixString + 1) < 1 || strlen(suffixString + 1)> 2) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"invalid alpha suffix \"%s\"", suffixString));
+		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
+			"INVALID_COLOR", NULL);
+		goto errorExit;
+	    }
+	    for (i = 1; i <= strlen(suffixString + 1); i++) {
+		if ( ! isxdigit(UCHAR(suffixString[i]))) {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "invalid alpha suffix \"%s\": expected hex digit",
+			    suffixString));
+		    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+			    "INVALID_COLOR", NULL);
+		    goto errorExit;
+		}
+	    }
+	    if (strlen(suffixString + 1) == 1) {
+		sscanf(suffixString, "#%1x", &suffixAlpha);
+		suffixAlpha *= 0x11;
+	    } else {
+		sscanf(suffixString, "#%2x", &suffixAlpha);
+	    }
+	    break;
+	default:
+	    Tcl_Panic("unexpected switch fallthrough");
+    }
+    
+    /*
+     * Put the pieces togegher and clean up
+     */
+    
+    *redPtr = parsedColor.red;
+    *greenPtr = parsedColor.green;
+    *bluePtr = parsedColor.blue;
+    if (formatType == PHOTO_COLORFORMAT_TKCOLOR) {
+	/* 
+	 * there was no alpha value in the color spec. use the one
+	 * from suffix, which is 255 if no suffix was passed.
+	 */
+	
+	*alphaPtr = suffixAlpha;
+    } else {
+	*alphaPtr = colorAlpha;
+    }
+    
+    if (colorObj != NULL) {
+	Tcl_DecrRefCount(colorObj);
+    }
+    
+    return TCL_OK;
+    
+  errorExit:
+    if (colorObj != NULL) {
+	Tcl_DecrRefCount(colorObj);
+    }
+    
+    return TCL_ERROR;
+    
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -3944,7 +4387,7 @@ Tk_PhotoGetImage(
 /*
  *--------------------------------------------------------------
  *
- * TkPostscriptPhoto --
+ * ImgPostscriptPhoto --
  *
  *	This function is called to output the contents of a photo image in
  *	Postscript by calling the Tk_PostscriptPhoto function.
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index f9ffa94..268700a 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -58,6 +58,9 @@ set README [makeFile {
 # find the teapot.ppm file for use in these tests
 set teapotPhotoFile [file join [file dirname [info script]] teapot.ppm]
 testConstraint hasTeapotPhoto [file exists $teapotPhotoFile]
+# let's see if we have the semi-transparent one as well
+set transpTeapotPhotoFile [file join [file dirname [info script]] teapotTransparent.png]
+testConstraint hasTranspTeapotPhoto [file exists $transpTeapotPhotoFile]
 
 # ----------------------------------------------------------------------
 
@@ -246,7 +249,7 @@ test imgPhoto-4.10 {ImgPhotoCmd procedure: copy option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 100 100]
 } -cleanup {
     image delete photo1 photo2
-} -result {256 256 {169 117 90}}
+} -result {256 256 {169 117 90 255}}
 test imgPhoto-4.11 {ImgPhotoCmd procedure: copy option} -setup {
     image create photo photo1
 } -body {
@@ -288,7 +291,7 @@ test imgPhoto-4.15 {ImgPhotoCmd procedure: copy option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 20 10]
 } -cleanup {
     image delete photo1 photo2
-} -result {60 50 {215 154 120}}
+} -result {60 50 {215 154 120 255}}
 test imgPhoto-4.16 {ImgPhotoCmd procedure: copy option} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -299,7 +302,7 @@ test imgPhoto-4.16 {ImgPhotoCmd procedure: copy option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 40 80]
 } -cleanup {
     image delete photo1 photo2
-} -result {80 100 {19 92 192}}
+} -result {80 100 {19 92 192 255}}
 test imgPhoto-4.17 {ImgPhotoCmd procedure: copy option} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -310,7 +313,7 @@ test imgPhoto-4.17 {ImgPhotoCmd procedure: copy option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 80 60]
 } -cleanup {
     image delete photo1 photo2
-} -result {100 100 {215 154 120}}
+} -result {100 100 {215 154 120 255}}
 test imgPhoto-4.18 {ImgPhotoCmd procedure: copy option} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -321,7 +324,7 @@ test imgPhoto-4.18 {ImgPhotoCmd procedure: copy option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 100 50]
 } -cleanup {
     image delete photo1 photo2
-} -result {120 100 {169 99 47}}
+} -result {120 100 {169 99 47 255}}
 test imgPhoto-4.19 {ImgPhotoCmd procedure: copy option} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -332,7 +335,7 @@ test imgPhoto-4.19 {ImgPhotoCmd procedure: copy option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 100 50]
 } -cleanup {
     image delete photo1 photo2
-} -result {120 100 {169 99 47}}
+} -result {120 100 {169 99 47 255}}
 test imgPhoto-4.20 {ImgPhotoCmd procedure: copy option} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -343,7 +346,7 @@ test imgPhoto-4.20 {ImgPhotoCmd procedure: copy option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 50 30]
 } -cleanup {
     image delete photo1 photo2
-} -result {90 80 {207 146 112}}
+} -result {90 80 {207 146 112 255}}
 test imgPhoto-4.21 {ImgPhotoCmd procedure: copy option} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -368,15 +371,15 @@ test imgPhoto-4.21 {ImgPhotoCmd procedure: copy option} -constraints {
     image delete photo1 photo2
 } -result {256 256 49 51 49 51 49 51 10 51 10 10}
 test imgPhoto-4.22 {ImgPhotoCmd procedure: get option} -constraints {
-    hasTeapotPhoto
+    hasTranspTeapotPhoto
 } -setup {
     image create photo photo1
 } -body {
-    photo1 read $teapotPhotoFile
+    photo1 read $transpTeapotPhotoFile
     list [photo1 get 100 100] [photo1 get 150 100] [photo1 get 100 150]
 } -cleanup {
     image delete photo1
-} -result {{169 117 90} {172 115 84} {35 35 35}}
+} -result {{175 71 0 162} {179 73 0 168} {14 8 0 219}}
 test imgPhoto-4.23 {ImgPhotoCmd procedure: get option} -setup {
     image create photo photo1
 } -body {
@@ -411,7 +414,7 @@ test imgPhoto-4.27 {ImgPhotoCmd procedure: put option} -setup {
     photo1 put {{white} {white white}}
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {all elements of color list must have the same number of elements}
+} -result {invalid row # 1: all rows must have the same number of elements}
 test imgPhoto-4.28 {ImgPhotoCmd procedure: put option} -setup {
     image create photo photo1
 } -body {
@@ -422,11 +425,16 @@ test imgPhoto-4.28 {ImgPhotoCmd procedure: put option} -setup {
 test imgPhoto-4.29 {ImgPhotoCmd procedure: put option} -setup {
     image create photo photo1
 } -body {
-    photo1 put -to 10 10 20 20 {{white}}
+    # SB: odd thing - this test passed with tk 8.6.6, even if the data
+    # is in the wrong position!
+    #photo1 put -to 10 10 20 20 {{white}}
+    # this is how it's supposed to be:
+    photo1 put {{white}} -to 10 10 20 20
     photo1 get 19 19
 } -cleanup {
     image delete photo1
-} -result {255 255 255}
+} -result {255 255 255 255}
+# more tests for image put: 4.90-4.94
 test imgPhoto-4.30 {ImgPhotoCmd procedure: read option} -setup {
     image create photo photo1
 } -body {
@@ -475,7 +483,7 @@ test imgPhoto-4.35 {ImgPhotoCmd procedure: read option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 120 120]
 } -cleanup {
     image delete photo1
-} -result {256 256 {161 109 82}}
+} -result {256 256 {161 109 82 255}}
 test imgPhoto-4.36 {ImgPhotoCmd procedure: read option} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -485,7 +493,7 @@ test imgPhoto-4.36 {ImgPhotoCmd procedure: read option} -constraints {
     list [image width photo1] [image height photo1] [photo1 get 29 19]
 } -cleanup {
     image delete photo1
-} -result {70 60 {244 180 144}}
+} -result {70 60 {244 180 144 255}}
 test imgPhoto-4.37 {ImgPhotoCmd procedure: redither option} -setup {
     image create photo photo1
 } -body {
@@ -521,21 +529,21 @@ test imgPhoto-4.41 {ImgPhotoCmd procedure: transparency get option} -setup {
     photo1 transparency get
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency get x y"}
+} -result {wrong # args: should be "photo1 transparency get x y ?-option?"}
 test imgPhoto-4.42 {ImgPhotoCmd procedure: transparency get option} -setup {
     image create photo photo1
 } -body {
     photo1 transparency get 0
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency get x y"}
+} -result {wrong # args: should be "photo1 transparency get x y ?-option?"}
 test imgPhoto-4.43 {ImgPhotoCmd procedure: transparency get option} -setup {
     image create photo photo1
 } -body {
-    photo1 transparency get 0 0 0
+    photo1 transparency get 0 0 -boolean 0
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency get x y"}
+} -result {wrong # args: should be "photo1 transparency get x y ?-option?"}
 test imgPhoto-4.44 {ImgPhotoCmd procedure: transparency get option} -setup {
     image create photo photo1
 } -body {
@@ -595,34 +603,35 @@ test imgPhoto-4.51 {ImgPhotoCmd procedure: transparency get option} -setup {
 } -cleanup {
     image delete photo1
 } -result 1
+# more tests for transparency get: 4.65, 4.66, 4.75-4.80
 test imgPhoto-4.52 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
     photo1 transparency set
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency set x y boolean"}
+} -result {wrong # args: should be "photo1 transparency set x y ?-option? newVal"}
 test imgPhoto-4.53 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
     photo1 transparency set 0
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency set x y boolean"}
+} -result {wrong # args: should be "photo1 transparency set x y ?-option? newVal"}
 test imgPhoto-4.54 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
     photo1 transparency set 0 0
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency set x y boolean"}
+} -result {wrong # args: should be "photo1 transparency set x y ?-option? newVal"}
 test imgPhoto-4.55 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
-    photo1 transparency set 0 0 0 0
+    photo1 transparency set 0 0 -boolean 0 0
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency set x y boolean"}
+} -result {wrong # args: should be "photo1 transparency set x y ?-option? newVal"}
 test imgPhoto-4.56 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
@@ -690,6 +699,7 @@ test imgPhoto-4.64 {ImgPhotoCmd procedure: transparency set option} -setup {
 } -cleanup {
     image delete photo1
 } -result 1
+# more tests for transparency set: 4.67, 4.68, 4.81-4.88
 # Now for some heftier testing, checking that setting and resetting of pixels'
 # transparency status doesn't "leak" with any one-off errors.
 test imgPhoto-4.65 {ImgPhotoCmd procedure: transparency get option} -setup {
@@ -815,6 +825,243 @@ test imgPhoto-4.75 {<photo> read command: filename starting with '-'} -constrain
     file delete ./-teapotPhotoFile
 } -result {}
 
+test imgPhoto-4.75 {ImgPhotoCmd procedure: transparancy get} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put white -to 0 0 1 1
+    photo1 transparency get 0 0 -alpha -boolean
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {wrong # args: should be "photo1 transparency get x y ?-option?"}
+test imgPhoto-4.76 {ImgPhotoCmd procedure: transparency get} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put white -to 0 0 1 1
+    photo1 transparency get 0 0 -bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {unknown option "-bogus": must be -alpha or -boolean}
+test imgPhoto-4.77 {ImgPhotoCmd procedure: transparency get} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put white -to 0 0 1 1
+    set result [photo1 transparency get 0 0 -boolean]
+    lappend result [photo1 transparency get 0 0 -alpha]
+} -cleanup {
+    imageCleanup
+} -result {0 255}
+test imgPhoto-4.78 {ImgPhotoCmd procedure: transparency get} -constraints {
+    hasTranspTeapotPhoto
+} -setup {
+    image create photo photo1 -file $transpTeapotPhotoFile
+    set result {}
+} -body {
+    set pixelCoords {{156 239} {76 207} {153 213} {139 43} {75 112}}
+    foreach coord $pixelCoords {
+	lappend result [photo1 transparency get {*}$coord]
+    }
+    set result
+} -cleanup {
+    imageCleanup
+} -result {0 1 0 0 0}
+test imgPhoto-4.79 {ImgPhotoCmd procedure: transparency get} -constraints {
+    hasTranspTeapotPhoto
+} -setup {
+    image create photo photo1 -file $transpTeapotPhotoFile
+    set result {}
+} -body {
+    set pixelCoords {{156 239} {76 207} {153 213} {139 43} {75 112}}
+    foreach coord $pixelCoords {
+	lappend result [photo1 transparency get {*}$coord -boolean]
+    }
+    set result
+} -cleanup {
+    imageCleanup
+} -result {0 1 0 0 0}
+test imgPhoto-4.80 {ImgPhotoCmd procedure: transparency get} -constraints {
+    hasTranspTeapotPhoto
+} -setup {
+    image create photo photo1 -file $transpTeapotPhotoFile
+    set result {}
+} -body {
+    set pixelCoords {{156 239} {76 207} {153 213} {139 43} {75 112}}
+    foreach coord $pixelCoords {
+	lappend result [photo1 transparency get {*}$coord -alpha]
+    }
+    set result
+} -cleanup {
+    imageCleanup
+} -result {255 0 1 254 206}
+test imgPhoto-4.81 {ImgPhotoCmd procedure: transparency set} -setup {
+    image create photo photo1
+} -body {
+    photo1 transparency set 0 0 -alpha -boolean 1
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {wrong # args: should be "photo1 transparency set x y ?-option? newVal"}
+test imgPhoto-4.82 {ImgPhotoCmd procedure: transparency set} -setup {
+    image create photo photo1
+} -body {
+    photo1 transparency set 0 0 -bogus 0
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {unknown option "-bogus": must be -alpha or -boolean}
+test imgPhoto-4.83 {ImgPhotoCmd procedure: transparency set} -setup {
+    image create photo photo1
+} -body {
+    photo1 transparency set 0 0 -alpha bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {expected integer but got "bogus"}
+test imgPhoto-4.84 {ImgPhotoCmd procedure: transparency set} -setup {
+    image create photo photo1
+} -body {
+    photo1 transparency set 0 0 -alpha -1
+} -returnCodes error -result \
+    {invalid alpha value "-1": must be integer between 0 and 255}
+test imgPhoto-4.85 {ImgPhotoCmd procedure: transparency set} -setup {
+    image create photo photo1
+} -body {
+    photo1 transparency set 0 0 -alpha 256
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid alpha value "256": must be integer between 0 and 255}
+test imgPhoto-4.86 {ImgPhotoCmd procedure: transparency set} -setup {
+    image create photo photo1
+} -body {
+    photo1 put white -to 0 0 2 1
+    photo1 transparency set 0 0 0
+    photo1 transparency set 1 0 1
+    list [photo1 transparency get 0 0 -alpha] [photo1 transparency get 1 0 -alpha]
+} -cleanup {
+    imageCleanup
+} -result {255 0}
+test imgPhoto-4.87 {ImgPhotoCmd procedure: transparency set} -setup {
+    image create photo photo1
+} -body {
+    photo1 put white -to 0 0 2 1
+    photo1 transparency set 0 0 -boolean 0
+    photo1 transparency set 1 0 -boolean 1
+    list [photo1 transparency get 0 0 -alpha] [photo1 transparency get 1 0 -alpha]
+} -cleanup {
+    imageCleanup
+} -result {255 0}
+test imgPhoto-4.88 {ImgPhotoCmd procedure: transparency set} -setup {
+    image create photo photo1
+} -body {
+    photo1 put white -to 0 0 2 2
+    photo1 transparency set 0 0 -alpha 0
+    photo1 transparency set 1 0 -alpha 1
+    photo1 transparency set 0 1 -alpha 254
+    photo1 transparency set 1 1 -alpha 255
+    list [photo1 transparency get 0 0] [photo1 transparency get 1 0] \
+	[photo1 transparency get 0 1] [photo1 transparency get 1 1]
+} -cleanup {
+    imageCleanup
+} -result {1 0 0 0}
+test imgPhoto-4.89 {ImgPhotoCmd procdeure: put option} -constraints {
+    hasTeapotPhoto
+} -setup {
+    image create photo photo1 -file $teapotPhotoFile
+    image create photo photo2
+} -body {
+    # put data in a registered format
+    set imgdata [photo1 data -format ppm]
+    photo2 put $imgdata -format ppm
+    set result {}
+    if {[image width photo1] != [image width photo2] \
+	    || [image height photo1] != [image height photo2]} {
+	lappend result [list [image width photo2] [image height photo2]]
+    } else {
+	lappend result 1
+    }
+    foreach point {{206 125} {67 12} {13 46} {19 184}} {
+	if {[photo1 get {*}$point] ne [photo2 get {*}$point]} {
+	    lappend result [photo2 get {*}$point]
+	} else {
+	    lappend result 1
+	}
+    }
+    set result
+} -cleanup {
+    imageCleanup
+} -result {1 1 1 1 1}
+test imgPhoto-4.90 {ImgPhotoCmd procedure: put option} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    # unknown format
+    photo1 put {no real data} -format bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {image format "bogus" is not supported}
+test imgPhoto-4.91 {ImgPhotoCmd procedure: put option} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    # default format, invalid data error case
+    photo1 put "not a \{ proper list" 
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {unmatched open brace in list}
+test imgPhoto-4.92 {ImgPhotoCmd procedure: put option} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    # no -to option, image size is data size
+    photo1 put {{red green blue} {blue red green}}
+    list [image width photo1] [image height photo1]
+} -cleanup {
+    imageCleanup
+} -result {3 2}
+test imgPhoto-4.93 {ImgPhotoCmd procedure: put option} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    # two coordinates for -to option
+    photo1 put {{"alice blue" "blanched almond"}
+		{"deep sky blue" "ghost white"}
+		{#AABBCC #AABBCCDD}} -to 5 6
+    list [image width photo1] [image height photo1]
+} -cleanup {
+    imageCleanup
+} -result {7 9}
+test imgPhoto-4.94 {ImgPhotoCmd procedure: put option} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    # 4 coordinates for -to option, data gets tiled
+    photo1 put {{#123 #456 #678} {#9AB #CDE #F01}} -to 1 2 20 21
+    set result {}
+    lappend result [photo1 get 19 20]
+    lappend result [string equal \
+	[photo1 data -from 1 2 4 4] [photo1 data -from 4 2 7 4]]
+    lappend result [string equal \
+	[photo1 data -from 10 12 13 14] [photo1 data -from 16 16 19 18]]
+    set result
+} -cleanup {
+    imageCleanup
+} -result {{17 34 51 255} 1 1}
+test imgPhoto-4.95 {ImgPhotoCmd procedure: put option} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    # empty data does not cause changes
+    photo1 put {{brown blue} {cyan coral}}
+    set imgData [photo1 data]
+    photo1 put {}
+    string equal $imgData [photo1 data]
+} -cleanup {
+    imageCleanup
+} -result {1}
+    
 test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -952,7 +1199,7 @@ test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} -setup {
     photo1 put "{#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000}" -to 0 0
     photo1 put "{#00ff00 #00ff00}" -to 2 0
     list [photo1 get 2 0] [photo1 get 3 0] [photo1 get 4 0]
-} -result {{0 255 0} {0 255 0} {255 0 0}}
+} -result {{0 255 0 255} {0 255 0 255} {255 0 0 255}}
 
 test imgPhoto-11.1 {Tk_FindPhoto} -setup {
     imageCleanup
@@ -971,7 +1218,7 @@ test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} -constraints hasTeapotPhoto -body {
     lappend result [image width p3] [image height p3] [p3 get 100 100]
 } -cleanup {
     image delete p3
-} -result {{19 92 192} {169 117 90} 512 512 {19 92 192}}
+} -result {{19 92 192 255} {169 117 90 255} 512 512 {19 92 192 255}}
 
 test imgPhoto-13.1 {check separation of images in different interpreters} -setup {
     imageCleanup
@@ -1169,6 +1416,363 @@ test imgPhoto-17.3 {photo write: format guessing from filename} -setup {
     catch {removeFile $f}
 } -result "P6\n"
 
+test imgPhoto-18.1 {ImgStringMatch: data is not a list} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {not a " proper list}
+    # " (this comment is here only for editor highlighting)
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {unmatched open quote in list}
+# empty data case tested with imgPhoto-4.95
+test imgPhoto-18.2 {ImgStringMatch: list element not a proper list} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{red white} {not "} {blue green}}
+    # "
+} -cleanup {
+    imageCleanup 
+} -returnCodes error -result {unmatched open quote in list} 
+test imgPhoto-18.3 {ImgStringMatch: sublists with differen lengths} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{#001122 #334455 #667788} 
+		{#99AABB #CCDDEE} 
+		{#FF0011 #223344 #556677}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid row # 1: all rows must have the same number of elements}
+test imgPhoto-18.4 {ImgStringMatch: valid data} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{blue green}
+		{yellow magenta} 
+		{#000000 #FFFFFFFF}}
+    list [image width photo1] [image height photo1] [photo1 get 0 2]
+} -cleanup {
+    imageCleanup
+} -result {2 3 {0 0 0 255}}
+# ImgStringRead: most of the error cases cannot be tested with current code, 
+# as the errors are detected by ImgStringMatch
+test imgPhoto-19.1 {ImgStringRead: normal use case} -constraints {
+    hasTeapotPhoto
+} -setup {
+    imageCleanup
+    image create photo photo1 -file $teapotPhotoFile
+    image create photo photo2
+} -body {
+    set imgData [photo1 data]
+    photo2 put $imgData
+    string equal [photo1 data] [photo2 data]
+} -cleanup {
+    imageCleanup
+    unset imgData
+} -result {1}
+test imgPhoto-19.2 {ImgStringRead: correct compositing rule} -constraints {
+    hasTranspTeapotPhoto
+} -setup {
+    imageCleanup
+    image create photo photo1 -file $transpTeapotPhotoFile
+    image create photo photo2
+} -body {
+    # currently, this test is pointless, as [imageName data] does not include 
+    # transparency information. To be considered as a placeholder.
+    photo2 put #FF0000 -to 0 0 50 50
+    photo2 put [photo1 data] -to 10 10 40 40
+    list [photo2 get 0 0] [photo2 get 20 25] [photo2 get 49 49]
+} -cleanup {
+    imageCleanup
+} -result {{255 0 0 255} {0 78 185 255} {255 0 0 255}}
+test imgPhoto-20.1 {ImgStringWrite: test some pixels} -constraints { 
+    hasTeapotPhoto
+} -setup {
+    set result {}
+    imageCleanup
+    image create photo photo1 -file $teapotPhotoFile
+} -body {
+    set imgData [photo1 data]
+    # note: with [lindex], the coords are inverted (y x)
+    lappend result [lindex $imgData 3 2]
+    lappend result [lindex $imgData 107 53]
+    lappend result [lindex $imgData 203 157]
+    set result 
+} -cleanup {
+    unset result
+    unset imgData
+    imageCleanup
+} -result {{#135cc0} #a06d52 #e1c8ba}
+test imgPhoto-21.1 {ImgPhotoParseColor: valid suffixes} -setup {
+    imageCleanup
+    image create photo photo1 
+    set result {}
+} -body {
+    photo1 put {{blue@0.711 #114433#C} {#8D4#1A magenta}}
+    lappend result [photo1 get 0 0]
+    lappend result [photo1 get 1 0]
+    lappend result [photo1 get 0 1]
+    lappend result [photo1 get 1 1]
+    set result
+} -cleanup {
+    unset result
+    imageCleanup
+} -result {{0 0 255 181} {17 68 51 204} {136 221 68 26} {255 0 255 255}}
+test imgPhoto-21.2 {ImgPhotoParseColor: valid suffixes, no suffix} -setup {
+    imageCleanup
+    image create photo photo1
+    set result {}
+} -body {
+    photo1 put {{#52D8a0 #2B5} {#E47@0.01 maroon#4}}
+    lappend result [photo1 get 0 0]
+    lappend result [photo1 get 1 0]
+    lappend result [photo1 get 0 1]
+    lappend result [photo1 get 1 1]
+    set result
+} -cleanup {
+    unset result
+    imageCleanup
+} -result {{82 216 160 255} {34 187 85 255} {238 68 119 3} {128 0 0 68}}
+test imgPhoto-21.3 {ImgPhotoParseColor: # suffix, no hex digits} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{black#}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid alpha suffix "#"}
+test imgPhoto-21.4 {ImgPhotoParseColor: # suffix, too many digists} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{#ABC#123}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid alpha suffix "#123"}
+test imgPhoto-21.5 {ImgPhotoParseColor: wrong digit count for color} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{#00}}
+} -returnCodes error -result {invalid color name "#00"}
+test imgPhoto-21.6 {ImgPhotoParseColor: invalid hex digit #1} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put #ABCDEG@.99
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "#ABCDEG"}
+test imgPhoto-21.7 {ImgPhotoParseColor: invalid hex digit #2} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {#ABCZ}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "#ABCZ"}
+test imgPhoto-21.8 {ImgPhotoParseColor: valid #ARGB color} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{#0d9bd502 #F7ac}}
+    list [photo1 get 0 0] [photo1 get 1 0]
+} -cleanup {
+    imageCleanup
+} -result {{155 213 2 13} {119 170 204 255}}
+test imgPhoto-21.9 {ImgPhotoParseColor: empty string} -setup {
+    imageCleanup
+    image create photo photo1
+    set result {}
+} -body {
+    photo1 put {{"" ""} {"" ""}}
+    lappend result [image width photo1]
+    lappend result [image height photo1]
+    lappend result [photo1 get 1 1]
+    set result
+} -cleanup {
+    unset result
+    imageCleanup
+} -result {2 2 {0 0 0 0}}
+test imgPhoto-21.10 {ImgPhotoParsecolor: empty string, mixed} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{black white} {{} white}}
+    list [photo1 get 0 0] [photo1 get 0 1]
+} -cleanup {
+    imageCleanup
+} -result {{0 0 0 255} {0 0 0 0}}
+test imgPhoto-21.9 {ImgPhotoParseColor: list form, invalid list} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{{123 45 67 "}}}
+    # "
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {can't parse color "123 45 67 ""}
+test imgPhoto-21.10 {ImgPhotoParseColor: too few elements in list} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{{0 255}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {can't parse color "0 255"}
+test imgPhoto-21.11 {ImgPhotoParseColor: too many elements in list} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{{0 100 200 255 0}}}
+} -returnCodes error -result {can't parse color "0 100 200 255 0"}
+test imgPhoto-21.12 {ImgPhotoParseColor: not an integer value} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{{9 0xf3 87 65} {43 21 10 1.0}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {expected integer but got "1.0"}
+test imgPhoto-21.13 {ImgPhotoParseColor: negative value in list} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{{121 121 -1}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid color "121 121 -1": expected integers in the range from 0 to 255}
+test imgPhoto-21.14 {ImgPhotoParseColor: value in list too large} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{{254 255 256}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+   {invalid color "254 255 256": expected integers in the range from 0 to 255}
+test imgPhoto-21.15 {ImgPhotoParseColor: valid list form} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{{0x0 0x10 0xfe 0xff} {0 100 254}}
+		{{30 30 30 0} {1 1 254 1}}}
+    list [photo1 get 0 0] [photo1 get 1 0] [photo1 get 0 1] [photo1 get 1 1]
+} -cleanup {
+    imageCleanup
+} -result {{0 16 254 255} {0 100 254 255} {30 30 30 0} {1 1 254 1}}
+test imgPhoto-21.16 {ImgPhotoParseColor: suffix not allowed #1} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put #ABCD@0.5
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid color "#ABCD@0.5": format does not allow alpha suffix}
+test imgPhoto-21.17 {ImgPhotoParseColor: suffix not allowed #2} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{{100 100 100#FE}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid color "100 100 100#FE": format does not allow alpha suffix}
+test ImgPoto-21.18 {ImgPhotoParseColor: suffix not allowed #3} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put #1111#1
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid color "#1111#1": format does not allow alpha suffix}
+test imgPhoto-21.19 {ImgPhotoParseColor: @A, not a float} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put blue@bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid alpha suffix "@bogus": expected floating-point value}
+test imgPhoto-21.20 {ImgPhotoParseColor: @A, value too low} -setup {
+    imageCleanup
+    image create photo photo1 
+} -body {
+    photo1 put green@-0.1
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid alpha suffix "@-0.1": value must be in the range from 0 to 1}
+test imgPhoto-21.21 {ImgPhotoParseColor: @A, value too high} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put #000000@1.0001
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid alpha suffix "@1.0001": value must be in the range from 0 to 1}
+test imgPhoto-21.22 {ImgPhotoParseColor: @A, edge values} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{yellow@1e-22 yellow@0.12352941 yellow@0.12352942 \
+		 yellow@0.9999999}}
+    list [photo1 get 0 0] [photo1 get 1 0] [photo1 get 2 0] [photo1 get 3 0]
+} -cleanup {
+    imageCleanup
+} -result {{255 255 0 0} {255 255 0 31} {255 255 0 32} {255 255 0 255}}
+test imgPhoto-21.23 {ImgPhotoParseColor: invalid digit in #X suffix} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put #000#g
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid alpha suffix "#g": expected hex digit}
+test imgPhoto-21.24 {ImgPhotoParseColor: invalid digit in #XX suffix} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put green#2W
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid alpha suffix "#2W": expected hex digit}
+test imgPhoto-21.25 {ImgPhotoParseColor: overall test - all color / suffix 
+	combinations} -setup {
+    imageCleanup
+    image create photo photo1
+    set result {}
+} -body {
+    photo1 put {
+	{snow@0.5 snow#80 snow#8 #fffffafafafa@0.5 #fffffabbfacc#8}
+	{#fffffafffaff#80 #ffffaafaa@.5 #ffffaafaa#8 #ffffaafaa#80 #fee#8}
+	{#fee#80 #fee@0.5 #fffafa@0.5 #fffafa#8 #fffafa#80}
+	{{0xff 250 0xfa 128} {255 250 250} #8fee #80fffafa snow}}
+    for {set y 0} {$y < 4} {incr y} {
+	for {set x 0} {$x < 5} {incr x} {
+	    lappend result [photo1 get $x $y]
+	}
+    }
+    set result
+} -cleanup {
+    imageCleanup
+    unset result
+} -result \
+{{255 250 250 128} {255 250 250 128} {255 250 250 136} {255 250 250 128}\
+{255 250 250 136} {255 250 250 128} {255 250 250 128} {255 250 250 136}\
+{255 250 250 128} {255 238 238 136} {255 238 238 128} {255 238 238 128}\
+{255 250 250 128} {255 250 250 136} {255 250 250 128} {255 250 250 128}\
+{255 250 250 255} {255 238 238 136} {255 250 250 128} {255 250 250 255}}
+    
 # ----------------------------------------------------------------------
 
 catch {rename foreachPixel {}}