Tk Source Code

\fBimage create photo \fR?\fIname\fR? ?\fIoptions\fR?

\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
there is an image file format handler that can read data.
.TP

is set, the old contents of the destination image are discarded and
the source image is used as-is.  The default compositing rule is
\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
\fB\-format\fR {\fIformat-name\fR ?\fIoption value ...\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
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
format (see \fBIMAGE FORMATS\fR below).
channel, \fIgg\fR for green, and \fIbb\fR for blue).
.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
extends from \fI(x1,y1)\fR to the bottom-right corner of
\fIimageName\fR.  If all four coordinates are given, they specify
diagonally opposite corners of the rectangular region, including x1,y1
and excluding x2,y2.  The default, if this option is not given, is the
whole image.
.TP
\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.
.VS 8.7
This command first searches the list of image file format handlers for
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
See \fBIMAGE FORMATS\fR below for details on formats for image data.
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
.VE 8.7
\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:
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. If the region specified with this opion
is smaller than the supplied \fIdata\fR, the exceeding data is silently
entire destination rectangle.  Note that if \fIdata\fR specifies a
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?
.
Reads image data from the file named \fIfilename\fR into the image.
This command first searches the list of
image file format handlers for a handler that can interpret the data
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
specified, the region extends from (\fIx1,y1\fR) to the bottom-right
corner of the image in the image file.  If all four coordinates are

displayed.
.TP
\fIimageName \fBtransparency \fIsubcommand \fR?\fIarg arg ...\fR?
.
Allows examination and manipulation of the transparency information in
the photo image.  Several subcommands are available:
.RS
.VS 8.7
.TP
\fIimageName \fBtransparency get \fIx y\fR
\fIimageName \fBtransparency get \fIx y\fR ?\fB-alpha\fR?
.
Returns a boolean indicating if the pixel at (\fIx\fR,\fIy\fR) is
transparent.
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 boolean\fR
\fIimageName \fBtransparency set \fIx y\fR \fInewVal\fR ?\fB-alpha\fR?
.
Makes the pixel at (\fIx\fR,\fIy\fR) transparent if \fIboolean\fR is
true, and makes that pixel opaque otherwise.
Change the transparency of the pixel at (\fIx\fR,\fIy\fR) 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.
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
\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 and, optionally, options to pass to the
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.
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
extends from \fI(x1,y1)\fR to the bottom-right corner of
\fIimageName\fR.  If all four coordinates are given, they specify

.SH "IMAGE FORMATS"
.PP
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, 
.VS 8.7
as well as the \fBdefault\fR handler to encode/decode image
data in a human readable form. 
.VE 8.7
formats, which are automatically registered on initialization.
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
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
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
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
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
.
The option has effect when reading image data from a file. When
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.
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
.
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.
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
the colors that are available.  The colors are allocated as a color
cube, that is, the number of colors allocated is the product of the

.CS
\fBimage create photo\fR icon \-file "icon.png"
\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:

/*
 * 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 ([email protected]),
 *              Department of Computer Science,
 *              Australian National University.
 *
 *      Simon Bachmann ([email protected])
 */


#include "tkImgPhoto.h"

/*
 * Message to generate when an attempt to allocate memory for an image fails.
 */

#define TK_PHOTO_ALLOC_FAILURE_MESSAGE \
        "not enough free memory for image buffer"


/*
 * Color name length limit: do not attempt to parse as color strings that are
 * longer than this limit
 */

#define TK_PHOTO_MAX_COLOR_CHARS 99

/*
 * Symbols for the different formats of a color string.
 */

enum ColorFormatType {
    COLORFORMAT_TKCOLOR,
    COLORFORMAT_EMPTYSTRING,
    COLORFORMAT_LIST,
    COLORFORMAT_RGB1,
    COLORFORMAT_RGB2,
    COLORFORMAT_RGBA1,
    COLORFORMAT_RGBA2
};

/*
 * Names for the color format types above.
 * Order must match the one in enum ColorFormatType
 */

static const char *const colorFormatNames[] = {
    "tkcolor",
    "emptystring",
    "list",
    "rgb-short",
    "rgb",
    "rgba-short",
    "rgba",
    NULL
};

/*
 * The following data structure is used to return information from
 * ParseFormatOptions:
 */

struct FormatOptions {
    int options;         /* Individual bits indicate which options were
                          * specified - see below. */
    Tcl_Obj *formatName; /* Name specified without an option. */
    enum ColorFormatType colorFormat;
                         /* The color format type given with the
                          * -colorformat option */
};
    
/*
 * Bit definitions for use with ParseFormatOptions: each bit is set in the
 * allowedOptions parameter on a call to ParseFormatOptions if that option
 * is allowed for the current photo image subcommand. On return, the bit is
 * set in the options field of the FormatOptions structure if that option
 * was specified.
 *
 * OPT_COLORFORMAT:         Set if -alpha option allowed/specified.
 */

#define OPT_COLORFORMAT     1

/*
 * List of format option names. The order here must match the order of
 * declarations of the FMT_OPT_* constants above.
 */

static const char *const formatOptionNames[] = {
    "-colorformat",
    NULL
};

/*
 * Forward declarations
 */

static int      ParseFormatOptions(Tcl_Interp *interp, int allowedOptions,
                    int objc, Tcl_Obj *const objv[], int *indexPtr,
                    struct FormatOptions *optPtr);
static Tcl_Obj  *GetBadOptMsg(const char *badValue, int allowedOpts);
static int      StringMatchDef(Tcl_Obj *data, Tcl_Obj *formatString,
                    int *widthPtr, int *heightPtr, Tcl_Interp *interp);
