diff options
author | fvogel <fvogelnew1@free.fr> | 2017-08-28 13:57:01 (GMT) |
---|---|---|
committer | fvogel <fvogelnew1@free.fr> | 2017-08-28 13:57:01 (GMT) |
commit | 5e690a71b5a1b19c7d50cd22695ba6a25be4d32a (patch) | |
tree | 5873103f9976efd351efed322a531929d62cce47 /generic | |
parent | 082e51738c83c69c7977ff1b3b1481dcc160f94a (diff) | |
parent | d3a2a48d8d9a19d934337117c18de3084225b7eb (diff) | |
download | tk-5e690a71b5a1b19c7d50cd22695ba6a25be4d32a.zip tk-5e690a71b5a1b19c7d50cd22695ba6a25be4d32a.tar.gz tk-5e690a71b5a1b19c7d50cd22695ba6a25be4d32a.tar.bz2 |
Merge tip-166 branch after positive vote by the TCT. Many thanks to Simon Bachmann.
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tkImgListFormat.c | 1141 | ||||
-rw-r--r-- | generic/tkImgPhoto.c | 619 | ||||
-rw-r--r-- | generic/tkInt.decls | 7 | ||||
-rw-r--r-- | generic/tkInt.h | 1 | ||||
-rw-r--r-- | generic/tkIntDecls.h | 7 | ||||
-rw-r--r-- | generic/tkStubInit.c | 1 | ||||
-rw-r--r-- | generic/tkTest.c | 54 | ||||
-rw-r--r-- | generic/tkWindow.c | 1 |
8 files changed, 1504 insertions, 327 deletions
diff --git a/generic/tkImgListFormat.c b/generic/tkImgListFormat.c new file mode 100644 index 0000000..20f2c4e --- /dev/null +++ b/generic/tkImgListFormat.c @@ -0,0 +1,1141 @@ +/* + * tkImgListFormat.c -- + * + * Implements the default image data format. I.e. the format used for + * [imageName data] and [imageName put] if no other format is specified. + * + * The default format consits of a list of scan lines (rows) with each + * list element being itself a list of pixels (or columns). For details, + * see the manpage photo.n + * + * This image format cannot read/write files, it is meant for string + * data only. + * + * + * Copyright (c) 1994 The Australian National University. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 2002-2003 Donal K. Fellows + * Copyright (c) 2003 ActiveState Corporation. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * Authors: + * Paul Mackerras (paulus@cs.anu.edu.au), + * Department of Computer Science, + * Australian National University. + * + * Simon Bachmann (simonbachmann@bluewin.ch) + */ + + +#include "tkImgPhoto.h" + +/* + * Message to generate when an attempt to allocate memory for an image fails. + */ + +#define TK_PHOTO_ALLOC_FAILURE_MESSAGE \ + "not enough free memory for image buffer" + + +/* + * Color name length limit: do not attempt to parse as color strings that are + * longer than this limit + */ + +#define TK_PHOTO_MAX_COLOR_CHARS 99 + +/* + * Symbols for the different formats of a color string. + */ + +enum ColorFormatType { + COLORFORMAT_TKCOLOR, + COLORFORMAT_EMPTYSTRING, + COLORFORMAT_LIST, + COLORFORMAT_RGB1, + COLORFORMAT_RGB2, + COLORFORMAT_RGBA1, + COLORFORMAT_RGBA2 +}; + +/* + * Names for the color format types above. + * Order must match the one in enum ColorFormatType + */ + +static const char *const colorFormatNames[] = { + "tkcolor", + "emptystring", + "list", + "rgb-short", + "rgb", + "rgba-short", + "rgba", + NULL +}; + +/* + * The following data structure is used to return information from + * ParseFormatOptions: + */ + +struct FormatOptions { + int options; /* Individual bits indicate which options were + * specified - see below. */ + Tcl_Obj *formatName; /* Name specified without an option. */ + enum ColorFormatType colorFormat; + /* The color format type given with the + * -colorformat option */ +}; + +/* + * Bit definitions for use with ParseFormatOptions: each bit is set in the + * allowedOptions parameter on a call to ParseFormatOptions if that option + * is allowed for the current photo image subcommand. On return, the bit is + * set in the options field of the FormatOptions structure if that option + * was specified. + * + * OPT_COLORFORMAT: Set if -alpha option allowed/specified. + */ + +#define OPT_COLORFORMAT 1 + +/* + * List of format option names. The order here must match the order of + * declarations of the FMT_OPT_* constants above. + */ + +static const char *const formatOptionNames[] = { + "-colorformat", + NULL +}; + +/* + * Forward declarations + */ + +static int ParseFormatOptions(Tcl_Interp *interp, int allowedOptions, + int objc, Tcl_Obj *const objv[], int *indexPtr, + struct FormatOptions *optPtr); +static Tcl_Obj *GetBadOptMsg(const char *badValue, int allowedOpts); +static int StringMatchDef(Tcl_Obj *data, Tcl_Obj *formatString, + int *widthPtr, int *heightPtr, Tcl_Interp *interp); +static int StringReadDef(Tcl_Interp *interp, Tcl_Obj *data, + Tcl_Obj *formatString, Tk_PhotoHandle imageHandle, + int destX, int destY, int width, int height, + int srcX, int srcY); +static int StringWriteDef(Tcl_Interp *interp, + Tcl_Obj *formatString, + Tk_PhotoImageBlock *blockPtr); +static int ParseColor(Tcl_Interp *interp, Tcl_Obj *specObj, + Display *display, Colormap colormap, unsigned char *redPtr, + unsigned char *greenPtr, unsigned char *bluePtr, + unsigned char *alphaPtr); +static int ParseColorAsList(Tcl_Interp *interp, const char *colorString, + int colorStrLen, unsigned char *redPtr, + unsigned char *greenPtr, unsigned char *bluePtr, + unsigned char *alphaPtr); +static int ParseColorAsHex(Tcl_Interp *interp, const char *colorString, + int colorStrLen, Display *display, Colormap colormap, + unsigned char *redPtr, unsigned char *greenPtr, + unsigned char *bluePtr, unsigned char *alphaPtr); +static int ParseColorAsStandard(Tcl_Interp *interp, + const char *colorString, int colorStrLen, + Display *display, Colormap colormap, + unsigned char *redPtr, unsigned char *greenPtr, + unsigned char *bluePtr, unsigned char *alphaPtr); + +/* + * The format record for the default image handler + */ + +Tk_PhotoImageFormat tkImgFmtDefault = { + "default", /* name */ + NULL, /* fileMatchProc: format doesn't support file ops */ + StringMatchDef, /* stringMatchProc */ + NULL, /* fileReadProc: format doesn't support file read */ + StringReadDef, /* stringReadProc */ + NULL, /* fileWriteProc: format doesn't support file write */ + StringWriteDef /* stringWriteProc */ +}; + +/* + *---------------------------------------------------------------------- + * + * ParseFormatOptions -- + * + * Parse the options passed to the image format handler. + * + * Results: + * On success, the structure pointed to by optPtr is filled with the + * values passed or with the defaults and TCL_OK returned. + * If an error occurs, leaves an error message in interp and returns + * TCL_ERROR. + * + * Side effects: + * The value in *indexPtr is updated to the index of the fist + * element in argv[] that does not look like an option/value, or to + * argc if parsing reached the end of argv[]. + * + *---------------------------------------------------------------------- + */ +static int +ParseFormatOptions( + Tcl_Interp *interp, /* For error messages */ + int allowedOptions, /* Bitfield specifying which options are + * to be considered allowed */ + int objc, /* Number of elements in argv[] */ + Tcl_Obj *const objv[], /* The arguments to parse */ + int *indexPtr, /* Index giving the first element to + * parse. The value is updated to the + * index where parsing ended */ + struct FormatOptions *optPtr) /* Parsed option values are written to + * this struct */ + +{ + int index, optIndex, typeIndex, first; + const char *option; + + first = 1; + + /* + * Fill in default values + */ + optPtr->options = 0; + optPtr->formatName = NULL; + optPtr->colorFormat = COLORFORMAT_RGB2; + for (index = *indexPtr; index < objc; *indexPtr = ++index) { + int optionExists; + + /* + * The first value can be the format handler's name. It goes to + * optPtr->name. + */ + option = Tcl_GetString(objv[index]); + if (option[0] != '-') { + if (first) { + optPtr->formatName = objv[index]; + first = 0; + continue; + } else { + break; + } + } + first = 0; + + /* + * Check if option is known and allowed + */ + + optionExists = 1; + if (Tcl_GetIndexFromObj(NULL, objv[index], formatOptionNames, + "format option", 0, &optIndex) != TCL_OK) { + optionExists = 0; + } + if (!optionExists || !((1 << optIndex) & allowedOptions)) { + Tcl_SetObjResult(interp, GetBadOptMsg(Tcl_GetString(objv[index]), + allowedOptions)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL); + return TCL_ERROR; + } + + /* + * Option-specific checks + */ + + switch (1 << optIndex) { + case OPT_COLORFORMAT: + *indexPtr = ++index; + if (index >= objc) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf("the \"%s\" option " + "requires a value", Tcl_GetString(objv[index - 1]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "MISSING_VALUE", NULL); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObj(NULL, objv[index], colorFormatNames, "", + TCL_EXACT, &typeIndex) != TCL_OK + || (typeIndex != COLORFORMAT_LIST + && typeIndex != COLORFORMAT_RGB2 + && typeIndex != COLORFORMAT_RGBA2) ) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad color format " + "\"%s\": must be rgb, rgba, or list", + Tcl_GetString(objv[index]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "BAD_COLOR_FORMAT", NULL); + return TCL_ERROR; + } + optPtr->colorFormat = typeIndex; + break; + default: + Tcl_Panic("ParseFormatOptions: unexpected switch fallthrough"); + } + + /* + * Add option to bitfield in optPtr + */ + optPtr->options |= (1 << optIndex); + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * GetBadOptMsg -- + * + * Build a Tcl_Obj containing an error message in the form "bad option + * "xx": must be y, or z", based on the bits set in allowedOpts. + * + * Results: + * A Tcl Object containig the error message. + * + * Side effects: + * None + *---------------------------------------------------------------------- + */ +static Tcl_Obj * +GetBadOptMsg( + const char *badValue, /* the erroneous option */ + int allowedOpts) /* bitfield specifying the allowed options */ +{ + int i, bit; + Tcl_Obj *resObj = Tcl_ObjPrintf("bad format option \"%s\": ", badValue); + + if (allowedOpts == 0) { + Tcl_AppendToObj(resObj, "no options allowed", -1); + } else { + Tcl_AppendToObj(resObj, "must be ", -1); + bit = 1; + for (i = 0; formatOptionNames[i] != NULL; i++) { + if (allowedOpts & bit) { + if (allowedOpts & (bit -1)) { + /* + * not the first option + */ + if (allowedOpts & ~((bit << 1) - 1)) { + /* + * not the last option + */ + Tcl_AppendToObj(resObj, ", ", -1); + } else { + Tcl_AppendToObj(resObj, ", or ", -1); + } + } + Tcl_AppendToObj(resObj, formatOptionNames[i], -1); + } + bit <<=1; + } + } + return resObj; +} + +/* + *---------------------------------------------------------------------- + * + * StringMatchDef -- + * + * 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 + * message 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 +StringMatchDef( + Tcl_Obj *data, /* The data to check */ + Tcl_Obj *formatString, /* Value of the -format option, not used here */ + int *widthPtr, /* Width of image is written to this location */ + int *heightPtr, /* Height of image is written to this location */ + Tcl_Interp *interp) /* Error messages are left in this interpreter */ +{ + int y, rowCount, colCount, curColCount; + unsigned char dummy; + Tcl_Obj **rowListPtr, *pixelData; + + /* + * See if data can be parsed as a list, if every element is itself a valid + * list and all sublists have the same length. + */ + + if (Tcl_ListObjGetElements(interp, data, &rowCount, &rowListPtr) + != TCL_OK) { + return 0; + } + if (rowCount == 0) { + /* + * empty list is 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; + } + } + + /* + * Data in base64 encoding (or even binary data), might actually pass + * these tests. To avoid parsing it as list of lists format, check one + * pixel for validity. + */ + if (Tcl_ListObjIndex(interp, rowListPtr[0], 0, &pixelData) != TCL_OK) { + return 0; + } + if (Tcl_GetCharLength(pixelData) > TK_PHOTO_MAX_COLOR_CHARS) { + return 0; + } + if (ParseColor(interp, pixelData, Tk_Display(Tk_MainWindow(interp)), + Tk_Colormap(Tk_MainWindow(interp)), &dummy, &dummy, &dummy, &dummy) + != TCL_OK) { + 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; + +} + +/* + *---------------------------------------------------------------------- + * + * StringReadDef -- + * + * String read function for default format. (see manpage for details on + * the format). + * + * 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. + * + *---------------------------------------------------------------------- +*/ + +static int +StringReadDef( + Tcl_Interp *interp, /* leave error messages here */ + Tcl_Obj *data, /* the data to parse */ + Tcl_Obj *formatString, /* 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; + Tcl_Obj **objv; + int objc; + unsigned char *curPixelPtr; + int x, y, rowCount, colCount, curColCount; + Tk_PhotoImageBlock srcBlock; + Display *display; + Colormap colormap; + struct FormatOptions opts; + int optIndex; + + /* + * Parse format suboptions + * We don't use any format suboptions, but we still need to provide useful + * error messages if suboptions were specified. + */ + + memset(&opts, 0, sizeof(opts)); + if (formatString != NULL) { + if (Tcl_ListObjGetElements(interp, formatString, &objc, &objv) + != TCL_OK) { + return TCL_ERROR; + } + optIndex = 0; + if (ParseFormatOptions(interp, 0, objc, objv, &optIndex, &opts) + != TCL_OK) { + return TCL_ERROR; + } + if (optIndex < objc) { + Tcl_SetObjResult(interp, + GetBadOptMsg(Tcl_GetString(objv[optIndex]), 0)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL); + return TCL_ERROR; + } + } + + /* + * Check 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; + display = Tk_Display(Tk_MainWindow(interp)); + colormap = Tk_Colormap(Tk_MainWindow(interp)); + 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 (ParseColor(interp, colListPtr[x], display, colormap, + 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; +} + +/* + *---------------------------------------------------------------------- + * + * StringWriteDef -- + * + * String write function for default image data format. See the user + * documentation for details. + * + * Results: + * The converted data is set as the result of interp. Returns a standard + * Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +StringWriteDef( + Tcl_Interp *interp, /* For the result and errors */ + Tcl_Obj *formatString, /* The value of the -format option */ + Tk_PhotoImageBlock *blockPtr) /* The image data to convert */ +{ + int greenOffset, blueOffset, alphaOffset, hasAlpha; + Tcl_Obj *result, **objv = NULL; + int objc, allowedOpts, optIndex; + struct FormatOptions opts; + + /* + * Parse format suboptions + */ + if (Tcl_ListObjGetElements(interp, formatString, &objc, &objv) + != TCL_OK) { + return TCL_ERROR; + } + allowedOpts = OPT_COLORFORMAT; + optIndex = 0; + if (ParseFormatOptions(interp, allowedOpts, objc, objv, &optIndex, &opts) + != TCL_OK) { + return TCL_ERROR; + } + if (optIndex < objc) { + Tcl_SetObjResult(interp, + GetBadOptMsg(Tcl_GetString(objv[optIndex]), allowedOpts)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL); + return TCL_ERROR; + } + + greenOffset = blockPtr->offset[1] - blockPtr->offset[0]; + blueOffset = blockPtr->offset[2] - blockPtr->offset[0]; + + /* + * A negative alpha offset signals that the image is fully opaque. + * That's not really documented anywhere, but it's the way it is! + */ + + if (blockPtr->offset[3] < 0) { + hasAlpha = 0; + alphaOffset = 0; + } else { + hasAlpha = 1; + alphaOffset = blockPtr->offset[3] - blockPtr->offset[0]; + } + + if ((blockPtr->width > 0) && (blockPtr->height > 0)) { + int row, col; + Tcl_DString data, line; + char colorBuf[11]; + unsigned char *pixelPtr; + unsigned char alphaVal = 255; + + Tcl_DStringInit(&data); + for (row=0; row<blockPtr->height; row++) { + pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0] + + row * blockPtr->pitch; + Tcl_DStringInit(&line); + for (col=0; col<blockPtr->width; col++) { + if (hasAlpha) { + alphaVal = pixelPtr[alphaOffset]; + } + + /* + * We don't build lines as a list for #RGBA and #RGB. Since + * these color formats look like comments, the first element + * of the list would get quoted with an additional {} . + * While this is not a problem if the data is used as + * a list, it would cause problems if someone decides to parse + * it as a string (and it looks kinda strange) + */ + + switch (opts.colorFormat) { + case COLORFORMAT_RGB2: + sprintf(colorBuf, "#%02x%02x%02x ", pixelPtr[0], + pixelPtr[greenOffset], pixelPtr[blueOffset]); + Tcl_DStringAppend(&line, colorBuf, -1); + break; + case COLORFORMAT_RGBA2: + sprintf(colorBuf, "#%02x%02x%02x%02x ", + pixelPtr[0], pixelPtr[greenOffset], + pixelPtr[blueOffset], alphaVal); + Tcl_DStringAppend(&line, colorBuf, -1); + break; + case COLORFORMAT_LIST: + Tcl_DStringStartSublist(&line); + sprintf(colorBuf, "%d", pixelPtr[0]); + Tcl_DStringAppendElement(&line, colorBuf); + sprintf(colorBuf, "%d", pixelPtr[greenOffset]); + Tcl_DStringAppendElement(&line, colorBuf); + sprintf(colorBuf, "%d", pixelPtr[blueOffset]); + Tcl_DStringAppendElement(&line, colorBuf); + sprintf(colorBuf, "%d", alphaVal); + Tcl_DStringAppendElement(&line, colorBuf); + Tcl_DStringEndSublist(&line); + break; + default: + Tcl_Panic("unexpected switch fallthrough"); + } + pixelPtr += blockPtr->pixelSize; + } + if (opts.colorFormat != COLORFORMAT_LIST) { + /* + * For the #XXX formats, we need to remove the last + * whitespace. + */ + + *(Tcl_DStringValue(&line) + Tcl_DStringLength(&line) - 1) + = '\0'; + } + Tcl_DStringAppendElement(&data, Tcl_DStringValue(&line)); + Tcl_DStringFree(&line); + } + result = Tcl_NewStringObj(Tcl_DStringValue(&data), -1); + Tcl_DStringFree(&data); + } else { + result = Tcl_NewObj(); + } + + Tcl_SetObjResult(interp, result); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ParseColor -- + * + * 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 +ParseColor( + Tcl_Interp *interp, /* error messages go there */ + Tcl_Obj *specObj, /* the color data to parse */ + Display *display, /* display of main window, needed to parse + * standard Tk colors */ + Colormap colormap, /* colormap of current display */ + unsigned char *redPtr, /* the result is written to these pointers */ + unsigned char *greenPtr, + unsigned char *bluePtr, + unsigned char *alphaPtr) +{ + const char *specString; + int charCount; + + /* + * Find out which color format we have + */ + + specString = Tcl_GetStringFromObj(specObj, &charCount); + + if (charCount == 0) { + /* Empty string */ + *redPtr = *greenPtr = *bluePtr = *alphaPtr = 0; + return TCL_OK; + } + if (charCount > TK_PHOTO_MAX_COLOR_CHARS) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid color")); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "INVALID_COLOR", NULL); + return TCL_ERROR; + } + if (specString[0] == '#') { + return ParseColorAsHex(interp, specString, charCount, display, + colormap, redPtr, greenPtr, bluePtr, alphaPtr); + } + if (ParseColorAsList(interp, specString, charCount, + redPtr, greenPtr, bluePtr, alphaPtr) == TCL_OK) { + return TCL_OK; + } + + /* + * Parsing the color as standard Tk color always is the last option tried + * because TkParseColor() is very slow with values it cannot parse. + */ + + Tcl_ResetResult(interp); + return ParseColorAsStandard(interp, specString, charCount, display, + colormap, redPtr, greenPtr, bluePtr, alphaPtr); + +} + +/* + *---------------------------------------------------------------------- + * + * ParseColorAsList -- + * + * This function extracts color and alpha values from a list of 3 or 4 + * integers (the list color format). + * + * 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. + * Returns a standard Tcl result. + * + * Side effects: + * Does *not* leave error messages in interp. The reason is that + * it is not always possible to tell if the list format was even + * intended and thus it is hard to return meaningful messages. + * A general error message from the caller is probably the best + * alternative. + * + *---------------------------------------------------------------------- + */ +static int +ParseColorAsList( + Tcl_Interp *interp, /* not used */ + const char *colorString, /* the color data to parse */ + int colorStrLen, /* length of the color string */ + unsigned char *redPtr, /* the result is written to these pointers */ + unsigned char *greenPtr, + unsigned char *bluePtr, + unsigned char *alphaPtr) +{ + + /* + * This is kinda ugly. The code would be certainly nicer if it + * used Tcl_ListObjGetElements() and Tcl_GetIntFromObj(). But with + * strtol() it's *much* faster. + */ + + const char *curPos; + int values[4]; + int i; + + curPos = colorString; + i = 0; + + /* + * strtol can give false positives with a sequence of space chars. + * To avoid that, avance the pointer to the next non-blank char. + */ + + while(isspace(*curPos)) { + ++curPos; + } + while (i < 4 && *curPos != '\0') { + values[i] = strtol(curPos, (char **)&curPos, 0); + if (values[i] < 0 || values[i] > 255) { + return TCL_ERROR; + } + while(isspace(*curPos)) { + ++curPos; + } + ++i; + } + + if (i < 3 || *curPos != '\0') { + return TCL_ERROR; + } + if (i < 4) { + values[3] = 255; + } + + *redPtr = (unsigned char) values[0]; + *greenPtr = (unsigned char) values[1]; + *bluePtr = (unsigned char) values[2]; + *alphaPtr = (unsigned char) values[3]; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ParseColorAsHex -- + * + * This function extracts color and alpha values from a string + * starting with '#', followed by hex digits. It undestands both + * the #RGBA form and the #RBG (with optional suffix) + * + * 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. + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static int +ParseColorAsHex( + Tcl_Interp *interp, /* error messages are left here */ + const char *colorString, /* the color data to parse */ + int colorStrLen, /* length of the color string */ + Display *display, /* display of main window */ + Colormap colormap, /* colormap of current display */ + unsigned char *redPtr, /* the result is written to these pointers */ + unsigned char *greenPtr, + unsigned char *bluePtr, + unsigned char *alphaPtr) +{ + int i; + unsigned long int colorValue = 0; + + if (colorStrLen - 1 != 4 && colorStrLen - 1 != 8) { + return ParseColorAsStandard(interp, colorString, colorStrLen, + display, colormap, redPtr, greenPtr, bluePtr, alphaPtr); + } + for (i = 1; i < colorStrLen; i++) { + if (!isxdigit(UCHAR(colorString[i]))) { + /* + * There still is a chance that this is a Tk color with + * an alpha suffix + */ + + return ParseColorAsStandard(interp, colorString, colorStrLen, + display, colormap, redPtr, greenPtr, bluePtr, alphaPtr); + } + } + + colorValue = strtoul(colorString + 1, NULL, 16); + switch (colorStrLen - 1) { + case 4: + /* #RGBA format */ + *redPtr = (unsigned char) ((colorValue >> 12) * 0x11); + *greenPtr = (unsigned char) (((colorValue >> 8) & 0xf) * 0x11); + *bluePtr = (unsigned char) (((colorValue >> 4) & 0xf) * 0x11); + *alphaPtr = (unsigned char) ((colorValue & 0xf) * 0x11); + return TCL_OK; + case 8: + /* #RRGGBBAA format */ + *redPtr = (unsigned char) (colorValue >> 24); + *greenPtr = (unsigned char) ((colorValue >> 16) & 0xff); + *bluePtr = (unsigned char) ((colorValue >> 8) & 0xff); + *alphaPtr = (unsigned char) (colorValue & 0xff); + return TCL_OK; + default: + Tcl_Panic("unexpected switch fallthrough"); + } + + /* Shouldn't get here */ + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * ParseColorAsStandard -- + * + * This function tries to split a color stirng in a color and a + * suffix part and to extract color and alpha values from them. The + * color part is treated as regular Tk color. + * + * 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. + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static int +ParseColorAsStandard( + Tcl_Interp *interp, /* error messages are left here */ + const char *specString, /* the color data to parse */ + int specStrLen, /* length of the color string */ + Display *display, /* display of main window */ + Colormap colormap, /* colormap of current display */ + unsigned char *redPtr, /* the result is written to these pointers */ + unsigned char *greenPtr, + unsigned char *bluePtr, + unsigned char *alphaPtr) +{ + XColor parsedColor; + const char *suffixString, *colorString; + char colorBuffer[TK_PHOTO_MAX_COLOR_CHARS + 1]; + char *tmpString; + double fracAlpha; + unsigned int suffixAlpha; + int i; + + /* + * Split color data string in color and suffix parts + */ + + if ((suffixString = strrchr(specString, '@')) == NULL + && ((suffixString = strrchr(specString, '#')) == NULL + || suffixString == specString)) { + suffixString = specString + specStrLen; + colorString = specString; + } else { + strncpy(colorBuffer, specString, suffixString - specString); + colorBuffer[suffixString - specString] = '\0'; + colorString = (const char*)colorBuffer; + } + + /* + * Try to parse as standard Tk 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. + */ + + if ( ! TkParseColor(display, colormap, colorString, &parsedColor)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", specString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "INVALID_COLOR", NULL); + return TCL_ERROR; + } + + /* + * parse the Suffix + */ + + 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); + return TCL_ERROR; + } + 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); + return TCL_ERROR; + } + suffixAlpha = (unsigned int) floor(fracAlpha * 255 + 0.5); + 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); + return TCL_ERROR; + } + for (i = 1; i <= (int)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); + return TCL_ERROR; + } + } + if (strlen(suffixString + 1) == 1) { + sscanf(suffixString, "#%1x", &suffixAlpha); + suffixAlpha *= 0x11; + } else { + sscanf(suffixString, "#%2x", &suffixAlpha); + } + break; + default: + Tcl_Panic("unexpected switch fallthrough"); + } + + *redPtr = (unsigned char) (parsedColor.red >> 8); + *greenPtr = (unsigned char) (parsedColor.green >> 8); + *bluePtr = (unsigned char) (parsedColor.blue >> 8); + *alphaPtr = (unsigned char) suffixAlpha; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TkDebugStringMatchDef -- + * + * Debugging function for StringMatchDef. Basically just an alias for + * that function, intended to expose it directly to tests, as + * StirngMatchDef cannot be sufficiently tested otherwise. + * + * Results: + * See StringMatchDef. + * + * Side effects: + * None + *---------------------------------------------------------------------- + */ +int +TkDebugPhotoStringMatchDef( + Tcl_Interp *interp, /* Error messages are left in this interpreter */ + Tcl_Obj *data, /* The data to check */ + Tcl_Obj *formatString, /* Value of the -format option, not used here */ + int *widthPtr, /* Width of image is written to this location */ + int *heightPtr) /* Height of image is written to this location */ +{ + return StringMatchDef(data, formatString, widthPtr, heightPtr, interp); +} + + +/* Local Variables: */ +/* mode: c */ +/* fill-column: 78 */ +/* c-basic-offset: 4 */ +/* tab-width: 8 */ +/* indent-tabs-mode: nil */ +/* End: */ diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c index fa35553..a1146b7 100644 --- a/generic/tkImgPhoto.c +++ b/generic/tkImgPhoto.c @@ -48,6 +48,7 @@ struct SubcommandOptions { * set in the options field of the SubcommandOptions structure if that option * was specified. * + * OPT_ALPHA: Set if -alpha option allowed/specified. * OPT_BACKGROUND: Set if -format option allowed/specified. * OPT_COMPOSITE: Set if -compositingrule option allowed/spec'd. * OPT_FORMAT: Set if -format option allowed/specified. @@ -56,18 +57,21 @@ struct SubcommandOptions { * OPT_SHRINK: Set if -shrink option allowed/specified. * OPT_SUBSAMPLE: Set if -subsample option allowed/spec'd. * OPT_TO: Set if -to option allowed/specified. + * OPT_WITHALPHA: Set if -withalpha option allowed/specified. * OPT_ZOOM: Set if -zoom option allowed/specified. */ -#define OPT_BACKGROUND 1 -#define OPT_COMPOSITE 2 -#define OPT_FORMAT 4 -#define OPT_FROM 8 -#define OPT_GRAYSCALE 0x10 -#define OPT_SHRINK 0x20 -#define OPT_SUBSAMPLE 0x40 -#define OPT_TO 0x80 -#define OPT_ZOOM 0x100 +#define OPT_ALPHA 1 +#define OPT_BACKGROUND 2 +#define OPT_COMPOSITE 4 +#define OPT_FORMAT 8 +#define OPT_FROM 0x10 +#define OPT_GRAYSCALE 0x20 +#define OPT_SHRINK 0x40 +#define OPT_SUBSAMPLE 0x80 +#define OPT_TO 0x100 +#define OPT_WITHALPHA 0x200 +#define OPT_ZOOM 0x400 /* * List of option names. The order here must match the order of declarations @@ -75,6 +79,7 @@ struct SubcommandOptions { */ static const char *const optionNames[] = { + "-alpha", "-background", "-compositingrule", "-format", @@ -83,6 +88,7 @@ static const char *const optionNames[] = { "-shrink", "-subsample", "-to", + "-withalpha", "-zoom", NULL }; @@ -182,9 +188,6 @@ static int ImgPhotoConfigureMaster(Tcl_Interp *interp, static int ToggleComplexAlphaIfNeeded(PhotoMaster *mPtr); static int ImgPhotoSetSize(PhotoMaster *masterPtr, int width, int height); -static int ImgStringWrite(Tcl_Interp *interp, - Tcl_Obj *formatString, - Tk_PhotoImageBlock *blockPtr); static char * ImgGetPhoto(PhotoMaster *masterPtr, Tk_PhotoImageBlock *blockPtr, struct SubcommandOptions *optPtr); @@ -402,12 +405,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; @@ -653,7 +654,8 @@ ImgPhotoCmd( options.compositingRule); case PHOTO_DATA: { - char *data; + char *data = NULL; + Tcl_Obj *freeObj = NULL; /* * photo data command - first parse and check any options given. @@ -661,7 +663,7 @@ ImgPhotoCmd( Tk_ImageStringWriteProc *stringWriteProc = NULL; - index = 2; + index = 1; memset(&options, 0, sizeof(options)); options.name = NULL; options.format = NULL; @@ -672,7 +674,7 @@ ImgPhotoCmd( &index, objc, objv) != TCL_OK) { return TCL_ERROR; } - if ((options.name != NULL) || (index < objc)) { + if ((options.name == NULL) || (index < objc)) { Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?"); return TCL_ERROR; } @@ -694,50 +696,50 @@ ImgPhotoCmd( options.fromX2 = masterPtr->width; options.fromY2 = masterPtr->height; } + if (!(options.options & OPT_FORMAT)) { + options.format = Tcl_NewStringObj("default", -1); + freeObj = options.format; + } /* * Search for an appropriate image string format handler. */ - if (options.options & OPT_FORMAT) { - matched = 0; - for (imageFormat = tsdPtr->formatList; imageFormat != NULL; - imageFormat = imageFormat->nextPtr) { - if ((strncasecmp(Tcl_GetString(options.format), - imageFormat->name, strlen(imageFormat->name)) == 0)) { - matched = 1; - if (imageFormat->stringWriteProc != NULL) { - stringWriteProc = imageFormat->stringWriteProc; - break; - } - } - } - if (stringWriteProc == NULL) { - oldformat = 1; - for (imageFormat = tsdPtr->oldFormatList; imageFormat != NULL; - imageFormat = imageFormat->nextPtr) { - if ((strncasecmp(Tcl_GetString(options.format), - imageFormat->name, - strlen(imageFormat->name)) == 0)) { - matched = 1; - if (imageFormat->stringWriteProc != NULL) { - stringWriteProc = imageFormat->stringWriteProc; - break; - } - } - } + matched = 0; + for (imageFormat = tsdPtr->formatList; imageFormat != NULL; + imageFormat = imageFormat->nextPtr) { + if ((strncasecmp(Tcl_GetString(options.format), + imageFormat->name, strlen(imageFormat->name)) == 0)) { + matched = 1; + if (imageFormat->stringWriteProc != NULL) { + stringWriteProc = imageFormat->stringWriteProc; + break; + } } - if (stringWriteProc == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "image string format \"%s\" is %s", - Tcl_GetString(options.format), - (matched ? "not supported" : "unknown"))); - Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", - Tcl_GetString(options.format), NULL); - return TCL_ERROR; + } + if (stringWriteProc == NULL) { + oldformat = 1; + for (imageFormat = tsdPtr->oldFormatList; imageFormat != NULL; + imageFormat = imageFormat->nextPtr) { + if ((strncasecmp(Tcl_GetString(options.format), + imageFormat->name, + strlen(imageFormat->name)) == 0)) { + matched = 1; + if (imageFormat->stringWriteProc != NULL) { + stringWriteProc = imageFormat->stringWriteProc; + break; + } + } } - } else { - stringWriteProc = ImgStringWrite; + } + if (stringWriteProc == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image string format \"%s\" is %s", + Tcl_GetString(options.format), + (matched ? "not supported" : "unknown"))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + Tcl_GetString(options.format), NULL); + goto dataErrorExit; } /* @@ -774,7 +776,22 @@ ImgPhotoCmd( if (data) { ckfree(data); } + if (freeObj != NULL) { + Tcl_DecrRefCount(freeObj); + } return result; + + dataErrorExit: + if (options.background) { + Tk_FreeColor(options.background); + } + if (data) { + ckfree(data); + } + if (freeObj != NULL) { + Tcl_DecrRefCount(freeObj); + } + return TCL_ERROR; } case PHOTO_GET: { @@ -782,12 +799,24 @@ ImgPhotoCmd( * photo get command - first parse and check parameters. */ - Tcl_Obj *channels[3]; - - if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "x y"); + Tcl_Obj *channels[4]; + int channelCount = 3; + + index = 3; + memset(&options, 0, sizeof(options)); + options.name = NULL; + if (ParseSubcommandOptions(&options, interp, OPT_WITHALPHA, + &index, objc, objv) != TCL_OK) { + return TCL_ERROR; + } + if (options.name == NULL || index < objc) { + Tcl_WrongNumArgs(interp, 2, objv, "x y ?-withalpha?"); return TCL_ERROR; } + if (options.options & OPT_WITHALPHA) { + channelCount = 4; + } + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { return TCL_ERROR; @@ -803,25 +832,29 @@ 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(channelCount, channels)); return TCL_OK; } - case PHOTO_PUT: + case PHOTO_PUT: { + Tcl_Obj *format, *data; + /* - * photo put command - first parse the options and colors specified. + * photo put command - first parse the options. */ index = 2; memset(&options, 0, sizeof(options)); options.name = NULL; + options.format = NULL; if (ParseSubcommandOptions(&options, interp, OPT_TO|OPT_FORMAT, &index, objc, objv) != TCL_OK) { return TCL_ERROR; @@ -831,174 +864,50 @@ ImgPhotoCmd( return TCL_ERROR; } - if (MatchStringFormat(interp, options.name ? objv[2]:NULL, - options.format, &imageFormat, &imageWidth, - &imageHeight, &oldformat) == TCL_OK) { - Tcl_Obj *format, *data; - - if (!(options.options & OPT_TO) || (options.toX2 < 0)) { - options.toX2 = options.toX + imageWidth; - options.toY2 = options.toY + imageHeight; - } - if (imageWidth > options.toX2 - options.toX) { - imageWidth = options.toX2 - options.toX; - } - if (imageHeight > options.toY2 - options.toY) { - imageHeight = options.toY2 - options.toY; - } - format = options.format; - data = objv[2]; - if (oldformat) { - if (format) { - format = (Tcl_Obj *) Tcl_GetString(format); - } - 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; - } - masterPtr->flags |= IMAGE_CHANGED; - return TCL_OK; - } - if (options.options & OPT_FORMAT) { - return TCL_ERROR; - } - Tcl_ResetResult(interp); - if (Tcl_ListObjGetElements(interp, options.name, - &dataHeight, &srcObjv) != TCL_OK) { + /* + * See if there's a format that can read the data + */ + + if (MatchStringFormat(interp, objv[2], options.format, &imageFormat, + &imageWidth, &imageHeight, &oldformat) != TCL_OK) { 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; + if (imageWidth > options.toX2 - options.toX) { + imageWidth = options.toX2 - options.toX; + } + if (imageHeight > options.toY2 - options.toY) { + imageHeight = options.toY2 - options.toY; + } + format = options.format; + data = objv[2]; + if (oldformat) { + if (format) { + format = (Tcl_Obj *) Tcl_GetString(format); } - return TCL_OK; + data = (Tcl_Obj *) Tcl_GetString(data); } + if (imageFormat->stringReadProc(interp, data, format, + (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. + * 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 and to set/unset the + * IMAGE_CHANGED bit. */ - - 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; - + masterPtr->flags |= IMAGE_CHANGED; + + return TCL_OK; + } case PHOTO_READ: { Tcl_Obj *format; @@ -1168,17 +1077,40 @@ ImgPhotoCmd( switch ((enum transOptions) index) { case PHOTO_TRANS_GET: { - XRectangle testBox; - TkRegion testRegion; + int boolMode; - if (objc != 5) { - Tcl_WrongNumArgs(interp, 3, objv, "x y"); + /* + * parse fixed args and option + */ + + 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; } + + index = 4; + memset(&options, 0, sizeof(options)); + if (ParseSubcommandOptions(&options, interp, + OPT_ALPHA, &index, objc, objv) != TCL_OK) { + return TCL_ERROR; + } + if (index < objc) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\": must be -alpha", + Tcl_GetString(objv[index]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", + NULL); + return TCL_ERROR; + } + boolMode = 1; + if (options.options & OPT_ALPHA) { + boolMode = 0; + } + if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1189,36 +1121,55 @@ 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)); + /* + * Extract and return the desired value + */ + 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; XRectangle setBox; + TkRegion modRegion; - if (objc != 6) { - Tcl_WrongNumArgs(interp, 3, objv, "x y boolean"); + /* + * Parse args and option, check for valid values + */ + + if (objc < 6 || objc > 7) { + Tcl_WrongNumArgs(interp, 3, objv, "x y newVal ?-option?"); 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; + } + + index = 5; + memset(&options, 0, sizeof(options)); + if (ParseSubcommandOptions(&options, interp, + OPT_ALPHA, &index, objc, objv) != TCL_OK) { return TCL_ERROR; } + if (index < objc) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\": must be -alpha", + Tcl_GetString(objv[index]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", + NULL); + return TCL_ERROR; + } + boolMode = 1; + if (options.options & OPT_ALPHA) { + boolMode = 0; + } + if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1229,38 +1180,53 @@ ImgPhotoCmd( return TCL_ERROR; } + if (boolMode) { + if (Tcl_GetBooleanFromObj(interp, objv[5], &newVal) != TCL_OK) { + return TCL_ERROR; + } + } else { + if (Tcl_GetIntFromObj(interp, objv[5], &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; + } + } + + /* + * 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 @@ -1462,13 +1428,18 @@ GetExtension( * * This function is invoked to process one of the options which may be * specified for the photo image subcommands, namely, -from, -to, -zoom, - * -subsample, -format, -shrink, and -compositingrule. + * -subsample, -format, -shrink, -compositingrule, -alpha, -boolean and + * -withalpha. + * Parsing starts at the index in *optIndexPtr and stops at the end of + * objv[] or at the first value that does not belong to an option. * * Results: * A standard Tcl result. * * Side effects: - * Fields in *optPtr get filled in. + * Fields in *optPtr get filled in. The value of optIndexPtr is updated + * to contain the index of the first element in argv[] that was not + * parsed, or argc if the end of objv[] was reached. * *---------------------------------------------------------------------- */ @@ -1593,7 +1564,8 @@ ParseSubcommandOptions( return TCL_ERROR; } *optIndexPtr = index; - } else if ((bit != OPT_SHRINK) && (bit != OPT_GRAYSCALE)) { + } else if (bit == OPT_TO || bit == OPT_FROM + || bit == OPT_SUBSAMPLE || bit == OPT_ZOOM) { const char *val; maxValues = ((bit == OPT_FROM) || (bit == OPT_TO)) ? 4 : 2; @@ -2549,7 +2521,7 @@ MatchStringFormat( int *oldformat) /* Returns 1 if the old image API is used. */ { int matched = 0, useoldformat = 0; - Tk_PhotoImageFormat *formatPtr; + Tk_PhotoImageFormat *formatPtr, *defaultFormatPtr = NULL; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); const char *formatString = NULL; @@ -2565,6 +2537,16 @@ MatchStringFormat( for (formatPtr = tsdPtr->formatList; formatPtr != NULL; formatPtr = formatPtr->nextPtr) { + /* + * To keep the behaviour of older versions (Tk <= 8.6), the default + * list-of-lists string format is checked last. Remember its position. + */ + + if (strncasecmp("default", formatPtr->name, strlen(formatPtr->name)) + == 0) { + defaultFormatPtr = formatPtr; + } + if (formatObj != NULL) { if (strncasecmp(formatString, formatPtr->name, strlen(formatPtr->name)) != 0) { @@ -2580,6 +2562,16 @@ MatchStringFormat( return TCL_ERROR; } } + + /* + * If this is the default format, and it was not passed as -format + * option, skip the stringMatchProc test. It'll be done later + */ + + if (formatObj == NULL && formatPtr == defaultFormatPtr) { + continue; + } + if ((formatPtr->stringMatchProc != NULL) && (formatPtr->stringReadProc != NULL) && formatPtr->stringMatchProc(data, formatObj, @@ -2617,23 +2609,46 @@ MatchStringFormat( } } } + if (formatPtr == NULL) { - if ((formatObj != NULL) && !matched) { + /* + * Try the default format as last resort (only if no -format option + * was passed). + */ + + if ( formatObj == NULL && defaultFormatPtr == NULL) { + Tcl_Panic("default image format handler not registered"); + } + if ( formatObj == NULL + && defaultFormatPtr->stringMatchProc != NULL + && defaultFormatPtr->stringReadProc != NULL + && defaultFormatPtr->stringMatchProc(data, formatObj, + widthPtr, heightPtr, interp) != 0) { + useoldformat = 0; + formatPtr = defaultFormatPtr; + } else if ((formatObj != NULL) && !matched) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "image format \"%s\" is not supported", formatString)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", formatString, NULL); + return TCL_ERROR; } else { Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't recognize image data", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "UNRECOGNIZED_DATA", NULL); + return TCL_ERROR; } - return TCL_ERROR; } *imageFormatPtr = formatPtr; *oldformat = useoldformat; + + /* + * Some stringMatchProc might have left error messages and error codes in + * interp. Clear them before return. + */ + Tcl_ResetResult(interp); return TCL_OK; } @@ -3925,57 +3940,6 @@ ImgGetPhoto( /* *---------------------------------------------------------------------- * - * ImgStringWrite -- - * - * Default string write function. The data is formatted in the default - * format as accepted by the "<img> put" command. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * See the user documentation. - * - *---------------------------------------------------------------------- - */ - -static int -ImgStringWrite( - Tcl_Interp *interp, - Tcl_Obj *formatString, - Tk_PhotoImageBlock *blockPtr) -{ - int greenOffset, blueOffset; - Tcl_Obj *data; - - greenOffset = blockPtr->offset[1] - blockPtr->offset[0]; - blueOffset = blockPtr->offset[2] - blockPtr->offset[0]; - - data = Tcl_NewObj(); - if ((blockPtr->width > 0) && (blockPtr->height > 0)) { - int row, col; - - for (row=0; row<blockPtr->height; row++) { - Tcl_Obj *line = Tcl_NewObj(); - unsigned char *pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0] - + row * blockPtr->pitch; - - for (col=0; col<blockPtr->width; col++) { - Tcl_AppendPrintfToObj(line, "%s#%02x%02x%02x", - col ? " " : "", *pixelPtr, - pixelPtr[greenOffset], pixelPtr[blueOffset]); - pixelPtr += blockPtr->pixelSize; - } - Tcl_ListObjAppendElement(NULL, data, line); - } - } - Tcl_SetObjResult(interp, data); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * Tk_PhotoGetImage -- * * This function is called to obtain image data from a photo image. This @@ -4018,7 +3982,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. @@ -4156,5 +4120,6 @@ Tk_PhotoSetSize_Panic( * mode: c * c-basic-offset: 4 * fill-column: 78 + * tab-width: 8 * End: */ diff --git a/generic/tkInt.decls b/generic/tkInt.decls index a13d8d7..19deb98 100644 --- a/generic/tkInt.decls +++ b/generic/tkInt.decls @@ -634,6 +634,13 @@ declare 184 { Tk_Font tkfont, const char *source, int numBytes, double x, double y, double angle) } + +# Debugging / testing functions for photo images +declare 185 { + int TkDebugPhotoStringMatchDef(Tcl_Interp *inter, Tcl_Obj *data, + Tcl_Obj *formatString, int *widthPtr, int *heightPtr) +} + ############################################################################## diff --git a/generic/tkInt.h b/generic/tkInt.h index 474cfb0..ed22fc3 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -945,6 +945,7 @@ MODULE_SCOPE const Tk_SmoothMethod tkBezierSmoothMethod; MODULE_SCOPE Tk_ImageType tkBitmapImageType; MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtGIF; MODULE_SCOPE void (*tkHandleEventProc) (XEvent* eventPtr); +MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtDefault; MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtPNG; MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtPPM; MODULE_SCOPE TkMainInfo *tkMainWindowList; diff --git a/generic/tkIntDecls.h b/generic/tkIntDecls.h index b8addbd..0ffe157 100644 --- a/generic/tkIntDecls.h +++ b/generic/tkIntDecls.h @@ -550,6 +550,10 @@ EXTERN void TkDrawAngledChars(Display *display, Drawable drawable, GC gc, Tk_Font tkfont, const char *source, int numBytes, double x, double y, double angle); +/* 185 */ +EXTERN int TkDebugPhotoStringMatchDef(Tcl_Interp *inter, + Tcl_Obj *data, Tcl_Obj *formatString, + int *widthPtr, int *heightPtr); typedef struct TkIntStubs { int magic; @@ -767,6 +771,7 @@ typedef struct TkIntStubs { void (*tkUnderlineAngledTextLayout) (Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, double angle, int underline); /* 182 */ int (*tkIntersectAngledTextLayout) (Tk_TextLayout layout, int x, int y, int width, int height, double angle); /* 183 */ void (*tkDrawAngledChars) (Display *display, Drawable drawable, GC gc, Tk_Font tkfont, const char *source, int numBytes, double x, double y, double angle); /* 184 */ + int (*tkDebugPhotoStringMatchDef) (Tcl_Interp *inter, Tcl_Obj *data, Tcl_Obj *formatString, int *widthPtr, int *heightPtr); /* 185 */ } TkIntStubs; extern const TkIntStubs *tkIntStubsPtr; @@ -1139,6 +1144,8 @@ extern const TkIntStubs *tkIntStubsPtr; (tkIntStubsPtr->tkIntersectAngledTextLayout) /* 183 */ #define TkDrawAngledChars \ (tkIntStubsPtr->tkDrawAngledChars) /* 184 */ +#define TkDebugPhotoStringMatchDef \ + (tkIntStubsPtr->tkDebugPhotoStringMatchDef) /* 185 */ #endif /* defined(USE_TK_STUBS) */ diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index bf55adf..a491622 100644 --- a/generic/tkStubInit.c +++ b/generic/tkStubInit.c @@ -473,6 +473,7 @@ static const TkIntStubs tkIntStubs = { TkUnderlineAngledTextLayout, /* 182 */ TkIntersectAngledTextLayout, /* 183 */ TkDrawAngledChars, /* 184 */ + TkDebugPhotoStringMatchDef, /* 185 */ }; static const TkIntPlatStubs tkIntPlatStubs = { diff --git a/generic/tkTest.c b/generic/tkTest.c index 61153e5..483fc0d 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -206,6 +206,9 @@ static int TrivialConfigObjCmd(ClientData dummy, Tcl_Obj * const objv[]); static void TrivialEventProc(ClientData clientData, XEvent *eventPtr); +static int TestPhotoStringMatchCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); /* *---------------------------------------------------------------------- @@ -269,6 +272,9 @@ Tktest_Init( Tcl_CreateObjCommand(interp, "testprintf", TestprintfObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testtext", TkpTesttextCmd, (ClientData) Tk_MainWindow(interp), NULL); + Tcl_CreateObjCommand(interp, "testphotostringmatch", + TestPhotoStringMatchCmd, (ClientData) Tk_MainWindow(interp), + NULL); #if defined(_WIN32) || defined(MAC_OSX_TK) Tcl_CreateObjCommand(interp, "testmetrics", TestmetricsObjCmd, @@ -2124,6 +2130,54 @@ CustomOptionFree( ckfree(*(char **)internalPtr); } } +/* + *---------------------------------------------------------------------- + * + * TestPhotoStringMatchCmd -- + * + * This function implements the "testphotostringmatch" command. It + * provides a way from Tcl to call the string match function for the + * default image handler directly. + * + * Results: + * A standard Tcl result. If data is in the proper format, the result in + * interp will contain width and height as a list. If the data cannot be + * parsed as default image format, returns TCL_ERROR and leaves an + * appropriate error message in interp. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TestPhotoStringMatchCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ +{ + Tcl_Obj *dummy = NULL; + Tcl_Obj *resultObj[2]; + int width, height; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "imageData"); + return TCL_ERROR; + } + if (TkDebugPhotoStringMatchDef(interp, objv[1], dummy, &width, &height)) { + resultObj[0] = Tcl_NewIntObj(width); + resultObj[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObj)); + return TCL_OK; + } else { + return TCL_ERROR; + } +} + + /* * Local Variables: diff --git a/generic/tkWindow.c b/generic/tkWindow.c index d9b5dec..ef06a5b 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -336,6 +336,7 @@ CreateTopLevelWindow( * Create built-in photo image formats. */ + Tk_CreatePhotoImageFormat(&tkImgFmtDefault); Tk_CreatePhotoImageFormat(&tkImgFmtGIF); Tk_CreatePhotoImageFormat(&tkImgFmtPNG); Tk_CreatePhotoImageFormat(&tkImgFmtPPM); |