Index: doc/photo.n ================================================================== --- doc/photo.n +++ doc/photo.n @@ -22,56 +22,62 @@ \fIimageName \fBblank\fR \fIimageName \fBcget \fIoption\fR \fIimageName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? \fIimageName \fBcopy \fIsourceImage\fR ?\fIoption value(s) ...\fR? \fIimageName \fBdata\fR ?\fIoption value(s) ...\fR? -\fIimageName \fBget \fIx y\fR +\fIimageName \fBget \fIx y\fR ?\fIoption\fR? \fIimageName \fBput \fIdata\fR ?\fIoption value(s) ...\fR? \fIimageName \fBread \fIfilename\fR ?\fIoption value(s) ...\fR? \fIimageName \fBredither\fR \fIimageName \fBtransparency \fIsubcommand \fR?\fIarg arg ...\fR? \fIimageName \fBwrite \fIfilename\fR ?\fIoption value(s) ...\fR? .fi .BE .SH DESCRIPTION .PP -A photo is an image whose pixels can display any color or be -transparent. A photo image is stored internally in full color (32 -bits per pixel), and is displayed using dithering if necessary. Image -data for a photo image can be obtained from a file or a string, or it -can be supplied from -C code through a procedural interface. At present, only +A photo is an image whose pixels can display any color with a varying +degree of transparency (the alpha channel). A photo image is stored +internally in full color (32 bits per pixel), and is displayed using +dithering if necessary. Image data for a photo image can be obtained +from a file or a string, or it can be supplied from C code through a +procedural interface. At present, only .VS 8.6 PNG, .VE 8.6 -GIF and PPM/PGM -formats are supported, but an interface exists to allow additional -image file formats to be added easily. A photo image is transparent -in regions where no image data has been supplied -or where it has been set transparent by the \fBtransparency set\fR -subcommand. +GIF and PPM/PGM formats are supported, but an interface exists to +allow additional image file formats to be added easily. A photo image +is (semi)transparent if the image data it was obtained from had +transparency informaton. In regions where no image data has been +supplied, it is fully transparent. Transparency may also be modified +with the \fBtransparency set\fR subcommand. .SH "CREATING PHOTOS" .PP Like all images, photos are created using the \fBimage create\fR command. Photos support the following \fIoptions\fR: .TP \fB\-data \fIstring\fR . -Specifies the contents of the image as a string. The string should -contain binary data or, for some formats, base64-encoded data (this is +Specifies the contents of the image as a string. +.VS 8.7 +The string should +contain data in the default list-of-lists form, +.VE 8.7 +binary data or, for some formats, base64-encoded data (this is currently guaranteed to be supported for PNG and GIF images). The -format of the -string must be one of those for which there is an image file format -handler that will accept string data. If both the \fB\-data\fR -and \fB\-file\fR options are specified, the \fB\-file\fR option takes -precedence. +format of the string must be one of those for which there is an image +file format handler that will accept string data. If both the +\fB\-data\fR and \fB\-file\fR options are specified, the \fB\-file\fR +option takes precedence. .TP -\fB\-format \fIformat-name\fR +\fB\-format\fR {\fIformat-name\fR ?\fIoption value ...\fR?} . Specifies the name of the file format for the data specified with the -\fB\-data\fR or \fB\-file\fR option. +\fB\-data\fR or \fB\-file\fR option and optional arguments passed to +the format handler. Note: the value of this option must be a Tcl list. +This means that the braces may be omitted if the argument has only one +word. Also, instead of braces, double quotes may be used for quoting. .TP \fB\-file \fIname\fR . \fIname\fR gives the name of a file that is to be read to supply data for the photo image. The file format must be one of those for which @@ -231,33 +237,43 @@ \fIoverlay\fR. .RE .TP \fIimageName \fBdata\fR ?\fIoption value(s) ...\fR? . -Returns image data in the form of a string. The following options -may be specified: +Returns image data in the form of a string. +.VS 8.7 +The format of the string depends on the format handler. By default, a +human readable format as a list of lists of pixel data is used, other +formats can be chosen with the \fB-format\fR option. +See \fBIMAGE FORMATS\fR below for details. +.VE 8.7 +The following options may be specified: .RS .TP \fB\-background\fI color\fR . If the color is specified, the data will not contain any transparency information. In all transparent pixels the color will be replaced by the specified color. .TP -\fB\-format\fI format-name\fR -. -Specifies the name of the image file format handler to be used. -Specifically, this subcommand searches -for the first handler whose name matches an initial substring of -\fIformat-name\fR and which has the capability to write a string -containing this image data. -If this option is not given, this subcommand uses a format that -consists of a list (one element per row) of lists (one element per -pixel/column) of colors in +\fB\-format\fR {\fIformat-name\fR ?\fIoption value ...\fR?} +. +Specifies the name of the image file format handler to use and, +optionally, arguments to the format handler. Specifically, this +subcommand searches for the first handler whose name matches an +initial substring of \fIformat-name\fR and which has the capability to +write a string containing this image data. +.VS 8.7 +If this option is not given, this subcommand uses the default format +that consists of a list (one element per row) of lists (one element +per pixel/column) of colors in .QW \fB#\fIrrggbb\fR -format (where \fIrr\fR is a pair of hexadecimal digits for the red -channel, \fIgg\fR for green, and \fIbb\fR for blue). +format (see \fBIMAGE FORMATS\fR below). +.VE 8.7 +Note: the value of this option must be a Tcl list. +This means that the braces may be omitted if the argument has only one +word. Also, instead of braces, double quotes may be used for quoting. .TP \fB\-from \fIx1 y1 x2 y2\fR . Specifies a rectangular region of \fIimageName\fR to be returned. If only \fIx1\fR and \fIy1\fR are specified, the region @@ -270,47 +286,55 @@ \fB\-grayscale\fR . If this options is specified, the data will not contain color information. All pixel data will be transformed into grayscale. .RE +.VS 8.7 .TP -\fIimageName \fBget\fR \fIx y\fR +\fIimageName \fBget\fR \fIx y\fR ?\fB-withalpha\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. +red, green and blue components respectively. If the \fB-withalpha\fR +option is specified, the returned list will have a fourth element +representing the alpha value of the pixel as an integer between 0 and +255. +.VE 8.7 .TP \fIimageName \fBput\fR \fIdata\fR ?\fIoption value(s) ...\fR? . Sets pixels in \fI imageName\fR to the data specified in \fIdata\fR. -This command first searches the list of image file format handlers for +.VS 8.7 +This command searches the list of image file format handlers for 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: +See \fBIMAGE FORMATS\fR below for details on formats for image data. +.VE 8.7 +The following options may be specified: .RS .TP -\fB\-format \fIformat-name\fR +\fB\-format\fR {\fIformat-name\fR ?\fIoption value ..\fR?} . -Specifies the format of the image data in \fIdata\fR. +Specifies the format of the image data in \fIdata\fR and, optionally, +arguments to be passed to the format handler. Specifically, only image file format handlers whose names begin with \fIformat-name\fR will be used while searching for an image data format handler to read the data. +Note: the value of this option must be a Tcl list. +This means that the braces may be omitted if the argument has only one +word. Also, instead of braces, double quotes may be used for quoting. .TP \fB\-to \fIx1 y1\fR ?\fIx2 y2\fR? . Specifies the coordinates of the top-left corner (\fIx1\fR,\fIy1\fR) 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 .TP \fIimageName \fBread\fR \fIfilename\fR ?\fIoption value(s) ...\fR? @@ -321,16 +345,20 @@ in \fIfilename\fR, and then reads the image in \fIfilename\fR into \fIimageName\fR (the destination image). The following options may be specified: .RS .TP -\fB\-format \fIformat-name\fR +\fB\-format {\fIformat-name\fR ?\fIoption value ..\fR?} . -Specifies the format of the image data in \fIfilename\fR. +Specifies the format of the image data in \fIfilename\fR and, +optionally, additional options to the format handler. Specifically, only image file format handlers whose names begin with \fIformat-name\fR will be used while searching for an image data format handler to read the data. +Note: the value of this option must be a Tcl list. +This means that the braces may be omitted if the argument has only one +word. Also, instead of braces, double quotes may be used for quoting. .TP \fB\-from \fIx1 y1 x2 y2\fR . Specifies a rectangular sub-region of the image file data to be copied to the destination image. If only \fIx1\fR and \fIy1\fR are @@ -369,20 +397,30 @@ \fIimageName \fBtransparency \fIsubcommand \fR?\fIarg arg ...\fR? . Allows examination and manipulation of the transparency information in the photo image. Several subcommands are available: .RS -.TP -\fIimageName \fBtransparency get \fIx y\fR -. -Returns a boolean indicating if the pixel at (\fIx\fR,\fIy\fR) is -transparent. -.TP -\fIimageName \fBtransparency set \fIx y boolean\fR -. -Makes the pixel at (\fIx\fR,\fIy\fR) transparent if \fIboolean\fR is -true, and makes that pixel opaque otherwise. +.VS 8.7 +.TP +\fIimageName \fBtransparency get \fIx y\fR ?\fB-alpha\fR? +. +Returns true if the pixel at (\fIx\fR,\fIy\fR) is fully transparent, +false otherwise. If the option \fB-alpha\fR is passed, returns the +alpha value of the pixel instead, as an integer in the range 0 to 255. +.VE 8.7 + +.VS 8.7 +.TP +\fIimageName \fBtransparency set \fIx y\fR \fInewVal\fR ?\fB-alpha\fR? +. +Change the transparency of the pixel at (\fIx\fR,\fIy\fR) to +\fInewVal.\fR If no additional option is passed, \fInewVal\fR is +interpreted as a boolean and the pixel is made fully transparent if +that value is true, fully opaque otherwise. If the \fB-alpha\fR +option is passed, \fInewVal\fR is interpreted as an integral alpha +value for the pixel, which must be in the range 0 to 255. +.VE 8.7 .RE .TP \fIimageName \fBwrite \fIfilename\fR ?\fIoption value(s) ...\fR? . Writes image data from \fIimageName\fR to a file named \fIfilename\fR. @@ -393,19 +431,23 @@ . If the color is specified, the data will not contain any transparency information. In all transparent pixels the color will be replaced by the specified color. .TP -\fB\-format\fI format-name\fR +\fB\-format\fR {\fIformat-name\fR ?\fIoption value ...\fR?} . Specifies the name of the image file format handler to be used to -write the data to the file. Specifically, this subcommand searches -for the first handler whose name matches an initial substring of -\fIformat-name\fR and which has the capability to write an image -file. If this option is not given, the format is guessed from -the file extension. If that cannot be determined, this subcommand -uses the first handler that has the capability to write an image file. +write the data to the file and, optionally, options to pass to the +format handler. Specifically, this subcommand searches for the first +handler whose name matches an initial substring of \fIformat-name\fR +and which has the capability to write an image file. If this option +is not given, the format is guessed from the file extension. If that +cannot be determined, this subcommand uses the first handler that has +the capability to write an image file. +Note: the value of this option must be a Tcl list. +This means that the braces may be omitted if the argument has only one +word. Also, instead of braces, double quotes may be used for quoting. .TP \fB\-from \fIx1 y1 x2 y2\fR . Specifies a rectangular region of \fIimageName\fR to be written to the image file. If only \fIx1\fR and \fIy1\fR are specified, the region @@ -424,24 +466,28 @@ The photo image code is structured to allow handlers for additional image file formats to be added easily. The photo image code maintains a list of these handlers. Handlers are added to the list by registering them with a call to \fBTk_CreatePhotoImageFormat\fR. The standard Tk distribution comes with handlers for PPM/PGM, PNG and GIF -formats, which are automatically registered on initialization. +formats, +.VS 8.7 +as well as the \fBdefault\fR handler to encode/decode image +data in a human readable form. +.VE 8.7 +These handlers are automatically registered on initialization. .PP -When reading an image file or processing -string data specified with the \fB\-data\fR configuration option, the -photo image code invokes each handler in turn until one is -found that claims to be able to read the data in the file or string. -Usually this will find the correct handler, but if it does not, the -user may give a format name with the \fB\-format\fR option to specify -which handler to use. In fact the photo image code will try those -handlers whose names begin with the string specified for the -\fB\-format\fR option (the comparison is case-insensitive). For -example, if the user specifies \fB\-format gif\fR, then a handler -named GIF87 or GIF89 may be invoked, but a handler -named JPEG may not (assuming that such handlers had been +When reading an image file or processing string data specified with +the \fB\-data\fR configuration option, the photo image code invokes +each handler in turn until one is found that claims to be able to read +the data in the file or string. Usually this will find the correct +handler, but if it does not, the user may give a format name with the +\fB\-format\fR option to specify which handler to use. In this case, +the photo image code will try those handlers whose names begin with +the string specified for the \fB\-format\fR option (the comparison is +case-insensitive). For example, if the user specifies \fB\-format +gif\fR, then a handler named GIF87 or GIF89 may be invoked, but a +handler named JPEG may not (assuming that such handlers had been registered). .PP When writing image data to a file, the processing of the \fB\-format\fR option is slightly different: the string value given for the \fB\-format\fR option must begin with the complete name of the @@ -448,31 +494,113 @@ requested handler, and may contain additional information following that, which the handler can use, for example, to specify which variant to use of the formats supported by the handler. Note that not all image handlers may support writing transparency data to a file, even where the target image format does. +.VS 8.7 +.SS "THE DEFAULT IMAGE HANDLER" +.PP +The \fBdefault\fR image handler cannot be used to read or write data +from/to a file. Its sole purpose is to encode and decode image data in +string form in a clear text, human readable, form. The \fIimageName\fR +\fBdata\fR subcommand uses this handler when no other format is +specified. When reading image data from a string with \fIimageName\fR +\fBput\fR or the \fB-data\fR option, the default handler is treated +as the other handlers. +.PP +Image data in the \fBdefault\fR string format is a (top-to-bottom) +list of scan-lines, with each scan-line being a (left-to-right) list +of pixel data. Every scan-line has the same length. The color +and, optionally, alpha value of each pixel is specified in any of +the forms described in the \fBCOLOR FORMATS\fR section below. +.VE 8.7 + .SS "FORMAT SUBOPTIONS" .PP .VS 8.6 -Some image formats support sub-options, which are specified at the time that -the image is loaded using additional words in the \fB\-format\fR option. At -the time of writing, the following are supported: +Image formats may support sub-options, wich ahre specified using +additional words in the value to the \fB\-format\fR option. These +suboptions can affect how image data is read or written to file or +string. The nature and values of these options is up to the format +handler. +The built-in handlers support these suboptions: +.VS 8.7 +.TP +\fBdefault \-colorformat\fI formatType\fR +. +The option is allowed when writing image data to a string with +\fIimageName\fR \fBdata\fR. Specifies the format to use for the color +string of each pixel. \fIformatType\fR may be one of: \fBrgb\fR to +encode pixel data in the form \fB#\fIRRGGBB\fR, \fBrgba\fR to encode +pixel data in the form \fB#\fIRRGGBBAA\fR or \fBlist\fR to encode +pixel data as a list with four elements. See \fBCOLOR FORMATS\fR +below for details. The default is \fBrgb\fR. +.VE 8.7 .TP \fBgif \-index\fI indexValue\fR . -When parsing a multi-part GIF image, Tk normally only accesses the first -image. By giving the \fB\-index\fR sub-option, the \fIindexValue\fR'th value -may be used instead. The \fIindexValue\fR must be an integer from 0 up to the -number of image parts in the GIF data. +The option has effect when reading image data from a file. When +parsing a multi-part GIF image, Tk normally only accesses the first +image. By giving the \fB\-index\fR sub-option, the \fIindexValue\fR'th +value may be used instead. The \fIindexValue\fR must be an integer +from 0 up to the number of image parts in the GIF data. .TP \fBpng \-alpha\fI alphaValue\fR . -An additional alpha filtering for the overall image, which allows the -background on which the image is displayed to show through. This usually also -has the effect of desaturating the image. The \fIalphaValue\fR must be between -0.0 and 1.0. +The option has effect when reading image data from a file. Specifies +an additional alpha filtering for the overall image, which allows the +background on which the image is displayed to show through. This +usually also has the effect of desaturating the image. The +\fIalphaValue\fR must be between 0.0 and 1.0. .VE 8.6 +.VS 8.7 +.SH "COLOR FORMATS" +.PP +The default image handler can represent/parse color and alpha values +of a pixel in one of the formats listed below. If a color format does +not contain transparency information, full opacity is assumed. The +available color formats are: +.IP \(bu 3 +The empty string - interpreted as full transparency, the color value +is undefined. +.IP \(bu 3 +Any value accepted by \fBTk_GetColor\fR, optionally followed by an +alpha suffix. The alpha suffix may be one of: +.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 +.IP \(bu 3 +A Tcl list with three or four integers in the range 0 to 255, +specifying the values for the red, green, blue and (optionally) +alpha channels respectively. +.IP \(bu 3 +\fB#\fR\fIRGBA\fR format: a \fB#\fR followed by four hexadecimal digits, +where each digit is the value for the red, green, blue and alpha +channels respectively. Each digit will be expanded internally to +8 bits by multiplication by 0x11. +.IP \(bu 3 +\fB#\fR\fIRRGGBBAA\fR format: \fB#\fR followed by eight hexadecimal digits, +where each pair of subsequent digits represents the value for the red, +green, blue and alpha channels respectively. +.VE 8.7 .SH "COLOR ALLOCATION" .PP When a photo image is displayed in a window, the photo image code allocates colors to use to display the image and dithers the image, if necessary, to display a reasonable approximation to the image using @@ -532,12 +660,29 @@ \fBimage create photo\fR iconDisabled \-file "icon.png" \e \-format "png \-alpha 0.5" button .b \-image icon \-disabledimage iconDisabled .CE .VE 8.6 +.PP +.VS 8.7 +Create a green box with a simple shadow effect +.PP +.CS +\fBimage create photo\fR foo + +# Make a simple graduated fill varying in alpha for the shadow +for {set i 14} {$i > 0} {incr i -1} { + set i2 [expr {$i + 30}] + foo \fBput\fR [format black#%x [expr {15-$i}]] -to $i $i $i2 $i2 +} + +# Put a solid green rectangle on top +foo \fBput\fR #F080 -to 0 0 30 30 +.VE 8.7 +.CE .SH "SEE ALSO" image(n) .SH KEYWORDS photo, image, color '\" Local Variables: '\" mode: nroff '\" End: ADDED generic/tkImgListFormat.c Index: generic/tkImgListFormat.c ================================================================== --- /dev/null +++ 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 " 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 || rowCount == 0 || colCount == 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; rowheight; row++) { + pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0] + + row * blockPtr->pitch; + Tcl_DStringInit(&line); + for (col=0; colwidth; 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: */ Index: generic/tkImgPhoto.c ================================================================== --- generic/tkImgPhoto.c +++ generic/tkImgPhoto.c @@ -46,45 +46,51 @@ * allowedOptions parameter on a call to ParseSubcommandOptions if that option * is allowed for the current photo image subcommand. On return, the bit is * 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. * OPT_FROM: Set if -from option allowed/specified. * OPT_GRAYSCALE: Set if -grayscale option allowed/specified. * 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 * of the OPT_* constants above. */ static const char *const optionNames[] = { + "-alpha", "-background", "-compositingrule", "-format", "-from", "-grayscale", "-shrink", "-subsample", "-to", + "-withalpha", "-zoom", NULL }; /* @@ -180,13 +186,10 @@ PhotoMaster *masterPtr, int objc, Tcl_Obj *const objv[], int flags); 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); static int MatchFileFormat(Tcl_Interp *interp, Tcl_Channel chan, const char *fileName, Tcl_Obj *formatString, @@ -400,16 +403,14 @@ PHOTO_GET, PHOTO_PUT, PHOTO_READ, PHOTO_REDITHER, PHOTO_TRANS, PHOTO_WRITE }; 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; Tcl_Channel chan; Tk_PhotoHandle srcHandle; @@ -651,19 +652,20 @@ options.toY2 - options.toY, options.zoomX, options.zoomY, options.subsampleX, options.subsampleY, options.compositingRule); case PHOTO_DATA: { - char *data; + char *data = NULL; + Tcl_Obj *freeObj = NULL; /* * photo data command - first parse and check any options given. */ Tk_ImageStringWriteProc *stringWriteProc = NULL; - index = 2; + index = 1; memset(&options, 0, sizeof(options)); options.name = NULL; options.format = NULL; options.fromX = 0; options.fromY = 0; @@ -670,11 +672,11 @@ if (ParseSubcommandOptions(&options, interp, OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND, &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; } if ((options.fromX > masterPtr->width) || (options.fromY > masterPtr->height) @@ -692,54 +694,54 @@ if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) { 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; - } - } - } - } - 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; - } - } else { - stringWriteProc = ImgStringWrite; + 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; + } + } + } + } + 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; } /* * Call the handler's string write function to write out the image. */ @@ -772,24 +774,51 @@ Tk_FreeColor(options.background); } 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: { /* * 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; } if ((x < 0) || (x >= masterPtr->width) @@ -801,206 +830,86 @@ NULL); return TCL_ERROR; } /* - * 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; } if ((options.name == NULL) || (index < objc)) { Tcl_WrongNumArgs(interp, 2, objv, "data ?-option value ...?"); 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) { - 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 (y < dataHeight || dataHeight == 0 || dataWidth == 0) { - if (block.pixelPtr != NULL) { - ckfree(block.pixelPtr); - } - if (y < dataHeight) { - return TCL_ERROR; - } - return TCL_OK; - } - - /* - * 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; - + /* + * 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; + } + + 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, + options.toX2 - options.toX, + options.toY2 - options.toY, 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 and to set/unset the + * IMAGE_CHANGED bit. + */ + masterPtr->flags |= IMAGE_CHANGED; + + return TCL_OK; + } case PHOTO_READ: { Tcl_Obj *format; /* * photo read command - first parse the options specified. @@ -1166,21 +1075,44 @@ return TCL_ERROR; } 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( "%s transparency get: coordinates out of range", Tcl_GetString(objv[0]))); @@ -1187,82 +1119,116 @@ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", NULL); 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( "%s transparency set: coordinates out of range", Tcl_GetString(objv[0]))); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", NULL); 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, - masterPtr->validRegion); - TkDestroyRegion(clearRegion); - - /* - * Set the alpha value correctly. - */ - - pixelPtr[3] = 0; - } else { - /* - * Make pixel opaque. - */ - + modRegion = TkCreateRegion(); + TkUnionRectWithRegion(&setBox, modRegion, modRegion); + if (pixelPtr[3]) { TkUnionRectWithRegion(&setBox, masterPtr->validRegion, masterPtr->validRegion); - pixelPtr[3] = 255; + } else { + TkSubtractRegion(masterPtr->validRegion, modRegion, + masterPtr->validRegion); } + TkDestroyRegion(modRegion); /* * Inform the generic image code that the image * has (potentially) changed. */ @@ -1460,17 +1426,22 @@ * * ParseSubcommandOptions -- * * 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. * *---------------------------------------------------------------------- */ static int @@ -1591,11 +1562,12 @@ "compositing rule", 0, &optPtr->compositingRule) != TCL_OK) { 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; argIndex = index + 1; for (numValues = 0; numValues < maxValues; ++numValues) { @@ -2547,11 +2519,11 @@ /* The dimensions of the image are returned * here. */ 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; if (formatObj) { @@ -2563,10 +2535,20 @@ * handle the image. */ 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) { continue; } @@ -2578,10 +2560,20 @@ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "NOT_DATA_FORMAT", NULL); 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, widthPtr, heightPtr, interp)) { break; @@ -2615,27 +2607,50 @@ widthPtr, heightPtr, interp)) { break; } } } + 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; } /* *---------------------------------------------------------------------- @@ -3923,61 +3938,10 @@ } /* *---------------------------------------------------------------------- * - * ImgStringWrite -- - * - * Default string write function. The data is formatted in the default - * format as accepted by the " 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; rowheight; row++) { - Tcl_Obj *line = Tcl_NewObj(); - unsigned char *pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0] - + row * blockPtr->pitch; - - for (col=0; colwidth; 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 * function fills in the Tk_PhotoImageBlock structure pointed to by * `blockPtr' with details of the address and layout of the image data in @@ -4016,11 +3980,11 @@ } /* *-------------------------------------------------------------- * - * TkPostscriptPhoto -- + * ImgPostscriptPhoto -- * * This function is called to output the contents of a photo image in * Postscript by calling the Tk_PostscriptPhoto function. * * Results: @@ -4154,7 +4118,8 @@ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 + * tab-width: 8 * End: */ Index: generic/tkInt.decls ================================================================== --- generic/tkInt.decls +++ generic/tkInt.decls @@ -632,10 +632,17 @@ declare 184 { void TkDrawAngledChars(Display *display,Drawable drawable, GC gc, 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) +} + ############################################################################## # Define the platform specific internal Tcl interface. These functions are # only available on the designated platform. Index: generic/tkInt.h ================================================================== --- generic/tkInt.h +++ generic/tkInt.h @@ -943,10 +943,11 @@ 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; MODULE_SCOPE Tk_ImageType tkPhotoImageType; MODULE_SCOPE Tcl_HashTable tkPredefBitmapTable; Index: generic/tkIntDecls.h ================================================================== --- generic/tkIntDecls.h +++ generic/tkIntDecls.h @@ -548,10 +548,14 @@ /* 184 */ 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; void *hooks; @@ -765,10 +769,11 @@ CONST86 char * (*tkSmoothPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 180 */ void (*tkDrawAngledTextLayout) (Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, double angle, int firstChar, int lastChar); /* 181 */ 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; #ifdef __cplusplus @@ -1137,10 +1142,12 @@ (tkIntStubsPtr->tkUnderlineAngledTextLayout) /* 182 */ #define TkIntersectAngledTextLayout \ (tkIntStubsPtr->tkIntersectAngledTextLayout) /* 183 */ #define TkDrawAngledChars \ (tkIntStubsPtr->tkDrawAngledChars) /* 184 */ +#define TkDebugPhotoStringMatchDef \ + (tkIntStubsPtr->tkDebugPhotoStringMatchDef) /* 185 */ #endif /* defined(USE_TK_STUBS) */ /* !END!: Do not edit above this line. */ Index: generic/tkStubInit.c ================================================================== --- generic/tkStubInit.c +++ generic/tkStubInit.c @@ -471,10 +471,11 @@ TkSmoothPrintProc, /* 180 */ TkDrawAngledTextLayout, /* 181 */ TkUnderlineAngledTextLayout, /* 182 */ TkIntersectAngledTextLayout, /* 183 */ TkDrawAngledChars, /* 184 */ + TkDebugPhotoStringMatchDef, /* 185 */ }; static const TkIntPlatStubs tkIntPlatStubs = { TCL_STUB_MAGIC, 0, Index: generic/tkTest.c ================================================================== --- generic/tkTest.c +++ generic/tkTest.c @@ -204,10 +204,13 @@ static int TrivialConfigObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, 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[]); /* *---------------------------------------------------------------------- * * Tktest_Init -- @@ -267,10 +270,13 @@ Tcl_CreateObjCommand(interp, "testprop", TestpropObjCmd, (ClientData) Tk_MainWindow(interp), NULL); 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, (ClientData) Tk_MainWindow(interp), NULL); #elif !defined(__CYGWIN__) @@ -2122,13 +2128,61 @@ { if (*(char **)internalPtr != NULL) { 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: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tkWindow.c ================================================================== --- generic/tkWindow.c +++ generic/tkWindow.c @@ -334,10 +334,11 @@ /* * Create built-in photo image formats. */ + Tk_CreatePhotoImageFormat(&tkImgFmtDefault); Tk_CreatePhotoImageFormat(&tkImgFmtGIF); Tk_CreatePhotoImageFormat(&tkImgFmtPNG); Tk_CreatePhotoImageFormat(&tkImgFmtPPM); } ADDED tests/imgListFormat.test Index: tests/imgListFormat.test ================================================================== --- /dev/null +++ tests/imgListFormat.test @@ -0,0 +1,661 @@ +# This file is a Tcl script to test out the default image data format +# ("list format") implementend in the file tkImgListFormat.c. +# It is organized in the standard fashion for Tcl tests. +# +# Copyright (c) 2017 Simon Bachmann +# All rights reserved. +# +# Author: Simon Bachmann (simonbachmann@bluewin.ch) + +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv +tcltest::loadTestedCommands + +imageInit + +# 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] + +# --------------------------------------------------------------------- + + +test imgListFormat-1.1 {ParseFormatOptions: default values} -setup { + image create photo photo1 +} -body { + photo1 put {{red green} {blue black}} + lindex [photo1 data] 1 1 +} -cleanup { + imageCleanup +} -result {#000000} +test imgListFormat-1.2 {ParseFormatOptions: format name as first arg} -setup { + image create photo photo1 +} -body { + photo1 put #1256ef -format {default} -to 0 0 10 10 +} -cleanup { + imageCleanup +} -result {} +test imgListFormat-1.3 {ParseFormatOptions: unknown option} -setup { + image create photo photo1 +} -body { + photo1 data -format {default -bogus} +} -cleanup { + imageCleanup +} -returnCodes error -result {bad format option "-bogus": must be -colorformat} +test imgListFormat-1.4 {ParseFormatOptions: option not allowed} -setup { + image create photo photo1 +} -body { + photo1 put yellow -format {default -colorformat rgb} +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {bad format option "-colorformat": no options allowed} +test imgListFormat-1.5 {ParseFormatOptions: no -colorformat value} -setup { + image create photo photo1 -data black +} -body { + photo1 data -format {default -colorformat} +} -returnCodes error -result {the "-colorformat" option requires a value} +test imgListFormat-1.6 {ParseFormatOptions: bad -colorformat val #1} -setup { + image create photo photo1 +} -body { + photo1 put yellow + photo1 data -format {default -colorformat bogus} +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {bad color format "bogus": must be rgb, rgba, or list} +test imgListFormat-1.7 {ParseFormatOptions: bad -colorformat val #2} -setup { + image create photo photo1 +} -body { + photo1 data -format {default -colorformat tkcolor} +} -returnCodes error -result \ + {bad color format "tkcolor": must be rgb, rgba, or list} +test imgListFormat-1.8 {ParseFormatOptions: bad -colorformat #3} -setup { + image create photo photo1 +} -body { + photo1 data -format {default -colorformat emptystring} +} -returnCodes error -result \ + {bad color format "emptystring": must be rgb, rgba, or list} +test imgListFormat-1.9 {ParseFormatOptions: bad -colorformat #4} -setup { + image create photo photo1 +} -body { + photo1 data -format {default -colorformat rgb-short} +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {bad color format "rgb-short": must be rgb, rgba, or list} +test imgListFormat-1.10 {ParseFormatOptions: bad -colorformat #5} -setup { + image create photo photo1 +} -body { + photo1 data -format {default -colorformat rgba-short} +} -returnCodes error -result \ + {bad color format "rgba-short": must be rgb, rgba, or list} +test imgListFormat-1.11 {valid colorformats} -setup { + image create photo photo1 +} -body { + photo1 put white#78 + set result {} + lappend result [photo1 data -format {default -colorformat rgb}] + lappend result [photo1 data -format {default -colorformat rgba}] + lappend result [photo1 data -format {default -colorformat list}] + set result +} -cleanup { + imageCleanup + unset result +} -result {{{#ffffff}} {{#ffffff78}} {{{255 255 255 120}}}} + +# GetBadOptMsg: only use case already tested with imgListFormat-1.4 + +test imgListFormat-3.1 {StringMatchDef: data is not a list} -body { + testphotostringmatch {not a " proper list} + # " (this comment is here only for editor highlighting) +} -returnCodes error -result {unmatched open quote in list} +# empty data case tested with imgPhoto-4.95 (imgPhoto.test) +test imgListFormat-3.2 {StringMatchDef: \ + list element not a proper list} -body { + testphotostringmatch {{red white} {not "} {blue green}} + # " +} -returnCodes error -result {unmatched open quote in list} +test imgListFormat-3.3 {StringMatchDef: \ + sublists with differen lengths} -body { + testphotostringmatch {{#001122 #334455 #667788} + {#99AABB #CCDDEE} + {#FF0011 #223344 #556677}} +} -returnCodes error -result \ + {invalid row # 1: all rows must have the same number of elements} +test imgListFormat-3.4 {StringMatchDef: base64 data is not parsed as valid \ +} -setup { + image create photo photo1 +} -body { + photo1 put { + iVBORw0KGgoAAAANSUhEUgAAAAIAAAACCA + YAAAEFsT2yAAAABGdBTUEAAYagMeiWXwAA + ABdJREFUCJkFwQEBAAAAgiD6P9pACRoqDk + fUBvt1wUFKAAAAAElFTkSuQmCC + } -format default +} -cleanup { + imageCleanup +} -returnCodes error -result {couldn't recognize image data} +test imgListFormat-3.5 {StringMatchDef: valid data} -setup { + image create photo photo1 +} -body { + photo1 put {{blue green} + {yellow magenta} + {#000000 #FFFFFFFF}} + list [image width photo1] [image height photo1] \ + [photo1 get 0 2 -withalpha] +} -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 StringMatchDef +test imgListFormat-4.1 {StringReadDef: use with -format opt} -setup { + image create photo photo1 +} -body { + photo1 put white -format "default" + photo1 get 0 0 +} -cleanup { + imageCleanup +} -result {255 255 255} +test imgListFormat-4.2 {StringReadDef: suboptions to format} -setup { + image create photo photo1 +} -body { + photo1 put white -format {default -bogus} +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {bad format option "-bogus": no options allowed} +test imgListFormat-4.3 {StringReadDef: erroneous non-option argument} -setup { + image create photo photo1 +} -body { + photo1 put orange -format {default bogus} +} -returnCodes error -result {bad format option "bogus": no options allowed} +test imgListFormat-4.4 {StringReadDef: normal use case} -constraints { + hasTeapotPhoto +} -setup { + 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 imgListFormat-4.5 {StringReadDef: correct compositing rule} -constraints { + hasTranspTeapotPhoto +} -setup { + image create photo photo1 -file $transpTeapotPhotoFile + image create photo photo2 +} -body { + photo2 put #FF0000 -to 0 0 50 50 + photo2 put [photo1 data -format {default -colorformat rgba}] -to 10 10 40 40 + list [photo2 get 0 0 -withalpha] [photo2 get 20 25 -withalpha] \ + [photo2 get 49 49 -withalpha] +} -cleanup { + imageCleanup +} -result {{255 0 0 255} {0 78 185 225} {255 0 0 255}} + +test imgListFormat-5.1 {StringWriteDef: format options not a list} -setup { + image create photo photo1 +} -body { + photo1 data -format {default " bogus} + # " +} -cleanup { + imageCleanup +} -returnCodes error -result {unmatched open quote in list} +test imgListFormat-5.2 {StringWriteDef: invalid format option} -setup { + image create photo photo1 +} -body { + photo1 data -format {default -bogus} +} -cleanup { + imageCleanup +} -returnCodes error -result {bad format option "-bogus": must be -colorformat} +test imgListFormat-5.3 {StringWriteDef: non-option arg in format} -setup { + image create photo photo1 +} -body { + photo1 data -format {default -colorformat list bogus} +} -cleanup { + imageCleanup +} -returnCodes error -result {bad format option "bogus": must be -colorformat} +test imgListFormat-5.4 {StringWriteDef: empty image} -setup { + image create photo photo1 +} -body { + photo1 data -format {default -colorformat rgba} +} -cleanup { + imageCleanup +} -result {} +test imgListFormat-5.5 {StirngWriteDef: size of data} -setup { + image create photo photo1 +} -body { + photo1 put blue -to 0 0 35 64 + set imgData [photo1 data] + list [llength [lindex $imgData 0]] [llength $imgData] +} -cleanup { + unset imgData + imageCleanup +} -result {35 64} +test imgListFormat-5.6 {StringWriteDef: test some pixels #1} -constraints { + hasTeapotPhoto +} -setup { + set result {} + image create photo photo1 -file $teapotPhotoFile +} -body { + set imgData [photo1 data] + # note: with [lindex], the coords are inverted (y x) + lappend result [lindex $imgData 0 0] + lappend result [lindex $imgData 3 2] + lappend result [lindex $imgData 107 53] + lappend result [lindex $imgData 203 157] + lappend result [lindex $imgData 255 255] + set result +} -cleanup { + unset result + unset imgData + imageCleanup +} -result {{#135cc0} #135cc0 #a06d52 #e1c8ba #135cc0} +test imgListFormat-5.7 {StringWriteDef: test some pixels #2} -constraints { + hasTeapotPhoto +} -setup { + set result {} + image create photo photo1 -file $teapotPhotoFile +} -body { + set imgData [photo1 data -format {default -colorformat rgba}] + # note: with [lindex], the coords are inverted (y x) + lappend result [lindex $imgData 0 0] + lappend result [lindex $imgData 3 2] + lappend result [lindex $imgData 107 53] + lappend result [lindex $imgData 203 157] + lappend result [lindex $imgData 255 255] + set result +} -cleanup { + unset result + unset imgData + imageCleanup +} -result {{#135cc0ff} #135cc0ff #a06d52ff #e1c8baff #135cc0ff} +test imgListFormat-5.8 {StringWriteDef: test some pixels #3} -constraints { + hasTranspTeapotPhoto +} -setup { + image create photo photo1 -file $transpTeapotPhotoFile +} -body { + set imgData [photo1 data -format {default -colorformat rgb}] + set result {} + 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 {{#004eb9} #a14100 #ffca9f} +test imgListFormat-5.9 {StringWriteDef: test some pixels #4} -constraints { + hasTranspTeapotPhoto +} -setup { + image create photo photo1 -file $transpTeapotPhotoFile +} -body { + set imgData [photo1 data -format {default -colorformat rgba}] + set 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 {{#004eb9e1} #a14100aa #ffca9faf} +test imgListFormat-5.10 {StringWriteDef: test some pixels #5} -constraints { + hasTranspTeapotPhoto +} -setup { + image create photo photo1 -file $transpTeapotPhotoFile +} -body { + set imgData [photo1 data -format {default -colorformat list}] + set result {} + lappend result [lindex $imgData 3 2] + lappend result [lindex $imgData 107 53] + lappend result [lindex $imgData 203 157] + set result +} -cleanup { + unset imgData + unset result + imageCleanup +} -result {{0 78 185 225} {161 65 0 170} {255 202 159 175}} + +test imgListFormat-6.1 {ParseColor: empty string} -setup { + 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 -withalpha] + set result +} -cleanup { + unset result + imageCleanup +} -result {2 2 {0 0 0 0}} +test imgListFormat-6.2 {ParseColor: empty string, mixed} -setup { + image create photo photo1 +} -body { + photo1 put {{black white} {{} white}} + list [photo1 get 0 0 -withalpha] [photo1 get 0 1 -withalpha] +} -cleanup { + imageCleanup +} -result {{0 0 0 255} {0 0 0 0}} +test imgListFormat-6.3 {ParseColor: color name too long} -setup { + image create photo photo1 + set longstr {} + for {set i 1} {$i <= 100} {incr i} { + append longstr "z" + } +} -body { + photo1 put [list [list blue] [list $longstr]] +} -cleanup { + imageCleanup + unset longstr +} -returnCodes error -result {invalid color} +test imgListFormat-6.4 {ParseColor: #XXX color, different forms} -setup { + image create photo photo1 +} -body { + photo1 put {{#A123 #334455} {#012 #fffefd#00}} + photo1 data -format {default -colorformat rgba} +} -cleanup { + imageCleanup +} -result {{#aa112233 #334455ff} {#001122ff #fffefd00}} +test imgListFormat-6.5 {ParseColor: list format} -setup { + image create photo photo1 +} -body { + photo1 put [list [list [list 255 255 255]]] + photo1 get 0 0 -withalpha +} -cleanup { + imageCleanup +} -result {255 255 255 255} +test imgListFormat-6.6 {ParseColor: string format} -setup { + image create photo photo1 +} -body { + photo1 put [list [list [list white]]] + photo1 get 0 0 -withalpha +} -cleanup { + imageCleanup +} -result {255 255 255 255} +test imgListFormat-6.7 {ParseColor: invalid color} -setup { + image create photo photo1 +} -body { + photo1 put {{blue red} {green bogus}} +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid color name "bogus"} +test imgListFormat-6.8 {ParseColor: overall test} -setup { + 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} #fee8 #fffafa80 snow}} + for {set y 0} {$y < 4} {incr y} { + for {set x 0} {$x < 5} {incr x} { + lappend result [photo1 get $x $y -withalpha] + } + } + 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}} + +# Note: these tests were written for an earlier implementation of +# ParseColorAsList. For this reason, their order and layout do not follow the +# current code very well. Test coverage is pretty good, nevertheless. +test imgListFormat-7.1 {ParseColorAsList: invalid list} -setup { + image create photo photo1 +} -body { + photo1 put {{{123 45 67 89} {123 45 " 67}}} + #" +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid color name "123 45 " 67"} +#" +test imgListFormat-7.2 {ParseColorAsList: too few elements in list} -setup { + image create photo photo1 +} -body { + photo1 put {{{0 255 0 255} {0 255}}} +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid color name "0 255"} +test imgListFormat-7.3 {ParseColorAsList: too many elements in list} -setup { + image create photo photo1 +} -body { + photo1 put {{{0 100 200 255} {0 100 200 255 0}}} +} -returnCodes error -result {invalid color name "0 100 200 255 0"} +test imgListFormat-7.4 {ParseColorAsList: not an integer value} -setup { + image create photo photo1 +} -body { + photo1 put {{{9 0xf3 87 65} {43 21 10 1.0}}} +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid color name "43 21 10 1.0"} +test imgListFormat-7.5 {ParseColorAsList: negative value in list} -setup { + image create photo photo1 +} -body { + photo1 put {{{121 121 121} {121 121 -1}}} +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid color name "121 121 -1"} +test imgListFormat-7.6 {ParseColorAsList: value in list too large} -setup { + image create photo photo1 +} -body { + photo1 put {{{0 1 2 3} {254 255 256}}} +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid color name "254 255 256"} +test imgListFormat-7.7 {ParseColorAsList: suffix not allowed} -setup { + image create photo photo1 +} -body { + photo1 put {{{100 100 100} {100 100 100#FE}}} +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid color name "100 100 100#FE"} +test imgListFormat-7.8 {ParseColorAsList: valid list form} -setup { + 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 -withalpha] [photo1 get 1 0 -withalpha] \ + [photo1 get 0 1 -withalpha] [photo1 get 1 1 -withalpha] +} -cleanup { + imageCleanup +} -result {{0 16 254 255} {0 100 254 255} {30 30 30 0} {1 1 254 1}} +test imgListFormat-7.9 {ParseColorAsList: additional spaces in list} -setup { + image create photo photo1 +} -body { + photo1 put { { { 1 2 3} {1 2 3} } { {1 2 3 } { 1 2 3 4 } } } + photo1 data -format {default -colorformat rgba} +} -cleanup { + imageCleanup +} -result {{#010203ff #010203ff} {#010203ff #01020304}} +test imgListFormat-7.10 {ParseColorAsList: list format, string rep} -setup { + image create photo photo1 +} -body { + photo1 put {{"111 222 33 44"}} + photo1 get 0 0 -withalpha +} -cleanup { + imageCleanup +} -result {111 222 33 44} + +test imgListFormat-8.1 {ParseColorAsHex: RGB format} -setup { + image create photo photo1 +} -body { + photo1 put {{#010 #001100}} + photo1 data +} -cleanup { + imageCleanup +} -result {{#001100 #001100}} +test imgListFormat-8.2 {ParseColorAsHex: invalid hex digit} -setup { + image create photo photo1 +} -body { + photo1 put {#ABCD #ABCZ} +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid color name "#ABCZ"} +test imgListFormat-8.3 {ParseColorAsHex: RGB with suffix, 8 chars} -setup { + image create photo photo1 +} -body { + photo1 put {{#FFfFFf #AbCdef#0}} + photo1 data +} -cleanup { + imageCleanup +} -result {{#ffffff #abcdef}} +test imgListFormat-8.4 {ParseColor: valid #RGBA color} -setup { + image create photo photo1 +} -body { + photo1 put {{#9bd5020d #7acF}} + list [photo1 get 0 0 -withalpha] [photo1 get 1 0 -withalpha] +} -cleanup { + imageCleanup +} -result {{155 213 2 13} {119 170 204 255}} + +test imgListFormat-9.1 {ParseColorAsStandard: + Tk color, valid suffixes} -setup { + image create photo photo1 + set result {} +} -body { + photo1 put {{blue@0.711 #114433#C} {#8D4#1A magenta}} + lappend result [photo1 get 0 0 -withalpha] + lappend result [photo1 get 1 0 -withalpha] + lappend result [photo1 get 0 1 -withalpha] + lappend result [photo1 get 1 1 -withalpha] + set result +} -cleanup { + unset result + imageCleanup +} -result {{0 0 255 181} {17 68 51 204} {136 221 68 26} {255 0 255 255}} +test imgListFormat-9.2 {ParseColorAsStandard: + Tk color with and w/o suffixes} -setup { + image create photo photo1 + set result {} +} -body { + photo1 put {{#52D8a0 #2B5} {#E47@0.01 maroon#4}} + lappend result [photo1 get 0 0 -withalpha] + lappend result [photo1 get 1 0 -withalpha] + lappend result [photo1 get 0 1 -withalpha] + lappend result [photo1 get 1 1 -withalpha] + set result +} -cleanup { + unset result + imageCleanup +} -result {{82 216 160 255} {34 187 85 255} {238 68 119 3} {128 0 0 68}} +test imgListFormat-9.3 {ParseColorAsStandard: wrong digit count} -setup { + image create photo photo1 +} -body { + photo1 put {{#000 #00}} +} -returnCodes error -result {invalid color name "#00"} +test imgListFormat-9.4 {ParseColorAsStandard: @A suffix, not a float} -setup { + image create photo photo1 +} -body { + photo1 put {{blue@0.5 blue@bogus}} +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {invalid alpha suffix "@bogus": expected floating-point value} +test imgListFormat-9.5 {ParseColorAsStandard: @A, value too low} -setup { + image create photo photo1 +} -body { + photo1 put {green@.1 green@-0.1} +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {invalid alpha suffix "@-0.1": value must be in the range from 0 to 1} +test imgListFormat-9.6 {ParseColorAsStandard: @A, value too high} -setup { + image create photo photo1 +} -body { + photo1 put {#000000@0 #000000@1.0001} +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {invalid alpha suffix "@1.0001": value must be in the range from 0 to 1} +test imgListFormat-9.7 {ParseColorAsStandard: @A suffix, 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 -withalpha] [photo1 get 1 0 -withalpha] \ + [photo1 get 2 0 -withalpha] [photo1 get 3 0 -withalpha] +} -cleanup { + imageCleanup +} -result {{255 255 0 0} {255 255 0 31} {255 255 0 32} {255 255 0 255}} +test imgListFormat-9.8 {ParseColorAsStandard: # suffix, no hex digits} -setup { + image create photo photo1 +} -body { + photo1 put {{black#f} {black#}} +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid alpha suffix "#"} +test imgListFormat-9.9 {ParseColorAsStandard: + '#' suffix, too many digits} -setup { + image create photo photo1 +} -body { + photo1 put {{#ABC#12 #ABC#123}} +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid alpha suffix "#123"} +test imgListFormat-9.10 {ParseColorAsStandard: + invalid digit in #X suffix} -setup { + image create photo photo1 +} -body { + photo1 put {#000#a #000#g} +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid alpha suffix "#g": expected hex digit} +test imgListFormat-9.11 {ParseColorAsStandard: + invalid digit in #XX suffix} -setup { + image create photo photo1 +} -body { + photo1 put {green#2 green#2W} +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid alpha suffix "#2W": expected hex digit} +test imgListFormat-9.12 {ParseColorAsStandard: + invalid color: not a hex digit} -setup { + image create photo photo1 +} -body { + photo1 put {#ABCDEF@.99 #ABCDEG@.99} +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid color name "#ABCDEG@.99"} +test imgListFormat-9.13 {ParseColorAsStandard: suffix not allowed #1} -setup { + image create photo photo1 +} -body { + photo1 put {#ABC@.5 #ABCD@0.5} +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid color name "#ABCD@0.5"} +test imgListFormat-9.14 {ParseColorAsStandard: suffix not allowed #2} -setup { + image create photo photo1 +} -body { + photo1 put {#1111 #1111#1} +} -cleanup { + imageCleanup +} -returnCodes error -result {invalid color name "#1111#1"} + + +# --------------------------------------------------------------------- + +imageFinish + +# cleanup +cleanupTests +return Index: tests/imgPhoto.test ================================================================== --- tests/imgPhoto.test +++ tests/imgPhoto.test @@ -7,19 +7,87 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2002-2008 Donal K. Fellows # All rights reserved. # # Author: Paul Mackerras (paulus@cs.anu.edu.au) + +# +# This file is somewhat caothic: the order of the tests does not +# really follow the order of the corresponding functions in +# tkImgPhoto.c. Probably, because early versions had only a few tests +# and over time test cases were added in bits and pieces. +# To be noted, also, that this file is not complete: large portions of +# code in tkImgPhoto.c have no test coverage. +# +# To help keeping the overview, the table below lists where to find +# tests for each of the functions in tkImgPhoto.c. The function are +# listed in the order as they appear in the source file. +# + +# +# Function name Tests for function +#-------------------------------------------------------------------------- +# PhotoFormatThreadExitProc no tests +# Tk_Create*PhotoImageFormat no tests +# ImgPhotoCreate imgPhoto-2.* +# ImgPhotoCmd imgPhoto-4.*, imgPhoto-17.* +# GetExtension: no tests +# ParseSubcommandOptions: imgPhoto-1.* +# ImgPhotoConfigureMaster: imgPhoto-3.*, imgPhoto-15.* +# toggleComplexAlphaIfNeeded: no tests +# ImgPhotoDelete: imgPhoto-8.* +# ImgPhotoCmdDeleteProc: imgPhoto-9.* +# ImgPhotoSetSize: no tests +# MatchFileFormat: imgPhoto-18.* +# MatchSringFormat: imgPhoto-19.* +# Tk_FindPhoto: imgPhoto-11.* +# Tk_PhotoPutBlock: imgPhoto-10.*, imgPhoto-16.* +# Tk_PhotoPutZoomedBlock: imgPhoto-12.* +# Tk_DitherPhoto: no tets +# Tk_PhotoBlank: no tests +# Tk_PhotoExpand: no tests +# Tk_PhotoGetSize: no tests +# Tk_PhotoSetSize: no tests +# TkGetPhotoValidRegion: no tests +# ImgGetPhoto: no tests +# Tk_PhotoGetImage no tests +# ImgPostscriptPhoto no tests +# Tk_PhotoPutBlock_NoComposite no tests, probably none needed +# Tk_PhotoPutZoomedBlock_NoComposite no tests, probably none needed +# Tk_PhotoExpand_Panic no tests, probably none needed +# Tk_PhotoPutBlock_Panic no tests, probably none needed +# Tk_PhotoPutZoomedBlock_Panic no tests, probably none needed +# Tk_PhotoSetSize_Panic no tests, probably none needed +#-------------------------------------------------------------------------- +# + +# +# Some tests are not specific to a function in tkImgPhoto.c. They are: +# + +# +# Test name(s) Description +#-------------------------------------------------------------------------- +# imgPhoto-5.* Do not really belong to this file. ImgPhotoGet and +# ImgPhotoFree are defined in tkImgPhInstance.c. +# imgPhoto-6.* Do not really belong to this file. ImgPhotoDisplay +# is defined in tkImgPhInstance.c. +# imgPhoto-7.* Do not really belong to this file. ImgPhotoFree is +# defined in tkImgPhInstance.c. +# imgPhoto-13.* Tests for separation in different interpreters +# imgPhoto-14.* Test GIF format. Would belong to imgGIF.test +# - which does not exist. +# package require tcltest 2.2 namespace import ::tcltest::* tcltest::configure {*}$argv tcltest::loadTestedCommands - -# Used for 4.65 - 4.73 tests -# Now for some heftier testing, checking that setting and resetting of pixels' -# transparency status doesn't "leak" with any one-off errors. + +# +# Used for imgPhoto-4.65 - imgPhoto-4.73 +# proc foreachPixel {img xVar yVar script} { upvar 1 $xVar x $yVar y set width [image width $img] set height [image height $img] for {set x 0} {$x<$width} {incr x} { @@ -56,11 +124,14 @@ } README-imgPhoto] # 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] + # ---------------------------------------------------------------------- test imgPhoto-1.1 {options for photo images} -body { image create photo photo1 -width 79 -height 83 list [photo1 cget -width] [photo1 cget -height] \ @@ -107,11 +178,27 @@ image create photo -data } -returnCodes error -result {value for "-data" missing} test imgPhoto-1.11 {options for photo images - error case} -body { image create photo photo1 -format } -returnCodes error -result {value for "-format" missing} - +test imgPhoto-1.12 {option -alpha, normal use} -setup { + image create photo photo1 +} -body { + photo1 put "white" -to 0 0 + photo1 transparency get 0 0 -alpha +} -cleanup { + imageCleanup +} -result {255} +test imgPhoto-1.13 {option -withalpha, normal use} -setup { + image create photo photo1 +} -body { + photo1 put {{blue green}} + photo1 get 1 0 -withalpha +} -cleanup { + imageCleanup +} -result {0 128 0 255} + test imgPhoto-2.1 {ImgPhotoCreate procedure} -setup { imageCleanup } -body { catch {image create photo -blah blah} imageNames @@ -130,11 +217,11 @@ # image create photo photo2 -width 10 -height 10 # catch {image create photo photo2 -file bogus.img} msg # photo1 copy photo2 # set msg # } {couldn't open "bogus.img": no such file or directory} - + test imgPhoto-3.1 {ImgPhotoConfigureMaster procedure} -constraints { hasTeapotPhoto } -body { image create photo photo1 -file $teapotPhotoFile photo1 configure -file $teapotPhotoFile @@ -166,11 +253,44 @@ list [image width photo1] [image height photo1] [.c bbox photo1.1] [.c bbox photo1.2] } -cleanup { destroy .c image delete photo1 } -result {256 256 {10 10 266 266} {300 10 556 266}} - +test imgPhoto-3.4 {ImgPhotoConfigureMaster: -data } -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 -file $teapotPhotoFile + image create photo photo2 +} -body { + photo2 configure -data [photo1 data -format ppm -from 100 100 120 120] + list [image width photo2] [image height photo2] +} -cleanup { + imageCleanup +} -result {20 20} +test imgPhoto-3.5 {ImgPhotoConfigureMaster: -data } -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 -file $teapotPhotoFile + image create photo photo2 +} -body { + photo2 configure -data [photo1 data -format png -from 120 120 140 140] + list [image width photo2] [image height photo2] +} -cleanup { + imageCleanup +} -result {20 20} +test imgPhoto-3.6 {ImgPhotoConfigureMaster: -data } -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 -file $teapotPhotoFile + image create photo photo2 +} -body { + photo2 configure -data [photo1 data -from 80 90 100 110] + list [image width photo2] [image height photo2] +} -cleanup { + imageCleanup +} -result {20 20} + test imgPhoto-4.1 {ImgPhotoCmd procedure} -setup { image create photo photo1 } -body { photo1 } -returnCodes error -cleanup { @@ -365,20 +485,23 @@ photo1 copy photo2 -from 0 0 10 10 -shrink lappend result [image width photo1] [image height photo1] } -cleanup { image delete photo1 photo2 } -result {256 256 49 51 49 51 49 51 10 51 10 10} +# tests for data: imgPhoto-4. test imgPhoto-4.22 {ImgPhotoCmd procedure: get option} -constraints { - hasTeapotPhoto + hasTranspTeapotPhoto } -setup { image create photo photo1 } -body { - photo1 read $teapotPhotoFile - list [photo1 get 100 100] [photo1 get 150 100] [photo1 get 100 150] + photo1 read $transpTeapotPhotoFile + list [photo1 get 100 100 -withalpha] \ + [photo1 get 150 100 -withalpha] \ + [photo1 get 100 150] [photo1 get 150 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} {0 0 0}} test imgPhoto-4.23 {ImgPhotoCmd procedure: get option} -setup { image create photo photo1 } -body { photo1 get 256 0 } -cleanup { @@ -392,14 +515,16 @@ image delete photo1 } -returnCodes error -result {photo1 get: coordinates out of range} test imgPhoto-4.25 {ImgPhotoCmd procedure: get option} -setup { image create photo photo1 } -body { - photo1 get + photo1 get 0 } -cleanup { image delete photo1 -} -returnCodes error -result {wrong # args: should be "photo1 get x y"} +} -returnCodes error -result \ + {wrong # args: should be "photo1 get x y ?-withalpha?"} +# more test for image get: 4.101-4.102 test imgPhoto-4.26 {ImgPhotoCmd procedure: put option} -setup { image create photo photo1 } -body { photo1 put } -returnCodes error -cleanup { @@ -409,26 +534,32 @@ image create photo photo1 } -body { 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 {couldn't recognize image data} test imgPhoto-4.28 {ImgPhotoCmd procedure: put option} -setup { image create photo photo1 } -body { photo1 put {{blahgle}} } -cleanup { image delete photo1 -} -returnCodes error -result {can't parse color "blahgle"} +} -returnCodes error -result {couldn't recognize image data} 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} +# more tests for image put: 4.90-4.100 test imgPhoto-4.30 {ImgPhotoCmd procedure: read option} -setup { image create photo photo1 } -body { photo1 read } -returnCodes error -cleanup { @@ -506,10 +637,11 @@ } -body { photo1 write teapot.tmp -format bogus } -cleanup { image delete photo1 } -returnCodes error -result {image file format "bogus" is unknown} +# more tests on "imageName write": imgPhoto-17.* test imgPhoto-4.40 {ImgPhotoCmd procedure: transparency option} -setup { image create photo photo1 } -body { photo1 transparency } -returnCodes error -cleanup { @@ -519,25 +651,25 @@ image create photo photo1 } -body { 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 0 -alpha } -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 { photo1 transparency get bogus 0 } -cleanup { @@ -593,38 +725,43 @@ photo1 blank photo1 transparency get 0 0 } -cleanup { image delete photo1 } -result 1 +# more tests for transparency get: 4.65, 4.66, 4.76-4.81 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 newVal ?-option?"} 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 newVal ?-option?"} 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 newVal ?-option?"} 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 0 0 -alpha } -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 newVal ?-option?"} test imgPhoto-4.56 {ImgPhotoCmd procedure: transparency set option} -setup { image create photo photo1 } -body { photo1 transparency set bogus 0 0 } -cleanup { @@ -637,10 +774,11 @@ } -cleanup { image delete photo1 } -returnCodes error -result {expected integer but got "bogus"} test imgPhoto-4.58 {ImgPhotoCmd procedure: transparency set option} -setup { image create photo photo1 + photo1 put blue } -body { photo1 transparency set 0 0 bogus } -cleanup { image delete photo1 } -returnCodes error -result {expected boolean value but got "bogus"} @@ -688,10 +826,11 @@ photo1 transparency set 0 0 true photo1 transparency get 0 0 } -cleanup { image delete photo1 } -result 1 +# more tests for transparency set: 4.67, 4.68, 4.82-4.89 # 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 { image create photo photo1 } -body { @@ -812,11 +951,415 @@ photo1 read -teapotPhotoFile } -cleanup { image delete photo1 file delete ./-teapotPhotoFile } -result {} - +test imgPhoto-4.76 {ImgPhotoCmd, transparancy get: too many options} -setup { + image create photo photo1 +} -body { + photo1 put white -to 0 0 1 1 + photo1 transparency get 0 0 -alpha -bogus +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {wrong # args: should be "photo1 transparency get x y ?-option?"} +test imgPhoto-4.77 {ImgPhotoCmd, transparency get: invalid option} -setup { + image create photo photo1 +} -body { + photo1 put white -to 0 0 1 1 + photo1 transparency get 0 0 -bogus +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {unrecognized option "-bogus": must be -alpha} +test imgPhoto-4.78 {ImgPhotoCmd, transparency get: normal use} -setup { + image create photo photo1 +} -body { + photo1 put white -to 0 0 1 1 + set result [photo1 transparency get 0 0] + lappend result [photo1 transparency get 0 0 -alpha] +} -cleanup { + imageCleanup +} -result {0 255} +test imgPhoto-4.79 {ImgPhotoCmd, transparency get: no option} -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.80: deleted (was transparency get: -boolean) +test imgPhoto-4.81 {ImgPhotoCmd, transparency get: -alpha} -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.82 {ImgPhotoCmd, transparency set: too many opts} -setup { + image create photo photo1 +} -body { + photo1 transparency set 0 0 -alpha -bogus 1 +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {wrong # args: should be "photo1 transparency set x y newVal ?-option?"} +test imgPhoto-4.83 {ImgPhotoCmd, transparency set: invalid opt} -setup { + image create photo photo1 -data black +} -body { + photo1 transparency set 0 0 0 -bogus +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {unrecognized option "-bogus": must be -alpha} +test imgPhoto-4.84 {ImgPhotoCmd, transparency set: invalid newVal} -setup { + image create photo photo1 -data white +} -body { + photo1 transparency set 0 0 bogus -alpha +} -cleanup { + imageCleanup +} -returnCodes error -result {expected integer but got "bogus"} +test imgPhoto-4.85 {ImgPhotoCmd, transparency set: invalid newVal} -setup { + image create photo photo1 -data red +} -body { + photo1 transparency set 0 0 -1 -alpha +} -returnCodes error -result \ + {invalid alpha value "-1": must be integer between 0 and 255} +test imgPhoto-4.86 {ImgPhotoCmd, transparency set: invalid newVal} -setup { + image create photo photo1 -data green +} -body { + photo1 transparency set 0 0 256 -alpha +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {invalid alpha value "256": must be integer between 0 and 255} +test imgPhoto-4.87 {ImgPhotoCmd, transparency set: no opt} -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} +# deleted: test imgPhoto-4.88 {ImgPhotoCmd, transparency set: -boolean} +test imgPhoto-4.89 {ImgPhotoCmd, transparency set: -alpha} -setup { + image create photo photo1 +} -body { + photo1 put white -to 0 0 2 2 + photo1 transparency set 0 0 0 -alpha + photo1 transparency set 1 0 1 -alpha + photo1 transparency set 0 1 254 -alpha + photo1 transparency set 1 1 255 -alpha + 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.90 {ImgPhotoCmd put: existing but not allowed opt} -setup { + image create photo photo1 +} -body { + photo1 put yellow -from 0 0 1 1 +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {unrecognized option "-from": must be -format, or -to} +test imgPhoto-4.91 {ImgPhotoCmd put: invalid option} -setup { + image create photo photo1 +} -body { + photo1 put {{0 1 2 3}} -bogus x +} -returnCodes error -result \ + {unrecognized option "-bogus": must be -format, or -to} +test imgPhoto-4.92 {ImgPhotocmd put: missing data} -setup { + image create photo photo1 +} -body { + photo1 put -to 0 0 +} -returnCodes error -result \ + {wrong # args: should be "photo1 put data ?-option value ...?"} +test imgPhoto-4.93 {ImgPhotoCmd put: data in ppm format} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 -file $teapotPhotoFile + image create photo photo2 +} -body { + 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.94 {ImgPhotoCmd put: unknown format} -setup { + image create photo photo1 +} -body { + photo1 put {no real data} -format bogus +} -cleanup { + imageCleanup +} -returnCodes error -result {image format "bogus" is not supported} +test imgPhoto-4.95 {ImgPhotoCmd put: default fmt, invalid data} -setup { + image create photo photo1 +} -body { + photo1 put {{red green blue} {red " blue}} + #" +} -cleanup { + imageCleanup +} -returnCodes error -result {couldn't recognize image data} +test imgPhoto-4.96 {ImgPhotoCmd put: "default" handler is selected} -setup { + image create photo photo1 + image create photo photo2 + set imgData {{{1 2 3 4} {5 6 7 8} {9 10 11 12}} + {{13 14 15 15} {17 18 19 20} {21 22 23 24}}} +} -body { + photo1 put $imgData + photo2 put $imgData -format default + set result {} + lappend result [list [image width photo1] [image height photo1]] + lappend result [list [image width photo2] [image height photo2]] + lappend result [string equal \ + [photo1 data -format "default -colorformat rgba"] \ + [photo2 data -format "default -colorformat rgba"]] + set result +} -cleanup { + imageCleanup + unset result + unset imgData +} -result {{3 2} {3 2} 1} +test imgPhoto-4.97 {ImgPhotoCmd put: image size} -setup { + image create photo photo1 +} -body { + photo1 put {{red green blue} {blue red green}} + list [image width photo1] [image height photo1] +} -cleanup { + imageCleanup +} -result {3 2} +test imgPhoto-4.98 {ImgPhotoCmd put: -to with 2 coords} -setup { + image create photo photo1 +} -body { + 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.99 {ImgPhotoCmd put: -to with 4 coords} -setup { + image create photo photo1 +} -body { + photo1 put {{#123 #456 #678} {#9AB #CDE #F01}} -to 1 2 20 21 + set result {} + lappend result [photo1 get 19 20 -withalpha] + 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.100 {ImgPhotoCmd put: no changes on empty data} -setup { + image create photo photo1 +} -body { + photo1 put {{brown blue} {cyan coral}} + set imgData [photo1 data] + photo1 put {} + string equal $imgData [photo1 data] +} -cleanup { + imageCleanup +} -result {1} +test imgPhoto-4.101 {ImgPhotoCmd get: too many args} -setup { + image create photo photo1 +} -body { + photo1 get 0 0 -withalpha bogus +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {wrong # args: should be "photo1 get x y ?-withalpha?"} +test imgPhoto-4.102 {ImgPhotoCmd get: invalid option} -setup { + image create photo photo1 +} -body { + photo1 get 0 0 -bogus +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {unrecognized option "-bogus": must be -withalpha} +test imgPhoto-4.103 {ImgPhotoCmd data: accepted opts} -setup { + image create photo photo1 -data black +} -body { + photo1 data -format default -from 0 0 -grayscale -background blue +} -cleanup { + imageCleanup +} -result {{#000000}} +test imgPhoto-4.104 {ImgPhotoCmd data: existing but not accepted opt} -setup { + image create photo photo1 +} -body { + photo1 data -to +} -cleanup { + imageCleanup +} -returnCodes error -result \ +{unrecognized option "-to": must be -background, -format, -from, or -grayscale} +test imgPhoto-4.105 {ImgPhotoCmd data: invalid option} -setup { + image create photo photo1 +} -body { + photo1 data -bogus +} -cleanup { + imageCleanup +} -returnCodes error -result \ +{unrecognized option "-bogus": must be -background, -format, -from, or -grayscale} +test imgPhoto-4.106 {ImgPhotoCmd data: extra arg before options} -setup { + image create photo photo1 +} -body { + photo1 data bogus -grayscale +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {wrong # args: should be "photo1 data ?-option value ...?"} +test imgPhoto-4.107 {ImgPhotoCmd data: extra arg after options} -setup { + image create photo photo1 +} -body { + photo1 data -format default bogus +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {wrong # args: should be "photo1 data ?-option value ...?"} +test imgPhoto-4.108 {ImgPhotoCmd data: invalid -from coords #1} -setup { + image create photo photo1 -data blue +} -body { + photo1 data -from 2 0 +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {coordinates for -from option extend outside image} +test imgPhoto-4.109 {ImgPhotoCmd data: invalid -from coords #2} -setup { + image create photo photo1 -data blue +} -body { + photo1 data -from 0 2 +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {coordinates for -from option extend outside image} +test imgPhoto-4.110 {ImgPhotoCmd data: invalid -from coords #3} -setup { + image create photo photo1 -data blue +} -body { + photo1 data -from 0 0 2 1 +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {coordinates for -from option extend outside image} +test imgPhoto-4.111 {ImgPhotoCmd data: invalid -from coords #4} -setup { + image create photo photo1 -data blue +} -body { + photo1 data -from 0 0 1 2 +} -cleanup { + imageCleanup +} -returnCodes error -result \ + {coordinates for -from option extend outside image} +test imgPhoto-4.112 {ImgPhotoCmd data: -from with 2 coords} -setup { + image create photo photo1 -data { + {black black black black black} + {white white white white white} + {green green green green green}} +} -body { + set imgData [photo1 data -from 2 1] + list [llength [lindex $imgData 0]] [llength $imgData] +} -cleanup { + imageCleanup + unset imgData +} -result {3 2} +test imgPhoto-4.113 {ImgPhotoCmd data: default is rgb format} -setup { + image create photo photo1 -data red +} -body { + photo1 data +} -cleanup { + imageCleanup +} -result {{#ff0000}} +test imgPhoto-4.114 {ImgPhotoCmd data: unknown format} -setup { + image create photo photo1 +} -body { + photo1 data -format bogus +} -cleanup { + imageCleanup +} -returnCodes error -result {image string format "bogus" is unknown} +test imgPhoto-4.115 {ImgPhotoCmd data: rgb colorformat} -setup { + image create photo photo1 -data {{red#a green#b} {blue#c white}} +} -body { + photo1 data -format {default -colorformat rgb} +} -result {{#ff0000 #008000} {#0000ff #ffffff}} +test imgPhoto-4.116 {ImgPhotoCmd data: rgba colorformat} -setup { + image create photo photo1 -data {{red green} {blue white}} +} -body { + photo1 data -format {default -colorformat rgba} +} -result {{#ff0000ff #008000ff} {#0000ffff #ffffffff}} +test imgPhoto-4.117 {ImgPhotoCmd data: list colorformat} -setup { + image create photo photo1 -data {{red#a green} {blue#c white#d}} +} -body { + photo1 data -format {default -colorformat list} +} -result {{{255 0 0 170} {0 128 0 255}} {{0 0 255 204} {255 255 255 221}}} +test imgPhoto-4.118 {ImgPhotoCmd data: using data for new image + results in same image as orignial } -constraints { + hasTeapotPhoto + hasTranspTeapotPhoto +} -setup { + image create photo teapot -file $teapotPhotoFile + teapot copy teapot -from 50 60 70 80 -shrink + image create photo teapotTransp -file $transpTeapotPhotoFile + teapotTransp copy teapotTransp -from 100 110 120 130 -shrink + image create photo photo1 +} -body { + set result {} + # We don't test gif here, as there seems to be a problem with + # data and gif format ("too many colors", probably a bug) + foreach fmt {ppm png {default -colorformat rgba} \ + {default -colorformat list}} { + set imgData [teapotTransp data -format $fmt] + photo1 blank + photo1 put $imgData + if { ! [string equal [photo1 data] [teapotTransp data]]} { + lappend result $fmt + } + } + set imgData [teapot data -format default] + photo1 blank + photo1 put $imgData + if { ! [string equal [photo1 data] [teapot data]]} { + lappend result default + } + set result +} -cleanup { + unset imgData + unset result + imageCleanup +} -result {} + test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} -constraints { hasTeapotPhoto } -setup { destroy .c pack [canvas .c] @@ -835,11 +1378,11 @@ update image delete photo1 } -cleanup { destroy .c } -result {} - + test imgPhoto-6.1 {ImgPhotoDisplay procedure, blank display} -setup { destroy .c pack [canvas .c] imageCleanup } -body { @@ -849,11 +1392,11 @@ update } -cleanup { destroy .c image delete photo1 } -result {} - + test imgPhoto-7.1 {ImgPhotoFree procedure, resource freeing} -constraints { hasTeapotPhoto } -setup { destroy .c pack [canvas .c] @@ -910,11 +1453,11 @@ .f.b2 configure -image {} update destroy .f image delete photo1 } -result {} - + test imgPhoto-8.1 {ImgPhotoDelete procedure} -constraints hasTeapotPhoto -body { image create photo photo2 -file $teapotPhotoFile image delete photo2 } -result {} test imgPhoto-8.2 {ImgPhotoDelete procedure} -constraints { @@ -934,19 +1477,19 @@ image delete photo2 photo1 copy photo2 } -returnCodes error -cleanup { imageCleanup } -result {image "photo2" doesn't exist or is not a photo image} - + test imgPhoto-9.1 {ImgPhotoCmdDeletedProc procedure} -constraints { hasTeapotPhoto } -body { image create photo photo2 -file $teapotPhotoFile rename photo2 {} list [lsearch -exact [imageNames] photo2] [catch {photo2 foo} msg] $msg } -result {-1 1 {invalid command name "photo2"}} - + test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} -setup { imageCleanup } -body { image create photo photo1 photo1 put "{#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000}" -to 0 0 @@ -989,21 +1532,20 @@ list [image width photo1] [image height photo1] } -cleanup { imageCleanup } -result {0 0} - test imgPhoto-11.1 {Tk_FindPhoto} -setup { imageCleanup } -body { image create bitmap i1 image create photo photo1 photo1 copy i1 } -cleanup { imageCleanup } -returnCodes error -result {image "i1" doesn't exist or is not a photo image} - + test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} -constraints hasTeapotPhoto -body { image create photo p3 -file $teapotPhotoFile set result [list [p3 get 50 50] [p3 get 100 100]] p3 copy p3 -zoom 2 lappend result [image width p3] [image height p3] [p3 get 100 100] @@ -1088,11 +1630,11 @@ x2 eval [list image create photo T1_data -data $data] } -cleanup { interp delete x1 interp delete x2 } -result T1_data - + test imgPhoto-14.1 {GIF writes work correctly} -setup { set data { R0lGODlhYwA5APcAAAAAAIAAAACAAICAAAAAgIAAgACAgICAgAysnGy8hKzM hASs3MTcjAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA @@ -1181,19 +1723,19 @@ set i [image create photo] $i configure -data $data } -cleanup { image delete $i } -returnCodes error -result {malformed image} - + test imgPhoto-15.1 {photo images can fail to allocate memory gracefully} -constraints { nonPortable } -body { # This is not portable to very large machines with more than around 3GB of # free memory available... image create photo -width 32000 -height 32000 } -returnCodes error -result {not enough free memory for image buffer} - + test imgPhoto-16.1 {copying to self doesn't access freed memory} -setup { set i [image create photo] } -body { # Bug 877950 makes this crash when trying to copy out of a deallocated # area. @@ -1200,11 +1742,11 @@ $i put red -to 0 0 1000 1000 $i copy $i -from 0 0 1000 1000 -to 500 0 } -cleanup { image delete $i } -result {} - + # Check that we can guess our supported output formats [Bug 2983824] test imgPhoto-17.1 {photo write: format guessing from filename} -setup { set i [image create photo -width 3 -height 3] } -body { set f [makeFile {} test.png] @@ -1239,10 +1781,113 @@ } -cleanup { catch {close $fd} image delete $i catch {removeFile $f} } -result "P6\n" +test imgPhoto-17.4 {photo write: default format not supported} -setup { + image create photo photo1 -data {{blue blue} {red red} {green green}} + set f [makeFile {} test.txt] +} -body { + photo1 write $f -format default +} -cleanup { + imageCleanup + catch {removeFile $f} + unset f +} -returnCodes error -result \ + {image file format "default" has no file writing capability} +test imgPhoto-17.5 {photo write: file with extension .default} -setup { + image create photo photo1 -data {{black}} + set f [makeFile {} test.default] +} -body { + photo1 write $f +} -cleanup { + imageCleanup + catch {removeFile $f} + unset f +} -returnCodes error -result \ + {image file format "default" has no file writing capability} + +test imgPhoto-18.1 {MatchFileFormat: "default" format not supported} -setup { + image create photo photo1 + set f [makeFile {} test.txt] +} -body { + photo1 read $f -format default +} -cleanup { + imageCleanup + catch {removeFile $f} + unset f +} -returnCodes error -result {-file option isn't supported for default images} + +test imgPhoto-19.1 {MatchStringFormat: with "-format default"} -setup { + image create photo photo1 +} -body { + photo1 put {{red blue red} {yellow green yellow}} -format default + list [image width photo1] [image height photo1] +} -cleanup { + imageCleanup +} -result {3 2} +test imgPhoto-19.2 {MatchStringFormat: without -format option, + default fmt} -body { + image create photo photo1 + photo1 put {{red} {green}} + list [image width photo1] [image height photo1] +} -cleanup { + imageCleanup +} -result {1 2} +test imgPhoto-19.3 {MatchStringFormat: "-format ppm"} -setup { + image create photo photo1 + image create photo photo2 + photo2 put {cyan cyan} + set imgData [photo2 data -format ppm] +} -body { + photo1 put $imgData -format ppm + list [image width photo1] [image height photo1] +} -cleanup { + unset imgData + imageCleanup +} -result {1 2} +test imgPhoto-19.4 {MatchStringFormat: ppm fmt, without opt} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 -file $teapotPhotoFile + image create photo photo2 +} -body { + set imgData [photo1 data -format ppm] + photo2 put $imgData + list [image width photo2] [image height photo2] +} -cleanup { + imageCleanup + unset imgData +} -result {256 256} +test imgPhoto-19.5 {MatchStirngFormat: unknown -format} -setup { + image create photo photo1 +} -body { + photo1 put {} -format bogus +} -cleanup { + imageCleanup +} -returnCodes error -result {image format "bogus" is not supported} +test imgPhoto-19.6 {MatchStringFormat: invalid data for default} -setup { + image create photo photo1 +} -body { + photo1 put bogus +} -cleanup { + imageCleanup +} -returnCodes error -result {couldn't recognize image data} +test imgPhoto-19.7 {MatchStringFormat: invalid data for default} -setup { + image create photo photo1 +} -body { + photo1 put bogus -format dEFault +} -cleanup { + imageCleanup +} -returnCodes error -result {couldn't recognize image data} +test imgPhoto-19.8 {MatchStirngFormat: invalid data for gif} -setup { + image create photo photo1 +} -body { + photo1 put bogus -format giF +} -cleanup { + imageCleanup +} -returnCodes error -result {couldn't recognize image data} # ---------------------------------------------------------------------- catch {rename foreachPixel {}} catch {rename checkImgTrans {}} ADDED tests/teapotTransparent.png Index: tests/teapotTransparent.png ================================================================== --- /dev/null +++ tests/teapotTransparent.png cannot compute difference between binary files Index: unix/Makefile.in ================================================================== --- unix/Makefile.in +++ unix/Makefile.in @@ -354,11 +354,11 @@ CANV_OBJS = tkCanvas.o tkCanvArc.o tkCanvBmap.o tkCanvImg.o \ tkCanvLine.o tkCanvPoly.o tkCanvPs.o tkCanvText.o \ tkCanvUtil.o tkCanvWind.o tkRectOval.o tkTrig.o IMAGE_OBJS = tkImage.o tkImgBmap.o tkImgGIF.o tkImgPNG.o tkImgPPM.o \ - tkImgPhoto.o tkImgPhInstance.o + tkImgPhoto.o tkImgPhInstance.o tkImgListFormat.o TEXT_OBJS = tkText.o tkTextBTree.o tkTextDisp.o tkTextImage.o tkTextIndex.o \ tkTextMark.o tkTextTag.o tkTextWind.o # either tkUnixFont.o (default) or tkUnixRFont.o (if --enable-xft) @@ -448,11 +448,11 @@ $(GENERIC_DIR)/tkCanvWind.c $(GENERIC_DIR)/tkRectOval.c \ $(GENERIC_DIR)/tkTrig.c $(GENERIC_DIR)/tkImage.c \ $(GENERIC_DIR)/tkImgBmap.c $(GENERIC_DIR)/tkImgGIF.c \ $(GENERIC_DIR)/tkImgPNG.c $(GENERIC_DIR)/tkImgPPM.c \ $(GENERIC_DIR)/tkImgPhoto.c $(GENERIC_DIR)/tkImgPhInstance.c \ - $(GENERIC_DIR)/tkText.c \ + $(GENERIC_DIR)/tkImgListFormat.c $(GENERIC_DIR)/tkText.c \ $(GENERIC_DIR)/tkTextBTree.c $(GENERIC_DIR)/tkTextDisp.c \ $(GENERIC_DIR)/tkTextImage.c \ $(GENERIC_DIR)/tkTextIndex.c $(GENERIC_DIR)/tkTextMark.c \ $(GENERIC_DIR)/tkTextTag.c $(GENERIC_DIR)/tkTextWind.c \ $(GENERIC_DIR)/tkOldConfig.c $(GENERIC_DIR)/tkOldTest.c \ @@ -1103,10 +1103,13 @@ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImage.c tkImgBmap.o: $(GENERIC_DIR)/tkImgBmap.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgBmap.c +tkImgListFormat.o: $(GENERIC_DIR)/tkImgListFormat.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgListFormat.c + tkImgGIF.o: $(GENERIC_DIR)/tkImgGIF.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgGIF.c tkImgPNG.o: $(GENERIC_DIR)/tkImgPNG.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPNG.c Index: win/Makefile.in ================================================================== --- win/Makefile.in +++ win/Makefile.in @@ -315,10 +315,11 @@ tkGet.$(OBJEXT) \ tkGrab.$(OBJEXT) \ tkGrid.$(OBJEXT) \ tkImage.$(OBJEXT) \ tkImgBmap.$(OBJEXT) \ + tkImgListFormat.$(OBJEXT) \ tkImgGIF.$(OBJEXT) \ tkImgPNG.$(OBJEXT) \ tkImgPPM.$(OBJEXT) \ tkImgPhoto.$(OBJEXT) \ tkImgPhInstance.$(OBJEXT) \ Index: win/makefile.vc ================================================================== --- win/makefile.vc +++ win/makefile.vc @@ -323,10 +323,11 @@ $(TMP_DIR)\tkGet.obj \ $(TMP_DIR)\tkGrab.obj \ $(TMP_DIR)\tkGrid.obj \ $(TMP_DIR)\tkImage.obj \ $(TMP_DIR)\tkImgBmap.obj \ + $(TMP_DIR)\tkImgListFormat.obj \ $(TMP_DIR)\tkImgGIF.obj \ $(TMP_DIR)\tkImgPNG.obj \ $(TMP_DIR)\tkImgPPM.obj \ $(TMP_DIR)\tkImgPhoto.obj \ $(TMP_DIR)\tkImgPhInstance.obj \