static int      StringReadDef(Tcl_Interp *interp, Tcl_Obj *data,
                    Tcl_Obj *formatString, Tk_PhotoHandle imageHandle,
                    int destX, int destY, int width, int height,
                    int srcX, int srcY);
static int      StringWriteDef(Tcl_Interp *interp,
                    Tcl_Obj *formatString,
                    Tk_PhotoImageBlock *blockPtr);
static int      ParseColor(Tcl_Interp *interp, Tcl_Obj *specObj,
                    Display *display, Colormap colormap, unsigned char *redPtr,
                    unsigned char *greenPtr, unsigned char *bluePtr,
                    unsigned char *alphaPtr);
static int      ParseColorAsList(Tcl_Interp *interp, const char *colorString,
                    int colorStrLen, unsigned char *redPtr,
                    unsigned char *greenPtr, unsigned char *bluePtr,
                    unsigned char *alphaPtr);
static int      ParseColorAsHex(Tcl_Interp *interp, const char *colorString,
                    int colorStrLen, Display *display, Colormap colormap,
                    unsigned char *redPtr, unsigned char *greenPtr,
                    unsigned char *bluePtr, unsigned char *alphaPtr);
static int      ParseColorAsStandard(Tcl_Interp *interp,
                    const char *colorString, int colorStrLen,
                    Display *display, Colormap colormap,
                    unsigned char *redPtr, unsigned char *greenPtr,
                    unsigned char *bluePtr, unsigned char *alphaPtr);

/*
 * The format record for the default image handler
 */

Tk_PhotoImageFormat tkImgFmtDefault = {
    "default",      /* name */
    NULL,           /* fileMatchProc: format doesn't support file ops */
    StringMatchDef, /* stringMatchProc */
    NULL,           /* fileReadProc: format doesn't support file read */
    StringReadDef,  /* stringReadProc */
    NULL,           /* fileWriteProc: format doesn't support file write */
    StringWriteDef  /* stringWriteProc */
};

/*
 *----------------------------------------------------------------------
 *
 * ParseFormatOptions --
 *
 *      Parse the options passed to the image format handler.
 *
 * Results:
 *      On success, the structure pointed to by optPtr is filled with the
 *      values passed or with the defaults and TCL_OK returned.
 *      If an error occurs, leaves an error message in interp and returns 
 *      TCL_ERROR.
 *
 * Side effects: 
 *      The value in *indexPtr is updated to the index of the fist
 *      element in argv[] that does not look like an option/value, or to 
 *      argc if parsing reached the end of argv[].
 *
 *----------------------------------------------------------------------
 */
static int
ParseFormatOptions(
    Tcl_Interp *interp,               /* For error messages */
    int allowedOptions,               /* Bitfield specifying which options are
                                       * to be considered allowed */
    int objc,                         /* Number of elements in argv[] */
    Tcl_Obj *const objv[],            /* The arguments to parse */
    int *indexPtr,                    /* Index giving the first element to 
                                       * parse. The value is updated to the
                                       * index where parsing ended */
    struct FormatOptions *optPtr)     /* Parsed option values are written to
                                       * this struct */
   
{
    int index, optIndex, typeIndex, first;
    const char *option;

    first = 1;

    /*
     * Fill in default values
     */
    optPtr->options = 0;
    optPtr->formatName = NULL;
    optPtr->colorFormat = COLORFORMAT_RGB2;
    for (index = *indexPtr; index < objc; *indexPtr = ++index) {
        int optionExists;

        /*
         * The first value can be the format handler's name. It goes to
         * optPtr->name.
         */
        option = Tcl_GetString(objv[index]);
        if (option[0] != '-') {
            if (first) {
                optPtr->formatName = objv[index];
                first = 0;
                continue;
            } else {
                break;
            }
        }
        first = 0;
        
        /* 
         * Check if option is known and allowed
         */
        
        optionExists = 1;
        if (Tcl_GetIndexFromObj(NULL, objv[index], formatOptionNames,
                "format option", 0, &optIndex) != TCL_OK) {
            optionExists = 0;
        }
        if (!optionExists || !((1 << optIndex) & allowedOptions)) {
            Tcl_SetObjResult(interp, GetBadOptMsg(Tcl_GetString(objv[index]),
                    allowedOptions));
            Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL);
            return TCL_ERROR;
        }

        /*
         * Option-specific checks
         */
        
        switch (1 << optIndex) {
        case OPT_COLORFORMAT:
            *indexPtr = ++index;
            if (index >= objc) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf("the \"%s\" option "
                        "requires a value", Tcl_GetString(objv[index - 1])));
                Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
                        "MISSING_VALUE", NULL);
                return TCL_ERROR;
            }
            if (Tcl_GetIndexFromObj(NULL, objv[index], colorFormatNames, "",
                    TCL_EXACT, &typeIndex) != TCL_OK
                    || (typeIndex != COLORFORMAT_LIST
                    && typeIndex != COLORFORMAT_RGB2
                    && typeIndex != COLORFORMAT_RGBA2) ) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad color format "
                        "\"%s\": must be rgb, rgba, or list",
                        Tcl_GetString(objv[index])));
                Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
                        "BAD_COLOR_FORMAT", NULL);
                return TCL_ERROR;
            }
            optPtr->colorFormat = typeIndex;
            break;
        default:
            Tcl_Panic("ParseFormatOptions: unexpected switch fallthrough");
        }

        /*
         * Add option to bitfield in optPtr
         */
        optPtr->options |= (1 << optIndex);
    }
    
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 *  GetBadOptMsg --
 *
 *      Build a Tcl_Obj containing an error message in the form "bad option
 *      "xx": must be y, or z", based on the bits set in allowedOpts.
 *
 * Results:
 *      A Tcl Object containig the error message. 
 *
 * Side effects:
 *      None
 *----------------------------------------------------------------------
 */
