/*
* 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
/*
* "Names" for the different formats of a color string.
*/
enum ColorFormatType {
COLORFORMAT_TKCOLOR,
COLORFORMAT_EMPTYSTRING,
COLORFORMAT_LIST,
COLORFORMAT_RGB1,
COLORFORMAT_RGB2,
COLORFORMAT_ARGB1,
COLORFORMAT_ARGB2
};
/*
* 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",
"argb-short",
"argb",
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, Tcl_Obj *specObj,
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 (Tcl_GetIndexFromObj(NULL, objv[index], colorFormatNames, "",
TCL_EXACT, &typeIndex) != TCL_OK
|| (typeIndex != COLORFORMAT_LIST
&& typeIndex != COLORFORMAT_RGB2
&& typeIndex != COLORFORMAT_ARGB2) ) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad color format "
"\"%s\": must be rgb, argb, 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 "![]()
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,
Tcl_Obj *formatString,
Tk_PhotoImageBlock *blockPtr)
{
int greenOffset, blueOffset, alphaOffset, hasAlpha;
Tcl_Obj *data, **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;
} else {
hasAlpha = 1;
}
alphaOffset = blockPtr->offset[3] - blockPtr->offset[0];
data = Tcl_NewObj();
if ((blockPtr->width > 0) && (blockPtr->height > 0)) {
int row, col;
Tcl_Obj *line, *colorList[4];
unsigned char *pixelPtr;
unsigned char alphaVal = 255;
for (row=0; rowheight; row++) {
line = Tcl_NewObj();
pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0]
+ row * blockPtr->pitch;
for (col=0; colwidth; col++) {
if (hasAlpha) {
alphaVal = pixelPtr[alphaOffset];
}
/*
* We don't build lines as a list for #ARGB and #RGB. Since
* these color formats look like comments, the first element
* of the list would get quoted with an additional {} .
* While this is would not be a problem if the data is used as
* a list, it will cause problems if someone decides to parse
* it as a string.
*/
switch (opts.colorFormat) {
case COLORFORMAT_RGB2:
Tcl_AppendPrintfToObj(line, "%s#%02x%02x%02x",
col == 0 ? "" : " ", pixelPtr[0],
pixelPtr[greenOffset], pixelPtr[blueOffset]);
break;
case COLORFORMAT_ARGB2:
Tcl_AppendPrintfToObj(line, "%s#%02x%02x%02x%02x",
col == 0 ? "" : " ", alphaVal, pixelPtr[0],
pixelPtr[greenOffset], pixelPtr[blueOffset]);
break;
case COLORFORMAT_LIST:
colorList[0] = Tcl_NewIntObj(pixelPtr[0]);
colorList[1] = Tcl_NewIntObj(pixelPtr[greenOffset]);
colorList[2] = Tcl_NewIntObj(pixelPtr[blueOffset]);
colorList[3] = Tcl_NewIntObj(alphaVal);
if (Tcl_ListObjAppendElement(interp, line,
Tcl_NewListObj(4, colorList)) != TCL_OK) {
return TCL_ERROR;
}
break;
default:
Tcl_Panic("unexpected switch fallthrough");
}
pixelPtr += blockPtr->pixelSize;
}
if (Tcl_ListObjAppendElement(interp, data, line) != TCL_OK) {
return TCL_ERROR;
}
}
}
Tcl_SetObjResult(interp, data);
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, *suffixString, *colorString;
Tcl_Obj *colorObj = NULL;
unsigned int i, charCount;
XColor parsedColor;
int parsedAsList;
/*
* If the string representation of color data is invalid, try to parse it
* as a list first, in order to avoid shimmering.
*/
parsedAsList = 0;
if (specObj->bytes == NULL) {
if (ParseColorAsList(interp, specObj, redPtr, greenPtr, bluePtr,
alphaPtr) == TCL_OK) {
goto okExit;
} else {
Tcl_ResetResult(interp);
}
parsedAsList = 1;
}
/*
* Next, try the formats that have no suffix
*/
specString = Tcl_GetString(specObj);
if (strlen(specString) == 0) {
/* Empty string */
*redPtr = *greenPtr = *bluePtr = *alphaPtr = 0;
goto okExit;
}
charCount = strlen(specString);
if (specString[0] == '#'
&& (charCount - 1 == 4 || charCount - 1 == 8)) {
int hexDigitsOnly = 1;
for (i = 1; i < charCount; i++) {
if ( ! isxdigit(UCHAR(specString[i]))) {
hexDigitsOnly = 0;
break;
}
}
if (hexDigitsOnly) {
switch (charCount - 1) {
case 4:
/* #ARGB format */
sscanf(specString, "#%1hhx%1hhx%1hhx%1hhx", alphaPtr,
redPtr, greenPtr, bluePtr);
*redPtr *= 0x11;
*greenPtr *= 0x11;
*bluePtr *= 0x11;
*alphaPtr *= 0x11;
goto okExit;
break;
case 8:
/* #AARRGGBB format */
sscanf(specString, "#%2hhx%2hhx%2hhx%2hhx", alphaPtr, redPtr,
greenPtr, bluePtr);
goto okExit;
break;
default:
Tcl_Panic("unexpected switch fallthrough");
}
}
}
/*
* Split color data string in color and suffix parts
*/
if ((suffixString = strrchr(specString, '@')) == NULL
&& ((suffixString = strrchr(specString, '#')) == NULL
|| suffixString == specString)) {
suffixString = specString + strlen(specString);
colorString = specString;
colorObj = specObj;
} else {
colorObj = Tcl_NewStringObj(specString, suffixString - specString);
colorString = Tcl_GetString(colorObj);
}
/*
* 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)) {
char *tmpString;
double fracAlpha;
unsigned int suffixAlpha;
parsedColor.red >>= 8;
parsedColor.green >>= 8;
parsedColor.blue >>= 8;
/*
* 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);
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");
}
*redPtr = parsedColor.red;
*greenPtr = parsedColor.green;
*bluePtr = parsedColor.blue;
*alphaPtr = suffixAlpha;
goto okExit;
}
/*
* Last, try to parse as a list, if we didn't already.
*/
if ( !parsedAsList && ParseColorAsList(interp, specObj, redPtr, greenPtr,
bluePtr, alphaPtr) == TCL_OK) {
goto okExit;
}
Tcl_ResetResult(interp);
/*
* Looks like we can't figure it out and must give up...
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invalid color name \"%s\"", specString));
Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
"INVALID_COLOR", NULL);
goto errorExit;
okExit:
if (colorObj != NULL && colorObj != specObj) {
Tcl_DecrRefCount(colorObj);
}
return TCL_OK;
errorExit:
if (colorObj != NULL && colorObj != specObj) {
Tcl_DecrRefCount(colorObj);
}
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* 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.
* If the input cannot be parsed, leaves an error message in
* interp. Returns a standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
ParseColorAsList(
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)
{
int listLen;
unsigned int i;
int values[4];
Tcl_Obj *curValue;
const char *specString;
if (Tcl_ListObjLength(interp, specObj, &listLen) != TCL_OK
|| listLen < 3 || listLen > 4) {
specString = Tcl_GetString(specObj);
Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid color name \"%s\"",
specString));
Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
"INVALID_COLOR", NULL);
return TCL_ERROR;
}
values[3] = -1;
for (i = 0; i < (unsigned)listLen; i++) {
if (Tcl_ListObjIndex(interp, specObj, i, &curValue) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, curValue, values + i) != TCL_OK) {
return TCL_ERROR;
}
if (values[i] < 0 || values[i] > 255) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid color: "
"expected integers in the range from 0 to 255"));
Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
"INVALID_COLOR", NULL);
return TCL_ERROR;
}
}
*redPtr = values[0];
*greenPtr = values[1];
*bluePtr = values[2];
*alphaPtr = values[3] == -1 ? 255 : values[3];
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);
}