static Tcl_Obj *
GetBadOptMsg(
    const char *badValue,   /* the erroneous option */
    int allowedOpts)        /* bitfield specifying the allowed options */
{
    int i, bit;
    Tcl_Obj *resObj = Tcl_ObjPrintf("bad format option \"%s\": ", badValue);

    if (allowedOpts == 0) {
        Tcl_AppendToObj(resObj, "no options allowed", -1);
    } else {
        Tcl_AppendToObj(resObj, "must be ", -1);
        bit = 1;
        for (i = 0; formatOptionNames[i] != NULL; i++) {
            if (allowedOpts & bit) {
                if (allowedOpts & (bit -1)) {
                    /* 
                     * not the first option
                     */
                    if (allowedOpts & ~((bit << 1) - 1)) {
                        /*
                         * not the last option
                         */
                        Tcl_AppendToObj(resObj, ", ", -1);
                    } else {
                        Tcl_AppendToObj(resObj, ", or ", -1);
                    }
                }
                Tcl_AppendToObj(resObj, formatOptionNames[i], -1);
            }
            bit <<=1;
        }
    }
    return resObj;
}

/*
 *----------------------------------------------------------------------
 *
 * StringMatchDef --
 *
 *      Default string match function. Test if image data in string form 
 *      appears to be in the default list-of-list-of-pixel-data format
 *      accepted by the "<img> put" command.
 *
 * Results:
 *      If thte data is in the default format, writes the size of the image 
 *      to widthPtr and heightPtr and returns 1. Otherwise, leaves an error 
 *      message in interp (if not NULL) and returns 0.
 *      Note that this function does not parse all data points. A return 
 *      value of 1 does not guarantee that the data can be read without 
 *      errors.
 *
 * Side effects:
 *      None
 *----------------------------------------------------------------------
 */
static int
StringMatchDef(
    Tcl_Obj *data,          /* The data to check */
    Tcl_Obj *formatString,  /* Value of the -format option, not used here */
    int *widthPtr,          /* Width of image is written to this location */
    int *heightPtr,         /* Height of image is written to this location */
    Tcl_Interp *interp)     /* Error messages are left in this interpreter */
{
    int y, rowCount, colCount, curColCount;
    unsigned char dummy;
    Tcl_Obj **rowListPtr, *pixelData;

    /*
     * See if data can be parsed as a list, if every element is itself a valid
     * list and all sublists have the same length.
     */

    if (Tcl_ListObjGetElements(interp, data, &rowCount, &rowListPtr)
            != TCL_OK) {
        return 0;
    }
    if (rowCount == 0) {
        /* 
         * empty list is valid data 
         */
        
        *widthPtr = 0; 
        *heightPtr = 0;
        return 1;
    }
    colCount = -1;
    for (y = 0; y < rowCount; y++) {
        if (Tcl_ListObjLength(interp, rowListPtr[y], &curColCount) != TCL_OK) {
            return 0;
        }
        if (colCount < 0) {
            colCount = curColCount;
        } else if (curColCount != colCount) {
            if (interp != NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid row # %d: "
                        "all rows must have the same number of elements", y));
                Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
                        "INVALID_DATA", NULL);
            }
            return 0;
        }
    }

    /*
     * Data in base64 encoding (or even binary data), might actually pass
     * these tests. To avoid parsing it as list of lists format, check one
     * pixel for validity.
     */
    if (Tcl_ListObjIndex(interp, rowListPtr[0], 0, &pixelData) != TCL_OK) {
        return 0;
    }
    if (Tcl_GetCharLength(pixelData) > TK_PHOTO_MAX_COLOR_CHARS) {
        return 0;
    }
    if (ParseColor(interp, pixelData, Tk_Display(Tk_MainWindow(interp)),
            Tk_Colormap(Tk_MainWindow(interp)), &dummy, &dummy, &dummy, &dummy)
            != TCL_OK) {
        return 0;
    }

    /*
     * Looks like we have valid data for this format.
     * We do not check any pixel values - that's the job of ImgStringRead()
     */
    
    *widthPtr = colCount;
    *heightPtr = rowCount;
    
    return 1;
    
}
 
/*
 *----------------------------------------------------------------------
 *
 * StringReadDef --
 *
 *      String read function for default format. (see manpage for details on
 *      the format).
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      If the data has valid format, write it to the image identified by 
 *      imageHandle.
 *      If the image data cannot be parsed, an error message is left in 
 *      interp.
 *
 *----------------------------------------------------------------------
*/

static int
StringReadDef(
    Tcl_Interp *interp,         /* leave error messages here */
    Tcl_Obj *data,              /* the data to parse */
    Tcl_Obj *formatString,      /* value of the -format option */
    Tk_PhotoHandle imageHandle, /* write data to this image */
    int destX, int destY,       /* start writing data at this point
                                 * in destination image*/
    int width, int height,      /* dimensions of area to write to */
    int srcX, int srcY)         /* start reading source data at these
                                 * coordinates */ 
{
    Tcl_Obj **rowListPtr, **colListPtr;
    Tcl_Obj **objv;
    int objc;
    unsigned char *curPixelPtr;
    int x, y, rowCount, colCount, curColCount;
    Tk_PhotoImageBlock srcBlock;
    Display *display;
    Colormap colormap;
    struct FormatOptions opts;
    int optIndex;
    
    /*
     * Parse format suboptions 
     * We don't use any format suboptions, but we still need to provide useful
     * error messages if suboptions were specified.
     */

    memset(&opts, 0, sizeof(opts));
    if (formatString != NULL) {
        if (Tcl_ListObjGetElements(interp, formatString, &objc, &objv)
                != TCL_OK) {
            return TCL_ERROR;
        }
        optIndex = 0;
        if (ParseFormatOptions(interp, 0, objc, objv, &optIndex, &opts)
                != TCL_OK) {
            return TCL_ERROR;
        }
        if (optIndex < objc) {
            Tcl_SetObjResult(interp,
                    GetBadOptMsg(Tcl_GetString(objv[optIndex]), 0));
            Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL);
            return TCL_ERROR;
        }
    }

    /*
     * Check input data
     */

    if (Tcl_ListObjGetElements(interp, data, &rowCount, &rowListPtr)
            != TCL_OK ) {
        return TCL_ERROR;
    }
    if ( rowCount > 0 && Tcl_ListObjLength(interp, rowListPtr[0], &colCount)
            != TCL_OK) {
        return TCL_ERROR;
    }
    if (width <= 0 || height <= 0 || 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; row<blockPtr->height; row++) {
            pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0]
                    + row * blockPtr->pitch;
            Tcl_DStringInit(&line);
            for (col=0; col<blockPtr->width; col++) {
                if (hasAlpha) {
                    alphaVal = pixelPtr[alphaOffset];
                }

                /*
                 * We don't build lines as a list for #RGBA and #RGB. Since 
                 * these color formats look like comments, the first element
                 * of the list would get quoted with an additional {} . 
                 * While this is not a problem if the data is used as
                 * a list, it would cause problems if someone decides to parse
                 * it as a string (and it looks kinda strange)
                 */

                switch (opts.colorFormat) {
                case COLORFORMAT_RGB2:
                    sprintf(colorBuf, "#%02x%02x%02x ",  pixelPtr[0],
                            pixelPtr[greenOffset], pixelPtr[blueOffset]);
                    Tcl_DStringAppend(&line, colorBuf, -1);
                    break;
                case COLORFORMAT_RGBA2:
                    sprintf(colorBuf, "#%02x%02x%02x%02x ",
                            pixelPtr[0], pixelPtr[greenOffset],
                            pixelPtr[blueOffset], alphaVal);
                    Tcl_DStringAppend(&line, colorBuf, -1);
                    break;
                case COLORFORMAT_LIST:
                    Tcl_DStringStartSublist(&line);
                    sprintf(colorBuf, "%d", pixelPtr[0]);
                    Tcl_DStringAppendElement(&line, colorBuf);
                    sprintf(colorBuf, "%d", pixelPtr[greenOffset]);
                    Tcl_DStringAppendElement(&line, colorBuf);
                    sprintf(colorBuf, "%d", pixelPtr[blueOffset]);
                    Tcl_DStringAppendElement(&line, colorBuf);
                    sprintf(colorBuf, "%d", alphaVal);
                    Tcl_DStringAppendElement(&line, colorBuf);
                    Tcl_DStringEndSublist(&line);
                    break;
                default:
                    Tcl_Panic("unexpected switch fallthrough");
                }
                pixelPtr += blockPtr->pixelSize;
            }
            if (opts.colorFormat != COLORFORMAT_LIST) {
                /*
                 * For the #XXX formats, we need to remove the last
                 * whitespace.
                 */
                
                *(Tcl_DStringValue(&line) + Tcl_DStringLength(&line) - 1)
                        = '\0';
            }
            Tcl_DStringAppendElement(&data, Tcl_DStringValue(&line));
            Tcl_DStringFree(&line);
        }
        result = Tcl_NewStringObj(Tcl_DStringValue(&data), -1);
        Tcl_DStringFree(&data);
    } else {
        result = Tcl_NewObj();
    }
    
    Tcl_SetObjResult(interp, result);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseColor --
 *
 *      This function extracts color and alpha values from a string. It 
 *      understands standard Tk color formats, alpha suffixes and the color 
 *      formats specific to photo images, which include alpha data.
 *
 * Results:
 *      On success, writes red, green, blue and alpha values to the 
 *      corresponding pointers. If the color spec contains no alpha 
 *      information, 255 is taken as transparency value. 
 *      If the input cannot be parsed, leaves an error message in 
 *      interp. Returns a standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int
ParseColor(
    Tcl_Interp *interp,         /* error messages go there */
    Tcl_Obj *specObj,           /* the color data to parse */
    Display *display,           /* display of main window, needed to parse
                                 * standard Tk colors */
    Colormap colormap,          /* colormap of current display */ 
    unsigned char *redPtr,      /* the result is written to these pointers */
    unsigned char *greenPtr,
    unsigned char *bluePtr,
    unsigned char *alphaPtr)
{
    const char *specString;
    int charCount;
    
    /*
     * Find out which color format we have
     */
    
    specString = Tcl_GetStringFromObj(specObj, &charCount);
    
    if (charCount == 0) {
        /* Empty string */
        *redPtr = *greenPtr = *bluePtr = *alphaPtr = 0;
        return TCL_OK;
    }
    if (charCount > TK_PHOTO_MAX_COLOR_CHARS) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid color"));
        Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
                "INVALID_COLOR", NULL);
        return TCL_ERROR;
    }
    if (specString[0] == '#') {
        return ParseColorAsHex(interp, specString, charCount, display,
                colormap, redPtr, greenPtr, bluePtr, alphaPtr);
    }
    if (ParseColorAsList(interp, specString, charCount,
            redPtr, greenPtr, bluePtr, alphaPtr) == TCL_OK) {
        return TCL_OK;
    }

    /*
     * Parsing the color as standard Tk color always is the last option tried
     * because TkParseColor() is very slow with values it cannot parse.
     */
    
    Tcl_ResetResult(interp);
    return ParseColorAsStandard(interp, specString, charCount, display,
            colormap, redPtr, greenPtr, bluePtr, alphaPtr);

}

/*
 *----------------------------------------------------------------------
 *
 * ParseColorAsList --
 *
 *      This function extracts color and alpha values from a list of 3 or 4
 *      integers (the list color format).
 *
 * Results:
 *      On success, writes red, green, blue and alpha values to the 
 *      corresponding pointers. If the color spec contains no alpha 
 *      information, 255 is taken as transparency value. 
 *      Returns a standard Tcl result.
 *
 * Side effects:
 *      Does *not* leave error messages in interp. The reason is that
 *      it is not always possible to tell if the list format was even
 *      intended and thus it is hard to return meaningful messages.
 *      A general error message from the caller is probably the best 
 *      alternative.
 *
 *----------------------------------------------------------------------
 */
static int
ParseColorAsList(
    Tcl_Interp *interp,         /* not used */
    const char *colorString,    /* the color data to parse */
    int colorStrLen,            /* length of the color string */
    unsigned char *redPtr,      /* the result is written to these pointers */
    unsigned char *greenPtr,
    unsigned char *bluePtr,
    unsigned char *alphaPtr)
{
    
    /* 
     * This is kinda ugly. The code would be certainly nicer if it
     * used Tcl_ListObjGetElements() and Tcl_GetIntFromObj(). But with
     * strtol() it's *much* faster.
     */

    const char *curPos;
    int values[4];
    int i;

    curPos = colorString;
    i = 0;

    /*
     * strtol can give false positives with a sequence of space chars.
     * To avoid that, avance the pointer to the next non-blank char.
     */

    while(isspace(*curPos)) {
        ++curPos;
    }
    while (i < 4 && *curPos != '\0') {
        values[i] = strtol(curPos, (char **)&curPos, 0);
        if (values[i] < 0 || values[i] > 255) {
            return TCL_ERROR;
        }
        while(isspace(*curPos)) {
            ++curPos;
        }
        ++i;
    }

    if (i < 3 || *curPos != '\0') {
        return TCL_ERROR;
    }
    if (i < 4) {
        values[3] = 255;
    }
    
    *redPtr = (unsigned char) values[0];
    *greenPtr = (unsigned char) values[1];
    *bluePtr = (unsigned char) values[2];
    *alphaPtr = (unsigned char) values[3];
    
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseColorAsHex --
 *
 *      This function extracts color and alpha values from a string
 *      starting with '#', followed by hex digits. It undestands both
 *      the #RGBA form and the #RBG (with optional suffix)
 *
 * Results:
 *      On success, writes red, green, blue and alpha values to the 
 *      corresponding pointers. If the color spec contains no alpha 
 *      information, 255 is taken as transparency value. 
 *      Returns a standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int
ParseColorAsHex(
    Tcl_Interp *interp,         /* error messages are left here */
    const char *colorString,    /* the color data to parse */
    int colorStrLen,            /* length of the color string */
    Display *display,           /* display of main window */
    Colormap colormap,          /* colormap of current display */
    unsigned char *redPtr,      /* the result is written to these pointers */
    unsigned char *greenPtr,
    unsigned char *bluePtr,
    unsigned char *alphaPtr)
{
    int i;
    unsigned long int colorValue = 0;
        
    if (colorStrLen - 1 != 4 && colorStrLen - 1 != 8) {
        return ParseColorAsStandard(interp, colorString, colorStrLen,
                display, colormap, redPtr, greenPtr, bluePtr, alphaPtr);
    }
    for (i = 1; i < colorStrLen; i++) {
        if (!isxdigit(UCHAR(colorString[i]))) {
            /*
             * There still is a chance that this is a Tk color with
             * an alpha suffix
             */
            
            return ParseColorAsStandard(interp, colorString, colorStrLen,
                    display, colormap, redPtr, greenPtr, bluePtr, alphaPtr);
        }
    }
    
    colorValue = strtoul(colorString + 1, NULL, 16);
    switch (colorStrLen - 1) {
    case 4:
        /* #RGBA format */
        *redPtr = (unsigned char) ((colorValue >> 12) * 0x11);
        *greenPtr = (unsigned char) (((colorValue >> 8) & 0xf) * 0x11);
        *bluePtr = (unsigned char) (((colorValue >> 4) & 0xf) * 0x11);
        *alphaPtr = (unsigned char) ((colorValue & 0xf) * 0x11);
        return TCL_OK;
    case 8:
        /* #RRGGBBAA format */
        *redPtr = (unsigned char) (colorValue >> 24);
        *greenPtr = (unsigned char) ((colorValue >> 16) & 0xff);
        *bluePtr = (unsigned char) ((colorValue >> 8) & 0xff);
        *alphaPtr = (unsigned char) (colorValue & 0xff);
        return TCL_OK;
    default:
        Tcl_Panic("unexpected switch fallthrough");
    }

    /* Shouldn't get here */
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseColorAsStandard --
 *
 *      This function tries to split a color stirng in a color and a
 *      suffix part and to extract color and alpha values from them. The
 *      color part is treated as regular Tk color.
 *
 * Results:
 *      On success, writes red, green, blue and alpha values to the 
 *      corresponding pointers. If the color spec contains no alpha 
 *      information, 255 is taken as transparency value. 
 *      Returns a standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int
ParseColorAsStandard(
    Tcl_Interp *interp,         /* error messages are left here */
    const char *specString,    /* the color data to parse */
    int specStrLen,            /* length of the color string */
    Display *display,           /* display of main window */
    Colormap colormap,          /* colormap of current display */
    unsigned char *redPtr,      /* the result is written to these pointers */
    unsigned char *greenPtr,
    unsigned char *bluePtr,
    unsigned char *alphaPtr)
{
    XColor parsedColor;
    const char *suffixString, *colorString;
    char colorBuffer[TK_PHOTO_MAX_COLOR_CHARS + 1];
    char *tmpString;
    double fracAlpha;
    unsigned int suffixAlpha;
    int i;
        
    /*
     * Split color data string in color and suffix parts
     */
 
    if ((suffixString = strrchr(specString, '@')) == NULL
            && ((suffixString = strrchr(specString, '#')) == NULL
                    || suffixString == specString)) {
        suffixString = specString + specStrLen;
        colorString = specString;
    } else {
        strncpy(colorBuffer, specString, suffixString - specString);
        colorBuffer[suffixString - specString] = '\0';
        colorString = (const char*)colorBuffer;
    }

    /*
     * Try to parse as standard Tk color.
     * 
     * We don't use Tk_GetColor() et al. here, as those functions
     * migth return a color that does not exaxtly match the given name
     * if the colormap is full. Also, we don't really want the color to be 
     * added to the colormap.
     */

    if ( ! TkParseColor(display, colormap, colorString, &parsedColor)) {
         Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            "invalid color name \"%s\"", specString));
         Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
                 "INVALID_COLOR", NULL);
         return TCL_ERROR;
    }
        
    /*
     * parse the Suffix
     */

    switch (suffixString[0]) {
    case '\0': 
        suffixAlpha = 255;
        break;
    case '@':
        fracAlpha = strtod(suffixString + 1, &tmpString);
        if (*tmpString != '\0') {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid alpha "
                    "suffix \"%s\": expected floating-point value", 
                    suffixString));
            Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
                    "INVALID COLOR", NULL);
            return TCL_ERROR;
        }
        if (fracAlpha < 0 || fracAlpha > 1) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid alpha suffix" 
                    " \"%s\": value must be in the range from 0 to 1", 
                    suffixString));
            Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
                    "INVALID_COLOR", NULL);
            return TCL_ERROR;
        }
        suffixAlpha = (unsigned int) floor(fracAlpha * 255 + 0.5);
        break;
    case '#':
        if (strlen(suffixString + 1) < 1 || strlen(suffixString + 1)> 2) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "invalid alpha suffix \"%s\"", suffixString));
            Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", 
                    "INVALID_COLOR", NULL);
            return TCL_ERROR;
        }
        for (i = 1; i <= (int)strlen(suffixString + 1); i++) {
            if ( ! isxdigit(UCHAR(suffixString[i]))) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "invalid alpha suffix \"%s\": expected hex digit",
                        suffixString));
                Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
                        "INVALID_COLOR", NULL);
                return TCL_ERROR;
            }
        }
        if (strlen(suffixString + 1) == 1) {
            sscanf(suffixString, "#%1x", &suffixAlpha);
            suffixAlpha *= 0x11;
        } else {
            sscanf(suffixString, "#%2x", &suffixAlpha);
        }
        break;
    default:
        Tcl_Panic("unexpected switch fallthrough");
    }
    
    *redPtr = (unsigned char) (parsedColor.red >> 8);
    *greenPtr = (unsigned char) (parsedColor.green >> 8);
    *bluePtr = (unsigned char) (parsedColor.blue >> 8);
    *alphaPtr = (unsigned char) suffixAlpha;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TkDebugStringMatchDef --
 *
 *      Debugging function for StringMatchDef. Basically just an alias for
 *      that function, intended to expose it directly to tests, as
 *      StirngMatchDef cannot be sufficiently tested otherwise.
 *
 * Results:
 *      See StringMatchDef.
 *
 * Side effects:
 *      None
 *----------------------------------------------------------------------
 */
int
TkDebugPhotoStringMatchDef(
    Tcl_Interp *interp,     /* Error messages are left in this interpreter */
    Tcl_Obj *data,          /* The data to check */
    Tcl_Obj *formatString,  /* Value of the -format option, not used here */
    int *widthPtr,          /* Width of image is written to this location */
    int *heightPtr)         /* Height of image is written to this location */    
{
    return StringMatchDef(data, formatString, widthPtr, heightPtr, interp);
}


/* Local Variables: */
/* mode: c */
/* fill-column: 78 */
/* c-basic-offset: 4 */
/* tab-width: 8 */
/* indent-tabs-mode: nil */
/* End: */

/*
 * Bit definitions for use with ParseSubcommandOptions: each bit is set in the
 * 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_ALPHA	1
#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_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
};

/*
 * Message to generate when an attempt to resize an image fails due to memory
 * problems.

static void		ImgPhotoCmdDeletedProc(ClientData clientData);
static int		ImgPhotoConfigureMaster(Tcl_Interp *interp,
			    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,
			    Tk_PhotoImageFormat **imageFormatPtr,
			    int *widthPtr, int *heightPtr, int *oldformat);

    enum PhotoOptions {
	PHOTO_BLANK, PHOTO_CGET, PHOTO_CONFIGURE, PHOTO_COPY, PHOTO_DATA,
	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;
    ThreadSpecificData *tsdPtr =
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

	return Tk_PhotoPutZoomedBlock(interp, (Tk_PhotoHandle) masterPtr,
		&block, options.toX, options.toY, options.toX2 - options.toX,
		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;
	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)
		|| (options.fromX2 > masterPtr->width)
		|| (options.fromY2 > masterPtr->height)) {

	 * Fill in default values for unspecified parameters.
	 */

	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;
	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;
	    }
	} else {
	    stringWriteProc = ImgStringWrite;
	}

	/*
	 * Call the handler's string write function to write out the image.
	 */

	data = ImgGetPhoto(masterPtr, &block, &options);

	}
	if (options.background) {
	    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)
		|| (y < 0) || (y >= masterPtr->height)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s get: coordinates out of range",
		    Tcl_GetString(objv[0])));
	    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES",
		    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]);
	channels[3] = Tcl_NewIntObj(pixelPtr[3]);
	Tcl_SetObjResult(interp, Tcl_NewListObj(3, channels));
	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;
	}

	/*
	 * See if there's a format that can read the data
	 */
	if (MatchStringFormat(interp, options.name ? objv[2]:NULL,
		options.format, &imageFormat, &imageWidth,
		&imageHeight, &oldformat) == TCL_OK) {
	
	if (MatchStringFormat(interp, objv[2], options.format, &imageFormat,
		&imageWidth, &imageHeight, &oldformat) != TCL_OK) {
	    Tcl_Obj *format, *data;
	    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,
	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) {
		options.toX2 - options.toX, 
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
	if (Tcl_ListObjGetElements(interp, options.name,
		&dataHeight, &srcObjv) != TCL_OK) {
		options.toY2 - options.toY, 0, 0) != 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...
		     */

	 * SB: is the next line really needed? The stringReadProc 
		    break;
		}
		dataWidth = listObjc;
		/*
 		 * Memory allocation overflow protection.
 		 * May not be able to trigger/ demo / test this.
 		 */

	 * writes image data with Tk_PhotoPutBlock(), which in turn
		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;
		}

	 * takes care to notify the changed image and to set/unset the
		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;
	    }

	 * IMAGE_CHANGED bit.
	    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.
		 */

	 */
	masterPtr->flags |= IMAGE_CHANGED;
		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;
	}
	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;

    case PHOTO_READ: {
	Tcl_Obj *format;

	/*
	 * photo read command - first parse the options specified.
	 */

	if (Tcl_GetIndexFromObj(interp, objv[2], photoTransOptions, "option",
		0, &index) != TCL_OK) {
	    return TCL_ERROR;
	}

	switch ((enum transOptions) index) {
	case PHOTO_TRANS_GET: {
	    int boolMode;
	    XRectangle testBox;
	    TkRegion testRegion;

	    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])));
		Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES",
			NULL);
		return TCL_ERROR;
	    }

	    testBox.x = x;
	    testBox.y = y;
	    testBox.width = 1;
	    /* 
	     * Extract and return the desired value
	     */
	    pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4;
	    testBox.height = 1;
	    /* What a way to do a test! */
	    testRegion = TkCreateRegion();
	    if (boolMode) {
		Tcl_SetObjResult(interp, Tcl_NewBooleanObj( ! pixelPtr[3]));
	    TkUnionRectWithRegion(&testBox, testRegion, testRegion);
	    TkIntersectRegion(testRegion, masterPtr->validRegion, testRegion);
	    TkClipBox(testRegion, &testBox);
	    TkDestroyRegion(testRegion);

	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
	    } else {
		Tcl_SetObjResult(interp, Tcl_NewIntObj(pixelPtr[3]));
		    testBox.width==0 && testBox.height==0));
	    }
	    return TCL_OK;
	}

	case PHOTO_TRANS_SET: {
	    int transFlag;
	    int newVal, boolMode;
	    XRectangle setBox;
	    TkRegion modRegion;

	    /* 
	     * Parse args and option, check for valid values
	     */
	    
	    if (objc != 6) {
		Tcl_WrongNumArgs(interp, 3, objv, "x y boolean");
	    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) {
	    setBox.x = x;
	    setBox.y = y;
	    setBox.width = 1;
	    setBox.height = 1;
		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;
	    pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4;

	    if (transFlag) {
		}
		if (newVal < 0 || newVal > 255) {
		/*
		 * Make pixel transparent.
		    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;
		 */

		}
		TkRegion clearRegion = TkCreateRegion();

	    }
		TkUnionRectWithRegion(&setBox, clearRegion, clearRegion);
		TkSubtractRegion(masterPtr->validRegion, clearRegion,
			masterPtr->validRegion);
		TkDestroyRegion(clearRegion);

		/*
		 * Set the alpha value correctly.
		 */

		pixelPtr[3] = 0;
	   
	    /*
	     * 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;
	    }
	    
		/*
	    /*
		 * Make pixel opaque.
		 */
	     * Update the validRegion of the image
	     */

	    setBox.x = x;
	    setBox.y = y;
	    setBox.width = 1;
	    setBox.height = 1;
	    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.
	     */

	    Tk_ImageChanged(masterPtr->tkMaster, x, y, 1, 1,

/*
 *----------------------------------------------------------------------
 *
 * 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
ParseSubcommandOptions(
    struct SubcommandOptions *optPtr,

	    index++;
	    if (Tcl_GetIndexFromObj(interp, objv[index], compositingRules,
		    "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) {
		if (argIndex >= objc) {
		    break;

				 * is returned here. */
    int *widthPtr, int *heightPtr,
				/* 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) {
	formatString = Tcl_GetString(formatObj);
    }

    /*
     * Scan through the table of file format handlers to find one which can
     * 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;
	    }
	    matched = 1;
	    if (formatPtr->stringMatchProc == NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"-data option isn't supported for %s images",
			formatString));
		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;
	}
    }

			    (Tcl_Obj *) Tcl_GetString(data),
			    (Tcl_Obj *) formatString,
			    widthPtr, heightPtr, interp)) {
		break;
	    }
	}
    }
    
    if (formatPtr == NULL) {
	/* 
	 * 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;
	if ((formatObj != NULL) && !matched) {
	} 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;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_FindPhoto --

    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ImgStringWrite --
 *
 *	Default string write function. The data is formatted in the default
 *	format as accepted by the "<img> put" command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
ImgStringWrite(
    Tcl_Interp *interp,
    Tcl_Obj *formatString,
    Tk_PhotoImageBlock *blockPtr)
{
    int greenOffset, blueOffset;
    Tcl_Obj *data;

    greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
    blueOffset = blockPtr->offset[2] - blockPtr->offset[0];

    data = Tcl_NewObj();
    if ((blockPtr->width > 0) && (blockPtr->height > 0)) {
	int row, col;

	for (row=0; row<blockPtr->height; row++) {
	    Tcl_Obj *line = Tcl_NewObj();
	    unsigned char *pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0]
		    + row * blockPtr->pitch;

	    for (col=0; col<blockPtr->width; col++) {
		Tcl_AppendPrintfToObj(line, "%s#%02x%02x%02x",
			col ? " " : "", *pixelPtr,
			pixelPtr[greenOffset], pixelPtr[blueOffset]);
		pixelPtr += blockPtr->pixelSize;
	    }
	    Tcl_ListObjAppendElement(NULL, data, line);
	}
    }
    Tcl_SetObjResult(interp, data);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_PhotoGetImage --
 *
 *	This function is called to obtain image data from a photo image. This
 *	function fills in the Tk_PhotoImageBlock structure pointed to by
 *	`blockPtr' with details of the address and layout of the image data in
 *	memory.
 *

    blockPtr->offset[3] = 3;
    return 1;
}

/*
 *--------------------------------------------------------------
 *
 * TkPostscriptPhoto --
 * ImgPostscriptPhoto --
 *
 *	This function is called to output the contents of a photo image in
 *	Postscript by calling the Tk_PostscriptPhoto function.
 *
 * Results:
 *	Returns a standard Tcl return value.
 *

#endif /* TK_NO_DEPRECATED */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

	    int width, int height, double angle)
}
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.

interface tkIntPlat

 * outside world:
 */

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;

MODULE_SCOPE const char *const tkWebColors[20];

				int x, int y, int width, int height,
				double angle);
/* 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;

    TkWindow * (*tkAllocWindow) (TkDisplay *dispPtr, int screenNum, TkWindow *parentPtr); /* 0 */
    void (*tkBezierPoints) (double control[], int numSteps, double *coordPtr); /* 1 */

    CONST86 char * (*tkOrientPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 178 */
    int (*tkSmoothParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset); /* 179 */
    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
}
#endif

	(tkIntStubsPtr->tkDrawAngledTextLayout) /* 181 */
#define TkUnderlineAngledTextLayout \
	(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. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

    TkOrientPrintProc, /* 178 */
    TkSmoothParseProc, /* 179 */
    TkSmoothPrintProc, /* 180 */
    TkDrawAngledTextLayout, /* 181 */
    TkUnderlineAngledTextLayout, /* 182 */
    TkIntersectAngledTextLayout, /* 183 */
    TkDrawAngledChars, /* 184 */
    TkDebugPhotoStringMatchDef, /* 185 */
};

static const TkIntPlatStubs tkIntPlatStubs = {
    TCL_STUB_MAGIC,
    0,
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
    TkAlignImageData, /* 0 */

#endif
static void		TrivialCmdDeletedProc(ClientData clientData);
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 --
 *
 *	This function performs intialization for the Tk test suite exensions.

    Tcl_CreateObjCommand(interp, "testmakeexist", TestmakeexistObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    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__)
    Tcl_CreateObjCommand(interp, "testmenubar", TestmenubarObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);

    Tk_Window tkwin,
    char *internalPtr)
{
    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:
 */

	Tk_CreateImageType(&tkBitmapImageType);
	Tk_CreateImageType(&tkPhotoImageType);

	/*
	 * Create built-in photo image formats.
	 */

        Tk_CreatePhotoImageFormat(&tkImgFmtDefault);
	Tk_CreatePhotoImageFormat(&tkImgFmtGIF);
	Tk_CreatePhotoImageFormat(&tkImgFmtPNG);
	Tk_CreatePhotoImageFormat(&tkImgFmtPPM);
    }

    if ((parent != NULL) && (screenName != NULL) && (screenName[0] == '\0')) {
	dispPtr = ((TkWindow *) parent)->dispPtr;