summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/CrtPhImgFmt.3294
-rw-r--r--doc/photo.n88
-rw-r--r--generic/tk.decls6
-rw-r--r--generic/tk.h62
-rw-r--r--generic/tkClipboard.c8
-rw-r--r--generic/tkCmds.c6
-rw-r--r--generic/tkDecls.h7
-rw-r--r--generic/tkImgGIF.c335
-rw-r--r--generic/tkImgPNG.c416
-rw-r--r--generic/tkImgPhoto.c600
-rw-r--r--generic/tkImgPhoto.h2
-rw-r--r--generic/tkInt.h4
-rw-r--r--generic/tkStubInit.c1
-rw-r--r--generic/tkWindow.c6
-rw-r--r--macosx/tkMacOSXClipboard.c8
-rw-r--r--macosx/tkMacOSXKeyEvent.c22
-rw-r--r--macosx/tkMacOSXMenu.c28
-rw-r--r--macosx/tkMacOSXSysTray.c6
-rw-r--r--tests/earth.gifbin51712 -> 51559 bytes
-rw-r--r--tests/imgPNG.test51
-rw-r--r--tests/imgPhoto.test454
-rw-r--r--tests/textDisp.test12
-rw-r--r--win/Makefile.in1
-rw-r--r--win/makefile.vc1
-rw-r--r--win/tkWinPrint.c3407
25 files changed, 5214 insertions, 611 deletions
diff --git a/doc/CrtPhImgFmt.3 b/doc/CrtPhImgFmt.3
index 92f2441..c7accdb 100644
--- a/doc/CrtPhImgFmt.3
+++ b/doc/CrtPhImgFmt.3
@@ -9,7 +9,7 @@
'\" Department of Computer Science,
'\" Australian National University.
'\"
-.TH Tk_CreatePhotoImageFormat 3 8.5 Tk "Tk Library Procedures"
+.TH Tk_CreatePhotoImageFormat 3 8.7 Tk "Tk Library Procedures"
.so man.macros
.BS
.SH NAME
@@ -18,15 +18,23 @@ Tk_CreatePhotoImageFormat \- define new file format for photo images
.nf
\fB#include <tk.h>\fR
.sp
+.VS 8.7
+\fBTk_CreatePhotoImageFormatVersion3\fR(\fIformatVersion3Ptr\fR)
+.VE 8.7
+.sp
\fBTk_CreatePhotoImageFormat\fR(\fIformatPtr\fR)
.SH ARGUMENTS
-.AS "const Tk_PhotoImageFormat" *formatPtr
+.AS "const Tk_PhotoImageFormatVersion3" *formatVersion3Ptr
+.VS 8.7
+.AP "const Tk_PhotoImageFormatVersion3" *formatVersion3Ptr in
+Structure that defines the new file format including metadata functionality.
+.VE 8.7
.AP "const Tk_PhotoImageFormat" *formatPtr in
Structure that defines the new file format.
.BE
.SH DESCRIPTION
.PP
-\fBTk_CreatePhotoImageFormat\fR is invoked to define a new file format
+\fBTk_CreatePhotoImageFormatVersion3\fR is invoked to define a new file format
for image data for use with photo images. The code that implements an
image file format is called an image file format handler, or
handler for short. The photo image code
@@ -38,22 +46,29 @@ The user can specify which handler to use with the \fB\-format\fR
image configuration option or the \fB\-format\fR option to the
\fBread\fR and \fBwrite\fR photo image subcommands.
.PP
+The alternate version 2 function \fBTk_CreatePhotoImageFormat\fR has
+identical functionality, but does not allow the handler to get or return
+the metadata dictionary of the image.
+It is described in section \fBVERSION 2 INTERFACE\fR below.
+.PP
An image file format handler consists of a collection of procedures
-plus a Tk_PhotoImageFormat structure, which contains the name of the
-image file format and pointers to six procedures provided by the
-handler to deal with files and strings in this format. The
-Tk_PhotoImageFormat structure contains the following fields:
+plus a \fBTk_PhotoImageFormatVersion3\fR structure, which contains the
+name of the image file format and pointers to six procedures provided
+by the handler to deal with files and strings in this format. The
+Tk_PhotoImageFormatVersion3 structure contains the following fields:
+.VS 8.7
.CS
-typedef struct Tk_PhotoImageFormat {
+typedef struct Tk_PhotoImageFormatVersion3 {
const char *\fIname\fR;
- Tk_ImageFileMatchProc *\fIfileMatchProc\fR;
- Tk_ImageStringMatchProc *\fIstringMatchProc\fR;
- Tk_ImageFileReadProc *\fIfileReadProc\fR;
- Tk_ImageStringReadProc *\fIstringReadProc\fR;
- Tk_ImageFileWriteProc *\fIfileWriteProc\fR;
- Tk_ImageStringWriteProc *\fIstringWriteProc\fR;
-} \fBTk_PhotoImageFormat\fR;
+ Tk_ImageFileMatchProcVersion3 *\fIfileMatchProc\fR;
+ Tk_ImageStringMatchProcVersion3 *\fIstringMatchProc\fR;
+ Tk_ImageFileReadProcVersion3 *\fIfileReadProc\fR;
+ Tk_ImageStringReadProcVersion3 *\fIstringReadProc\fR;
+ Tk_ImageFileWriteProcVersion3 *\fIfileWriteProc\fR;
+ Tk_ImageStringWriteProcVersion3 *\fIstringWriteProc\fR;
+} \fBTk_PhotoImageFormatVersion3\fR;
.CE
+.VE 8.7
.PP
The handler need not provide implementations of all six procedures.
For example, the procedures that handle string data would not be
@@ -67,14 +82,16 @@ procedure, and the \fIstringMatchProc\fR procedure if it provides the
.SS NAME
.PP
\fIformatPtr->name\fR provides a name for the image type.
-Once \fBTk_CreatePhotoImageFormat\fR returns, this name may be used
-in the \fB\-format\fR photo image configuration and subcommand option.
+Once \fBTk_CreatePhotoImageFormatVersion3\fR returns, this name may be
+used in the \fB\-format\fR photo image configuration and subcommand
+option.
The manual page for the photo image (photo(n)) describes how image
file formats are chosen based on their names and the value given to
the \fB\-format\fR option. The first character of \fIformatPtr->name\fR
must not be an uppercase character from the ASCII character set
(that is, one of the characters \fBA\fR-\fBZ\fR). Such names are used
only for legacy interface support (see below).
+.VS 8.7
.SS FILEMATCHPROC
.PP
\fIformatPtr->fileMatchProc\fR provides the address of a procedure for
@@ -82,39 +99,47 @@ Tk to call when it is searching for an image file format handler
suitable for reading data in a given file.
\fIformatPtr->fileMatchProc\fR must match the following prototype:
.CS
-typedef int \fBTk_ImageFileMatchProc\fR(
+typedef int \fBTk_ImageFileMatchProcVersion3\fR(
+ Tcl_Interp *\fIinterp\fR,
Tcl_Channel \fIchan\fR,
const char *\fIfileName\fR,
Tcl_Obj *\fIformat\fR,
+ Tcl_Obj *\fImetadataIn\fR,
int *\fIwidthPtr\fR,
int *\fIheightPtr\fR,
- Tcl_Interp *\fIinterp\fR);
+ Tcl_Obj *\fImetadataOut\fR);
.CE
The \fIfileName\fR argument is the name of the file containing the
image data, which is open for reading as \fIchan\fR. The
\fIformat\fR argument contains the value given for the
\fB\-format\fR option, or NULL if the option was not specified.
+\fBmetadataIn\fR and \fBmetadataOut\fR inputs and returns a metadata
+dictionary as described in section \fBMETADATA INTERFACE\fR below.
If the data in the file appears to be in the format supported by this
handler, the \fIformatPtr->fileMatchProc\fR procedure should store the
width and height of the image in *\fIwidthPtr\fR and *\fIheightPtr\fR
respectively, and return 1. Otherwise it should return 0.
.SS STRINGMATCHPROC
.PP
-\fIformatPtr->stringMatchProc\fR provides the address of a procedure for
-Tk to call when it is searching for an image file format handler for
+\fIformatPtr->stringMatchProc\fR provides the address of a procedure
+for Tk to call when it is searching for an image file format handler
suitable for reading data from a given string.
\fIformatPtr->stringMatchProc\fR must match the following prototype:
.CS
-typedef int \fBTk_ImageStringMatchProc\fR(
+typedef int \fBTk_ImageStringMatchProcVersion3\fR(
+ Tcl_Interp *\fIinterp\fR,
Tcl_Obj *\fIdata\fR,
Tcl_Obj *\fIformat\fR,
+ Tcl_Obj *\fImetadataIn\fR,
int *\fIwidthPtr\fR,
int *\fIheightPtr\fR,
- Tcl_Interp *\fIinterp\fR);
+ Tcl_Obj *\fImetadataOut\fR);
.CE
The \fIdata\fR argument points to the object containing the image
data. The \fIformat\fR argument contains the value given for
the \fB\-format\fR option, or NULL if the option was not specified.
+\fBmetadataIn\fR and \fBmetadataOut\fR inputs and returns a metadata
+dictionary as described in section \fBMETADATA INTERFACE\fR below.
If the data in the string appears to be in the format supported by
this handler, the \fIformatPtr->stringMatchProc\fR procedure should
store the width and height of the image in *\fIwidthPtr\fR and
@@ -131,10 +156,12 @@ typedef int \fBTk_ImageFileReadProc\fR(
Tcl_Channel \fIchan\fR,
const char *\fIfileName\fR,
Tcl_Obj *\fIformat\fR,
+ Tcl_Obj *\fImetadataIn\fR,
PhotoHandle \fIimageHandle\fR,
int \fIdestX\fR, int \fIdestY\fR,
int \fIwidth\fR, int \fIheight\fR,
- int \fIsrcX\fR, int \fIsrcY\fR);
+ int \fIsrcX\fR, int \fIsrcY\fR,
+ Tcl_Obj *\fImetadataOut\fR);
.CE
The \fIinterp\fR argument is the interpreter in which the command was
invoked to read the image; it should be used for reporting errors.
@@ -148,34 +175,40 @@ dimensions \fIwidth\fR x \fIheight\fR and has its top-left corner at
coordinates (\fIsrcX\fR,\fIsrcY\fR). It is to be stored in the photo
image with its top-left corner at coordinates
(\fIdestX\fR,\fIdestY\fR) using the \fBTk_PhotoPutBlock\fR procedure.
+\fBmetadataIn\fR and \fBmetadataOut\fR inputs and returns a metadata
+dictionary as described in section \fBMETADATA INTERFACE\fR below.
The return value is a standard Tcl return value.
.SS STRINGREADPROC
.PP
-\fIformatPtr->stringReadProc\fR provides the address of a procedure for
-Tk to call to read data from a string into a photo image.
+\fIformatPtr->stringReadProc\fR provides the address of a procedure
+for Tk to call to read data from a string into a photo image.
\fIformatPtr->stringReadProc\fR must match the following prototype:
.CS
typedef int \fBTk_ImageStringReadProc\fR(
Tcl_Interp *\fIinterp\fR,
Tcl_Obj *\fIdata\fR,
Tcl_Obj *\fIformat\fR,
+ Tcl_Obj *\fImetadataIn\fR,
PhotoHandle \fIimageHandle\fR,
int \fIdestX\fR, int \fIdestY\fR,
int \fIwidth\fR, int \fIheight\fR,
- int \fIsrcX\fR, int \fIsrcY\fR);
+ int \fIsrcX\fR, int \fIsrcY\fR,
+ Tcl_Obj *\fImetadataOut\fR);
.CE
The \fIinterp\fR argument is the interpreter in which the command was
invoked to read the image; it should be used for reporting errors.
The \fIdata\fR argument points to the image data in object form.
The \fIformat\fR argument contains the
value given for the \fB\-format\fR option, or NULL if the option was
-not specified. The image data in the string, or a subimage of it, is to
-be read into the photo image identified by the handle
+not specified. The image data in the string, or a subimage of it, is
+to be read into the photo image identified by the handle
\fIimageHandle\fR. The subimage of the data in the string is of
dimensions \fIwidth\fR x \fIheight\fR and has its top-left corner at
coordinates (\fIsrcX\fR,\fIsrcY\fR). It is to be stored in the photo
image with its top-left corner at coordinates
(\fIdestX\fR,\fIdestY\fR) using the \fBTk_PhotoPutBlock\fR procedure.
+\fBmetadataIn\fR and \fBmetadataOut\fR inputs and returns a metadata
+dictionary as described in section \fBMETADATA INTERFACE\fR below.
The return value is a standard Tcl return value.
.SS FILEWRITEPROC
.PP
@@ -187,6 +220,7 @@ typedef int \fBTk_ImageFileWriteProc\fR(
Tcl_Interp *\fIinterp\fR,
const char *\fIfileName\fR,
Tcl_Obj *\fIformat\fR,
+ Tcl_Obj *\fImetadataIn\fR,
Tk_PhotoImageBlock *\fIblockPtr\fR);
.CE
The \fIinterp\fR argument is the interpreter in which the command was
@@ -201,16 +235,20 @@ not specified. The format string can contain extra characters
after the name of the format. If appropriate, the
\fIformatPtr->fileWriteProc\fR procedure may interpret these
characters to specify further details about the image file.
+\fBmetadataIn\fR may contain metadata keys that a driver may include
+into the output data.
The return value is a standard Tcl return value.
.SS STRINGWRITEPROC
.PP
-\fIformatPtr->stringWriteProc\fR provides the address of a procedure for
-Tk to call to translate image data from a photo image into a string.
+\fIformatPtr->stringWriteProc\fR provides the address of a procedure
+for Tk to call to translate image data from a photo image into a
+string.
\fIformatPtr->stringWriteProc\fR must match the following prototype:
.CS
typedef int \fBTk_ImageStringWriteProc\fR(
Tcl_Interp *\fIinterp\fR,
Tcl_Obj *\fIformat\fR,
+ Tcl_Obj *\fImetadataIn\fR,
Tk_PhotoImageBlock *\fIblockPtr\fR);
.CE
The \fIinterp\fR argument is the interpreter in which the command was
@@ -225,7 +263,201 @@ not specified. The format string can contain extra characters
after the name of the format. If appropriate, the
\fIformatPtr->stringWriteProc\fR procedure may interpret these
characters to specify further details about the image file.
+\fBmetadataIn\fR may contain metadata keys that a driver may include
+into the output data.
The return value is a standard Tcl return value.
+.PP
+.SH "METADATA INTERFACE"
+.PP
+Image formats contain a description of the image bitmap and may
+contain additional information like image resolution or comments.
+Image metadata may be read from image files and passed to the script
+level by including dictionary keys into the metadata property of the
+image. Image metadata may be written to image data on file write or
+image data output.
+.PP
+.PP
+.SS "METADATA KEYS"
+.PP
+The metadata may contain any key.
+A driver will handle only a set of dictionary keys documented in the
+documentation. See the photo image manual page for currently defined
+keys for the system drivers.
+.PP
+The following rules may give guidance to name metadata keys:
+.RS
+Abreviation are in upper case
+.RE
+.RS
+Words are in US English in small case (except proper nouns)
+.RE
+.RS
+Vertical DPI is expressed as DPI/aspect. The reason is, that some
+image formats may feature aspect and no resolution value.
+.RE
+.SS "METADATA INPUT"
+.PP
+Each driver function gets a Tcl object pointer \fBmetadataIn\fR as
+parameter. This parameter serves to input a metadata dict to the
+driver function.
+It may be NULL to flag that the metadata dict is empty.
+.PP
+A typical driver code snipped to check for a metadata key is:
+.CS
+if (NULL != metadataIn) {
+ Tcl_Obj *itemData;
+ Tcl_DictObjGet(interp, metadataIn, Tcl_NewStringObj("Comment",-1), &itemData));
+.CE
+.PP
+The \-metadata command option data of the following commands is passed
+to the driver: \fBimage create\fR, \fBconfigure\fR, \fBput\fR,
+\fBread\fR, \fBdata\fR and \fBwrite\fR.
+If no \-metadata command option available or not given, the metadata
+property of the image is passed to the driver using the following
+commands: \fBcget\fR, \fBconfigure\fR, \fBdata\fR and \fBwrite\fR.
+.PP
+Note that setting the \-metadata property of an image using
+\fBconfigure\fR without any other option does not invoke any driver
+function.
+.PP
+The metadata dictionary is not suited to pass options to the driver
+related to the bitmap representation, as the image bitmap is not
+recreated on a metadata change. The format string should be used for
+this purpose.
+.PP
+.SS "METADATA OUTPUT"
+.PP
+The image match and read driver functions may set keys in a prepared
+matadata dict to return them.
+Those functions get a Tcl object pointer \fBmetadataOut\fR as
+parameter.
+metadataOut may be NULL to indicate, that no metadata return is
+attended(\fBput\fR, \fBread\fR subcommands).
+\fBmetadataOut\fR is initialized to an empty unshared dict object if
+metadata return is attended (\fBimage create\fR command, \fBconfigure\fR
+subcommand). The driver may set dict keys in this object to return
+metadata.
+If a match function succeeds, the metadataOut pointer is passed to the
+corresponding read function.
+.PP
+A sample driver code snippet is:
+.CS
+if (NULL != metadataOut) {
+ Tcl_DictObjPut(NULL, metadataOut, Tcl_NewStringObj("XMP",-1), Tcl_NewStringObj(xmpMetadata);
+.CE
+.PP
+The metadata keys returned by the driver are merged into the present
+metadata property of the image or into the metadata dict given by the
+\fB\-metadata\fR command line option.
+At the script level, the command \fBimage create\fR and the
+\fBconfigure\fR method may return metadata from the driver.
+.PP
+Format string options or metadata keys may influence the creation of
+metadata within the driver.
+For example, the creation of an expensive metadata key may depend on a
+format string option or on a metadata input key.
+.PP
+.VE 8.7
+.SH "VERSION 2 INTERFACE"
+.PP
+Version 2 Interface does not include the possibility for the driver to
+use the metadata dict for input or output.
+.SS SYNOPSIS
+\fB#include <tk.h>\fR
+.sp
+\fBTk_CreatePhotoImageFormat\fR(\fIformatPtr\fR)
+.SS ARGUMENTS
+.AS "const Tk_PhotoImageFormat" *formatPtr
+.AP "const Tk_PhotoImageFormat" *formatPtr in
+Structure that defines the new file format.
+.BE
+.SS DESCRIPTION
+A driver using the version 2 interface invokes \fBTk_CreatePhotoImageFormat\fR
+for driver registration. The Tk_PhotoImageFormat structure
+contains the following fields:
+.CS
+typedef struct Tk_PhotoImageFormat {
+ const char *\fIname\fR;
+ Tk_ImageFileMatchProc *\fIfileMatchProc\fR;
+ Tk_ImageStringMatchProc *\fIstringMatchProc\fR;
+ Tk_ImageFileReadProc *\fIfileReadProc\fR;
+ Tk_ImageStringReadProc *\fIstringReadProc\fR;
+ Tk_ImageFileWriteProc *\fIfileWriteProc\fR;
+ Tk_ImageStringWriteProc *\fIstringWriteProc\fR;
+} \fBTk_PhotoImageFormat\fR;
+.CE
+.PP
+.SS FILEMATCHPROC
+.PP
+\fIformatPtr->fileMatchProc\fR must match the following prototype:
+.CS
+typedef int \fBTk_ImageFileMatchProc\fR(
+ Tcl_Channel \fIchan\fR,
+ const char *\fIfileName\fR,
+ Tcl_Obj *\fIformat\fR,
+ int *\fIwidthPtr\fR,
+ int *\fIheightPtr\fR,
+ Tcl_Interp *\fIinterp\fR);
+.CE
+.PP
+.SS STRINGMATCHPROC
+.PP
+\fIformatPtr->stringMatchProc\fR must match the following prototype:
+.CS
+typedef int \fBTk_ImageStringMatchProc\fR(
+ Tcl_Obj *\fIdata\fR,
+ Tcl_Obj *\fIformat\fR,
+ int *\fIwidthPtr\fR,
+ int *\fIheightPtr\fR,
+ Tcl_Interp *\fIinterp\fR);
+.CE
+.SS FILEREADPROC
+.PP
+\fIformatPtr->fileReadProc\fR must match the following prototype:
+.CS
+typedef int \fBTk_ImageFileReadProc\fR(
+ Tcl_Interp *\fIinterp\fR,
+ Tcl_Channel \fIchan\fR,
+ const char *\fIfileName\fR,
+ Tcl_Obj *\fIformat\fR,
+ PhotoHandle \fIimageHandle\fR,
+ int \fIdestX\fR, int \fIdestY\fR,
+ int \fIwidth\fR, int \fIheight\fR,
+ int \fIsrcX\fR, int \fIsrcY\fR);
+.CE
+.SS STRINGREADPROC
+.PP
+\fIformatPtr->stringReadProc\fR must match the following prototype:
+.CS
+typedef int \fBTk_ImageStringReadProc\fR(
+ Tcl_Interp *\fIinterp\fR,
+ Tcl_Obj *\fIdata\fR,
+ Tcl_Obj *\fIformat\fR,
+ PhotoHandle \fIimageHandle\fR,
+ int \fIdestX\fR, int \fIdestY\fR,
+ int \fIwidth\fR, int \fIheight\fR,
+ int \fIsrcX\fR, int \fIsrcY\fR);
+.CE
+.SS FILEWRITEPROC
+.PP
+\fIformatPtr->fileWriteProc\fR must match the following prototype:
+.CS
+typedef int \fBTk_ImageFileWriteProc\fR(
+ Tcl_Interp *\fIinterp\fR,
+ const char *\fIfileName\fR,
+ Tcl_Obj *\fIformat\fR,
+ Tk_PhotoImageBlock *\fIblockPtr\fR);
+.CE
+.SS STRINGWRITEPROC
+.PP
+\fIformatPtr->stringWriteProc\fR must match the following prototype:
+.CS
+typedef int \fBTk_ImageStringWriteProc\fR(
+ Tcl_Interp *\fIinterp\fR,
+ Tcl_Obj *\fIformat\fR,
+ Tk_PhotoImageBlock *\fIblockPtr\fR);
+.CE
+.PP
.SH "LEGACY INTERFACE SUPPORT"
.PP
In Tk 8.2 and earlier, the definition of all the function pointer
diff --git a/doc/photo.n b/doc/photo.n
index 3b206f5..f30039d 100644
--- a/doc/photo.n
+++ b/doc/photo.n
@@ -101,6 +101,16 @@ Specifies the height of the image, in pixels. This option is useful
primarily in situations where the user wishes to build up the contents
of the image piece by piece. A value of zero (the default) allows the
image to expand or shrink vertically to fit the data stored in it.
+.VS 8.7
+.TP
+\fB\-metadata \fImetadata\fR
+.
+Set the metadata dictionary of the image.
+Additional keys may be set within the metadata dictionary of the image,
+if image data is processed due to a \fB\-file\fR or \fB\-data\fR options
+and the driver outputs any metadata keys.
+See section \fBMETADATA DICTIONARY\fR below.
+.VE 8.7
.TP
\fB\-palette \fIpalette-spec\fR
.
@@ -146,7 +156,7 @@ The following commands are possible for photo images:
.
Blank the image; that is, set the entire image to have no data, so it
will be displayed as transparent, and the background of whatever
-window it is displayed in will show through.
+window it is displayed in will show through. The metadata dict of the image is not changed.
.TP
\fIimageName \fBcget\fR \fIoption\fR
.
@@ -169,6 +179,10 @@ modifies the given option(s) to have the given value(s); in
this case the command returns an empty string.
\fIOption\fR may have any of the values accepted by the
\fBimage create\fR \fBphoto\fR command.
+.VS 8.7
+Note: setting the \fB\-metadata\fR option without any other option
+will not invoke the image format driver to recreate the bitmap.
+.VE 8.7
.TP
\fIimageName \fBcopy\fR \fIsourceImage\fR ?\fIoption value(s) ...\fR?
.
@@ -287,9 +301,18 @@ whole image.
.
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
+\fB\-metadata\fR \fImetadata\fR
+.
+Image format handler may use metadata to be included in the returned
+data string.
+The specified \fImetadata\fR is passed to the driver for inclusion in the
+data.
+If no \fB\-metadata\fR option is given, the current metadata of the
+image is used.
+.VE 8.7
+.RE
\fIimageName \fBget\fR \fIx y\fR ?\fB-withalpha\fR?
.
Returns the color of the pixel at coordinates (\fIx\fR,\fIy\fR) in the
@@ -322,6 +345,15 @@ 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.
+.VS 8.7
+.TP
+\fB\-metadata\fR \fImetadata\fR
+.
+A specified \fImetadata\fR is passed to the image format driver when interpreting
+the data.
+Note: The current metadata of the image is not passed to the format driver
+and is not changed by the command.
+.VE 8.7
.TP
\fB\-to \fIx1 y1\fR ?\fIx2 y2\fR?
.
@@ -367,6 +399,15 @@ corner of the image in the image file. If all four coordinates are
specified, they specify diagonally opposite corners or the region.
The default, if this option is not specified, is the whole of the
image in the image file.
+.VS 8.7
+.TP
+\fB\-metadata\fR \fImetadata\fR
+.
+A specified \fImetadata\fR is passed to the image format driver when interpreting
+the data.
+Note: The current metadata of the image is not passed to the format driver
+and is not changed by the command.
+.VE 8.7
.TP
\fB\-shrink\fR
.
@@ -460,6 +501,16 @@ if this option is not given, is the whole image.
.
If this options is specified, the data will not contain color
information. All pixel data will be transformed into grayscale.
+.VS 8.7
+.TP
+\fB\-metadata\fR \fBmetadata\fR
+.
+Image format handler may use metadata to be included in the written file.
+The specified \fImetadata\fR is passed to the driver for inclusion in the
+file.
+If no \fB\-metadata\fR option is given, the current metadata of the
+image is used.
+.VE 8.7
.RE
.SH "IMAGE FORMATS"
.PP
@@ -682,6 +733,39 @@ each primary color to try to allocate. It can also be used to force
the image to be displayed in shades of gray, even on a color display,
by giving a single number rather than three numbers separated by
slashes.
+.VS 8.7
+.SH "METADATA DICTIONARY"
+.PP
+Each image has a metadata dictionary property.
+This dictionary is not relevant to the bitmap representation of the
+image, but may contain additional information like resolution or
+comments.
+Image format drivers may output metadata when image data is
+parsed, or may use metadata to be included in image files or formats.
+.SS "METADATA KEYS"
+.PP
+Each image format driver supports an individual set of metadata dictionary
+keys. Predefined keys are:
+.TP
+DPI
+.
+Horizontal image resolution in DPI as a double value.
+Supported by format \fBpng\fR.
+.TP
+aspect
+.
+Aspect ratio horizontal divided by vertical as double value.
+Supported by formats \fBgif\fR and \fBpng\fR.
+.TP
+comment
+.
+Image text comment.
+Supported by formats \fBgif\fR and \fBpng\fR.
+.PP
+It is valid to set any key in the metadata dict.
+A format driver will ignore keys it does not handle.
+.PP
+.VE 8.7
.SH CREDITS
.PP
The photo image type was designed and implemented by Paul Mackerras,
diff --git a/generic/tk.decls b/generic/tk.decls
index d9b136c..418ae35 100644
--- a/generic/tk.decls
+++ b/generic/tk.decls
@@ -1091,6 +1091,12 @@ declare 279 {
Tcl_Obj *Tk_FontGetDescription(Tk_Font tkfont)
}
+# TIP#529
+declare 280 {
+ void Tk_CreatePhotoImageFormatVersion3(
+ const Tk_PhotoImageFormatVersion3 *formatPtr)
+}
+
# Define the platform specific public Tk interface. These functions are
# only available on the designated platform.
diff --git a/generic/tk.h b/generic/tk.h
index 4008dae..3f4c92a 100644
--- a/generic/tk.h
+++ b/generic/tk.h
@@ -1436,6 +1436,36 @@ typedef int (Tk_ImageStringWriteProc) (Tcl_Interp *interp, Tcl_Obj *format,
#endif /* USE_OLD_IMAGE */
/*
+ * The following alternate definitions are used with the Tk8.7 file format
+ * supporting a metadata dict, internal dstring and close file flag
+ */
+
+typedef struct Tk_PhotoImageFormatVersion3 Tk_PhotoImageFormatVersion3;
+typedef int (Tk_ImageFileMatchProcVersion3) (Tcl_Interp *interp,
+ Tcl_Channel chan, const char *fileName, Tcl_Obj *format,
+ Tcl_Obj *metadataIn, int *widthPtr, int *heightPtr,
+ Tcl_Obj *metadataOut);
+typedef int (Tk_ImageStringMatchProcVersion3) (Tcl_Interp *interp,
+ Tcl_Obj *dataObj, Tcl_Obj *format, Tcl_Obj *metadataIn, int *widthPtr,
+ int *heightPtr, Tcl_Obj *metadataOut);
+typedef int (Tk_ImageFileReadProcVersion3) (Tcl_Interp *interp,
+ Tcl_Channel chan,
+ const char *fileName, Tcl_Obj *format, Tcl_Obj *metadataIn,
+ Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height, int srcX, int srcY,
+ Tcl_Obj *metadataOut);
+typedef int (Tk_ImageStringReadProcVersion3) (Tcl_Interp *interp,
+ Tcl_Obj *dataObj, Tcl_Obj *format, Tcl_Obj *metadataIn,
+ Tk_PhotoHandle imageHandle, int destX, int destY, int width, int height,
+ int srcX, int srcY, Tcl_Obj *metadataOut);
+typedef int (Tk_ImageFileWriteProcVersion3) (Tcl_Interp *interp,
+ const char *fileName, Tcl_Obj *format, Tcl_Obj *metadataIn,
+ Tk_PhotoImageBlock *blockPtr);
+typedef int (Tk_ImageStringWriteProcVersion3) (Tcl_Interp *interp,
+ Tcl_Obj *format, Tcl_Obj *metadataIn, Tk_PhotoImageBlock *blockPtr);
+
+
+/*
* The following structure represents a particular file format for storing
* images (e.g., PPM, GIF, JPEG, etc.). It provides information to allow image
* files of that format to be recognized and read into a photo image.
@@ -1467,6 +1497,38 @@ struct Tk_PhotoImageFormat {
* currently known. Filled in by Tk, not by
* image format handler. */
};
+
+/*
+ * The following structure is the same plus added support for the metadata
+ * structure.
+ */
+
+struct Tk_PhotoImageFormatVersion3 {
+ const char *name; /* Name of image file format */
+ Tk_ImageFileMatchProcVersion3 *fileMatchProc;
+ /* Procedure to call to determine whether an
+ * image file matches this format. */
+ Tk_ImageStringMatchProcVersion3 *stringMatchProc;
+ /* Procedure to call to determine whether the
+ * data in a string matches this format. */
+ Tk_ImageFileReadProcVersion3 *fileReadProc;
+ /* Procedure to call to read data from an
+ * image file into a photo image. */
+ Tk_ImageStringReadProcVersion3 *stringReadProc;
+ /* Procedure to call to read data from a
+ * string into a photo image. */
+ Tk_ImageFileWriteProcVersion3 *fileWriteProc;
+ /* Procedure to call to write data from a
+ * photo image to a file. */
+ Tk_ImageStringWriteProcVersion3 *stringWriteProc;
+ /* Procedure to call to obtain a string
+ * representation of the data in a photo
+ * image.*/
+ struct Tk_PhotoImageFormatVersion3 *nextPtr;
+ /* Next in list of all photo image formats
+ * currently known. Filled in by Tk, not by
+ * image format handler. */
+};
/*
*----------------------------------------------------------------------
diff --git a/generic/tkClipboard.c b/generic/tkClipboard.c
index a972230..1f4298d 100644
--- a/generic/tkClipboard.c
+++ b/generic/tkClipboard.c
@@ -709,7 +709,13 @@ ClipboardGetProc(
* used). */
const char *portion) /* New information to be appended. */
{
- Tcl_DStringAppend((Tcl_DString *)clientData, portion, -1);
+ Tcl_Encoding utf8 = Tcl_GetEncoding(NULL, "utf-8");
+ Tcl_DString ds;
+
+ Tcl_ExternalToUtfDString(utf8, portion, -1, &ds);
+ Tcl_DStringAppend((Tcl_DString *) clientData, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ Tcl_FreeEncoding(utf8);
return TCL_OK;
}
diff --git a/generic/tkCmds.c b/generic/tkCmds.c
index e57f21e..36981af 100644
--- a/generic/tkCmds.c
+++ b/generic/tkCmds.c
@@ -1113,14 +1113,16 @@ Tk_TkwaitObjCmd(
static char *
WaitVariableProc(
ClientData clientData, /* Pointer to integer to set to 1. */
- TCL_UNUSED(Tcl_Interp *), /* Interpreter containing variable. */
- TCL_UNUSED(const char *), /* Name of variable. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *name1, /* Name of variable. */
TCL_UNUSED(const char *), /* Second part of variable name. */
TCL_UNUSED(int)) /* Information about what happened. */
{
int *donePtr = (int *)clientData;
*donePtr = 1;
+ Tcl_UntraceVar(interp, name1, TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ WaitVariableProc, clientData);
return NULL;
}
diff --git a/generic/tkDecls.h b/generic/tkDecls.h
index dee52bd..b7b0c14 100644
--- a/generic/tkDecls.h
+++ b/generic/tkDecls.h
@@ -893,6 +893,9 @@ EXTERN void Tk_SendVirtualEvent(Tk_Window tkwin,
const char *eventName, Tcl_Obj *detail);
/* 279 */
EXTERN Tcl_Obj * Tk_FontGetDescription(Tk_Font tkfont);
+/* 280 */
+EXTERN void Tk_CreatePhotoImageFormatVersion3(
+ const Tk_PhotoImageFormatVersion3 *formatPtr);
typedef struct {
const struct TkPlatStubs *tkPlatStubs;
@@ -1185,6 +1188,8 @@ typedef struct TkStubs {
Tcl_Obj * (*tk_NewWindowObj) (Tk_Window tkwin); /* 277 */
void (*tk_SendVirtualEvent) (Tk_Window tkwin, const char *eventName, Tcl_Obj *detail); /* 278 */
Tcl_Obj * (*tk_FontGetDescription) (Tk_Font tkfont); /* 279 */
+ void (*tk_CreatePhotoImageFormatVersion3) (
+ const Tk_PhotoImageFormatVersion3 *formatPtr); /* 280 */
} TkStubs;
extern const TkStubs *tkStubsPtr;
@@ -1757,6 +1762,8 @@ extern const TkStubs *tkStubsPtr;
(tkStubsPtr->tk_SendVirtualEvent) /* 278 */
#define Tk_FontGetDescription \
(tkStubsPtr->tk_FontGetDescription) /* 279 */
+#define Tk_CreatePhotoImageFormatVersion3 \
+ (tkStubsPtr->tk_CreatePhotoImageFormatVersion3) /* 280 */
#endif /* defined(USE_TK_STUBS) */
diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c
index cf9a8ac..8702970 100644
--- a/generic/tkImgGIF.c
+++ b/generic/tkImgGIF.c
@@ -118,28 +118,37 @@ typedef size_t (WriteBytesFunc) (ClientData clientData, const char *bytes,
* The format record for the GIF file format:
*/
-static int FileMatchGIF(Tcl_Channel chan, const char *fileName,
- Tcl_Obj *format, int *widthPtr, int *heightPtr,
- Tcl_Interp *interp);
+static int FileMatchGIF(Tcl_Interp *interp, Tcl_Channel chan,
+ const char *fileName, Tcl_Obj *format,
+ Tcl_Obj *metadataInObj, int *widthPtr,
+ int *heightPtr, Tcl_Obj *metadataOutObj);
static int FileReadGIF(Tcl_Interp *interp, Tcl_Channel chan,
const char *fileName, Tcl_Obj *format,
- Tk_PhotoHandle imageHandle, int destX, int destY,
- int width, int height, int srcX, int srcY);
-static int StringMatchGIF(Tcl_Obj *dataObj, Tcl_Obj *format,
- int *widthPtr, int *heightPtr, Tcl_Interp *interp);
+ Tcl_Obj *metadataInObj, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height,
+ int srcX, int srcY, Tcl_Obj *metadataOutObj);
+static int StringMatchGIF(Tcl_Interp *interp, Tcl_Obj *dataObj,
+ Tcl_Obj *format, Tcl_Obj *metadataInObj,
+ int *widthPtr, int *heightPtr,
+ Tcl_Obj *metadataOutObj);
static int StringReadGIF(Tcl_Interp *interp, Tcl_Obj *dataObj,
- Tcl_Obj *format, Tk_PhotoHandle imageHandle,
+ Tcl_Obj *format, Tcl_Obj *metadataInObj,
+ Tk_PhotoHandle imageHandle,
int destX, int destY, int width, int height,
- int srcX, int srcY);
+ int srcX, int srcY, Tcl_Obj *metadataOutObj);
static int FileWriteGIF(Tcl_Interp *interp, const char *filename,
- Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr);
+ Tcl_Obj *format, Tcl_Obj *metadataInObj,
+ Tk_PhotoImageBlock *blockPtr);
static int StringWriteGIF(Tcl_Interp *interp, Tcl_Obj *format,
+ Tcl_Obj *metadataInObj,
Tk_PhotoImageBlock *blockPtr);
-static int CommonWriteGIF(Tcl_Interp *interp, ClientData clientData,
+static int CommonWriteGIF(Tcl_Interp *interp,
+ ClientData clientData,
WriteBytesFunc *writeProc, Tcl_Obj *format,
+ Tcl_Obj *metadataInObj,
Tk_PhotoImageBlock *blockPtr);
-Tk_PhotoImageFormat tkImgFmtGIF = {
+Tk_PhotoImageFormatVersion3 tkImgFmtGIF = {
"gif", /* name */
FileMatchGIF, /* fileMatchProc */
StringMatchGIF, /* stringMatchProc */
@@ -165,9 +174,11 @@ Tk_PhotoImageFormat tkImgFmtGIF = {
* Prototypes for local functions defined in this file:
*/
+static int ReadOneByte(Tcl_Interp *interp,
+ GIFImageConfig *gifConfPtr, Tcl_Channel chan);
static int DoExtension(GIFImageConfig *gifConfPtr,
Tcl_Channel chan, int label, unsigned char *buffer,
- int *transparent);
+ int *transparent, Tcl_Obj *metadataOutObj);
static int GetCode(Tcl_Channel chan, int code_size, int flag,
GIFImageConfig *gifConfPtr);
static int GetDataBlock(GIFImageConfig *gifConfPtr,
@@ -345,18 +356,17 @@ static void FlushChar(GIFState_t *statePtr);
static int
FileMatchGIF(
+ TCL_UNUSED(Tcl_Interp *), /* not used */
Tcl_Channel chan, /* The image file, open for reading. */
- const char *fileName, /* The name of the image file. */
- Tcl_Obj *format, /* User-specified format object, or NULL. */
+ TCL_UNUSED(const char *), /* The name of the image file. */
+ TCL_UNUSED(Tcl_Obj *), /* User-specified format object, or NULL. */
+ TCL_UNUSED(Tcl_Obj *), /* metadata input, may be NULL */
int *widthPtr, int *heightPtr,
/* The dimensions of the image are returned
* here if the file is a valid raw GIF file. */
- Tcl_Interp *dummy) /* not used */
+ TCL_UNUSED(Tcl_Obj *)) /* metadata return dict, may be NULL */
{
GIFImageConfig gifConf;
- (void)fileName;
- (void)format;
- (void)dummy;
memset(&gifConf, 0, sizeof(GIFImageConfig));
return ReadGIFHeader(&gifConf, chan, widthPtr, heightPtr);
@@ -387,13 +397,15 @@ FileReadGIF(
Tcl_Channel chan, /* The image file, open for reading. */
const char *fileName, /* The name of the image file. */
Tcl_Obj *format, /* User-specified format object, or NULL. */
+ TCL_UNUSED(Tcl_Obj *), /* metadata input, may be NULL */
Tk_PhotoHandle imageHandle, /* The photo image to write into. */
int destX, int destY, /* Coordinates of top-left pixel in photo
* image to be written to. */
int width, int height, /* Dimensions of block of photo image to be
* written to. */
- int srcX, int srcY) /* Coordinates of top-left pixel to be used in
+ int srcX, int srcY, /* Coordinates of top-left pixel to be used in
* image being read. */
+ Tcl_Obj *metadataOutObj) /* metadata return dict, may be NULL */
{
int fileWidth, fileHeight, imageWidth, imageHeight;
unsigned int nBytes;
@@ -402,6 +414,7 @@ FileReadGIF(
unsigned char buf[100];
unsigned char *trashBuffer = NULL;
int bitPixel;
+ int gifLabel;
unsigned char colorMap[MAXCOLORMAPSIZE][4];
int transparent = -1;
static const char *const optionStrings[] = {
@@ -504,23 +517,21 @@ FileReadGIF(
}
/*
+ * -------------------------------------------------------------------------
+ * From here on, go to error to not leave memory leaks
+ * -------------------------------------------------------------------------
+ */
+
+ /*
* Search for the frame from the GIF to display.
*/
while (1) {
- if (Fread(gifConfPtr, buf, 1, 1, chan) != 1) {
- /*
- * Premature end of image.
- */
-
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "premature end of image data for this index", -1));
- Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "PREMATURE_END",
- NULL);
+ if (-1 == (gifLabel = ReadOneByte( interp, gifConfPtr, chan ) ) ) {
goto error;
}
- switch (buf[0]) {
+ switch (gifLabel) {
case GIF_TERMINATOR:
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"no image data for this index", -1));
@@ -532,16 +543,12 @@ FileReadGIF(
* This is a GIF extension.
*/
- if (Fread(gifConfPtr, buf, 1, 1, chan) != 1) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "error reading extension function code in GIF image",
- -1));
- Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT",
- NULL);
+ if (-1 == (gifLabel = ReadOneByte( interp, gifConfPtr, chan ) ) ) {
goto error;
}
- if (DoExtension(gifConfPtr, chan, buf[0],
- gifConfPtr->workingBuffer, &transparent) < 0) {
+ if (DoExtension(gifConfPtr, chan, gifLabel,
+ gifConfPtr->workingBuffer, &transparent, metadataOutObj)
+ < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"error reading extension in GIF image", -1));
Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT",
@@ -719,10 +726,52 @@ FileReadGIF(
* which suits as well). We're done.
*/
+ while (1) {
+ if (-1 == (gifLabel = ReadOneByte( interp, gifConfPtr, chan ) ) ) {
+ goto error;
+ }
+ switch (gifLabel) {
+ case GIF_TERMINATOR:
+ break;
+
+ case GIF_EXTENSION:
+ /*
+ * This is a GIF extension.
+ */
+
+ if (-1 == (gifLabel = ReadOneByte( interp, gifConfPtr, chan ) ) ) {
+ goto error;
+ }
+ if (DoExtension(gifConfPtr, chan, gifLabel,
+ gifConfPtr->workingBuffer, &transparent, metadataOutObj)
+ < 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error reading extension in GIF image", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT",
+ NULL);
+ goto error;
+ }
+ continue;
+ case GIF_START:
+ /*
+ * There should not be a second image block - bail out without error
+ */
+ break;
+ default:
+ /*
+ * Not a valid start character; ignore it.
+ */
+
+ continue;
+ }
+ break;
+ }
+
Tcl_SetObjResult(interp, Tcl_NewStringObj(tkImgFmtGIF.name, -1));
result = TCL_OK;
- error:
+error:
+
/*
* If a trash buffer has been allocated, free it now.
*/
@@ -733,6 +782,45 @@ FileReadGIF(
return result;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Read one Byte --
+ *
+ * Read one byte (label byte) from the image stream.
+ *
+ * Results:
+ * The return value is 1 if the first characters in the data are like GIF
+ * data, and 0 otherwise.
+ *
+ * Side effects:
+ * The access position in the source is incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadOneByte(
+ Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
+ GIFImageConfig *gifConfPtr,
+ Tcl_Channel chan /* The image file, open for reading. */
+ )
+{
+ unsigned char buf[2];
+ if (Fread(gifConfPtr, buf, 1, 1, chan) != 1) {
+ /*
+ * Premature end of image.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "premature end of image data", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "PREMATURE_END", NULL);
+ return -1;
+ }
+ return buf[0];
+}
+
/*
*----------------------------------------------------------------------
*
@@ -751,19 +839,20 @@ FileReadGIF(
*----------------------------------------------------------------------
*/
+
static int
StringMatchGIF(
+ TCL_UNUSED(Tcl_Interp *), /* not used */
Tcl_Obj *dataObj, /* the object containing the image data */
- Tcl_Obj *format, /* the image format object, or NULL */
+ TCL_UNUSED(Tcl_Obj *), /* the image format object, or NULL */
+ TCL_UNUSED(Tcl_Obj *), /* metadata input, may be NULL */
int *widthPtr, /* where to put the string width */
int *heightPtr, /* where to put the string height */
- Tcl_Interp *dummy) /* not used */
+ TCL_UNUSED(Tcl_Obj *)) /* metadata return dict, may be NULL */
{
unsigned char *data, header[10];
TkSizeT got, length;
MFile handle;
- (void)format;
- (void)dummy;
data = Tcl_GetByteArrayFromObj(dataObj, &length);
@@ -825,10 +914,12 @@ StringReadGIF(
Tcl_Interp *interp, /* interpreter for reporting errors in */
Tcl_Obj *dataObj, /* object containing the image */
Tcl_Obj *format, /* format object, or NULL */
+ Tcl_Obj *metadataInObj, /* metadata input, may be NULL */
Tk_PhotoHandle imageHandle, /* the image to write this data into */
int destX, int destY, /* The rectangular region of the */
int width, int height, /* image to copy */
- int srcX, int srcY)
+ int srcX, int srcY,
+ Tcl_Obj *metadataOutObj) /* metadata return dict, may be NULL */
{
MFile handle, *hdlPtr = &handle;
TkSizeT length;
@@ -857,7 +948,8 @@ StringReadGIF(
*/
return FileReadGIF(interp, (Tcl_Channel) hdlPtr, xferFormat, format,
- imageHandle, destX, destY, width, height, srcX, srcY);
+ metadataInObj, imageHandle, destX, destY, width, height, srcX, srcY,
+ metadataOutObj);
}
/*
@@ -936,48 +1028,103 @@ ReadColorMap(
return 1;
}
+/*
+*----------------------------------------------------------------------
+*
+* DoExtension --
+*
+* Process a GIF extension block
+*
+* Results:
+* -1 to trigger an extension read error
+* >= 0 ok
+*
+* Side effects:
+* The transparent color is set if present in current extensions
+* The data of the following extensions are saved to the metadata dict:
+* - Application extension
+* - Comment extension in key "comment"
+* Plain text extensions are currently ignored.
+*
+*----------------------------------------------------------------------
+*/
+
static int
DoExtension(
GIFImageConfig *gifConfPtr,
Tcl_Channel chan,
int label,
- unsigned char *buf,
- int *transparent)
+ unsigned char *buf, /* defined as 280 byte working buffer */
+ int *transparent,
+ Tcl_Obj *metadataOutObj)
{
int count;
+ /* Prepare extension name
+ * Maximum string size: "comment" + Code(3) + trailing zero
+ */
+ char extensionStreamName[8];
+ extensionStreamName[0] = '\0';
switch (label) {
case 0x01: /* Plain Text Extension */
+ /* this extension is ignored, skip below */
break;
-
- case 0xff: /* Application Extension */
- break;
-
- case 0xfe: /* Comment Extension */
- do {
- count = GetDataBlock(gifConfPtr, chan, buf);
- } while (count > 0);
- return count;
-
case 0xf9: /* Graphic Control Extension */
count = GetDataBlock(gifConfPtr, chan, buf);
if (count < 0) {
- return 1;
+ return -1;
}
if ((buf[0] & 0x1) != 0) {
*transparent = buf[3];
}
-
- do {
+ break;
+ case 0xfe: /* Comment Extension */
+ strcpy(extensionStreamName,"comment");
+ /* copy the extension data below */
+ break;
+ }
+ /* Add extension to dict */
+ if (NULL != metadataOutObj
+ && extensionStreamName[0] != '\0' ) {
+ Tcl_Obj *ValueObj;
+ int length = 0;
+ for (;;) {
count = GetDataBlock(gifConfPtr, chan, buf);
- } while (count > 0);
- return count;
+ switch (count) {
+ case -1: /* error */
+ return -1;
+ case 0: /* end of data */
+ if (length > 0) {
+ if ( TCL_OK != Tcl_DictObjPut(NULL, metadataOutObj,
+ Tcl_NewByteArrayObj(
+ (unsigned char *)extensionStreamName,
+ strlen(extensionStreamName)), ValueObj)) {
+ return -1;
+ }
+ }
+ /* return success */
+ return 0;
+ default: /* block received */
+ if (length == 0) {
+ /* first block */
+ ValueObj = Tcl_NewByteArrayObj(buf, count);
+ length = count;
+ } else {
+ /* consecutive block */
+ unsigned char *bytePtr;
+ bytePtr = Tcl_SetByteArrayLength(ValueObj, length+count);
+ memcpy(bytePtr+length,buf,count);
+ length += count;
+ }
+ break;
+ }
+ } /* for */
}
-
+ /* skip eventual remaining data block bytes */
do {
count = GetDataBlock(gifConfPtr, chan, buf);
} while (count > 0);
- return count;
+ return count; /* this may be -1 for error or 0 */
}
static int
@@ -1034,7 +1181,8 @@ ReadImage(
Tcl_Channel chan,
int len, int rows,
unsigned char cmap[MAXCOLORMAPSIZE][4],
- int srcX, int srcY,
+ TCL_UNUSED(int),
+ TCL_UNUSED(int),
int interlace,
int transparent)
{
@@ -1049,8 +1197,6 @@ ReadImage(
unsigned char *top;
int codeSize, clearCode, inCode, endCode, oldCode, maxCode;
int code, firstCode, v;
- (void)srcX;
- (void)srcY;
/*
* Initialize the decoder
@@ -1637,6 +1783,7 @@ FileWriteGIF(
Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
const char *filename,
Tcl_Obj *format,
+ Tcl_Obj *metadataInObj,
Tk_PhotoImageBlock *blockPtr)
{
Tcl_Channel chan = NULL;
@@ -1652,7 +1799,8 @@ FileWriteGIF(
return TCL_ERROR;
}
- result = CommonWriteGIF(interp, chan, WriteToChannel, format, blockPtr);
+ result = CommonWriteGIF(interp, chan, WriteToChannel, format, metadataInObj,
+ blockPtr);
if (Tcl_Close(interp, chan) == TCL_ERROR) {
return TCL_ERROR;
@@ -1665,6 +1813,7 @@ StringWriteGIF(
Tcl_Interp *interp, /* Interpreter to use for reporting errors and
* returning the GIF data. */
Tcl_Obj *format,
+ Tcl_Obj *metadataInObj,
Tk_PhotoImageBlock *blockPtr)
{
int result;
@@ -1672,7 +1821,7 @@ StringWriteGIF(
Tcl_IncrRefCount(objPtr);
result = CommonWriteGIF(interp, objPtr, WriteToByteArray, format,
- blockPtr);
+ metadataInObj, blockPtr);
if (result == TCL_OK) {
Tcl_SetObjResult(interp, objPtr);
}
@@ -1711,7 +1860,8 @@ CommonWriteGIF(
Tcl_Interp *interp,
ClientData handle,
WriteBytesFunc *writeProc,
- Tcl_Obj *format,
+ TCL_UNUSED(Tcl_Obj *),
+ Tcl_Obj *metadataInObj,
Tk_PhotoImageBlock *blockPtr)
{
GifWriterState state;
@@ -1719,7 +1869,6 @@ CommonWriteGIF(
long width, height, x;
unsigned char c;
unsigned int top, left;
- (void)format;
top = 0;
left = 0;
@@ -1842,6 +1991,50 @@ CommonWriteGIF(
c = 0;
writeProc(handle, (char *) &c, 1);
+ /*
+ * Check for metadata keys to add to file
+ */
+ if (NULL != metadataInObj) {
+ Tcl_Obj *itemData;
+
+ /*
+ * Check and code comment block
+ */
+
+ if (TCL_ERROR == Tcl_DictObjGet(interp, metadataInObj,
+ Tcl_NewStringObj("comment",-1),
+ &itemData)) {
+ return TCL_ERROR;
+ }
+ if (itemData != NULL) {
+ int length;
+ unsigned char *comment;
+ comment = Tcl_GetByteArrayFromObj(itemData, &length);
+ if (length > 0) {
+ /* write comment header */
+ writeProc(handle, (char *) "\x21\xfe", 2);
+ /* write comment blocks */
+ for (;length > 0;) {
+ int blockLength;
+ unsigned char blockLengthChar;
+ if (length > 255) {
+ length -=255;
+ blockLength = 255;
+ } else {
+ blockLength = length;
+ length = 0;
+ }
+ blockLengthChar = (unsigned char) blockLength;
+ writeProc(handle, (char *) &blockLengthChar, 1);
+ writeProc(handle, (char *) comment, blockLength);
+ comment += blockLength;
+ }
+ /* Block terminator */
+ c = 0;
+ writeProc(handle, (char *) &c, 1);
+ }
+ }
+ }
c = GIF_TERMINATOR;
writeProc(handle, (char *) &c, 1);
diff --git a/generic/tkImgPNG.c b/generic/tkImgPNG.c
index 318b3ab..5fd741c 100644
--- a/generic/tkImgPNG.c
+++ b/generic/tkImgPNG.c
@@ -175,6 +175,15 @@ typedef struct {
Tcl_Obj *thisLineObj; /* Current line of pixels to process. */
int lineSize; /* Number of bytes in a PNG line. */
int phaseSize; /* Number of bytes/line in current phase. */
+
+
+ /*
+ * Physical size: pHYS chunks.
+ */
+
+ double DPI;
+ double aspect;
+
} PNGImage;
/*
@@ -198,16 +207,20 @@ static int DecodePNG(Tcl_Interp *interp, PNGImage *pngPtr,
Tcl_Obj *fmtObj, Tk_PhotoHandle imageHandle,
int destX, int destY);
static int EncodePNG(Tcl_Interp *interp,
- Tk_PhotoImageBlock *blockPtr, PNGImage *pngPtr);
-static int FileMatchPNG(Tcl_Channel chan, const char *fileName,
- Tcl_Obj *fmtObj, int *widthPtr, int *heightPtr,
- Tcl_Interp *interp);
+ Tk_PhotoImageBlock *blockPtr, PNGImage *pngPtr,
+ Tcl_Obj *metadataInObj);
+static int FileMatchPNG(Tcl_Interp *interp, Tcl_Channel chan,
+ const char *fileName, Tcl_Obj *fmtObj,
+ Tcl_Obj *metadataInObj, int *widthPtr,
+ int *heightPtr, Tcl_Obj *metadataOut);
static int FileReadPNG(Tcl_Interp *interp, Tcl_Channel chan,
const char *fileName, Tcl_Obj *fmtObj,
- Tk_PhotoHandle imageHandle, int destX, int destY,
- int width, int height, int srcX, int srcY);
+ Tcl_Obj *metadataInObj, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height,
+ int srcX, int srcY, Tcl_Obj *metadataOutPtr);
static int FileWritePNG(Tcl_Interp *interp, const char *filename,
- Tcl_Obj *fmtObj, Tk_PhotoImageBlock *blockPtr);
+ Tcl_Obj *fmtObj, Tcl_Obj *metadataInObj,
+ Tk_PhotoImageBlock *blockPtr);
static int InitPNGImage(Tcl_Interp *interp, PNGImage *pngPtr,
Tcl_Channel chan, Tcl_Obj *objPtr, int dir);
static inline unsigned char Paeth(int a, int b, int c);
@@ -236,14 +249,18 @@ static int ReadTRNS(Tcl_Interp *interp, PNGImage *pngPtr,
int chunkSz, unsigned long crc);
static int SkipChunk(Tcl_Interp *interp, PNGImage *pngPtr,
int chunkSz, unsigned long crc);
-static int StringMatchPNG(Tcl_Obj *dataObj, Tcl_Obj *fmtObj,
+static int StringMatchPNG(Tcl_Interp *interp, Tcl_Obj *pObjData,
+ Tcl_Obj *fmtObj, Tcl_Obj *metadataInObj,
int *widthPtr, int *heightPtr,
- Tcl_Interp *interp);
-static int StringReadPNG(Tcl_Interp *interp, Tcl_Obj *dataObj,
- Tcl_Obj *fmtObj, Tk_PhotoHandle imageHandle,
+ Tcl_Obj *metadataOutObj);
+static int StringReadPNG(Tcl_Interp *interp, Tcl_Obj *pObjData,
+ Tcl_Obj *fmtObj, Tcl_Obj *metadataInObj,
+ Tk_PhotoHandle imageHandle,
int destX, int destY, int width, int height,
- int srcX, int srcY);
+ int srcX, int srcY, Tcl_Obj *metadataOutObj);
+
static int StringWritePNG(Tcl_Interp *interp, Tcl_Obj *fmtObj,
+ Tcl_Obj *metadataInObj,
Tk_PhotoImageBlock *blockPtr);
static int UnfilterLine(Tcl_Interp *interp, PNGImage *pngPtr);
static inline int WriteByte(Tcl_Interp *interp, PNGImage *pngPtr,
@@ -255,7 +272,7 @@ static int WriteData(Tcl_Interp *interp, PNGImage *pngPtr,
const unsigned char *srcPtr, size_t srcSz,
unsigned long *crcPtr);
static int WriteExtraChunks(Tcl_Interp *interp,
- PNGImage *pngPtr);
+ PNGImage *pngPtr, Tcl_Obj *metadataInObj);
static int WriteIHDR(Tcl_Interp *interp, PNGImage *pngPtr,
Tk_PhotoImageBlock *blockPtr);
static int WriteIDAT(Tcl_Interp *interp, PNGImage *pngPtr,
@@ -267,7 +284,7 @@ static inline int WriteInt32(Tcl_Interp *interp, PNGImage *pngPtr,
* The format record for the PNG file format:
*/
-Tk_PhotoImageFormat tkImgFmtPNG = {
+Tk_PhotoImageFormatVersion3 tkImgFmtPNG = {
"png", /* name */
FileMatchPNG, /* fileMatchProc */
StringMatchPNG, /* stringMatchProc */
@@ -344,6 +361,13 @@ InitPNGImage(
}
return TCL_ERROR;
}
+
+ /*
+ * Initialize physical size pHYS values
+ */
+
+ pngPtr->DPI = -1;
+ pngPtr->aspect = -1;
return TCL_OK;
}
@@ -933,6 +957,7 @@ ReadChunkHeader(
case CHUNK_IDAT:
case CHUNK_IEND:
case CHUNK_IHDR:
+ case CHUNK_pHYs:
case CHUNK_PLTE:
case CHUNK_tRNS:
break;
@@ -951,7 +976,6 @@ ReadChunkHeader(
case CHUNK_iTXt:
case CHUNK_oFFs:
case CHUNK_pCAL:
- case CHUNK_pHYs:
case CHUNK_sBIT:
case CHUNK_sCAL:
case CHUNK_sPLT:
@@ -1643,6 +1667,84 @@ ReadTRNS(
/*
*----------------------------------------------------------------------
*
+ * ReadPHYS --
+ *
+ * This function reads the PHYS (physical size) chunk data from
+ * the PNG file and populates the fields in the PNGImage
+ * structure.
+ *
+ * Results:
+ * TCL_OK, or TCL_ERROR if an I/O error occurs or the PHYS chunk is
+ * invalid.
+ *
+ * Side effects:
+ * The access position in f advances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadPHYS(
+ Tcl_Interp *interp,
+ PNGImage *pngPtr,
+ int chunkSz,
+ unsigned long crc)
+{
+ unsigned long PPUx, PPUy;
+ char unitSpecifier;
+
+ /*
+ * Check chunk size equal 9 bytes
+ */
+
+ if (chunkSz != 9) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invalid physical chunk size", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_PHYS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Read the chunk data
+ * 4 bytes: Pixels per unit, x axis
+ * 4 bytes: Pixels per unit, y axis
+ * 1 byte: unit specifier
+ */
+
+ if (ReadInt32(interp, pngPtr, &PPUx, &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (ReadInt32(interp, pngPtr, &PPUy, &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (ReadData(interp, pngPtr, (unsigned char *)&unitSpecifier, 1, &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (CheckCRC(interp, pngPtr, crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if ( PPUx > 2147483647 || PPUy > 2147483647
+ || unitSpecifier > 1 ) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invalid physical size value", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_PHYS", NULL);
+ return TCL_ERROR;
+ }
+
+ if (PPUx > 0) {
+ pngPtr->aspect = ((double) PPUy) / ((double) PPUx);
+ }
+ if (1 == unitSpecifier) {
+ pngPtr->DPI = ((double) PPUx) * 0.0254;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Paeth --
*
* Utility function for applying the Paeth filter to a pixel. The Paeth
@@ -2415,6 +2517,29 @@ DecodePNG(
return TCL_ERROR;
}
+ /*
+ * Physical header may be present here so try to parse it
+ */
+
+ if (CHUNK_pHYs == chunkType) {
+ /*
+ * Finish parsing the PHYS chunk.
+ */
+
+ if (ReadPHYS(interp, pngPtr, chunkSz, crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Begin the next chunk.
+ */
+
+ if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType,
+ &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ }
+
if (CHUNK_PLTE == chunkType) {
/*
* Finish parsing the PLTE chunk.
@@ -2466,6 +2591,29 @@ DecodePNG(
}
/*
+ * Physical header may be present here so try to parse it
+ */
+
+ if (CHUNK_pHYs == chunkType) {
+ /*
+ * Finish parsing the PHYS chunk.
+ */
+
+ if (ReadPHYS(interp, pngPtr, chunkSz, crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Begin the next chunk.
+ */
+
+ if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType,
+ &crc) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
* Other ancillary chunk types could appear here, but for now we're only
* interested in IDAT. The others should have been skipped.
*/
@@ -2667,17 +2815,18 @@ DecodePNG(
static int
FileMatchPNG(
- Tcl_Channel chan,
- const char *fileName,
- Tcl_Obj *fmtObj,
- int *widthPtr,
- int *heightPtr,
- Tcl_Interp *interp)
+ Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
+ Tcl_Channel chan, /* The image file, open for reading. */
+ TCL_UNUSED(const char *), /* The name of the image file. */
+ TCL_UNUSED(Tcl_Obj *), /* User-specified format object, or NULL. */
+ TCL_UNUSED(Tcl_Obj *), /* metadata input, may be NULL */
+ int *widthPtr, int *heightPtr,
+ /* The dimensions of the image are returned
+ * here if the file is a valid raw GIF file. */
+ TCL_UNUSED(Tcl_Obj *)) /* metadata return dict, may be NULL */
{
PNGImage png;
int match = 0;
- (void)fileName;
- (void)fmtObj;
InitPNGImage(NULL, &png, chan, NULL, TCL_ZLIB_STREAM_INFLATE);
@@ -2713,25 +2862,24 @@ FileMatchPNG(
static int
FileReadPNG(
- Tcl_Interp *interp,
- Tcl_Channel chan,
- const char *fileName,
- Tcl_Obj *fmtObj,
- Tk_PhotoHandle imageHandle,
- int destX,
- int destY,
- int width,
- int height,
- int srcX,
- int srcY)
+ Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
+ Tcl_Channel chan, /* The image file, open for reading. */
+ TCL_UNUSED(const char *), /* The name of the image file. */
+ Tcl_Obj *fmtObj, /* User-specified format object, or NULL. */
+ TCL_UNUSED(Tcl_Obj *), /* metadata input, may be NULL */
+ Tk_PhotoHandle imageHandle, /* The photo image to write into. */
+ int destX, int destY, /* Coordinates of top-left pixel in photo
+ * image to be written to. */
+ TCL_UNUSED(int), /* Dimensions of block of photo image to be
+ * written to. */
+ TCL_UNUSED(int),
+ TCL_UNUSED(int), /* Coordinates of top-left pixel to be used in
+ * image being read. */
+ TCL_UNUSED(int),
+ Tcl_Obj *metadataOutObj) /* metadata return dict, may be NULL */
{
PNGImage png;
int result = TCL_ERROR;
- (void)fileName;
- (void)width;
- (void)height;
- (void)srcX;
- (void)srcY;
result = InitPNGImage(interp, &png, chan, NULL, TCL_ZLIB_STREAM_INFLATE);
@@ -2739,6 +2887,18 @@ FileReadPNG(
result = DecodePNG(interp, &png, fmtObj, imageHandle, destX, destY);
}
+ if (TCL_OK == result && metadataOutObj != NULL && png.DPI != -1) {
+ result = Tcl_DictObjPut(NULL, metadataOutObj,
+ Tcl_NewStringObj("DPI",-1),
+ Tcl_NewDoubleObj(png.DPI));
+ }
+
+ if (TCL_OK == result && metadataOutObj != NULL && png.aspect != -1) {
+ result = Tcl_DictObjPut(NULL, metadataOutObj,
+ Tcl_NewStringObj("aspect",-1),
+ Tcl_NewDoubleObj(png.aspect));
+ }
+
CleanupPNGImage(&png);
return result;
}
@@ -2763,15 +2923,16 @@ FileReadPNG(
static int
StringMatchPNG(
- Tcl_Obj *pObjData,
- Tcl_Obj *fmtObj,
- int *widthPtr,
- int *heightPtr,
- Tcl_Interp *interp)
+ Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
+ Tcl_Obj *pObjData, /* the object containing the image data */
+ TCL_UNUSED(Tcl_Obj *), /* the image format object, or NULL */
+ TCL_UNUSED(Tcl_Obj *), /* metadata input, may be NULL */
+ int *widthPtr, /* where to put the string width */
+ int *heightPtr, /* where to put the string height */
+ TCL_UNUSED(Tcl_Obj *)) /* metadata return dict, may be NULL */
{
PNGImage png;
int match = 0;
- (void)fmtObj;
InitPNGImage(NULL, &png, NULL, pObjData, TCL_ZLIB_STREAM_INFLATE);
@@ -2807,23 +2968,20 @@ StringMatchPNG(
static int
StringReadPNG(
- Tcl_Interp *interp,
- Tcl_Obj *pObjData,
- Tcl_Obj *fmtObj,
- Tk_PhotoHandle imageHandle,
- int destX,
- int destY,
- int width,
- int height,
- int srcX,
- int srcY)
+ Tcl_Interp *interp, /* interpreter for reporting errors in */
+ Tcl_Obj *pObjData, /* object containing the image */
+ Tcl_Obj *fmtObj, /* format object, or NULL */
+ TCL_UNUSED(Tcl_Obj *), /* metadata input, may be NULL */
+ Tk_PhotoHandle imageHandle, /* the image to write this data into */
+ int destX, int destY, /* The rectangular region of the */
+ TCL_UNUSED(int), /* image to copy */
+ TCL_UNUSED(int),
+ TCL_UNUSED(int),
+ TCL_UNUSED(int),
+ Tcl_Obj *metadataOutObj) /* metadata return dict, may be NULL */
{
PNGImage png;
int result = TCL_ERROR;
- (void)width;
- (void)height;
- (void)srcX;
- (void)srcY;
result = InitPNGImage(interp, &png, NULL, pObjData,
TCL_ZLIB_STREAM_INFLATE);
@@ -2832,6 +2990,18 @@ StringReadPNG(
result = DecodePNG(interp, &png, fmtObj, imageHandle, destX, destY);
}
+ if (TCL_OK == result && metadataOutObj != NULL && png.DPI != -1) {
+ result = Tcl_DictObjPut(NULL, metadataOutObj,
+ Tcl_NewStringObj("DPI",-1),
+ Tcl_NewDoubleObj(png.DPI));
+ }
+
+ if (TCL_OK == result && metadataOutObj != NULL && png.aspect != -1) {
+ result = Tcl_DictObjPut(NULL, metadataOutObj,
+ Tcl_NewStringObj("aspect",-1),
+ Tcl_NewDoubleObj(png.aspect));
+ }
+
CleanupPNGImage(&png);
return result;
}
@@ -2918,6 +3088,34 @@ WriteByte(
/*
*----------------------------------------------------------------------
*
+ * LongToInt32 --
+ *
+ * This function transforms to a 32-bit integer value as
+ * four bytes in network byte order.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Buffer will be modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline void
+LongToInt32(
+ unsigned long l,
+ unsigned char *pc)
+{
+ pc[0] = (unsigned char) ((l & 0xff000000) >> 24);
+ pc[1] = (unsigned char) ((l & 0x00ff0000) >> 16);
+ pc[2] = (unsigned char) ((l & 0x0000ff00) >> 8);
+ pc[3] = (unsigned char) ((l & 0x000000ff) >> 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* WriteInt32 --
*
* This function writes a 32-bit integer value out to the PNG image as
@@ -2940,12 +3138,7 @@ WriteInt32(
unsigned long *crcPtr)
{
unsigned char pc[4];
-
- pc[0] = (unsigned char) ((l & 0xff000000) >> 24);
- pc[1] = (unsigned char) ((l & 0x00ff0000) >> 16);
- pc[2] = (unsigned char) ((l & 0x0000ff00) >> 8);
- pc[3] = (unsigned char) ((l & 0x000000ff) >> 0);
-
+ LongToInt32(l,pc);
return WriteData(interp, pngPtr, pc, 4, crcPtr);
}
@@ -3264,7 +3457,8 @@ WriteIDAT(
static int
WriteExtraChunks(
Tcl_Interp *interp,
- PNGImage *pngPtr)
+ PNGImage *pngPtr,
+ Tcl_Obj *metadataInObj)
{
static const unsigned char sBIT_contents[] = {
8, 8, 8, 8
@@ -3315,7 +3509,80 @@ WriteExtraChunks(
return TCL_ERROR;
}
Tcl_DStringFree(&buf);
+
+ /*
+ * Add a pHYs chunk if there is metadata for DPI and/or aspect
+ * aspect = PPUy / PPUx
+ * DPI = PPUx * 0.0254
+ * The physical chunk consists of:
+ * - Points per meter in x direction (32 bit)
+ * - Points per meter in x direction (32 bit)
+ * - Unit specifier: 0: no unit (only aspect), 1: Points per meter
+ */
+
+ if (metadataInObj != NULL) {
+
+ Tcl_Obj *aspectObj, *DPIObj;
+ double aspectValue=-1, DPIValue=-1;
+ unsigned long PPUx = 65536, PPUy = 65536;
+ char unitSpecifier;
+
+ if (TCL_ERROR == Tcl_DictObjGet(interp, metadataInObj,
+ Tcl_NewStringObj("aspect",-1),
+ &aspectObj) ||
+ TCL_ERROR == Tcl_DictObjGet(interp, metadataInObj,
+ Tcl_NewStringObj("DPI",-1),
+ &DPIObj) ) {
+ return TCL_ERROR;
+ }
+ if (DPIObj != NULL) {
+ if (TCL_ERROR == Tcl_GetDoubleFromObj(interp, DPIObj, &DPIValue))
+ {
+ return TCL_ERROR;
+ }
+ PPUx = (unsigned long)floor(DPIValue / 0.0254+0.5);
+ if (aspectObj == NULL) {
+ PPUy = PPUx;
+ }
+ unitSpecifier = 1;
+ }
+ if (aspectObj != NULL) {
+ if (TCL_ERROR == Tcl_GetDoubleFromObj(interp, aspectObj,
+ &aspectValue)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * aspect = PPUy / PPUx
+ */
+
+ if (DPIObj == NULL) {
+ unitSpecifier = 0;
+ PPUx = 65536;
+ PPUy = (unsigned long)floor(65536.0 * aspectValue+0.5);
+ } else {
+ PPUy = (unsigned long)floor(DPIValue * aspectValue / 0.0254+0.5);
+ }
+ }
+ if (DPIObj != NULL || aspectObj != NULL) {
+ unsigned char buffer[9];
+ if ( PPUx > 2147483647 || PPUy > 2147483647 ) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "DPI or aspect out of range", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "PHYS", NULL);
+ return TCL_ERROR;
+ }
+
+ LongToInt32(PPUx, buffer);
+ LongToInt32(PPUy, buffer+4);
+ buffer[8] = unitSpecifier;
+ if (WriteChunk(interp, pngPtr, CHUNK_pHYs, buffer, 9)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ }
return TCL_OK;
}
@@ -3341,7 +3608,8 @@ static int
EncodePNG(
Tcl_Interp *interp,
Tk_PhotoImageBlock *blockPtr,
- PNGImage *pngPtr)
+ PNGImage *pngPtr,
+ Tcl_Obj *metadataInObj)
{
int greenOffset, blueOffset, alphaOffset;
@@ -3424,7 +3692,7 @@ EncodePNG(
* other programs more than us.
*/
- if (WriteExtraChunks(interp, pngPtr) == TCL_ERROR) {
+ if (WriteExtraChunks(interp, pngPtr, metadataInObj) == TCL_ERROR) {
return TCL_ERROR;
}
@@ -3465,13 +3733,13 @@ static int
FileWritePNG(
Tcl_Interp *interp,
const char *filename,
- Tcl_Obj *fmtObj,
+ TCL_UNUSED(Tcl_Obj *),
+ Tcl_Obj *metadataInObj,
Tk_PhotoImageBlock *blockPtr)
{
Tcl_Channel chan;
PNGImage png;
int result = TCL_ERROR;
- (void)fmtObj;
/*
* Open a Tcl file channel where the image data will be stored. Tk ought
@@ -3507,7 +3775,7 @@ FileWritePNG(
* Write the raw PNG data out to the file.
*/
- result = EncodePNG(interp, blockPtr, &png);
+ result = EncodePNG(interp, blockPtr, &png, metadataInObj);
cleanup:
Tcl_Close(interp, chan);
@@ -3536,13 +3804,13 @@ FileWritePNG(
static int
StringWritePNG(
Tcl_Interp *interp,
- Tcl_Obj *fmtObj,
+ TCL_UNUSED(Tcl_Obj *),
+ Tcl_Obj *metadataInObj,
Tk_PhotoImageBlock *blockPtr)
{
Tcl_Obj *resultObj = Tcl_NewObj();
PNGImage png;
int result = TCL_ERROR;
- (void)fmtObj;
/*
* Initalize PNGImage instance for encoding.
@@ -3558,7 +3826,7 @@ StringWritePNG(
* back to the interpreter if successful.
*/
- result = EncodePNG(interp, blockPtr, &png);
+ result = EncodePNG(interp, blockPtr, &png, metadataInObj);
if (TCL_OK == result) {
Tcl_SetObjResult(interp, png.objDataPtr);
diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c
index 82c715d..5352a15 100644
--- a/generic/tkImgPhoto.c
+++ b/generic/tkImgPhoto.c
@@ -39,6 +39,7 @@ struct SubcommandOptions {
XColor *background; /* Value specified for -background option. */
int compositingRule; /* Value specified for -compositingrule
* option. */
+ Tcl_Obj *metadata; /* Value specified for -metadata option. */
};
/*
@@ -54,6 +55,7 @@ struct SubcommandOptions {
* 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_METADATA: Set if -metadata 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.
@@ -67,11 +69,12 @@ struct SubcommandOptions {
#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
+#define OPT_METADATA 0x40
+#define OPT_SHRINK 0x80
+#define OPT_SUBSAMPLE 0x100
+#define OPT_TO 0x200
+#define OPT_WITHALPHA 0x400
+#define OPT_ZOOM 0x800
/*
* List of option names. The order here must match the order of declarations
@@ -85,6 +88,7 @@ static const char *const optionNames[] = {
"-format",
"-from",
"-grayscale",
+ "-metadata",
"-shrink",
"-subsample",
"-to",
@@ -140,6 +144,9 @@ typedef struct {
/* Pointer to the first in the list of known
* photo image formats.*/
#endif
+ Tk_PhotoImageFormatVersion3 *formatListVersion3;
+ /* Pointer to the first in the list of known
+ * photo image formats in Version3 format.*/
int initialized; /* Set to 1 if we've initialized the
* structure. */
} ThreadSpecificData;
@@ -195,11 +202,17 @@ static char * ImgGetPhoto(PhotoModel *modelPtr,
struct SubcommandOptions *optPtr);
static int MatchFileFormat(Tcl_Interp *interp, Tcl_Channel chan,
const char *fileName, Tcl_Obj *formatString,
+ Tcl_Obj *metadataInObj,
+ Tcl_Obj *metadataOutObj,
Tk_PhotoImageFormat **imageFormatPtr,
+ Tk_PhotoImageFormatVersion3 **imageFormatVersion3Ptr,
int *widthPtr, int *heightPtr, int *oldformat);
static int MatchStringFormat(Tcl_Interp *interp, Tcl_Obj *data,
Tcl_Obj *formatString,
+ Tcl_Obj *metadataInObj,
+ Tcl_Obj *metadataOutObj,
Tk_PhotoImageFormat **imageFormatPtr,
+ Tk_PhotoImageFormatVersion3 **imageFormatVersion3Ptr,
int *widthPtr, int *heightPtr, int *oldformat);
static const char * GetExtension(const char *path);
@@ -224,6 +237,7 @@ PhotoFormatThreadExitProc(
TCL_UNUSED(void *)) /* not used */
{
Tk_PhotoImageFormat *freePtr;
+ Tk_PhotoImageFormatVersion3 *freePtrVersion3;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
@@ -240,12 +254,19 @@ PhotoFormatThreadExitProc(
ckfree((char *)freePtr->name);
ckfree(freePtr);
}
+ while (tsdPtr->formatListVersion3 != NULL) {
+ freePtrVersion3 = tsdPtr->formatListVersion3;
+ tsdPtr->formatListVersion3 = tsdPtr->formatListVersion3->nextPtr;
+ ckfree((char *)freePtrVersion3->name);
+ ckfree(freePtrVersion3);
+ }
}
/*
*----------------------------------------------------------------------
*
- * Tk_CreateOldPhotoImageFormat, Tk_CreatePhotoImageFormat --
+ * Tk_CreateOldPhotoImageFormat, Tk_CreatePhotoImageFormat,
+ * Tk_CreatePhotoImageFormatVersion3 --
*
* This function is invoked by an image file handler to register a new
* photo image format and the functions that handle the new format. The
@@ -316,6 +337,32 @@ Tk_CreatePhotoImageFormat(
tsdPtr->formatList = copyPtr;
}
}
+void
+Tk_CreatePhotoImageFormatVersion3(
+ const Tk_PhotoImageFormatVersion3 *formatPtr)
+ /* Structure describing the format. All of the
+ * fields except "nextPtr" must be filled in
+ * by caller. */
+{
+ Tk_PhotoImageFormatVersion3 *copyPtr;
+ char *name;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ Tcl_CreateThreadExitHandler(PhotoFormatThreadExitProc, NULL);
+ }
+ copyPtr = (Tk_PhotoImageFormatVersion3 *)
+ ckalloc(sizeof(Tk_PhotoImageFormatVersion3));
+ *copyPtr = *formatPtr;
+ /* for compatibility with aMSN: make a copy of formatPtr->name */
+ name = (char *)ckalloc(strlen(formatPtr->name) + 1);
+ strcpy(name, formatPtr->name);
+ copyPtr->name = name;
+ copyPtr->nextPtr = tsdPtr->formatListVersion3;
+ tsdPtr->formatListVersion3 = copyPtr;
+}
/*
*----------------------------------------------------------------------
@@ -419,6 +466,7 @@ ImgPhotoCmd(
unsigned char *pixelPtr;
Tk_PhotoImageBlock block;
Tk_PhotoImageFormat *imageFormat;
+ Tk_PhotoImageFormatVersion3 *imageFormatVersion3;
TkSizeT length;
int imageWidth, imageHeight, matched, oldformat = 0;
Tcl_Channel chan;
@@ -466,6 +514,10 @@ ImgPhotoCmd(
if (modelPtr->format) {
Tcl_SetObjResult(interp, modelPtr->format);
}
+ } else if (strncmp(arg, "-metadata", length) == 0) {
+ if (modelPtr->metadata) {
+ Tcl_SetObjResult(interp, modelPtr->metadata);
+ }
} else {
Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
(char *) modelPtr, Tcl_GetString(objv[2]), 0);
@@ -501,6 +553,13 @@ ImgPhotoCmd(
Tcl_AppendStringsToObj(subobj, " {}", NULL);
}
Tcl_ListObjAppendElement(interp, obj, subobj);
+ subobj = Tcl_NewStringObj("-metadata {} {} {}", 16);
+ if (modelPtr->metadata) {
+ Tcl_ListObjAppendElement(NULL, subobj, modelPtr->metadata);
+ } else {
+ Tcl_AppendStringsToObj(subobj, " {}", NULL);
+ }
+ Tcl_ListObjAppendElement(interp, obj, subobj);
Tcl_ListObjAppendList(interp, obj, Tcl_GetObjResult(interp));
Tcl_SetObjResult(interp, obj);
return TCL_OK;
@@ -535,6 +594,20 @@ ImgPhotoCmd(
Tcl_AppendResult(interp, " {}", NULL);
}
return TCL_OK;
+ } else if (length > 1 &&
+ !strncmp(arg, "-metadata", length)) {
+ Tcl_AppendResult(interp, "-metadata {} {} {}", NULL);
+ if (modelPtr->metadata) {
+ /*
+ * TODO: Modifying result is bad!
+ */
+
+ Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+ modelPtr->metadata);
+ } else {
+ Tcl_AppendResult(interp, " {}", NULL);
+ }
+ return TCL_OK;
} else {
return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
configSpecs, (char *) modelPtr, arg, 0);
@@ -678,21 +751,25 @@ ImgPhotoCmd(
case PHOTO_DATA: {
char *data = NULL;
Tcl_Obj *freeObj = NULL;
+ Tcl_Obj *metadataIn;
/*
* photo data command - first parse and check any options given.
*/
Tk_ImageStringWriteProc *stringWriteProc = NULL;
+ Tk_ImageStringWriteProcVersion3 *stringWriteProcVersion3 = NULL;
index = 1;
memset(&options, 0, sizeof(options));
options.name = NULL;
options.format = NULL;
+ options.metadata = NULL;
options.fromX = 0;
options.fromY = 0;
if (ParseSubcommandOptions(&options, interp,
- OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND,
+ OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND
+ | OPT_METADATA,
&index, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
@@ -722,6 +799,16 @@ ImgPhotoCmd(
options.format = Tcl_NewStringObj("default", -1);
freeObj = options.format;
}
+
+ /*
+ * Use argument metadata if specified, otherwise the master metadata
+ */
+
+ if (NULL != options.metadata) {
+ metadataIn = options.metadata;
+ } else {
+ metadataIn = modelPtr->metadata;
+ }
/*
* Search for an appropriate image string format handler.
@@ -757,12 +844,29 @@ ImgPhotoCmd(
}
#endif
if (stringWriteProc == NULL) {
+ oldformat = 0;
+ for (imageFormatVersion3 = tsdPtr->formatListVersion3;
+ imageFormatVersion3 != NULL;
+ imageFormatVersion3 = imageFormatVersion3->nextPtr) {
+ if ((strncasecmp(Tcl_GetString(options.format),
+ imageFormatVersion3->name,
+ strlen(imageFormatVersion3->name)) == 0)) {
+ matched = 1;
+ if (imageFormatVersion3->stringWriteProc != NULL) {
+ stringWriteProcVersion3 =
+ imageFormatVersion3->stringWriteProc;
+ break;
+ }
+ }
+ }
+ }
+ if (stringWriteProc == NULL && stringWriteProcVersion3 == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "image string format \"%s\" is %s",
- Tcl_GetString(options.format),
- (matched ? "not supported" : "unknown")));
+ "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);
+ Tcl_GetString(options.format), NULL);
goto dataErrorExit;
}
@@ -772,7 +876,10 @@ ImgPhotoCmd(
data = ImgGetPhoto(modelPtr, &block, &options);
- if (oldformat) {
+ if (stringWriteProc == NULL) {
+ result = (stringWriteProcVersion3)(interp,
+ options.format, metadataIn, &block);
+ } else if (oldformat) {
Tcl_DString buffer;
typedef int (*OldStringWriteProc)(Tcl_Interp *interp,
Tcl_DString *dataPtr, const char *formatString,
@@ -879,7 +986,9 @@ ImgPhotoCmd(
memset(&options, 0, sizeof(options));
options.name = NULL;
options.format = NULL;
- if (ParseSubcommandOptions(&options, interp, OPT_TO|OPT_FORMAT,
+ options.metadata = NULL;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_TO|OPT_FORMAT|OPT_METADATA,
&index, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
@@ -892,8 +1001,10 @@ ImgPhotoCmd(
* See if there's a format that can read the data
*/
- if (MatchStringFormat(interp, objv[2], options.format, &imageFormat,
- &imageWidth, &imageHeight, &oldformat) != TCL_OK) {
+ if (MatchStringFormat(interp, objv[2], options.format,
+ options.metadata, NULL, &imageFormat,
+ &imageFormatVersion3, &imageWidth, &imageHeight, &oldformat)
+ != TCL_OK) {
return TCL_ERROR;
}
@@ -916,12 +1027,25 @@ ImgPhotoCmd(
data = (Tcl_Obj *) Tcl_GetString(data);
}
- if (imageFormat->stringReadProc(interp, data, format,
- (Tk_PhotoHandle) modelPtr, options.toX, options.toY,
- options.toX2 - options.toX,
- options.toY2 - options.toY, 0, 0) != TCL_OK) {
- return TCL_ERROR;
+ if (imageFormat != NULL) {
+ if (imageFormat->stringReadProc(interp, data, format,
+ (Tk_PhotoHandle) modelPtr, options.toX, options.toY,
+ options.toX2 - options.toX,
+ options.toY2 - options.toY, 0, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ if (imageFormatVersion3->stringReadProc(interp, data, format,
+ options.metadata,
+ (Tk_PhotoHandle) modelPtr, options.toX, options.toY,
+ options.toX2 - options.toX,
+ options.toY2 - options.toY, 0, 0,
+ NULL)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
}
+
/*
* SB: is the next line really needed? The stringReadProc
* writes image data with Tk_PhotoPutBlock(), which in turn
@@ -943,8 +1067,9 @@ ImgPhotoCmd(
memset(&options, 0, sizeof(options));
options.name = NULL;
options.format = NULL;
+ options.metadata = NULL;
if (ParseSubcommandOptions(&options, interp,
- OPT_FORMAT | OPT_FROM | OPT_TO | OPT_SHRINK,
+ OPT_FORMAT | OPT_FROM | OPT_TO | OPT_SHRINK | OPT_METADATA,
&index, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
@@ -985,10 +1110,12 @@ ImgPhotoCmd(
}
if (MatchFileFormat(interp, chan,
- Tcl_GetString(options.name), options.format, &imageFormat,
- &imageWidth, &imageHeight, &oldformat) != TCL_OK) {
- Tcl_Close(NULL, chan);
- return TCL_ERROR;
+ Tcl_GetString(options.name), options.format,
+ options.metadata, NULL, &imageFormat,
+ &imageFormatVersion3, &imageWidth, &imageHeight, &oldformat)
+ != TCL_OK) {
+ result = TCL_ERROR;
+ goto readCleanup;
}
/*
@@ -1002,8 +1129,8 @@ ImgPhotoCmd(
"coordinates for -from option extend outside source image",
-1));
Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL);
- Tcl_Close(NULL, chan);
- return TCL_ERROR;
+ result = TCL_ERROR;
+ goto readCleanup;
}
if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) {
width = imageWidth - options.fromX;
@@ -1024,8 +1151,8 @@ ImgPhotoCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1));
Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
- Tcl_Close(NULL, chan);
- return TCL_ERROR;
+ result = TCL_ERROR;
+ goto readCleanup;
}
}
@@ -1038,10 +1165,19 @@ ImgPhotoCmd(
if (oldformat && format) {
format = (Tcl_Obj *) Tcl_GetString(format);
}
- result = imageFormat->fileReadProc(interp, chan,
- Tcl_GetString(options.name),
- format, (Tk_PhotoHandle) modelPtr, options.toX,
- options.toY, width, height, options.fromX, options.fromY);
+ if (imageFormat != NULL) {
+ result = imageFormat->fileReadProc(interp, chan,
+ Tcl_GetString(options.name),
+ format, (Tk_PhotoHandle) modelPtr, options.toX,
+ options.toY, width, height, options.fromX, options.fromY);
+ } else {
+ result = imageFormatVersion3->fileReadProc(interp, chan,
+ Tcl_GetString(options.name),
+ format, options.metadata, (Tk_PhotoHandle) modelPtr,
+ options.toX, options.toY, width, height, options.fromX,
+ options.fromY, NULL);
+ }
+readCleanup:
if (chan != NULL) {
Tcl_Close(NULL, chan);
}
@@ -1271,7 +1407,7 @@ ImgPhotoCmd(
case PHOTO_WRITE: {
char *data;
const char *fmtString;
- Tcl_Obj *format;
+ Tcl_Obj *format, *metadataIn;
int usedExt;
/*
@@ -1293,8 +1429,10 @@ ImgPhotoCmd(
memset(&options, 0, sizeof(options));
options.name = NULL;
options.format = NULL;
+ options.metadata = NULL;
if (ParseSubcommandOptions(&options, interp,
- OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND,
+ OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND
+ | OPT_METADATA,
&index, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
@@ -1330,6 +1468,17 @@ ImgPhotoCmd(
usedExt = 0;
}
+
+ /*
+ * Use argument metadata if specified, otherwise the master metadata
+ */
+
+ if (NULL != options.metadata) {
+ metadataIn = options.metadata;
+ } else {
+ metadataIn = modelPtr->metadata;
+ }
+
/*
* Search for an appropriate image file format handler, and give an
* error if none is found.
@@ -1337,6 +1486,7 @@ ImgPhotoCmd(
matched = 0;
redoFormatLookup:
+ imageFormatVersion3 = NULL;
for (imageFormat = tsdPtr->formatList; imageFormat != NULL;
imageFormat = imageFormat->nextPtr) {
if ((fmtString == NULL)
@@ -1364,6 +1514,21 @@ ImgPhotoCmd(
}
}
#endif
+ if (imageFormat == NULL) {
+ oldformat = 0;
+ for (imageFormatVersion3 = tsdPtr->formatListVersion3;
+ imageFormatVersion3 != NULL;
+ imageFormatVersion3 = imageFormatVersion3->nextPtr) {
+ if ((fmtString == NULL)
+ || (strncasecmp(fmtString, imageFormatVersion3->name,
+ strlen(imageFormatVersion3->name)) == 0)) {
+ matched = 1;
+ if (imageFormatVersion3->fileWriteProc != NULL) {
+ break;
+ }
+ }
+ }
+ }
if (usedExt && !matched) {
/*
* If we didn't find one and we're using file extensions as the
@@ -1375,7 +1540,7 @@ ImgPhotoCmd(
fmtString = NULL;
goto redoFormatLookup;
}
- if (imageFormat == NULL) {
+ if (imageFormat == NULL && imageFormatVersion3 == NULL) {
if (fmtString == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"no available image file format has file writing"
@@ -1402,8 +1567,14 @@ ImgPhotoCmd(
if (oldformat && format) {
format = (Tcl_Obj *) Tcl_GetString(options.format);
}
- result = imageFormat->fileWriteProc(interp,
- Tcl_GetString(options.name), format, &block);
+ if (imageFormat != NULL) {
+ result = imageFormat->fileWriteProc(interp,
+ Tcl_GetString(options.name), format, &block);
+ } else {
+ result = imageFormatVersion3->fileWriteProc(interp,
+ Tcl_GetString(options.name), format, metadataIn,
+ &block);
+ }
if (options.background) {
Tk_FreeColor(options.background);
}
@@ -1455,8 +1626,8 @@ GetExtension(
*
* This function is invoked to process one of the options which may be
* specified for the photo image subcommands, namely, -from, -to, -zoom,
- * -subsample, -format, -shrink, -compositingrule, -alpha, -boolean and
- * -withalpha.
+ * -subsample, -format, -shrink, -compositingrule, -alpha, -boolean,
+ * -withalpha and -metadata.
* 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.
*
@@ -1574,6 +1745,17 @@ ParseSubcommandOptions(
}
*optIndexPtr = ++index;
optPtr->format = objv[index];
+ } else if (bit == OPT_METADATA) {
+ /*
+ * The -metadata option takes a single dict value. Note that
+ * parsing this is outside the scope of this function.
+ */
+
+ if (index + 1 >= objc) {
+ goto oneValueRequired;
+ }
+ *optIndexPtr = ++index;
+ optPtr->metadata = objv[index];
} else if (bit == OPT_COMPOSITE) {
/*
* The -compositingrule option takes a single value from a
@@ -1770,13 +1952,15 @@ ImgPhotoConfigureModel(
{
PhotoInstance *instancePtr;
const char *oldFileString, *oldPaletteString;
- Tcl_Obj *oldData, *data = NULL, *oldFormat, *format = NULL;
+ Tcl_Obj *oldData, *data = NULL, *oldFormat, *format = NULL,
+ *metadataInObj = NULL, *metadataOutObj = NULL;
Tcl_Obj *tempdata, *tempformat;
TkSizeT length;
int i, j, result, imageWidth, imageHeight, oldformat;
double oldGamma;
Tcl_Channel chan;
Tk_PhotoImageFormat *imageFormat;
+ Tk_PhotoImageFormatVersion3 *imageFormatVersion3;
const char **args;
args = (const char **)ckalloc((objc + 1) * sizeof(char *));
@@ -1809,6 +1993,19 @@ ImgPhotoConfigureModel(
"MISSING_VALUE", NULL);
return TCL_ERROR;
}
+ } else if ((args[j][1] == 'm') &&
+ !strncmp(args[j], "-metadata", length)) {
+ if (++i < objc) {
+ metadataInObj = objv[i];
+ j--;
+ } else {
+ ckfree(args);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "value for \"-metadata\" missing", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+ "MISSING_VALUE", NULL);
+ return TCL_ERROR;
+ }
}
}
}
@@ -1848,7 +2045,7 @@ ImgPhotoConfigureModel(
ckfree(args);
/*
- * Regard the empty string for -file, -data or -format as the null value.
+ * Regard the empty string for -file, -data, -format or -metadata as the null value.
*/
if ((modelPtr->fileString != NULL) && (modelPtr->fileString[0] == 0)) {
@@ -1890,6 +2087,32 @@ ImgPhotoConfigureModel(
}
modelPtr->format = format;
}
+ if (metadataInObj) {
+ /*
+ * Make -metadata a dict.
+ * Take also empty metadatas as this may be a sign to replace
+ * existing metadata.
+ */
+ int dictSize;
+
+ if (TCL_OK != Tcl_DictObjSize(interp,metadataInObj, &dictSize)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "value for \"-metadata\" not a dict", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+ "UNRECOGNIZED_DATA", NULL);
+ return TCL_ERROR;
+ }
+
+ if (dictSize > 0) {
+ Tcl_IncrRefCount(metadataInObj);
+ } else {
+ metadataInObj = NULL;
+ }
+ if (modelPtr->metadata) {
+ Tcl_DecrRefCount(modelPtr->metadata);
+ }
+ modelPtr->metadata = metadataInObj;
+ }
/*
* Set the image to the user-requested size, if any, and make sure storage
* is correctly allocated for this image.
@@ -1911,6 +2134,7 @@ ImgPhotoConfigureModel(
if ((modelPtr->fileString != NULL)
&& ((modelPtr->fileString != oldFileString)
|| (modelPtr->format != oldFormat))) {
+
/*
* Prevent file system access in a safe interpreter.
*/
@@ -1930,14 +2154,22 @@ ImgPhotoConfigureModel(
}
/*
+ * Flag that we want the metadata result dict
+ */
+
+ metadataOutObj = Tcl_NewDictObj();
+ Tcl_IncrRefCount(metadataOutObj);
+
+ /*
* -translation binary also sets -encoding binary
*/
if ((Tcl_SetChannelOption(interp, chan,
"-translation", "binary") != TCL_OK) ||
(MatchFileFormat(interp, chan, modelPtr->fileString,
- modelPtr->format, &imageFormat, &imageWidth,
- &imageHeight, &oldformat) != TCL_OK)) {
+ modelPtr->format, modelPtr->metadata, metadataOutObj,
+ &imageFormat, &imageFormatVersion3,
+ &imageWidth, &imageHeight, &oldformat) != TCL_OK)) {
Tcl_Close(NULL, chan);
goto errorExit;
}
@@ -1953,9 +2185,19 @@ ImgPhotoConfigureModel(
if (oldformat && tempformat) {
tempformat = (Tcl_Obj *) Tcl_GetString(tempformat);
}
- result = imageFormat->fileReadProc(interp, chan,
- modelPtr->fileString, tempformat, (Tk_PhotoHandle) modelPtr,
- 0, 0, imageWidth, imageHeight, 0, 0);
+ if (imageFormat != NULL) {
+ result = imageFormat->fileReadProc(interp, chan,
+ modelPtr->fileString, tempformat,
+ (Tk_PhotoHandle) modelPtr,
+ 0, 0, imageWidth, imageHeight, 0, 0);
+ } else {
+ result = imageFormatVersion3->fileReadProc(interp, chan,
+ modelPtr->fileString, tempformat, modelPtr->metadata,
+ (Tk_PhotoHandle) modelPtr,
+ 0, 0, imageWidth, imageHeight, 0, 0,
+ metadataOutObj);
+ }
+
Tcl_Close(NULL, chan);
if (result != TCL_OK) {
goto errorExit;
@@ -1969,8 +2211,16 @@ ImgPhotoConfigureModel(
&& ((modelPtr->dataString != oldData)
|| (modelPtr->format != oldFormat))) {
+ /*
+ * Flag that we want the metadata result dict
+ */
+
+ metadataOutObj = Tcl_NewDictObj();
+ Tcl_IncrRefCount(metadataOutObj);
+
if (MatchStringFormat(interp, modelPtr->dataString,
- modelPtr->format, &imageFormat, &imageWidth,
+ modelPtr->format, modelPtr->metadata, metadataOutObj,
+ &imageFormat, &imageFormatVersion3, &imageWidth,
&imageHeight, &oldformat) != TCL_OK) {
goto errorExit;
}
@@ -1988,10 +2238,18 @@ ImgPhotoConfigureModel(
}
tempdata = (Tcl_Obj *) Tcl_GetString(tempdata);
}
- if (imageFormat->stringReadProc(interp, tempdata, tempformat,
- (Tk_PhotoHandle) modelPtr, 0, 0, imageWidth, imageHeight,
- 0, 0) != TCL_OK) {
- goto errorExit;
+ if (imageFormat != NULL) {
+ if (imageFormat->stringReadProc(interp, tempdata, tempformat,
+ (Tk_PhotoHandle) modelPtr, 0, 0, imageWidth, imageHeight,
+ 0, 0) != TCL_OK) {
+ goto errorExit;
+ }
+ } else {
+ if (imageFormatVersion3->stringReadProc(interp, tempdata, tempformat,
+ modelPtr->metadata, (Tk_PhotoHandle) modelPtr, 0, 0,
+ imageWidth, imageHeight, 0, 0, metadataOutObj) != TCL_OK) {
+ goto errorExit;
+ }
}
Tcl_ResetResult(interp);
@@ -1999,6 +2257,49 @@ ImgPhotoConfigureModel(
}
/*
+ * Merge driver returned metadata and master metadata
+ */
+ if (metadataOutObj != NULL) {
+ int dictSize;
+ if (TCL_OK != Tcl_DictObjSize(interp,metadataOutObj, &dictSize)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "driver metadata not a dict", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+ "UNRECOGNIZED_DATA", NULL);
+ goto errorExit;
+ }
+ if (dictSize > 0) {
+
+ /*
+ * We have driver return metadata
+ */
+
+ if (modelPtr->metadata == NULL) {
+ modelPtr->metadata = metadataOutObj;
+ metadataOutObj = NULL;
+ } else {
+ Tcl_DictSearch search;
+ Tcl_Obj *key, *value;
+ int done;
+
+ if (Tcl_IsShared(modelPtr->metadata)) {
+ Tcl_DecrRefCount(modelPtr->metadata);
+ modelPtr->metadata = Tcl_DuplicateObj(modelPtr->metadata);
+ Tcl_IncrRefCount(modelPtr->metadata);
+ }
+
+ if (Tcl_DictObjFirst(interp, metadataOutObj, &search, &key,
+ &value, &done) != TCL_OK) {
+ goto errorExit;
+ }
+ for (; !done ; Tcl_DictObjNext(&search, &key, &value, &done)) {
+ Tcl_DictObjPut(interp, modelPtr->metadata, key, value);
+ }
+ }
+ }
+ }
+
+ /*
* Enforce a reasonable value for gamma.
*/
@@ -2036,6 +2337,9 @@ ImgPhotoConfigureModel(
if (oldFormat != NULL) {
Tcl_DecrRefCount(oldFormat);
}
+ if (metadataOutObj != NULL) {
+ Tcl_DecrRefCount(metadataOutObj);
+ }
ToggleComplexAlphaIfNeeded(modelPtr);
@@ -2048,6 +2352,9 @@ ImgPhotoConfigureModel(
if (oldFormat != NULL) {
Tcl_DecrRefCount(oldFormat);
}
+ if (metadataOutObj != NULL) {
+ Tcl_DecrRefCount(metadataOutObj);
+ }
return TCL_ERROR;
}
@@ -2145,6 +2452,9 @@ ImgPhotoDelete(
if (modelPtr->format != NULL) {
Tcl_DecrRefCount(modelPtr->format);
}
+ if (modelPtr->metadata != NULL) {
+ Tcl_DecrRefCount(modelPtr->metadata);
+ }
Tk_FreeOptions(configSpecs, (char *) modelPtr, NULL, 0);
ckfree(modelPtr);
}
@@ -2381,9 +2691,9 @@ ImgPhotoSetSize(
*
* Results:
* A standard TCL return value. If the return value is TCL_OK, a pointer
- * to the image format record is returned in *imageFormatPtr, and the
- * width and height of the image are returned in *widthPtr and
- * *heightPtr.
+ * to the image format record is returned in *imageFormatPtr or
+ * *imageFormatVersion3Ptr, and the width and height of the image are
+ * returned in *widthPtr and *heightPtr.
*
* Side effects:
* None.
@@ -2397,9 +2707,16 @@ MatchFileFormat(
Tcl_Channel chan, /* The image file, open for reading. */
const char *fileName, /* The name of the image file. */
Tcl_Obj *formatObj, /* User-specified format string, or NULL. */
+ Tcl_Obj *metadataInObj, /* User-specified metadata, may be NULL */
+ Tcl_Obj *metadataOutObj, /* metadata to return, may be NULL */
Tk_PhotoImageFormat **imageFormatPtr,
/* A pointer to the photo image format record
- * is returned here. */
+ * is returned here. For formatVersion3, this is
+ * set to NULL */
+ Tk_PhotoImageFormatVersion3 **imageFormatVersion3Ptr,
+ /* A pointer to the photo image formatVersion3
+ * record is returned here. For non
+ * formatVersion3, this is set to NULL*/
int *widthPtr, int *heightPtr,
/* The dimensions of the image are returned
* here. */
@@ -2408,6 +2725,7 @@ MatchFileFormat(
int matched = 0;
int useoldformat = 0;
Tk_PhotoImageFormat *formatPtr;
+ Tk_PhotoImageFormatVersion3 *formatVersion3Ptr;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
const char *formatString = NULL;
@@ -2490,27 +2808,97 @@ if (formatPtr == NULL) {
}
#endif
- if (formatPtr == NULL) {
- if ((formatObj != NULL) && !matched) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "image file format \"%s\" is not supported",
- formatString));
- Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
- formatString, NULL);
- } else {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't recognize data in image file \"%s\"",
- fileName));
- Tcl_SetErrorCode(interp, "TK", "PHOTO", "IMAGE",
- "UNRECOGNIZED_DATA", NULL);
+ /*
+ * For old and not version 3 format, exit now with success
+ */
+
+ if (formatPtr != NULL) {
+ *imageFormatPtr = formatPtr;
+ *imageFormatVersion3Ptr = NULL;
+ *oldformat = useoldformat;
+ (void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET);
+ return TCL_OK;
+ }
+
+ /*
+ * Scan through the table of file format version 3 handlers to find one
+ * which can handle the image.
+ */
+
+ for (formatVersion3Ptr = tsdPtr->formatListVersion3;
+ formatVersion3Ptr != NULL;
+ formatVersion3Ptr = formatVersion3Ptr->nextPtr) {
+ if (formatObj != NULL) {
+ if (strncasecmp(formatString,
+ formatVersion3Ptr->name, strlen(formatVersion3Ptr->name))
+ != 0) {
+ continue;
+ }
+ matched = 1;
+ if (formatVersion3Ptr->fileMatchProc == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "-file option isn't supported for %s images",
+ formatString));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
+ "NOT_FILE_FORMAT", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (formatVersion3Ptr->fileMatchProc != NULL) {
+ (void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET);
+
+ if (formatVersion3Ptr->fileMatchProc(interp, chan, fileName,
+ formatObj, metadataInObj, widthPtr, heightPtr,
+ metadataOutObj)) {
+ if (*widthPtr < 1) {
+ *widthPtr = 1;
+ }
+ if (*heightPtr < 1) {
+ *heightPtr = 1;
+ }
+ *imageFormatVersion3Ptr = formatVersion3Ptr;
+ *imageFormatPtr = NULL;
+ *oldformat = 0;
+ (void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET);
+ return TCL_OK;
+ }
+
+ /*
+ * Check if driver has shared or changed the metadata Tcl object.
+ * In this case, release and recreate it.
+ */
+
+ if (metadataOutObj != NULL) {
+ int dictSize;
+ if (Tcl_IsShared(metadataOutObj)
+ || TCL_OK != Tcl_DictObjSize(interp,metadataOutObj, &dictSize)
+ || dictSize > 0) {
+ Tcl_DecrRefCount(metadataOutObj);
+ metadataOutObj = Tcl_NewDictObj();
+ Tcl_IncrRefCount(metadataOutObj);
+ }
+ }
}
- return TCL_ERROR;
}
+
+ /*
+ * No matching format found
+ */
- *imageFormatPtr = formatPtr;
- *oldformat = useoldformat;
- (void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET);
- return TCL_OK;
+ if ((formatObj != NULL) && !matched) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "image file format \"%s\" is not supported",
+ formatString));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
+ formatString, NULL);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't recognize data in image file \"%s\"",
+ fileName));
+ Tcl_SetErrorCode(interp, "TK", "PHOTO", "IMAGE",
+ "UNRECOGNIZED_DATA", NULL);
+ }
+ return TCL_ERROR;
}
/*
@@ -2525,9 +2913,9 @@ if (formatPtr == NULL) {
*
* Results:
* A standard TCL return value. If the return value is TCL_OK, a pointer
- * to the image format record is returned in *imageFormatPtr, and the
- * width and height of the image are returned in *widthPtr and
- * *heightPtr.
+ * to the image format record is returned in *imageFormatPtr or
+ * *imageFormatVersion3Ptr, and the width and height of the image are
+ * returned in *widthPtr and *heightPtr.
*
* Side effects:
* None.
@@ -2540,9 +2928,16 @@ MatchStringFormat(
Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
Tcl_Obj *data, /* Object containing the image data. */
Tcl_Obj *formatObj, /* User-specified format string, or NULL. */
+ Tcl_Obj *metadataInObj, /* User-specified metadata, may be NULL */
+ Tcl_Obj *metadataOutObj, /* metadata output dict, may be NULL */
Tk_PhotoImageFormat **imageFormatPtr,
/* A pointer to the photo image format record
- * is returned here. */
+ * is returned here. For formatVersion3, this is
+ * set to NULL*/
+ Tk_PhotoImageFormatVersion3 **imageFormatVersion3Ptr,
+ /* A pointer to the photo image formatVersion3
+ * record is returned here. For non
+ * formatVersion3, this is set to NULL*/
int *widthPtr, int *heightPtr,
/* The dimensions of the image are returned
* here. */
@@ -2550,6 +2945,7 @@ MatchStringFormat(
{
int matched = 0, useoldformat = 0;
Tk_PhotoImageFormat *formatPtr, *defaultFormatPtr = NULL;
+ Tk_PhotoImageFormatVersion3 *formatVersion3Ptr = NULL;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
const char *formatString = NULL;
@@ -2641,6 +3037,53 @@ MatchStringFormat(
#endif
if (formatPtr == NULL) {
+ useoldformat = 0;
+ for (formatVersion3Ptr = tsdPtr->formatListVersion3;
+ formatVersion3Ptr != NULL;
+ formatVersion3Ptr = formatVersion3Ptr->nextPtr) {
+ if (formatObj != NULL) {
+ if (strncasecmp(formatString,
+ formatVersion3Ptr->name, strlen(formatVersion3Ptr->name)
+ ) != 0) {
+ continue;
+ }
+ matched = 1;
+ if (formatVersion3Ptr->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 ((formatVersion3Ptr->stringMatchProc != NULL)
+ && (formatVersion3Ptr->stringReadProc != NULL)
+ && formatVersion3Ptr->stringMatchProc(interp, data,
+ formatObj, metadataInObj, widthPtr, heightPtr,
+ metadataOutObj)) {
+ break;
+ }
+
+ /*
+ * Check if driver has shared or changed the metadata tcl object.
+ * In this case, release and recreate it.
+ */
+
+ if (metadataOutObj != NULL) {
+ int dictSize;
+ if (Tcl_IsShared(metadataOutObj)
+ || TCL_OK != Tcl_DictObjSize(interp,metadataOutObj, &dictSize)
+ || dictSize > 0) {
+ Tcl_DecrRefCount(metadataOutObj);
+ metadataOutObj = Tcl_NewDictObj();
+ Tcl_IncrRefCount(metadataOutObj);
+ }
+ }
+ }
+ }
+
+ if (formatPtr == NULL && formatVersion3Ptr == NULL) {
/*
* Try the default format as last resort (only if no -format option
* was passed).
@@ -2681,6 +3124,7 @@ MatchStringFormat(
}
*imageFormatPtr = formatPtr;
+ *imageFormatVersion3Ptr = formatVersion3Ptr;
*oldformat = useoldformat;
/*
diff --git a/generic/tkImgPhoto.h b/generic/tkImgPhoto.h
index e30ba8b..7ac738f 100644
--- a/generic/tkImgPhoto.h
+++ b/generic/tkImgPhoto.h
@@ -159,6 +159,8 @@ struct PhotoModel {
Tcl_Obj *dataString; /* Object to use as contents of image. */
Tcl_Obj *format; /* User-specified format of data in image file
* or string value. */
+ Tcl_Obj *metadata; /* User-specified metadata dict or read from
+ * image file */
unsigned char *pix32; /* Local storage for 32-bit image. */
int ditherX, ditherY; /* Location of first incorrectly dithered
* pixel in image. */
diff --git a/generic/tkInt.h b/generic/tkInt.h
index cc29660..ee453ea 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -1072,10 +1072,10 @@ MODULE_SCOPE const Tcl_ObjType tkTextIndexType;
MODULE_SCOPE const Tk_SmoothMethod tkBezierSmoothMethod;
MODULE_SCOPE Tk_ImageType tkBitmapImageType;
-MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtGIF;
+MODULE_SCOPE Tk_PhotoImageFormatVersion3 tkImgFmtGIF;
MODULE_SCOPE void (*tkHandleEventProc) (XEvent* eventPtr);
MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtDefault;
-MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtPNG;
+MODULE_SCOPE Tk_PhotoImageFormatVersion3 tkImgFmtPNG;
MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtPPM;
MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtSVGnano;
MODULE_SCOPE TkMainInfo *tkMainWindowList;
diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c
index 2839f66..ac3e95a 100644
--- a/generic/tkStubInit.c
+++ b/generic/tkStubInit.c
@@ -1332,6 +1332,7 @@ const TkStubs tkStubs = {
Tk_NewWindowObj, /* 277 */
Tk_SendVirtualEvent, /* 278 */
Tk_FontGetDescription, /* 279 */
+ Tk_CreatePhotoImageFormatVersion3 /* 280 */
};
/* !END!: Do not edit above this line. */
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 3be72c6..2a98876 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -334,9 +334,9 @@ CreateTopLevelWindow(
* Create built-in photo image formats.
*/
- Tk_CreatePhotoImageFormat(&tkImgFmtDefault);
- Tk_CreatePhotoImageFormat(&tkImgFmtGIF);
- Tk_CreatePhotoImageFormat(&tkImgFmtPNG);
+ Tk_CreatePhotoImageFormat(&tkImgFmtDefault);
+ Tk_CreatePhotoImageFormatVersion3(&tkImgFmtGIF);
+ Tk_CreatePhotoImageFormatVersion3(&tkImgFmtPNG);
Tk_CreatePhotoImageFormat(&tkImgFmtPPM);
Tk_CreatePhotoImageFormat(&tkImgFmtSVGnano);
}
diff --git a/macosx/tkMacOSXClipboard.c b/macosx/tkMacOSXClipboard.c
index 8e2b4a4..41887f4 100644
--- a/macosx/tkMacOSXClipboard.c
+++ b/macosx/tkMacOSXClipboard.c
@@ -137,13 +137,7 @@ TkSelGetSelection(
string = [pb stringForType:type];
}
if (string) {
- if (target == dispPtr->utf8Atom) {
- result = proc(clientData, interp, string.UTF8String);
- } else if (target == XA_STRING) {
- const char *latin1 = [string
- cStringUsingEncoding:NSISOLatin1StringEncoding];
- result = proc(clientData, interp, latin1);
- }
+ result = proc(clientData, interp, string.UTF8String);
}
} else {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
diff --git a/macosx/tkMacOSXKeyEvent.c b/macosx/tkMacOSXKeyEvent.c
index 4d5a98a..86e3ba7 100644
--- a/macosx/tkMacOSXKeyEvent.c
+++ b/macosx/tkMacOSXKeyEvent.c
@@ -92,26 +92,33 @@ static NSUInteger textInputModifiers;
*/
if (type == NSKeyUp || type == NSKeyDown) {
- if ([[theEvent characters] length] > 0) {
- keychar = [[theEvent characters] characterAtIndex:0];
+ NSString *characters = [theEvent characters];
+ if (characters.length > 0) {
+ keychar = [characters characterAtIndex:0];
/*
* Currently, real keys always send BMP characters, but who knows?
*/
if (CFStringIsSurrogateHighCharacter(keychar)) {
- UniChar lowChar = [[theEvent characters] characterAtIndex:1];
+ UniChar lowChar = [characters characterAtIndex:1];
keychar = CFStringGetLongCharacterForSurrogatePair(
keychar, lowChar);
}
} else {
/*
- * This is a dead key, such as Option-e, so it should go to the
- * TextInputClient.
+ * This is a dead key, such as Option-e, so it usually should get
+ * passed to the TextInputClient. But if it has a Command modifier
+ * then it is not functioning as a dead key and should not be
+ * handled by the TextInputClient. See ticket [1626ed65b8] and the
+ * method performKeyEquivalent which is implemented in
+ * tkMacOSXMenu.c.
*/
- use_text_input = YES;
+ if (!(modifiers & NSCommandKeyMask)) {
+ use_text_input = YES;
+ }
}
/*
@@ -604,11 +611,12 @@ static void
setupXEvent(XEvent *xEvent, Tk_Window tkwin, NSUInteger modifiers)
{
unsigned int state = 0;
- Display *display = Tk_Display(tkwin);
+ Display *display;
if (tkwin == NULL) {
return;
}
+ display = Tk_Display(tkwin);
if (modifiers) {
state = (modifiers & NSAlphaShiftKeyMask ? LockMask : 0) |
(modifiers & NSShiftKeyMask ? ShiftMask : 0) |
diff --git a/macosx/tkMacOSXMenu.c b/macosx/tkMacOSXMenu.c
index 19a7019..321d308 100644
--- a/macosx/tkMacOSXMenu.c
+++ b/macosx/tkMacOSXMenu.c
@@ -189,6 +189,34 @@ TKBackgroundLoop *backgroundLoop = nil;
{
return (_tkSpecial == special);
}
+
+/*
+ * There are cases where a KeyEquivalent (aka menu accelerator) is defined for
+ * a "dead key", i.e. a key which does not have an associated character but is
+ * only meant to be the start of a composition sequence. For example, on a
+ * Spanish keyboard both the ' and the ` keys are dead keys used to place
+ * accents over letters. But ⌘` is a standard KeyEquivalent which cycles
+ * through the open windows of an application, changing the focus to the next
+ * window.
+ *
+ * The performKeyEquivalent callback method is being overridden here to work
+ * around a bug reported in [1626ed65b8]. When a dead key that is also as a
+ * KeyEquivalent is pressed, a KeyDown event with no characters is passed to
+ * performKeyEquivalent. The default implementation provided by Apple will
+ * cause that event to be routed to some private methods of NSMenu which raise
+ * NSInvalidArgumentException, causing an abort. Returning NO in such a case
+ * prevents the abort, but does not prevent the KeyEquivalent action from being
+ * invoked, presumably because the event does get correctly handled higher in
+ * the responder chain.
+ */
+
+- (BOOL)performKeyEquivalent:(NSEvent *)event
+{
+ if (event.characters.length == 0) {
+ return NO;
+ }
+ return [super performKeyEquivalent:event];
+}
@end
@implementation TKMenu(TKMenuPrivate)
diff --git a/macosx/tkMacOSXSysTray.c b/macosx/tkMacOSXSysTray.c
index a0f0829..563b58f 100644
--- a/macosx/tkMacOSXSysTray.c
+++ b/macosx/tkMacOSXSysTray.c
@@ -437,11 +437,7 @@ typedef TkStatusItem** StatusItemInfo;
*/
DEBUG_LOG("willPresentNotification\n");
-#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101400
- if (@available(macOS 11.0, *)) {
- completionHandler(ALERT_OPTION);
- }
-#endif
+ completionHandler(ALERT_OPTION);
}
- (void) userNotificationCenter:(UNUserNotificationCenter *)center
diff --git a/tests/earth.gif b/tests/earth.gif
index 2c229eb..d667244 100644
--- a/tests/earth.gif
+++ b/tests/earth.gif
Binary files differ
diff --git a/tests/imgPNG.test b/tests/imgPNG.test
index f68ba01..522dca7 100644
--- a/tests/imgPNG.test
+++ b/tests/imgPNG.test
@@ -1056,7 +1056,10 @@ duFtaSrZF3pfCpiGjN2imToJJ39m6BjG1XZRwrkAI8YUKSZWlEZQDAIrNArHnyvpXtmM/B7wJeAbwO
fBcxKuQMrzfLdBoz29fX9led5v6u1XnBJW7vnr/YlrXEoNo22LRYOYlxZ1S6rkOfDcLvPAY/hGmWC7
H68uFI+x0oSPg2MAN/L5/M/vtqSED/T5cMu9J4Wf7HMGsB/4TEv/DFwe3Y/NPN57VXh+5BWApwFLlh
r661tV1eju/ne8YJrkWtES0tmRe2VOviv2j2aBp5nHihiRaz/A4oCnsAsje/+AAAAAElFTkSuQmCC"
- }
+ dpi100aspect2
+"iVBORw0KGgoAAAANSUhEUgAAAAIAAAACCAIAAAD91JpzAAAACXBIWXMAAA9hAAAewgEw8YEEAAAA
+FklEQVR4nGP4+vXrP11lJgYGhj9xSQAzOwXsETZ69QAAAABJRU5ErkJggg=="
+ }
# $encoded(basn0g08), $encoded(basn2c08), $encoded(basn3p08), $encoded(basn6a08)
test imgPNG-1.1 {reading basic images; grayscale} -setup {
@@ -1114,8 +1117,52 @@ test imgPNG-3.1 {reading image with unknown ancillary chunk - bug [1c659ef0f1]}
} -cleanup {
image delete $i
} -result 0
-
+
+test imgPNG-4.1 {data image with metadata} -body {
+ image create photo i1 -data $encoded(dpi100aspect2)
+ i1 cget -metadata
+} -cleanup {
+ image delete i1
+} -result {DPI 99.9998 aspect 2.0}
+
+test imgPNG-4.2 {file image with metadata} -setup {
+ set path [file join [configure -tmpdir] test.png]
+ set h [open $path "WRONLY BINARY CREAT"]
+ puts -nonewline $h [binary decode base64 $encoded(dpi100aspect2)]
+ close $h
+} -body {
+ image create photo i1 -file $path
+ i1 cget -metadata
+} -cleanup {
+ image delete i1
+ file delete $path
+} -result {DPI 99.9998 aspect 2.0}
+
+test imgPNG-4.3 {data output with metadata} -setup {
+ image create photo i1 -data $encoded(dpi100aspect2)
+} -body {
+ set imgData [i1 data -format png]
+ image delete i1
+ image create photo i1 -data $imgData
+ i1 cget -metadata
+} -cleanup {
+ image delete i1
+} -result {DPI 99.9998 aspect 2.0}
+
+test imgPNG-4.4 {file output with metadata} -setup {
+ image create photo i1 -data $encoded(dpi100aspect2)
+ set path [file join [configure -tmpdir] test.png]
+} -body {
+ i1 write $path -format png
+ image delete i1
+ image create photo i1 -file $path
+ i1 cget -metadata
+} -cleanup {
+ image delete i1
+} -result {DPI 99.9998 aspect 2.0}
+
}
+
namespace delete png
imageFinish
cleanupTests
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 759c87d..544b2e6 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -57,6 +57,8 @@
# Tk_PhotoPutBlock_Panic no tests, probably none needed
# Tk_PhotoPutZoomedBlock_Panic no tests, probably none needed
# Tk_PhotoSetSize_Panic no tests, probably none needed
+# Tk_PhotoGetMetadata: imgPhoto-21.*
+# Tk_PhotoSetMetadata: imgPhoto-22.*
#--------------------------------------------------------------------------
#
@@ -196,6 +198,9 @@ test imgPhoto-1.13 {option -withalpha, normal use} -setup {
} -cleanup {
imageCleanup
} -result {0 128 0 255}
+test imgPhoto-1.14 {options for photo images - error case} -body {
+ image create photo photo1 -metadata
+} -returnCodes error -result {value for "-metadata" missing}
test imgPhoto-2.1 {ImgPhotoCreate procedure} -setup {
imageCleanup
@@ -332,7 +337,7 @@ test imgPhoto-4.6 {ImgPhotoCmd procedure: configure option} -setup {
llength [photo1 configure]
} -cleanup {
image delete photo1
-} -result 7
+} -result 8
test imgPhoto-4.7 {ImgPhotoCmd procedure: configure option} -setup {
image create photo photo1
} -body {
@@ -574,7 +579,7 @@ test imgPhoto-4.31 {ImgPhotoCmd procedure: read option} -constraints {
photo1 read $teapotPhotoFile -zoom 2
} -returnCodes error -cleanup {
image delete photo1
-} -result {unrecognized option "-zoom": must be -format, -from, -shrink, or -to}
+} -result {unrecognized option "-zoom": must be -format, -from, -metadata, -shrink, or -to}
test imgPhoto-4.32 {ImgPhotoCmd procedure: read option} -setup {
image create photo photo1
} -body {
@@ -1091,13 +1096,13 @@ test imgPhoto-4.90 {ImgPhotoCmd put: existing but not allowed opt} -setup {
} -cleanup {
imageCleanup
} -returnCodes error -result \
- {unrecognized option "-from": must be -format, or -to}
+ {unrecognized option "-from": must be -format, -metadata, or -to}
test imgPhoto-4.91 {ImgPhotoCmd put: invalid option} -setup {
image create photo photo1
} -body {
photo1 put {{0 1 2 3}} -bogus x
} -returnCodes error -result \
- {unrecognized option "-bogus": must be -format, or -to}
+ {unrecognized option "-bogus": must be -format, -metadata, or -to}
test imgPhoto-4.92 {ImgPhotocmd put: missing data} -setup {
image create photo photo1
} -body {
@@ -1237,7 +1242,7 @@ test imgPhoto-4.104 {ImgPhotoCmd data: existing but not accepted opt} -setup {
} -cleanup {
imageCleanup
} -returnCodes error -result \
-{unrecognized option "-to": must be -background, -format, -from, or -grayscale}
+{unrecognized option "-to": must be -background, -format, -from, -grayscale, or -metadata}
test imgPhoto-4.105 {ImgPhotoCmd data: invalid option} -setup {
image create photo photo1
} -body {
@@ -1245,7 +1250,7 @@ test imgPhoto-4.105 {ImgPhotoCmd data: invalid option} -setup {
} -cleanup {
imageCleanup
} -returnCodes error -result \
-{unrecognized option "-bogus": must be -background, -format, -from, or -grayscale}
+{unrecognized option "-bogus": must be -background, -format, -from, -grayscale, or -metadata}
test imgPhoto-4.106 {ImgPhotoCmd data: extra arg before options} -setup {
image create photo photo1
} -body {
@@ -2074,6 +2079,443 @@ test imgPhoto-20.12 {Valid GIF (file)} -setup {
catch {image delete gif1}
} -result gif1
+# imgPhoto-21.x : Tk_PhotoGetMetadata
+
+test imgPhoto-21.1 {option -metadata, get configure list} -setup {
+ image create photo photo1 -metadata {dpi 100}
+} -body {
+ photo1 configure -metadata
+} -cleanup {
+ catch {image delete photo1}
+} -result {-metadata {} {} {} {dpi 100}}
+
+test imgPhoto-21.2 {option -metadata, get value} -setup {
+ image create photo photo1 -metadata {dpi 100}
+} -body {
+ photo1 cget -metadata
+} -cleanup {
+ catch {image delete photo1}
+} -result {dpi 100}
+
+test imgPhoto-21.3 {option -metadata, get default value} -setup {
+ image create photo photo1
+} -body {
+ photo1 cget -metadata
+} -cleanup {
+ catch {image delete photo1}
+} -result {}
+
+# imgPhoto-22.x : Tk_PhotoSetMetadata
+
+test imgPhoto-22.1 {option -metadata, set value} -setup {
+ image create photo photo1
+} -body {
+ photo1 configure -metadata {dpi 100}
+ photo1 cget -metadata
+} -cleanup {
+ catch {image delete photo1}
+} -result {dpi 100}
+
+test imgPhoto-22.2 {option -metadata, change value} -setup {
+ image create photo photo1 -metadata {dpi 200}
+} -body {
+ photo1 configure -metadata {dpi 100}
+ photo1 cget -metadata
+} -cleanup {
+ catch {image delete photo1}
+} -result {dpi 100}
+
+test imgPhoto-22.3 {option -metadata, clear value} -setup {
+ image create photo photo1 -metadata {dpi 200}
+} -body {
+ photo1 configure -metadata {}
+ photo1 cget -metadata
+} -cleanup {
+ catch {image delete photo1}
+} -result {}
+
+# 23.x GIF images with metadata
+
+# The following gif core data is used by the following data.
+# N.B. this is the same image as test imgPhoto-18.10
+
+# size 16x16, global color table size: 8
+set gifstart "GIF89a\x10\x00\x10\x00\xc2\x07\x00"
+# color table
+append gifstart "\x00\x00\x00\x33\x33\xff\xff\x33\x33\xff\x33\xff\x33\xff\x33\x33\xff\xff\xff\xff\x33\xff\xff\xff"
+# Graphic control extension: Transparent color index: 7 (not needed here)
+# append gifdata "\x21\xf9\x04\x01\x0a\x00\x07\x00"
+# Image descriptor: 16x16, no local color table
+set gifdata "\x2c\x00\x00\x00\x00\x10\x00\x10\x00\x00"
+# Image data
+append gifdata "\x03\x21\x78\xba\xdc\x2d\x30\x42\x77\xa4\x15\xef\xda\xa5\xb5\xea\xd7\x07\x4a\xe2\x38\x55\xe6\x99\xaa\x6b\x69\x72\x2f\x33\x52\x1d\x65\x37\x09\x00"
+set gifend "\x3b"
+
+test imgPhoto-23.1 {GIF comment before image data (-data)} -setup {
+ set data $::gifstart
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifdata $::gifend
+} -body {
+ image create photo gif1 -data $data
+ gif1 cget -metadata
+} -cleanup {
+ catch {image delete gif1}
+} -result {comment ABCD}
+
+test imgPhoto-23.2 {GIF file comment before image data (-file)} -setup {
+ set data $::gifstart
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifdata $::gifend
+ set path [file join [configure -tmpdir] test.gif]
+ set h [open $path "WRONLY BINARY CREAT"]
+ puts -nonewline $h $data
+ close $h
+} -body {
+ image create photo gif1 -file $path
+ gif1 cget -metadata
+} -cleanup {
+ catch {image delete gif1}
+ file delete $path
+} -result {comment ABCD}
+
+test imgPhoto-23.3 {GIF comment after image data (-data)} -setup {
+ set data $::gifstart
+ append data $::gifdata
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifend
+} -body {
+ image create photo gif1 -data $data
+ gif1 cget -metadata
+} -cleanup {
+ catch {image delete gif1}
+} -result {comment ABCD}
+
+test imgPhoto-23.4 {GIF comment after image data (-file)} -setup {
+ set data $::gifstart
+ append data $::gifdata
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifend
+ set path [file join [configure -tmpdir] test.gif]
+ set h [open $path "WRONLY BINARY CREAT"]
+ puts $h $data
+ close $h
+} -body {
+ image create photo gif1 -file $path
+ gif1 cget -metadata
+} -cleanup {
+ catch {image delete gif1}
+ file delete $path
+} -result {comment ABCD}
+
+test imgPhoto-23.5 {Two GIF comment blocks (-data)} -setup {
+ set data $::gifstart
+ # Append a comment extension block with data "1234"
+ append data "\x21\xfe\x04" "1234" "\x0"
+ append data $::gifdata
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifend
+} -body {
+ image create photo gif1 -data $data
+ gif1 cget -metadata
+} -cleanup {
+ catch {image delete gif1}
+} -result {comment ABCD}
+
+test imgPhoto-23.6 {Two GIF comment blocks (-file)} -setup {
+ set data $::gifstart
+ # Append a comment extension block with data "1234"
+ append data "\x21\xfe\x04" "1234" "\x0"
+ append data $::gifdata
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifend
+ set path [file join [configure -tmpdir] test.gif]
+ set h [open $path "WRONLY BINARY CREAT"]
+ puts $h $data
+ close $h
+} -body {
+ image create photo gif1 -file $path
+ gif1 cget -metadata
+} -cleanup {
+ catch {image delete gif1}
+ file delete $path
+} -result {comment ABCD}
+
+test imgPhoto-23.7 {create: test if shared metadata object is not preserved\
+ (-data)}\
+-setup {
+ set data $::gifstart
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifdata $::gifend
+} -body {
+ set metadataDict [dict create A 1]
+ set metadataDict2 $metadataDict
+ image create photo gif1 -data $data -metadata $metadataDict
+ list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
+} -cleanup {
+ catch {image delete gif1}
+} -result {{A 1 comment ABCD} {A 1} {A 1}}
+
+test imgPhoto-23.8 {create: test if shared metadata object is not preserved\
+ (-file)}\
+-setup {
+ set data $::gifstart
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifdata $::gifend
+
+ set path [file join [configure -tmpdir] test.gif]
+ set h [open $path "WRONLY BINARY CREAT"]
+ puts $h $data
+ close $h
+} -body {
+ set metadataDict [dict create A 1]
+ set metadataDict2 $metadataDict
+ image create photo gif1 -file $path -metadata $metadataDict
+ list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
+} -cleanup {
+ catch {image delete gif1}
+ file delete $path
+} -result {{A 1 comment ABCD} {A 1} {A 1}}
+
+test imgPhoto-23.9 {configure: test if shared metadata object is not\
+ preserved (empty image, -data)}\
+-setup {
+ set data $::gifstart
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifdata $::gifend
+} -body {
+ image create photo gif1
+ set metadataDict [dict create A 1]
+ set metadataDict2 $metadataDict
+ gif1 configure -data $data -format gif -metadata $metadataDict
+ list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
+} -cleanup {
+ catch {image delete gif1}
+} -result {{A 1 comment ABCD} {A 1} {A 1}}
+
+test imgPhoto-23.10 {configure: test if shared metadata object is not preserved\
+ (empty image, -file)}\
+-setup {
+ set data $::gifstart
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifdata $::gifend
+
+ set path [file join [configure -tmpdir] test.gif]
+ set h [open $path "WRONLY BINARY CREAT"]
+ puts $h $data
+ close $h
+} -body {
+ image create photo gif1
+ set metadataDict [dict create A 1]
+ set metadataDict2 $metadataDict
+ gif1 configure -file $path -format gif -metadata $metadataDict
+ list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
+} -cleanup {
+ catch {image delete gif1}
+ file delete $path
+} -result {{A 1 comment ABCD} {A 1} {A 1}}
+
+test imgPhoto-23.11 {configure: test if shared metadata object is not preserved\
+ (metadata replace, -data}\
+-setup {
+ set data $::gifstart
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifdata $::gifend
+} -body {
+ image create photo gif1 -data "$::gifstart$::gifdata$::gifend"
+ set metadataDict [dict create A 1]
+ set metadataDict2 $metadataDict
+ gif1 configure -data $data -format gif -metadata $metadataDict
+ list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
+} -cleanup {
+ catch {image delete gif1}
+} -result {{A 1 comment ABCD} {A 1} {A 1}}
+
+test imgPhoto-23.12 {configure: test if shared metadata object is not preserved\
+ (metadata replace, -file}\
+-setup {
+ set data $::gifstart
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifdata $::gifend
+
+ set path [file join [configure -tmpdir] test.gif]
+ set h [open $path "WRONLY BINARY CREAT"]
+ puts $h $data
+ close $h
+} -body {
+ image create photo gif1 -data "$::gifstart$::gifdata$::gifend"
+ set metadataDict [dict create A 1]
+ set metadataDict2 $metadataDict
+ gif1 configure -file $path -format gif -metadata $metadataDict
+ list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
+} -cleanup {
+ catch {image delete gif1}
+ file delete $path
+} -result {{A 1 comment ABCD} {A 1} {A 1}}
+
+test imgPhoto-23.13 {configure: test if shared metadata object is not preserved\
+ (-data)}\
+-setup {
+ set data $::gifstart$::gifdata$::gifend
+} -body {
+ image create photo gif1 -data $data
+ set metadataDict [dict create A 1]
+ set metadataDict2 $metadataDict
+ set data $::gifstart
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifdata $::gifend
+ gif1 configure -data $data -format gif -metadata $metadataDict
+ list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
+} -cleanup {
+ catch {image delete gif1}
+} -result {{A 1 comment ABCD} {A 1} {A 1}}
+
+test imgPhoto-23.14 {configure: test if shared metadata object is not preserved\
+ (-file)}\
+-setup {
+ set data $::gifstart
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifdata $::gifend
+
+ set path [file join [configure -tmpdir] test.gif]
+ set h [open $path "WRONLY BINARY CREAT"]
+ puts $h $data
+ close $h
+} -body {
+ image create photo gif1 -data "$::gifstart$::gifdata$::gifend"
+ set metadataDict [dict create A 1]
+ set metadataDict2 $metadataDict
+ gif1 configure -file $path -format gif -metadata $metadataDict
+ list [dict get [gif1 cget -metadata]] $metadataDict $metadataDict2
+} -cleanup {
+ catch {image delete gif1}
+ file delete $path
+} -result {{A 1 comment ABCD} {A 1} {A 1}}
+
+test imgPhoto-23.15 {output data with comment (from -metadata argument)}\
+-setup {
+ set data $::gifstart$::gifdata$::gifend
+} -body {
+ image create photo gif1 -data $data
+ set gifData [gif1 data -format gif -metadata [dict create comment ABCD]]
+} -cleanup {
+ catch {image delete gif1}
+} -match glob -result {*ABCD*}
+
+test imgPhoto-23.22 {output file with comment (from -metadata argument)}\
+-setup {
+ set data $::gifstart$::gifdata$::gifend
+ set path [file join [configure -tmpdir] test.gif]
+} -body {
+ image create photo gif1 -data $data
+ gif1 write $path -format gif -metadata [dict create comment ABCD]
+ image delete gif1
+ image create photo gif1 -file $path
+ dict get [gif1 cget -metadata] comment
+} -cleanup {
+ catch {image delete gif1}
+ file delete $path
+} -result {ABCD}
+
+test imgPhoto-23.16 {output data with comment (from -metadata property)}\
+-setup {
+ set data $::gifstart$::gifdata$::gifend
+} -body {
+ image create photo gif1 -data $data
+ gif1 configure -metadata [dict create comment ABCD]
+ set gifData [gif1 data -format gif]
+} -cleanup {
+ catch {image delete gif1}
+} -match glob -result {*ABCD*}
+
+test imgPhoto-23.17 {output file with comment (from -metadata property)}\
+-setup {
+ set data $::gifstart$::gifdata$::gifend
+ set path [file join [configure -tmpdir] test.gif]
+} -body {
+ image create photo gif1 -data $data
+ gif1 configure -metadata [dict create comment ABCD]
+ gif1 write $path -format gif
+ image delete gif1
+ image create photo gif1 -file $path
+ dict get [gif1 cget -metadata] comment
+} -cleanup {
+ catch {image delete gif1}
+ file delete $path
+} -result {ABCD}
+
+test imgPhoto-23.18 {configure: empty metadata parameter overwrites image metadata} -setup {
+ image create photo gif1 -data $::gifstart$::gifdata$::gifend\
+ -metadata {foo bar}
+ set data $::gifstart
+ # Append a comment extension block with data "ABCD"
+ append data "\x21\xfe\x04" "ABCD" "\x0"
+ # Trailer
+ append data $::gifdata $::gifend
+} -body {
+ gif1 configure -data $data -metadata {}
+ gif1 cget -metadata
+} -cleanup {
+ catch {image delete gif1}
+} -result {comment ABCD}
+
+test imgPhoto-23.19 {write: empty metadata parameter overwrites image metadata} -setup {
+ image create photo gif1 -data $::gifstart$::gifdata$::gifend\
+ -metadata {comment bar}
+ set path [file join [configure -tmpdir] test.gif]
+} -body {
+ gif1 write $path -format gif -metadata {}
+ image delete gif1
+ image create photo gif1 -file $path
+ dict size [gif1 cget -metadata]
+} -cleanup {
+ catch {image delete gif1}
+ file delete $path
+} -result {0}
+
+test imgPhoto-23.20 {data: empty metadata parameter overwrites image metadata} -setup {
+ image create photo gif1 -data $::gifstart$::gifdata$::gifend\
+ -metadata {comment bar}
+} -body {
+ set data [gif1 data -format gif -metadata {}]
+ image delete gif1
+ image create photo gif1 -data $data
+ dict size [gif1 cget -metadata]
+} -cleanup {
+ catch {image delete gif1}
+ file delete $path
+} -result {0}
+
+unset -nocomplain gifstart gifdata gifend
+
+
catch {rename foreachPixel {}}
catch {rename checkImgTrans {}}
catch {rename checkImgTransLoop {}}
diff --git a/tests/textDisp.test b/tests/textDisp.test
index fee8bd4..d1296b4 100644
--- a/tests/textDisp.test
+++ b/tests/textDisp.test
@@ -606,7 +606,7 @@ test textDisp-4.4 {UpdateDisplayInfo, wrap-mode "none"} {textfonts} {
list [.t bbox 2.0] [.t bbox 2.25] [.t bbox 3.0] $tk_textRelayout
} [list [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] {} [list 5 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] {1.0 2.0 3.0}]
test textDisp-4.5 {UpdateDisplayInfo, tiny window} {textfonts} {
- if {$tcl_platform(platform) == "windows"} {
+ if {[tk windowingsystem] == "win32"} {
wm overrideredirect . 1
}
wm geom . 103x$height
@@ -617,7 +617,7 @@ test textDisp-4.5 {UpdateDisplayInfo, tiny window} {textfonts} {
updateText
list [.t bbox 2.0] [.t bbox 2.1] [.t bbox 3.0] $tk_textRelayout
} [list [list 5 [expr {$fixedDiff + 18}] 1 $fixedHeight] {} [list 5 [expr {2*$fixedDiff + 31}] 1 $fixedHeight] {1.0 2.0 3.0}]
-if {$tcl_platform(platform) == "windows"} {
+if {[tk windowingsystem] == "win32"} {
wm overrideredirect . 0
}
test textDisp-4.6 {UpdateDisplayInfo, tiny window} {
@@ -628,7 +628,7 @@ test textDisp-4.6 {UpdateDisplayInfo, tiny window} {
# the overrideredirect on "." confuses the window manager and
# causes subsequent tests to fail.
- if {$tcl_platform(platform) == "windows"} {
+ if {[tk windowingsystem] == "win32"} {
wm overrideredirect . 1
}
frame .f2 -width 20 -height 100
@@ -660,7 +660,7 @@ test textDisp-4.7 {UpdateDisplayInfo, filling in extra vertical space} {
# the overrideredirect on "." confuses the window manager and
# causes subsequent tests to fail.
- if {$tcl_platform(platform) == "windows"} {
+ if {[tk windowingsystem] == "win32"} {
wm overrideredirect . 1
}
.t delete 1.0 end
@@ -3324,7 +3324,7 @@ test textDisp-24.15 {TkTextCharLayoutProc, -wrap none} {textfonts} {
list [.t bbox 1.19] [.t bbox 1.20]
} [list [list 136 3 7 $fixedHeight] [list 143 3 3 $fixedHeight]]
test textDisp-24.16 {TkTextCharLayoutProc, no chars fit} {textfonts} {
- if {$tcl_platform(platform) == "windows"} {
+ if {[tk windowingsystem] == "win32"} {
wm overrideredirect . 1
}
.t configure -wrap char
@@ -3334,7 +3334,7 @@ test textDisp-24.16 {TkTextCharLayoutProc, no chars fit} {textfonts} {
updateText
list [.t bbox 1.0] [.t bbox 1.1] [.t bbox 1.2]
} [list [list 3 3 1 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 1 $fixedHeight] [list 3 [expr {2*$fixedDiff + 29}] 1 $fixedHeight]]
-if {$tcl_platform(platform) == "windows"} {
+if {[tk windowingsystem] == "win32"} {
wm overrideredirect . 0
}
test textDisp-24.17 {TkTextCharLayoutProc, -wrap word} {textfonts} {
diff --git a/win/Makefile.in b/win/Makefile.in
index c2baf7f..d0c3c2e 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -306,6 +306,7 @@ TK_OBJS = \
tkWinDraw.$(OBJEXT) \
tkWinEmbed.$(OBJEXT) \
tkWinFont.$(OBJEXT) \
+ tkWinGDI.$(OBJEXT) \
tkWinIco.$(OBJEXT) \
tkWinImage.$(OBJEXT) \
tkWinInit.$(OBJEXT) \
diff --git a/win/makefile.vc b/win/makefile.vc
index a668384..c3288d8 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -178,6 +178,7 @@ TKOBJS = \
$(TMP_DIR)\tkWinDraw.obj \
$(TMP_DIR)\tkWinEmbed.obj \
$(TMP_DIR)\tkWinFont.obj \
+ $(TMP_DIR)\tkWinGDI.obj \
$(TMP_DIR)\tkWinIco.obj \
$(TMP_DIR)\tkWinImage.obj \
$(TMP_DIR)\tkWinInit.obj \
diff --git a/win/tkWinPrint.c b/win/tkWinPrint.c
index 86a1d60..41cc88a 100644
--- a/win/tkWinPrint.c
+++ b/win/tkWinPrint.c
@@ -3,8 +3,8 @@
*
* This module implements Win32 printer access.
*
- * Copyright © 1998 Bell Labs Innovations for Lucent Technologies.
- * Copyright © 2018 Microsoft Corporation.
+ * Copyright © 1998-2019 Harald Oehlmann, Elmicron GmbH
+ * Copyright © 2018 Microsoft Corporation.
* Copyright © 2021 Kevin Walzer/WordTech Communications LLC.
*
* See the file "license.terms" for information on usage and redistribution of
@@ -12,397 +12,3176 @@
*/
+#pragma warning(disable : 4201 4214 4514)
+#define STRICT
+#define UNICODE
+#define _UNICODE
+/* Taget WIndows Server 2003 */
+#define WINVER 0x0502
+#define _WIN32_WINNT 0x0502
+/* TCL Defines */
+#define DLL_BUILD
+
#include <windows.h>
-#include <winspool.h>
+#include <windowsx.h>
#include <commdlg.h>
-#include <wingdi.h>
-#include <tcl.h>
-#include <tk.h>
-#include "tkWinInt.h"
+#include <tchar.h>
+
#include <string.h>
#include <stdlib.h>
#include <math.h>
+#include <tcl.h>
+#include <tk.h>
+
+/* Helper defines. */
+
+/*
+* Values of the Res variable.
+* /
+
+/* Success, result value not set */
+#define RET_OK_NO_RESULT_SET 2
+/* Succes, result value set or not necessary. */
+#define RET_OK 0
+/* Error and result set. */
+#define RET_ERROR -1
+/* Printer i/o error. */
+#define RET_ERROR_PRINTER_IO -2
+/* Out of memory error. */
+#define RET_ERROR_MEMORY -3
+/* Parameter error. */
+#define RET_ERROR_PARAMETER -4
+/* User abort. */
+#define RET_ERROR_USER -5
+/* Printer not open. */
+#define RET_ERROR_PRINTER_NOT_OPEN -6
+/* Printer driver answered with an error. */
+#define RET_ERROR_PRINTER_DRIVER -7
+
+/* Flag parameter of GetDeviceName function. */
+#define F_FREE_MEM (1)
+#define F_RETURN_LIST (2)
+
+
+/*
+ * File Global Constants.
+ */
+
+/* Version information. */
+static char version_string[] = "3.0";
+static char usage_string[] =
+ "Windows printing (c) Elmicron GmbH, Harald Oehlmann, 2019-01-23\n"
+ "Preparation:\n"
+ " winprint getattr option: possible options:\n"
+ " printers, defaultprinter, copies, firstpage, lastpage, mapmode*,\n"
+ " avecharheight*, avecharwidth*, horzres*, vertres*, dpi*,\n"
+ " physicaloffsetx*, physicaloffsety*, printer, orientation, papersize,\n"
+ " papertypes, mapmodes, fontweights, fontcharsets, fontpitchvalues,\n"
+ " fontfamilies, fontunicoderanges: lists option\n"
+ " fonts*: returns list of unique font name, weight, charset, variable/fixed\n"
+ " fontnames*: returns list of unique font names\n"
+ " fontunicoderanges: returns list of alternating start len unicode point ints\n"
+ " *: requires open printer\n"
+ " winprint pagesetup ?printer? ?Orientation? ?PaperSize? "
+ "?left? ?top? ?right? ?bottom?\n"
+ " returns a list of identical parameters reflecting the users choice\n"
+ " Margin unit is millimeter. Default values also by empty string\n"
+ " winprint selectprinter: select a printer\n"
+ " winprint printersetup ?printer? ? Orientation? ?PageSize?\n"
+ " Sets up the printer options and returns them.\n"
+ " Not exposed printer settings are editable.\n"
+ "Open printer: use one of:\n"
+ " winprint openjobdialog ?printer? ?Orientation? ?PaperSize? ?Maxpage?\n"
+ " winprint openprinter ?printer? ?Orientation? ?PaperSize?\n"
+ "Get information about the print job and user selections:\n"
+ " winprint getattr {copies firstpage lastpage avecharheight avecharwidth"
+ "horzres\n"
+ " vertres dpi physicaloffsetx physicaloffsety printer orientation "
+ "papersize}\n"
+ " The dpi value is used to transform from paint units (pixel) to mm:\n"
+ " Size/[mm] = [winprint getattr horzres]/[winprint getattr dpi]*2.54\n"
+ "Start document and page\n"
+ " winprint opendoc jobname\n"
+ " winprint openpage\n"
+ "Configure and select drawing tools\n"
+ " winprint setmapmode mapmode\n"
+ " Define the coordinate system. 'Text' is in device units origin "
+ "top-up.\n"
+ " winprint pen width ?r g b?: r,g,b is 16 bit color value (internal / 256)\n"
+ " No rgb values uses black color.\n"
+ " winprint brushcolor r g b: filling for rectangle\n"
+ " winfo bkcolor r g b: text background\n"
+ " winprint fontcreate Fontnumber Fontname Points/10 ?Weight? ?Italic? "
+ "?Charset?\n"
+ " ?Pitch? ?Family? : use getattr font* to get possible values.\n"
+ " winprint fontselect Fontnumber\n"
+ "Create printed items:\n"
+ " winprint ruler x0 y0 width height\n"
+ " winprint rectangle x0 y0 x1 y1\n"
+ " winprint text X0 Y0 Text ?r g b?: no rgb uses black text\n"
+ " winprint getfirstfontnochar Text: -1 or first index with no glyph\n"
+ " winprint gettextsize Text\n"
+ " winprint photo tkimage X0 Y0 ?Width? ?Height?\n"
+ "Close page and printjob\n"
+ " winprint closepage Close a page\n"
+ " winprint closedoc Close the document\n"
+ " winprint close ?option?\n"
+ " Close and cleanup the printing interface.\n"
+ " If the option -eraseprinterstate is given, also the printer settings "
+ "not passed\n"
+ " to the script level are deleted."
+ "";
+
+
+/* File Global Variables */
+static BOOL fPDLGInitialised = FALSE;
+static PRINTDLG pdlg;
+static PAGESETUPDLG pgdlg;
+static HPEN hPen = NULL;
+static HFONT hFont[10] =
+ {NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL};
+/* Index of the actually selected font, -1:None */
+static int SelectedFont = -1;
+
+/*
+ * Interpreter pointer to return automatic errors from the EnumerateFontsEx
+ * callback and the ListFontsEx function.
+ */
+static Tcl_Interp *fg_interp;
+
+/* Subcommand "getattr" option list and indexes. */
+static char *fg_getattr_sub_cmds[] = {
+ "printers", "defaultprinter", "copies", "firstpage", "lastpage",
+ "mapmode", "avecharheight", "avecharwidth", "horzres", "vertres",
+ "dpi", "physicaloffsetx", "physicaloffsety",
+ "printer", "orientation", "papersize",
+ "papertypes", "mapmodes",
+ "fontweights", "fontcharsets", "fontpitchvalues", "fontfamilies", "fonts",
+ "fontnames", "fontunicoderanges", NULL};
+static enum fg_getattr_i_command {
+ iPrinters, iDefaultPrinter, iCopies, iFirstPage, iLastPage,
+ iMapMode, iAveCharHeight, iAveCharWidth, iHorzRes, iVertRes,
+ iDPI, iPhysicalOffsetX, iPhysicalOffsetY,
+ iPrinter, iOrientation, iPaperSize,
+ iPaperTypes, iMapModes,
+ iFontWeights, iFontCharsets, iFontPitchValues, iFontFamilies, iFonts,
+ iFontNames, iFontUnicodeRanges};
+
+/* Subcommand "pagesetup" orientation option list and indexes. */
+static char *fg_orient_sub_cmds[] = {"portrait", "landscape", "", NULL};
+static short fg_orient_i_command[] = {
+ DMORIENT_PORTRAIT,
+ DMORIENT_LANDSCAPE,
+ -1};
+
+/* Subcommand "pagesetup" pagesize. */
+static char *fg_papersize_sub_cmds[] = {
+ "Letter", "LetterSmall", "Tabloid", "Ledger", "Legal", "Statement",
+ "Executive", "A3", "A4", "A4Small", "A5", "B4", "B5", "Folio", "Quarto",
+ "10X14", "11X17", "Note", "Env_9", "Env_10", "Env_11", "Env_12", "Env_14",
+ "CSheet", "DSheet", "ESheet", "Env_Dl", "Env_C5", "Env_C3", "Env_C4",
+ "Env_C6", "Env_C65", "Env_B4", "Env_B5", "Env_B6", "Env_Italy",
+ "Env_Monarch", "Env_Personal", "Fanfold_Us", "Fanfold_Std_German",
+ "Fanfold_Lgl_German", "Iso_B4", "Japanese_Postcard", "9X11", "10X11",
+ "15X11", "Env_Invite", "Reserved_48", "Reserved_49", "Letter_Extra",
+ "Legal_Extra", "Tabloid_Extra", "A4_Extra", "Letter_Transverse",
+ "A4_Transverse", "Letter_Extra_Transverse", "A_Plus", "B_Plus",
+ "Letter_Plus", "A4_Plus", "A5_Transverse", "B5_Transverse", "A3_Extra",
+ "A5_Extra", "B5_Extra", "A2", "A3_Transverse", "A3_Extra_Transverse",
+ "Dbl_Japanese_Postcard", "A6", "JEnv_Kaku2", "JEnv_Kaku3", "JEnv_Chou3",
+ "JEnv_Chou4", "Letter_Rotated", "A3_Rotated", "A4_Rotated", "A5_Rotated",
+ "B4_JIS_Rotated", "B5_JIS_Rotated", "Japanese_Postcard_Rotated",
+ "Dbl_Japanese_Postcard_Rotated", "A6_Rotated", "JEnv_Kaku2_Rotated",
+ "JEnv_Kaku3_Rotated", "JEnv_Chou3_Rotated", "JEnv_Chou4_Rotated", "B6_JIS",
+ "B6_Jis_Rotated", "12X11", "Jenv_You4", "Jenv_You4_Rotated", "P16K", "P32K",
+ "P32Kbig", "PEnv_1", "PEnv_2", "PEnv_3", "PEnv_4", "PEnv_5", "PEnv_6",
+ "PEnv_7", "PEnv_8", "PEnv_9", "PEnv_10", "P16K_Rotated", "P32K_Rotated",
+ "P32Kbig_Rotated", "PEnv_1_Rotated", "PEnv_2_Rotated", "PEnv_3_Rotated",
+ "PEnv_4_Rotated", "PEnv_5_Rotated", "PEnv_6_Rotated", "PEnv_7_Rotated",
+ "PEnv_8_Rotated", "PEnv_9_Rotated", "PEnv_10_Rotated",
+ "User",
+ "", NULL };
+static short fg_papersize_i_command[] = {
+ DMPAPER_LETTER,
+ DMPAPER_LETTERSMALL,
+ DMPAPER_TABLOID,
+ DMPAPER_LEDGER,
+ DMPAPER_LEGAL,
+ DMPAPER_STATEMENT,
+ DMPAPER_EXECUTIVE,
+ DMPAPER_A3,
+ DMPAPER_A4,
+ DMPAPER_A4SMALL,
+ DMPAPER_A5,
+ DMPAPER_B4,
+ DMPAPER_B5,
+ DMPAPER_FOLIO,
+ DMPAPER_QUARTO,
+ DMPAPER_10X14,
+ DMPAPER_11X17,
+ DMPAPER_NOTE,
+ DMPAPER_ENV_9,
+ DMPAPER_ENV_10,
+ DMPAPER_ENV_11,
+ DMPAPER_ENV_12,
+ DMPAPER_ENV_14,
+ DMPAPER_CSHEET,
+ DMPAPER_DSHEET,
+ DMPAPER_ESHEET,
+ DMPAPER_ENV_DL,
+ DMPAPER_ENV_C5,
+ DMPAPER_ENV_C3,
+ DMPAPER_ENV_C4,
+ DMPAPER_ENV_C6,
+ DMPAPER_ENV_C65,
+ DMPAPER_ENV_B4,
+ DMPAPER_ENV_B5,
+ DMPAPER_ENV_B6,
+ DMPAPER_ENV_ITALY,
+ DMPAPER_ENV_MONARCH,
+ DMPAPER_ENV_PERSONAL,
+ DMPAPER_FANFOLD_US,
+ DMPAPER_FANFOLD_STD_GERMAN,
+ DMPAPER_FANFOLD_LGL_GERMAN,
+ DMPAPER_ISO_B4,
+ DMPAPER_JAPANESE_POSTCARD,
+ DMPAPER_9X11,
+ DMPAPER_10X11,
+ DMPAPER_15X11,
+ DMPAPER_ENV_INVITE,
+ DMPAPER_RESERVED_48,
+ DMPAPER_RESERVED_49,
+ DMPAPER_LETTER_EXTRA,
+ DMPAPER_LEGAL_EXTRA,
+ DMPAPER_TABLOID_EXTRA,
+ DMPAPER_A4_EXTRA,
+ DMPAPER_LETTER_TRANSVERSE,
+ DMPAPER_A4_TRANSVERSE,
+ DMPAPER_LETTER_EXTRA_TRANSVERSE,
+ DMPAPER_A_PLUS,
+ DMPAPER_B_PLUS,
+ DMPAPER_LETTER_PLUS,
+ DMPAPER_A4_PLUS,
+ DMPAPER_A5_TRANSVERSE,
+ DMPAPER_B5_TRANSVERSE,
+ DMPAPER_A3_EXTRA,
+ DMPAPER_A5_EXTRA,
+ DMPAPER_B5_EXTRA,
+ DMPAPER_A2,
+ DMPAPER_A3_TRANSVERSE,
+ DMPAPER_A3_EXTRA_TRANSVERSE,
+ DMPAPER_DBL_JAPANESE_POSTCARD,
+ DMPAPER_A6,
+ DMPAPER_JENV_KAKU2,
+ DMPAPER_JENV_KAKU3,
+ DMPAPER_JENV_CHOU3,
+ DMPAPER_JENV_CHOU4,
+ DMPAPER_LETTER_ROTATED,
+ DMPAPER_A3_ROTATED,
+ DMPAPER_A4_ROTATED,
+ DMPAPER_A5_ROTATED,
+ DMPAPER_B4_JIS_ROTATED,
+ DMPAPER_B5_JIS_ROTATED,
+ DMPAPER_JAPANESE_POSTCARD_ROTATED,
+ DMPAPER_DBL_JAPANESE_POSTCARD_ROTATED,
+ DMPAPER_A6_ROTATED,
+ DMPAPER_JENV_KAKU2_ROTATED,
+ DMPAPER_JENV_KAKU3_ROTATED,
+ DMPAPER_JENV_CHOU3_ROTATED,
+ DMPAPER_JENV_CHOU4_ROTATED,
+ DMPAPER_B6_JIS,
+ DMPAPER_B6_JIS_ROTATED,
+ DMPAPER_12X11,
+ DMPAPER_JENV_YOU4,
+ DMPAPER_JENV_YOU4_ROTATED,
+ DMPAPER_P16K,
+ DMPAPER_P32K,
+ DMPAPER_P32KBIG,
+ DMPAPER_PENV_1,
+ DMPAPER_PENV_2,
+ DMPAPER_PENV_3,
+ DMPAPER_PENV_4,
+ DMPAPER_PENV_5,
+ DMPAPER_PENV_6,
+ DMPAPER_PENV_7,
+ DMPAPER_PENV_8,
+ DMPAPER_PENV_9,
+ DMPAPER_PENV_10,
+ DMPAPER_P16K_ROTATED,
+ DMPAPER_P32K_ROTATED,
+ DMPAPER_P32KBIG_ROTATED,
+ DMPAPER_PENV_1_ROTATED,
+ DMPAPER_PENV_2_ROTATED,
+ DMPAPER_PENV_3_ROTATED,
+ DMPAPER_PENV_4_ROTATED,
+ DMPAPER_PENV_5_ROTATED,
+ DMPAPER_PENV_6_ROTATED,
+ DMPAPER_PENV_7_ROTATED,
+ DMPAPER_PENV_8_ROTATED,
+ DMPAPER_PENV_9_ROTATED,
+ DMPAPER_PENV_10_ROTATED,
+ DMPAPER_USER,
+ -1
+ };
+
+/* Map modes */
+static char *fg_map_modes_sub_cmds[] = {
+ "Text",
+ "LoMetric",
+ "HiMetric",
+ "LoEnglish",
+ "HiEnglish",
+ "Twips",
+ "Isotropic",
+ "Anisotropic",
+ NULL
+};
+static int fg_map_modes_i_command[] = {
+ MM_TEXT,
+ MM_LOMETRIC,
+ MM_HIMETRIC,
+ MM_LOENGLISH,
+ MM_HIENGLISH,
+ MM_TWIPS,
+ MM_ISOTROPIC,
+ MM_ANISOTROPIC
+};
+
+/*
+ * Font weights.
+ */
+/* Map modes */
+static char *fg_font_weight_sub_cmds[] = {
+ "Dontcare",
+ "Thin",
+ "Extralight",
+ "Light",
+ "Normal",
+ "Medium",
+ "Semibold",
+ "Bold",
+ "Extrabold",
+ "Heavy",
+ NULL
+};
+static int fg_font_weight_i_command[] = {
+ FW_DONTCARE,
+ FW_THIN,
+ FW_EXTRALIGHT,
+ FW_LIGHT,
+ FW_NORMAL,
+ FW_MEDIUM,
+ FW_SEMIBOLD,
+ FW_BOLD,
+ FW_EXTRABOLD,
+ FW_HEAVY
+};
+
+static char *fg_font_charset_sub_cmds[] = {
+ "Default",
+ "ANSI",
+ "Symbol",
+ "ShiftJIS",
+ "Hangeul",
+ "Hangul",
+ "GB2312",
+ "ChineseBig5",
+ "OEM",
+ "Johab",
+ "Hebrew",
+ "Arabic",
+ "Greek",
+ "Turkish",
+ "Vietnamese",
+ "Thai",
+ "Easteurope",
+ "Russian",
+ "Mac",
+ "Baltic",
+ NULL
+};
+static int fg_font_charset_i_command[] = {
+ DEFAULT_CHARSET,
+ ANSI_CHARSET,
+ SYMBOL_CHARSET,
+ SHIFTJIS_CHARSET,
+ HANGEUL_CHARSET,
+ HANGUL_CHARSET,
+ GB2312_CHARSET,
+ CHINESEBIG5_CHARSET,
+ OEM_CHARSET,
+ HEBREW_CHARSET,
+ ARABIC_CHARSET,
+ GREEK_CHARSET,
+ TURKISH_CHARSET,
+ VIETNAMESE_CHARSET,
+ THAI_CHARSET,
+ EASTEUROPE_CHARSET,
+ RUSSIAN_CHARSET,
+ MAC_CHARSET,
+ BALTIC_CHARSET
+};
+
+static char *fg_font_pitch_sub_cmds[] = {
+ "Default",
+ "Fixed",
+ "Variable",
+ "Mono",
+ NULL
+};
+
+static int fg_font_pitch_i_command[] = {
+ DEFAULT_PITCH,
+ FIXED_PITCH,
+ VARIABLE_PITCH
+ ,MONO_FONT
+};
+
+static char *fg_font_family_sub_cmds[] = {
+ "Dontcare",
+ "Roman",
+ "Swiss",
+ "Modern",
+ "Script",
+ "Decorative",
+ NULL
+};
+
+static int fg_font_family_i_command[] = {
+ FF_DONTCARE,
+ FF_ROMAN,
+ FF_SWISS,
+ FF_MODERN,
+ FF_SCRIPT,
+ FF_DECORATIVE
+};
/* Declaration for functions used later in this file.*/
-static HPALETTE WinGetSystemPalette(void);
-static int WinCanvasPrint(void *, Tcl_Interp *, int, Tcl_Obj *const *);
-static int WinTextPrint(void *, Tcl_Interp *, int, Tcl_Obj *const *);
+static int WinPrintCmd(ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static TCHAR * ReturnLockedDeviceName( HGLOBAL hDevNames );
+static char GetDeviceName(
+ Tcl_Interp *interp,
+ HGLOBAL hDevNames,
+ char Flags );
+static char PrintSelectPrinter( Tcl_Interp *interp );
+static Tcl_Obj * GetOrientation( DEVMODE * pDevMode );
+static Tcl_Obj * GetPaperSize( DEVMODE * pDevMode );
+static char AppendOrientPaperSize( Tcl_Interp *interp, DEVMODE * pDevMode );
+static char PrintPrinterSetup( Tcl_Interp *interp, TCHAR *Printer,
+ short Orientation, short PaperSize);
+static char PrintPageSetup( Tcl_Interp *interp, TCHAR *pPrinter,
+ short Orientation, short PaperSize,
+ int Left, int Top, int Right, int Bottom );
+static char CreateDevMode( TCHAR * pPrinter, short Orientation, short PaperSize,
+ char fShowPropertySheet );
+static char PrintOpenPrinter(
+ TCHAR * pPrinter, short Orientation, short PaperSize);
+static char PrintReset( char fPreserveDeviceData );
+static char PrintOpenJobDialog(
+ TCHAR * pPrinter,
+ short Orientation,
+ short PaperSize,
+ unsigned short MaxPage
+ );
+static char PrintOpenDoc(Tcl_Obj *resultPtr, TCHAR *DocName);
+static char PrintCloseDoc();
+static char PrintOpenPage();
+static char PrintClosePage();
+static char PrintGetAttr(Tcl_Interp *interp, int Index);
+static char PrintSetAttr(Tcl_Interp *interp, int Index, Tcl_Obj *oParam);
+static char DefaultPrinterGet( Tcl_Interp *interp );
+static char ListPrinters(Tcl_Interp *interp);
+static char ListChoices(Tcl_Interp *interp, char *ppChoiceList[]);
+static char PrintSetMapMode( int MapMode);
+static char LoadDefaultPrinter( );
+static char DefaultPrinterGet( Tcl_Interp *interp );
+static char PrintPen(int Width, COLORREF Color);
+static char PrintBrushColor(COLORREF Color);
+static char PrintBkColor(COLORREF Color);
+static char PrintRuler(int X0, int Y0, int LenX, int LenY);
+static char PrintRectangle(int X0, int Y0, int X1, int Y1);
+static char PrintFontCreate(int FontNumber,
+ TCHAR *Name, double PointSize, int Weight, int Italic, int Charset,
+ int Pitch, int Family);
+static char PrintFontSelect(int FontNumber);
+static char PrintText(int X0, int Y0, TCHAR *pText, COLORREF Color );
+static char PrintGetTextSize( Tcl_Interp *interp, TCHAR *pText);
+static char ListFonts(Tcl_Interp *interp, HDC hDC, int fFontNameOnly);
+static char ListFontUnicodeRanges(Tcl_Interp *interp, HDC hDC);
+static char GetFirstTextNoChar(Tcl_Interp *interp, TCHAR *pText);
+static int CALLBACK EnumFontFamExProc(
+ ENUMLOGFONTEX *lpelfe, /* logical-font data */
+ NEWTEXTMETRICEX *lpntme, /* physical-font data */
+ DWORD FontType, /* type of font */
+ LPARAM lParam /* application-defined data */
+);
+static char PaintPhoto( Tcl_Interp *interp, Tcl_Obj *CONST oImageName,
+ int PosX, int PosY, int Width, int Height);
+
+
+/*DLL entry point */
+
+BOOL __declspec(dllexport) WINAPI DllEntryPoint(
+ HINSTANCE hInstance,
+ DWORD seginfo,
+ LPVOID lpCmdLine)
+{
+ /* Don't do anything, so just return true */
+ return TRUE;
+}
+
+/*Initialisation Procedu Res */
+
+int __declspec(dllexport) Winprint_Init (Tcl_Interp *Interp)
+{
+ if (Tcl_InitStubs(Interp, "8.1", 0) == NULL
+ || Tk_InitStubs(Interp, "8.1", 0) == NULL)
+ {
+ return RET_ERROR;
+ }
+ Tcl_CreateObjCommand(Interp, "winprint", WinPrintCmd, (ClientData)NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ Tcl_PkgProvide (Interp, "winprint", version_string);
+ return RET_OK;
+}
+
+/*Called routine */
/*
* --------------------------------------------------------------------------
*
- * WinGetSystemPalette --
+ * WinPrintCmd --
+ *
+ * Provides core interface to Win32 printing API from Tcl.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+int WinPrintCmd(ClientData unused, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[])
+{
+ /* Option list and indexes */
+ const char *subCmds[] = {
+ "help", "selectprinter", "printersetup", "pagesetup",
+ "openjobdialog",
+ "openprinter", "close", "closedoc", "openpage",
+ "closepage", "version", "getattr", "setattr", "opendoc",
+ "pen", "brushcolor", "bkcolor",
+ "fontselect", "gettextsize", "ruler", "rectangle", "fontcreate",
+ "text", "textuni", "getfirstfontnochar",
+ "photo",
+ NULL};
+ enum iCommand {
+ iHelp, iSelectPrinter, iPrinterSetup, iPageSetup,
+ iOpenjobdialog,
+ iOpenPrinter, iClose, iClosedoc, iOpenpage,
+ iClosepage, iVersion, iGetattr, iSetAttr, iOpendoc,
+ iPen, iBrushColor, iBkColor,
+ iFontselect, iGetTextSize, iRuler, iRectangle, iFontCreate,
+ iText, iTextuni, iGetFirstFontNochar,
+ iPhoto
+ };
+
+ /*
+ * State variables.
+ */
+
+ /* Choice of option. */
+ int Index;
+ /* Result flag. */
+ char Res;
+ /* Result of Tcl functions. */
+ int TclResult;
+ /* Store the parameters in strings. */
+ int iPar[8];
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+ char ParCur;
+ Tcl_DString sPar1;
+ int PositionSPar;
+ /*
+ * Check if option argument is given and decode it.
+ */
+ if (objc > 1)
+ {
+ if (RET_ERROR ==
+ Tcl_GetIndexFromObj(interp, objv[1], subCmds, "subcmd", 0, &Index))
+ return RET_ERROR;
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "subcmd");
+ return RET_ERROR;
+ }
+
+ /* Check parameters and give usage messages. */
+ switch (Index) {
+ case iGetattr:
+ case iOpendoc:
+ case iFontselect:
+ case iGetTextSize:
+ case iGetFirstFontNochar:
+ if (objc != 3)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, "argument");
+ return RET_ERROR;
+ }
+ break;
+ case iSetAttr:
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp, 3, objv, "argument");
+ return RET_ERROR;
+ }
+ break;
+ case iText:
+ case iTextuni:
+ if (objc != 5 && objc != 8) {
+ Tcl_WrongNumArgs(interp, 2, objv, "X0 Y0 text ?red green blue?");
+ return RET_ERROR;
+ }
+ break;
+ case iRuler:
+ case iRectangle:
+ if (objc != 6)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, "X0 Y0 Width Height");
+ return RET_ERROR;
+ }
+ break;
+ case iFontCreate:
+ if (objc < 5 || objc > 10)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "Fontnumber Fontname Points ?Weight? ?Italic? ?Charset?"
+ " ?Pitch? ?Family?");
+ return RET_ERROR;
+ }
+ break;
+ case iPhoto:
+ if (objc < 5 || objc > 7)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "imagename x0 y0 ?width? ?height?");
+ return RET_ERROR;
+ }
+ break;
+ case iPen:
+ /* width and optionally red green blue together */
+ if (objc != 3 && objc != 6) {
+ Tcl_WrongNumArgs(interp, 2, objv, "width ?red green blue?");
+ return RET_ERROR;
+ }
+ break;
+ case iBrushColor:
+ case iBkColor:
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "red green blue");
+ return RET_ERROR;
+ }
+ break;
+ }
+
+ /* Default result. */
+ Res = RET_OK;
+
+ /*
+ * One string parameter.
+ * if this option is not given, a 0 pointer
+ * is present.
+ */
+ Tcl_DStringInit(& sPar1);
+ switch (Index) {
+ case iPrinterSetup:
+ case iPageSetup:
+ case iOpendoc:
+ case iOpenPrinter:
+ case iOpenjobdialog:
+ case iGetTextSize:
+ case iGetFirstFontNochar:
+ PositionSPar = 2;
+ break;
+ case iFontCreate:
+ PositionSPar = 3;
+ break;
+ case iText:
+ case iTextuni:
+ PositionSPar = 4;
+ break;
+ default:
+ PositionSPar = -1;
+ }
+ if ( -1 != PositionSPar )
+ {
+ if ( objc > PositionSPar )
+ {
+ char *pStr;
+ int lStr;
+ pStr = Tcl_GetStringFromObj(objv[PositionSPar],&lStr);
+ Tcl_WinUtfToTChar( pStr, lStr, &sPar1);
+ }
+ }
+ /*
+ * Decode parameters and invoke.
+ */
+ switch (Index) {
+ case iHelp:
+ Tcl_SetStringObj(resultPtr, usage_string,-1);
+ break;
+ case iVersion:
+ Tcl_SetStringObj(resultPtr, version_string,-1);
+ break;
+ case iSelectPrinter:
+ Res = PrintSelectPrinter( interp );
+ break;
+ case iClose:
+ {
+ const char *close_subCmds[] = {
+ "-eraseprinterstate",
+ NULL
+ };
+ enum iCloseCommand {
+ iErasePrinterState
+ };
+ char fPreserveState;
+ /* Decode argument. */
+ if ( objc > 2 )
+ {
+ int OptionIndex;
+ if (RET_ERROR ==
+ Tcl_GetIndexFromObj(
+ interp, objv[2], close_subCmds, "option", 0,
+ &OptionIndex))
+ {
+ Res = RET_ERROR;
+ } else {
+ switch (OptionIndex)
+ {
+ case iErasePrinterState:
+ fPreserveState = 0;
+ break;
+ default:
+ fPreserveState = 1;
+ break;
+ }
+ }
+ } else {
+ fPreserveState = 1;
+ }
+ if ( Res == RET_OK )
+ {
+ Res = PrintReset( fPreserveState );
+ }
+ }
+ break;
+ case iClosedoc:
+ Res=PrintCloseDoc();
+ break;
+ case iOpenpage:
+ Res=PrintOpenPage();
+ break;
+ case iClosepage:
+ Res=PrintClosePage();
+ break;
+ case iGetTextSize:
+ Res = PrintGetTextSize( interp, (TCHAR *)Tcl_DStringValue(& sPar1) );
+ break;
+ case iGetattr:
+ case iSetAttr:
+ /* One Index parameter. */
+ {
+ int IndexAttr;
+ if (RET_ERROR ==
+ Tcl_GetIndexFromObj(
+ interp, objv[2], fg_getattr_sub_cmds, "getattr", 0,
+ &IndexAttr))
+ {
+ return RET_ERROR;
+ }
+ if ( Index == iGetattr )
+ {
+ Res = PrintGetAttr( interp, IndexAttr );
+ } else {
+ Res = PrintSetAttr( interp, IndexAttr, objv[3] );
+ }
+ }
+ break;
+ case iOpendoc:
+ Res = PrintOpenDoc( resultPtr, (TCHAR *)Tcl_DStringValue(& sPar1));
+ break;
+ case iPageSetup:
+ case iPrinterSetup:
+ case iOpenPrinter:
+ case iOpenjobdialog:
+ {
+ short Orientation;
+ short PaperSize;
+ unsigned short MaxPage;
+ double Double;
+ /*
+ * Argument 2: Printer is already in sPar or NULL.
+ */
+
+ /* Orientation */
+ if ( objc > 3 )
+ {
+ int ParInt;
+ if (RET_ERROR ==
+ Tcl_GetIndexFromObj(
+ interp, objv[3], fg_orient_sub_cmds, "orient", 0,
+ &ParInt))
+ {
+ Res = RET_ERROR;
+ } else {
+ Orientation = fg_orient_i_command[ParInt];
+ }
+ } else {
+ Orientation = -1;
+ }
+ /* Paper Size */
+ if ( objc > 4 )
+ {
+ int ParInt;
+ if (RET_ERROR ==
+ Tcl_GetIndexFromObj(
+ interp, objv[4], fg_papersize_sub_cmds, "papersize", 0,
+ &ParInt))
+ {
+ Res = RET_ERROR;
+ } else {
+ PaperSize = fg_papersize_i_command[ParInt];
+ }
+ } else {
+ PaperSize = -1;
+ }
+ switch (Index)
+ {
+ case iPrinterSetup:
+ if ( Res == RET_OK )
+ {
+ Res = PrintPrinterSetup(
+ interp, (TCHAR *)Tcl_DStringValue(& sPar1),
+ Orientation,PaperSize );
+ }
+ break;
+ case iPageSetup:
+ /* Margins: Left, Top, Right, Bottom. */
+ if ( objc <= 5
+ || RET_OK != Tcl_GetDoubleFromObj(interp,objv[5], &Double) )
+ {
+ iPar[0] = -1;
+ } else {
+ iPar[0] = (int) (Double * 100);
+ }
+ if ( objc <= 6
+ || RET_OK != Tcl_GetDoubleFromObj(interp,objv[6], &Double) )
+ {
+ iPar[1] = -1;
+ } else {
+ iPar[1] = (int) (Double * 100);
+ }
+ if ( objc <= 7
+ || RET_OK != Tcl_GetDoubleFromObj(interp,objv[7], &Double) )
+ {
+ iPar[2] = -1;
+ } else {
+ iPar[2] = (int) (Double * 100);
+ }
+ if ( objc <= 8
+ || RET_OK != Tcl_GetDoubleFromObj(interp,objv[8], &Double) )
+ {
+ iPar[3] = -1;
+ } else {
+ iPar[3] = (int) (Double * 100);
+ }
+ if ( Res == RET_OK )
+ {
+ Res = PrintPageSetup(
+ interp, (TCHAR *)Tcl_DStringValue(& sPar1),
+ Orientation,PaperSize,
+ iPar[0], iPar[1], iPar[2],
+ iPar[3]);
+ }
+ break;
+ case iOpenPrinter:
+ if ( Res == RET_OK )
+ {
+ Res = PrintOpenPrinter(
+ (TCHAR *) Tcl_DStringValue(& sPar1),
+ Orientation, PaperSize );
+ }
+ break;
+ case iOpenjobdialog:
+ default:
+ /* MaxPage */
+ if ( objc > 5 )
+ {
+ int ParInt;
+ if (RET_ERROR ==
+ Tcl_GetIntFromObj( interp, objv[5], &ParInt))
+ {
+ Res = RET_ERROR;
+ }
+ MaxPage = (unsigned short) ParInt;
+ } else {
+ MaxPage = 0;
+ }
+ if ( Res == RET_OK )
+ {
+ Res = PrintOpenJobDialog(
+ (TCHAR *)Tcl_DStringValue(& sPar1),
+ Orientation,
+ PaperSize,
+ MaxPage );
+ }
+ break;
+ }
+ }
+ break;
+ case iFontCreate:
+ /* | Type | name | ParCur | objv | iParCur */
+ /* +--------+---------------+-----------+-------+-------- */
+ /* | int | Font number | 0 | 2 | 0 */
+ /* | string | font name | 1 | 3 | % */
+ /* | double | points | 2 | 4 | % */
+ /* | choice | Weight | 3 | 5 | 3 */
+ /* | int0/1 | Italic | 4 | 6 | 4 */
+ /* | choice | Charset | 5 | 7 | 5 */
+ /* | choice | Pitch | 6 | 8 | 6 */
+ /* | choice | Family | 7 | 9 | 7 */
+ {
+ double dPointSize;
+ int IndexOut;
+ const char ** pTable;
+ const char * pMsg;
+ const int *pValue;
+
+ /* Set default values. */
+ iPar[3] = FW_DONTCARE; /* Weight */
+ iPar[4] = 0; /* Default Italic: off */
+ iPar[5] = DEFAULT_CHARSET; /* Character set */
+ iPar[6] = FW_DONTCARE; /* Pitch */
+ iPar[7] = FF_DONTCARE; /* Family */
+
+ for ( ParCur = 0 ; ParCur < objc-2 && Res != RET_ERROR ; ParCur++)
+ {
+ switch (ParCur)
+ {
+ case 1:
+ /* Font name: Char parameter was already decoded */
+ break;
+ case 2:
+ /* Point Size: double parameter */
+ if (RET_ERROR ==
+ Tcl_GetDoubleFromObj(
+ interp,
+ objv[ParCur+2],& dPointSize ) )
+ {
+ Res = RET_ERROR;
+ }
+ break;
+ case 3:
+ /* Weight */
+ case 5:
+ /* CharSet */
+ case 6:
+ /* Pitch */
+ case 7:
+ /* Family */
+ switch (ParCur)
+ {
+ case 3:
+ pTable = fg_font_weight_sub_cmds;
+ pValue = fg_font_weight_i_command;
+ pMsg = "font weight";
+ break;
+ case 5:
+ pTable = fg_font_charset_sub_cmds;
+ pValue = fg_font_charset_i_command;
+ pMsg = "font charset";
+ break;
+ case 6:
+ pTable = fg_font_pitch_sub_cmds;
+ pValue = fg_font_pitch_i_command;
+ pMsg = "font pitch";
+ break;
+ case 7:
+ default:
+ pTable = fg_font_family_sub_cmds;
+ pValue = fg_font_family_i_command;
+ pMsg = "font family";
+ break;
+ }
+ if (RET_ERROR ==
+ Tcl_GetIndexFromObj(
+ interp, objv[ParCur+2], pTable,
+ pMsg, 0, & IndexOut ) )
+ {
+ Res = RET_ERROR;
+ } else {
+ iPar[ParCur] = pValue[IndexOut];
+ }
+ break;
+ case 0:
+ /* Font Number */
+ case 4:
+ /* Italic */
+ default:
+ /* Int parameter */
+ if (RET_ERROR ==
+ Tcl_GetIntFromObj(
+ interp,
+ objv[ParCur+2],& (iPar[ParCur])) )
+ {
+ Res = RET_ERROR;
+ }
+ break;
+ }
+ }
+ if (Res != RET_ERROR)
+ {
+ Res = PrintFontCreate(
+ iPar[0], (TCHAR *)Tcl_DStringValue(& sPar1),
+ dPointSize, iPar[3],
+ iPar[4], iPar[5], iPar[6], iPar[7]);
+ }
+ }
+ break;
+ case iFontselect:
+ /* One int parameter */
+ TclResult = Tcl_GetIntFromObj(interp, objv[2], & (iPar[0]));
+ if (TclResult == RET_OK) {
+ Res = PrintFontSelect( iPar[0]);
+ } else {
+ Res = RET_ERROR;
+ }
+ break;
+ case iPen:
+ /* One int parameter and 3 optional color parameter. */
+ if (RET_OK != Tcl_GetIntFromObj(interp, objv[2], & (iPar[0]))) {
+ Res = RET_ERROR;
+ } else {
+ COLORREF Color = 0;
+ if (objc > 3) {
+ int r,g,b;
+ if (RET_OK != Tcl_GetIntFromObj(interp, objv[3], &r)) {
+ Res = RET_ERROR;
+ } else if (RET_OK != Tcl_GetIntFromObj(interp, objv[4], &g)) {
+ Res = RET_ERROR;
+ } else if (RET_OK != Tcl_GetIntFromObj(interp, objv[5], &b)) {
+ Res = RET_ERROR;
+ } else {
+ Color = RGB(r/256,g/256,b/256);
+ }
+ }
+ Res = PrintPen( iPar[0],Color);
+ }
+ break;
+ case iBrushColor:
+ case iBkColor:
+ /* 3 color parameter. */
+ {
+ COLORREF Color = 0;
+ int r,g,b;
+ if (RET_OK != Tcl_GetIntFromObj(interp, objv[2], &r)) {
+ Res = RET_ERROR;
+ } else if (RET_OK != Tcl_GetIntFromObj(interp, objv[3], &g)) {
+ Res = RET_ERROR;
+ } else if (RET_OK != Tcl_GetIntFromObj(interp, objv[4], &b)) {
+ Res = RET_ERROR;
+ } else {
+ Color = RGB(r/256,g/256,b/256);
+ }
+ if (Index == iBrushColor)
+ Res = PrintBrushColor(Color);
+ else
+ Res = PrintBkColor(Color);
+ }
+ break;
+ case iText:
+ case iTextuni:
+ /* Two int, one string and optional 3 color parameters. */
+ if ( RET_OK != Tcl_GetIntFromObj(interp,objv[2],& (iPar[0])) ) {
+ Res = RET_ERROR;
+ } else if ( RET_OK != Tcl_GetIntFromObj(interp,objv[3],& (iPar[1])) ) {
+ Res = RET_ERROR;
+ } else {
+ COLORREF Color = 0;
+ if (objc > 5) {
+ int r,g,b;
+ if (RET_OK != Tcl_GetIntFromObj(interp, objv[5], &r)) {
+ Res = RET_ERROR;
+ } else if (RET_OK != Tcl_GetIntFromObj(interp, objv[6], &g)) {
+ Res = RET_ERROR;
+ } else if (RET_OK != Tcl_GetIntFromObj(interp, objv[7], &b)) {
+ Res = RET_ERROR;
+ } else {
+ Color = RGB(r/256,g/256,b/256);
+ }
+ }
+ Res = PrintText( iPar[0], iPar[1],
+ (TCHAR *)Tcl_DStringValue(& sPar1), Color );
+ }
+ break;
+ case iGetFirstFontNochar:
+ /* One string. */
+ Res = GetFirstTextNoChar( interp, (TCHAR *)Tcl_DStringValue(& sPar1));
+ break;
+ case iRuler:
+ case iRectangle:
+ /* 4 int */
+ for ( ParCur=0 ; ParCur < 4 ; ParCur++ )
+ {
+ if ( RET_ERROR == Tcl_GetIntFromObj(interp,
+ objv[ParCur+2],& (iPar[ParCur])) )
+ {
+ Res = RET_ERROR;
+ break;
+ }
+ }
+ if (Res != RET_ERROR)
+ {
+ if (Index == iRuler)
+ Res = PrintRuler(iPar[0], iPar[1], iPar[2], iPar[3]);
+ else
+ Res = PrintRectangle(iPar[0], iPar[1], iPar[2], iPar[3]);
+ }
+ break;
+
+ case iPhoto:
+ /* tkImg + 2..4 int: X0, Y0, Width, Height */
+ /* initialize optional parameters */
+ iPar[2] = 0;
+ iPar[3] = 0;
+ for ( ParCur=0 ; ParCur < objc-3 ; ParCur++ )
+ {
+ if ( RET_ERROR == Tcl_GetIntFromObj(interp,
+ objv[ParCur+3],& (iPar[ParCur])) )
+ {
+ Res = RET_ERROR;
+ break;
+ }
+ }
+ if (Res != RET_ERROR) {
+ Res = PaintPhoto(interp, objv[2], iPar[0], iPar[1], iPar[2],
+ iPar[3]);
+ }
+ break;
+ }
+ /*
+ * Free any intermediated strings.
+ */
+
+ /* String parameter. */
+ Tcl_DStringFree(& sPar1);
+
+ /*
+ * Format return value.
+ */
+ switch (Res)
+ {
+ case RET_OK_NO_RESULT_SET:
+ Tcl_SetStringObj( resultPtr, "", -1);
+ case RET_OK:
+ return RET_OK;
+ case RET_ERROR_PRINTER_IO:
+ Tcl_SetStringObj( resultPtr, "Printer I/O error",-1);
+ return RET_ERROR;
+ case RET_ERROR_MEMORY:
+ Tcl_SetStringObj( resultPtr, "Out of memory",-1);
+ return RET_ERROR;
+ case RET_ERROR_PARAMETER:
+ Tcl_SetStringObj( resultPtr, "Wrong parameter",-1);
+ return RET_ERROR;
+ case RET_ERROR_USER:
+ Tcl_SetStringObj( resultPtr, "User abort",-1);
+ return RET_ERROR;
+ case RET_ERROR_PRINTER_NOT_OPEN:
+ Tcl_SetStringObj( resultPtr, "Printer not open",-1);
+ return RET_ERROR;
+ case RET_ERROR_PRINTER_DRIVER:
+ Tcl_SetStringObj( resultPtr, "Printer driver error",-1);
+ return RET_ERROR;
+ default:
+ case RET_ERROR:
+ return RET_ERROR;
+ }
+}
+
+/*
+ * --------------------------------------------------------------------------
*
- * Sets a default color palette for bitmap rendering on Win32.
+ * ReturnLockedDeviceName --
*
+ * Extract the locked device name from the hDevNames structure and returns
+ * its pointer. hDevNames must be unlocked on success (which captures
+ * the return value).
+
* Results:
+ * Returns the device name.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static TCHAR * ReturnLockedDeviceName( HGLOBAL hDevNames )
+{
+ LPDEVNAMES pDevNames;
+ pDevNames = (LPDEVNAMES) GlobalLock( hDevNames );
+ if ( NULL == pDevNames )
+ return NULL;
+ if ( pDevNames->wDeviceOffset == 0)
+ {
+ GlobalUnlock( hDevNames );
+ return NULL;
+ }
+ return ( (TCHAR *) pDevNames ) + ( pDevNames->wDeviceOffset );
+}
+
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * GetDeviceName --
+ *
+ * Extract the device name from the hDevNames structure and put it in the
+ * interpreter result.
*
- * Sets the palette.
+ * Results:
+ * Returns the device name.
*
* -------------------------------------------------------------------------
*/
-HPALETTE
-WinGetSystemPalette(void)
+
+static char GetDeviceName(
+ Tcl_Interp *interp,
+ HGLOBAL hDevNames,
+ char Flags )
{
- HDC hDC;
- HPALETTE hPalette;
- DWORD flags;
+ char Ret;
+ TCHAR * pPrinter;
+ Tcl_DString Printer;
- hPalette = NULL;
- hDC = GetDC(NULL); /* Get the desktop device context */
- flags = GetDeviceCaps(hDC, RASTERCAPS);
- if (flags &RC_PALETTE) {
- LOGPALETTE *palettePtr;
+ pPrinter = ReturnLockedDeviceName( hDevNames );
+ if ( pPrinter == NULL )
+ return RET_ERROR_PRINTER_IO;
+
+ Tcl_DStringInit( &Printer );
+ Tcl_WinTCharToUtf( pPrinter, -1, &Printer);
+ Ret = RET_OK;
+ if ( Flags & F_RETURN_LIST )
+ {
+ Tcl_Obj *PrinterObj;
+ Tcl_Obj *lResult;
+
+ PrinterObj = Tcl_NewStringObj(
+ Tcl_DStringValue( &Printer ),
+ Tcl_DStringLength( &Printer ) );
+ Tcl_DStringFree( &Printer );
- palettePtr = (LOGPALETTE *)
- GlobalAlloc(GPTR, sizeof(LOGPALETTE) + 256 * sizeof(PALETTEENTRY));
- palettePtr->palVersion = 0x300;
- palettePtr->palNumEntries = 256;
- GetSystemPaletteEntries(hDC, 0, 256, palettePtr->palPalEntry);
- hPalette = CreatePalette(palettePtr);
- GlobalFree(palettePtr);
- }
- ReleaseDC(NULL, hDC);
- return hPalette;
+ lResult = Tcl_GetObjResult( interp );
+ if ( RET_OK !=
+ Tcl_ListObjAppendElement( interp, lResult, PrinterObj ))
+ {
+ /* Error already set in interp */
+ Ret = RET_ERROR;
+ }
+ } else {
+ Tcl_DStringResult( interp, &Printer );
+ }
+ GlobalUnlock( hDevNames );
+
+ if ( Flags & F_FREE_MEM )
+ {
+ GlobalFree(hDevNames);
+ }
+ return Ret;
}
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintSelectPrinter --
+ *
+ * Return the selected printer using the printer selection box.
+ *
+ * Results:
+ * Returns the selected printer.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintSelectPrinter( Tcl_Interp *interp )
+{
+ PrintReset( 1 );
+ pdlg.Flags = 0
+ | PD_DISABLEPRINTTOFILE
+ | PD_HIDEPRINTTOFILE
+ | PD_NOPAGENUMS
+ | PD_NOSELECTION
+ | PD_USEDEVMODECOPIESANDCOLLATE
+ ;
+ if ( PrintDlg( &pdlg ) == FALSE)
+ return RET_ERROR_USER;
+ /* Return the selected printer name. */
+ if ( NULL == pdlg.hDevNames )
+ return RET_ERROR_USER;
+ /* Get device names. */
+ return GetDeviceName( interp, pdlg.hDevNames, 0 );
+}
/*
* --------------------------------------------------------------------------
*
- * WinCanvasPrint --
+ * GetOrientation --
*
- * Prints a snapshot of a Tk_Window/canvas to the designated printer.
+ * Search the DevMode structure for an orientation value and return
+ * it as a Tcl object. If not found, NULL is returned.
*
* Results:
- * Returns a standard Tcl result.
+ * Returns the selected orientation.
*
* -------------------------------------------------------------------------
*/
-static int
-WinCanvasPrint(
- TCL_UNUSED(void *),
- Tcl_Interp * interp,
- int objc,
- Tcl_Obj * const *objv)
-{
- BITMAPINFO bi;
- DIBSECTION ds;
- HBITMAP hBitmap;
- HPALETTE hPalette;
- HDC hDC, printDC, memDC;
- void *data;
- Tk_Window tkwin;
- TkWinDCState state;
- int result;
- PRINTDLG pd;
- DOCINFO di;
- double pageWidth, pageHeight;
- int jobId;
- Tcl_DString dString;
- char *path;
- double scale, sx, sy;
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "window");
- return TCL_ERROR;
- }
- Tcl_DStringInit(&dString);
- path = Tcl_GetString(objv[1]);
- tkwin = Tk_NameToWindow(interp, path, Tk_MainWindow(interp));
- if (tkwin == NULL) {
- return TCL_ERROR;
- }
- if (Tk_WindowId(tkwin) == None) {
- Tk_MakeWindowExist(tkwin);
- }
- result = TCL_ERROR;
- hDC = TkWinGetDrawableDC(Tk_Display(tkwin), Tk_WindowId(tkwin), &state);
-
-
- /* Initialize bitmap to contain window contents/data. */
- ZeroMemory(&bi, sizeof(bi));
- bi.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
- bi.bmiHeader.biWidth = Tk_Width(tkwin);
- bi.bmiHeader.biHeight = Tk_Height(tkwin);
- bi.bmiHeader.biPlanes = 1;
- bi.bmiHeader.biBitCount = 32;
- bi.bmiHeader.biCompression = BI_RGB;
- hBitmap = CreateDIBSection(hDC, &bi, DIB_RGB_COLORS, &data, NULL, 0);
- memDC = CreateCompatibleDC(hDC);
- SelectObject(memDC, hBitmap);
- hPalette = WinGetSystemPalette();
- if (hPalette != NULL) {
- SelectPalette(hDC, hPalette, FALSE);
- RealizePalette(hDC);
- SelectPalette(memDC, hPalette, FALSE);
- RealizePalette(memDC);
- }
- /* Copy the window contents to the memory surface. */
- if (!BitBlt(memDC, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), hDC, 0, 0,
- SRCCOPY)) {
- Tcl_AppendResult(interp, "can't blit \"", Tk_PathName(tkwin), NULL);
- goto done;
- }
- /*
- * Now that the DIB contains the image of the window, get the databits
- * and write them to the printer device, stretching the image to the fit
- * the printer's resolution.
- */
- if (GetObject(hBitmap, sizeof(DIBSECTION), &ds) == 0) {
- Tcl_AppendResult(interp, "can't get DIB object", NULL);
- goto done;
- }
- /* Initialize print dialog. */
- ZeroMemory(&pd, sizeof(pd));
- pd.lStructSize = sizeof(pd);
- pd.Flags = PD_RETURNDC;
- pd.hwndOwner = GetDesktopWindow();
-
- if (PrintDlg(&pd) == TRUE) {
- printDC = pd.hDC;
-
- if (printDC == NULL) {
- Tcl_AppendResult(interp, "can't allocate printer DC", NULL);
- goto done;
- }
-
- /* Get the resolution of the printer device. */
- sx = (double)GetDeviceCaps(printDC, HORZRES) / (double)Tk_Width(tkwin);
- sy = (double)GetDeviceCaps(printDC, VERTRES) / (double)Tk_Height(tkwin);
- scale = fmin(sx, sy);
- pageWidth = scale * Tk_Width(tkwin);
- pageHeight = scale * Tk_Height(tkwin);
-
- ZeroMemory(&di, sizeof(di));
- di.cbSize = sizeof(di);
- Tcl_DStringAppend(&dString, "Snapshot of \"", -1);
- Tcl_DStringAppend(&dString, Tk_PathName(tkwin), -1);
- Tcl_DStringAppend(&dString, "\"", -1);
- di.lpszDocName = Tcl_DStringValue(&dString);
- jobId = StartDoc(printDC, &di);
- if (jobId <= 0) {
- Tcl_AppendResult(interp, "can't start document", NULL);
- goto done;
- }
- if (StartPage(printDC) <= 0) {
- Tcl_AppendResult(interp, "error starting page", NULL);
- goto done;
- }
- StretchDIBits(printDC, 0, 0, pageWidth, pageHeight, 0, 0,
- Tk_Width(tkwin), Tk_Height(tkwin), ds.dsBm.bmBits,
- (LPBITMAPINFO) &ds.dsBmih, DIB_RGB_COLORS, SRCCOPY);
- EndPage(printDC);
- EndDoc(printDC);
- DeleteDC(printDC);
- result = TCL_OK;
-
-done:
- Tcl_DStringFree(&dString);
-
- DeleteObject(hBitmap);
- DeleteDC(memDC);
- TkWinReleaseDrawableDC(Tk_WindowId(tkwin), hDC, &state);
- if (hPalette != NULL) {
- DeleteObject(hPalette);
- }
- } else {
- return TCL_ERROR;
- }
- return result;
-}
-
-
-/*
- * ----------------------------------------------------------------------
- *
- * WinTextPrint --
- *
- * Prints a character buffer to the designated printer.
+static Tcl_Obj * GetOrientation( DEVMODE * pDevMode )
+{
+ char * pText;
+ int IndexCur;
+
+ if ( pDevMode == NULL)
+ return NULL;
+
+ pText = NULL;
+ for (IndexCur = 0; fg_orient_sub_cmds[IndexCur] != NULL ; IndexCur++)
+ {
+ if ( pDevMode->dmOrientation == fg_orient_i_command[IndexCur] )
+ {
+ pText = fg_orient_sub_cmds[IndexCur];
+ break;
+ }
+ }
+ if ( NULL == pText )
+ return NULL;
+
+ return Tcl_NewStringObj( pText, -1 );
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * GetPaperSize--
+ *
+ * Search the DevMode structure for a paper size value and return
+ * it as a Tcl object. If not found, NULL is returned.
*
* Results:
- * Returns a standard Tcl result.
+ * Returns the paper size.
*
- * ----------------------------------------------------------------------
+ * -------------------------------------------------------------------------
*/
-static int WinTextPrint(
- TCL_UNUSED(void * ),
- Tcl_Interp * interp,
- int objc,
- Tcl_Obj *
- const * objv) {
- PRINTDLG pd;
- HDC hDC;
- HWND hwndEdit;
- TEXTMETRIC tm;
- int result;
- DOCINFO di;
- HFONT hFont = NULL;
- char * data;
- const char * tmptxt;
- LPCTSTR printbuffer;
- LONG bufferlen;
- int yChar, chars_per_line, lines_per_page, total_lines,
- total_pages, page, line, line_number;
- PTSTR linebuffer;
- BOOL success;
-
- result = TCL_OK;
- success = TRUE;
-
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "text");
- result = TCL_ERROR;
- return result;
- }
-
- /*
- *Initialize print dialog.
- */
- ZeroMemory( & pd, sizeof(pd));
- pd.lStructSize = sizeof(pd);
- pd.hwndOwner = GetDesktopWindow();
- pd.Flags = PD_RETURNDC | PD_NOPAGENUMS | PD_ALLPAGES | PD_USEDEVMODECOPIESANDCOLLATE;
+static Tcl_Obj * GetPaperSize( DEVMODE * pDevMode )
+{
+ char * pText;
+ int IndexCur;
+
+ if ( pDevMode == NULL)
+ return NULL;
- if (PrintDlg( &pd) == TRUE) {
- hDC = pd.hDC;
- if (hDC == NULL) {
- Tcl_AppendResult(interp, "can't allocate printer DC", NULL);
- return TCL_ERROR;
+ pText = NULL;
+ for (IndexCur = 0; fg_papersize_sub_cmds[IndexCur] != NULL ; IndexCur++)
+ {
+ if ( pDevMode->dmPaperSize == fg_papersize_i_command[IndexCur] )
+ {
+ pText = fg_papersize_sub_cmds[IndexCur];
+ break;
+ }
}
+ if ( NULL == pText )
+ return NULL;
- ZeroMemory( &di, sizeof(di));
- di.cbSize = sizeof(di);
- di.lpszDocName = "Tk Output";
+ return Tcl_NewStringObj( pText, -1 );
+}
- /*
- * Get text for printing.
- */
- data = Tcl_GetString(objv[1]);
+/*
+ * --------------------------------------------------------------------------
+ *
+ * AppendOrientPaperSize--
+ *
+ * Append orientation and paper size to the configuration.
+ *
+ * Results:
+ * Returns the paper size.
+ *
+ * -------------------------------------------------------------------------
+ */
- /*
- * Convert input text into a format Windows can use for printing.
- */
- tmptxt = data;
- printbuffer = (LPCTSTR) tmptxt;
- bufferlen = lstrlen(printbuffer);
+static char AppendOrientPaperSize( Tcl_Interp *interp, DEVMODE * pDevMode )
+{
+ Tcl_Obj *lResult;
+ Tcl_Obj *pObj;
- /*
- * Place text into a hidden Windows multi-line edit control
- * to make it easier to parse for printing.
- */
+ lResult = Tcl_GetObjResult( interp );
- hwndEdit = CreateWindowEx(
- 0, "EDIT",
- NULL,
- WS_POPUP | ES_MULTILINE,
- 0, 0, 0, 0,
- NULL,
- NULL,
- NULL,
- NULL);
+ /* Orientation */
+ pObj = GetOrientation( pDevMode );
+ if ( pObj == NULL )
+ return RET_ERROR_PRINTER_IO;
- /*
- * Add text to the window.
- */
- SendMessage(hwndEdit, WM_SETTEXT, 0, (LPARAM) printbuffer);
+ if ( RET_OK !=
+ Tcl_ListObjAppendElement( interp, lResult, pObj ))
+ {
+ return RET_ERROR;
+ }
- if (0 == (total_lines = SendMessage(hwndEdit, EM_GETLINECOUNT, 0, 0)))
- return TCL_OK;
+ /* PaperSize */
+ pObj = GetPaperSize( pDevMode );
+ if ( pObj == NULL )
+ return RET_ERROR_PRINTER_IO;
- /*
- * Determine how text will fit on page.
+ if ( RET_OK !=
+ Tcl_ListObjAppendElement( interp, lResult, pObj ))
+ {
+ return RET_ERROR;
+ }
+ return RET_OK;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintPrinterSetup--
+ *
+ * Show the page setup dialogue box and for paper size and orientation
+ * and return the users selection as Tcl variables.
+ *
+ * Results:
+ * Returns the paper size and orientation.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintPrinterSetup( Tcl_Interp *interp, TCHAR *pPrinter,
+ short Orientation, short PaperSize)
+{
+ char Res;
+ DEVMODE *pDevMode;
+
+ PrintReset( 1 );
+ Res = CreateDevMode( pPrinter, Orientation, PaperSize, 1 );
+ if ( RET_OK != Res )
+ return Res;
+ if ( pdlg.hDevMode == NULL )
+ {
+ return RET_ERROR_PRINTER_IO;
+ }
+ pDevMode = GlobalLock( pdlg.hDevMode );
+ if ( NULL == pDevMode )
+ return RET_ERROR_MEMORY;
+
+ /* Orientation and paper size */
+ if ( Res == RET_OK )
+ {
+ Res = AppendOrientPaperSize( interp, pDevMode );
+ }
+
+ GlobalUnlock( pdlg.hDevMode );
+
+ return Res;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintPageSetup--
+ *
+ * Show the page setup dialogue box and return the users selection
+* as Tcl variables.
+ *
+ * Results:
+ * Returns the complete page setup.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintPageSetup( Tcl_Interp *interp, TCHAR *pPrinter,
+ short Orientation, short PaperSize,
+ int Left, int Top, int Right, int Bottom
+ )
+{
+ PAGESETUPDLG sPageSetupDlg;
+ char Res;
+ Tcl_Obj *pObj;
+ Tcl_Obj *lResult;
+
+ PrintReset( 1 );
+
+ ZeroMemory( & sPageSetupDlg, sizeof( sPageSetupDlg ) );
+ sPageSetupDlg.lStructSize = sizeof( sPageSetupDlg );
+
+ /* Get old device names */
+ sPageSetupDlg.hDevNames = pdlg.hDevNames;
+
+ Res = CreateDevMode( pPrinter, Orientation, PaperSize, 0);
+ if (Res != RET_OK || pdlg.hDevMode == NULL )
+ return Res;
+
+ /* Copy devmode pointer */
+ sPageSetupDlg.hDevMode = pdlg.hDevMode;
+
+ /* Initialise with current values */
+ sPageSetupDlg.Flags = 0
+ | PSD_INHUNDREDTHSOFMILLIMETERS
+ | PSD_MARGINS
+ ;
+ sPageSetupDlg.rtMargin.left = ( Left != -1) ? Left : 2500;
+ sPageSetupDlg.rtMargin.top = ( Top != -1) ? Top : 2500;
+ sPageSetupDlg.rtMargin.right = ( Right != -1) ? Right : 2500;
+ sPageSetupDlg.rtMargin.bottom = ( Bottom != -1) ? Bottom : 2500;
+
+ /* Show page setup dialog box. */
+ if ( FALSE == PageSetupDlg( & sPageSetupDlg ) )
+ {
+ DWORD Err;
+ Err = CommDlgExtendedError();
+ if ( Err == 0 )
+ {
+ /* User cancel. */
+ return RET_ERROR_USER;
+ } else {
+ /* Printer error. */
+ return RET_ERROR_PRINTER_IO;
+ }
+ }
+
+ /* Get device name. */
+ Res = GetDeviceName( interp, sPageSetupDlg.hDevNames, F_RETURN_LIST );
+
+ if ( sPageSetupDlg.hDevNames != pdlg.hDevNames
+ && sPageSetupDlg.hDevNames != NULL)
+ {
+ if ( pdlg.hDevNames != NULL )
+ GlobalFree( pdlg.hDevNames );
+
+ pdlg.hDevNames = sPageSetupDlg.hDevNames;
+ }
+
+ /* Get device mode data. */
+ if ( sPageSetupDlg.hDevMode != NULL )
+ {
+ DEVMODE *pDevMode;
+ pDevMode = GlobalLock( sPageSetupDlg.hDevMode );
+ if ( NULL == pDevMode )
+ return RET_ERROR_MEMORY;
+
+ /* Orientation and paper size. */
+ if ( Res == RET_OK )
+ {
+ Res = AppendOrientPaperSize( interp, pDevMode );
+ }
+
+ /* Save the DevMode structure handle */
+ if ( pdlg.hDevMode != sPageSetupDlg.hDevMode )
+ {
+ if ( pdlg.hDevMode != NULL )
+ GlobalFree( pdlg.hDevMode );
+ pdlg.hDevMode = sPageSetupDlg.hDevMode;
+ }
+ GlobalUnlock( sPageSetupDlg.hDevMode );
+ }
+
+ /* Get and treat margin rectangle. */
+
+ lResult = Tcl_GetObjResult( interp );
+
+ if ( Res == RET_OK )
+ {
+ pObj = Tcl_NewDoubleObj( sPageSetupDlg.rtMargin.left / 100.0 );
+ if ( RET_OK != Tcl_ListObjAppendElement( interp, lResult, pObj ))
+ Res = RET_ERROR;
+ }
+ if ( Res == RET_OK )
+ {
+ pObj = Tcl_NewDoubleObj( sPageSetupDlg.rtMargin.top / 100.0 );
+ if ( RET_OK != Tcl_ListObjAppendElement( interp, lResult, pObj ))
+ Res = RET_ERROR;
+ }
+ if ( Res == RET_OK )
+ {
+ pObj = Tcl_NewDoubleObj( sPageSetupDlg.rtMargin.right / 100.0 );
+ if ( RET_OK != Tcl_ListObjAppendElement( interp, lResult, pObj ))
+ Res = RET_ERROR;
+ }
+ if ( Res == RET_OK )
+ {
+ pObj = Tcl_NewDoubleObj( sPageSetupDlg.rtMargin.bottom / 100.0 );
+ if ( RET_OK != Tcl_ListObjAppendElement( interp, lResult, pObj ))
+ Res = RET_ERROR;
+ }
+ return Res;
+}
+
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * CreateDevMode--
+ *
+ * Create a DevMode structure for the given settings. The devmode
+ * structure is put in a moveable memory object. The handle is placed
+ * in pdlg.hDevMode.
+ *
+ * Results:
+ * Creates a DevMode structure for the printer.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char CreateDevMode( TCHAR * pPrinter, short Orientation, short PaperSize,
+ char fShowPropertySheet )
+{
+ HANDLE hPrinter;
+ DEVMODE* lpDevMode;
+ LONG Size;
+ DWORD fMode;
+ char fDevNamesLocked;
+ char Res;
+
+ Res = RET_OK;
+ /* If no printer given use last or default printer. */
+ if ( pPrinter == NULL || pPrinter[0] == '\0' )
+ {
+ if ( pdlg.hDevNames == NULL )
+ {
+ Res = LoadDefaultPrinter( );
+ if ( Res != RET_OK )
+ return Res;
+ }
+ pPrinter = ReturnLockedDeviceName( pdlg.hDevNames );
+ fDevNamesLocked = 1;
+ } else {
+ fDevNamesLocked = 0;
+ }
+ /* Get Printer handle. */
+ if ( FALSE == OpenPrinter( pPrinter, &hPrinter, NULL) )
+ {
+ hPrinter = NULL;
+ Res = RET_ERROR_PRINTER_IO;
+ }
+ /* Get DevMode structure size. */
+ if (Res == RET_OK )
+ {
+ Size = DocumentProperties( NULL, hPrinter, pPrinter, NULL, NULL, 0 );
+ if ( Size < 0 )
+ {
+ Res = RET_ERROR_PRINTER_IO;
+ }
+ }
+
+ /* Adjust or get new memory. */
+ lpDevMode = NULL;
+ if (Res == RET_OK )
+ {
+ if ( pdlg.hDevMode != NULL )
+ pdlg.hDevMode = GlobalReAlloc( pdlg.hDevMode, Size, GMEM_ZEROINIT);
+ else
+ pdlg.hDevMode = GlobalAlloc( GMEM_MOVEABLE | GMEM_ZEROINIT, Size);
+ lpDevMode = GlobalLock( pdlg.hDevMode );
+ if ( pdlg.hDevMode == NULL || lpDevMode == NULL)
+ {
+ Res = RET_ERROR_MEMORY;
+ }
+ }
+
+ /* Initialise if new. */
+ if ( Res == RET_OK && lpDevMode->dmSize == 0 )
+ {
+ /* Get default values */
+ if ( IDOK != DocumentProperties(
+ NULL,
+ hPrinter,
+ pPrinter,
+ lpDevMode,
+ NULL,
+ DM_OUT_BUFFER ) )
+ {
+ Res = RET_ERROR_PRINTER_IO;
+ }
+ }
+
+ if (Res == RET_OK )
+ {
+ /* Set values. */
+ if (Orientation != -1 )
+ {
+
+ lpDevMode->dmFields |= DM_ORIENTATION;
+ lpDevMode->dmOrientation = Orientation;
+ }
+ if ( PaperSize != -1 )
+ {
+ lpDevMode->dmFields |= DM_PAPERSIZE;
+ lpDevMode->dmPaperSize = PaperSize;
+ }
+ /* ---------------------------------------------------------------------- */
+ /* Modify present and eventually show property dialogue */
+ fMode = DM_IN_BUFFER | DM_OUT_BUFFER;
+ if ( fShowPropertySheet )
+ fMode |= DM_IN_PROMPT;
+
+ Size = DocumentProperties(
+ NULL,
+ hPrinter,
+ pPrinter,
+ lpDevMode,
+ lpDevMode,
+ fMode );
+
+ if ( Size < 0 )
+ {
+ Res = RET_ERROR_PRINTER_IO;
+ }
+ if ( fDevNamesLocked )
+ GlobalUnlock( pdlg.hDevNames );
+ if ( hPrinter != NULL )
+ ClosePrinter( hPrinter );
+ if ( lpDevMode != NULL )
+ GlobalUnlock( pdlg.hDevMode );
+ if ( Res != RET_OK )
+ {
+ GlobalFree( pdlg.hDevMode );
+ pdlg.hDevMode = NULL;
+ }
+ /* User may pres the cancel button when interactive. */
+ if ( Res == RET_OK && fShowPropertySheet && Size == IDCANCEL )
+ return RET_ERROR_USER;
+ return Res;
+}
+
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintOpenPrinter--
+ *
+ * Open the given printer.
+ *
+ * Results:
+ * Opens the selected printer.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+
+static char PrintOpenPrinter(
+ TCHAR * pPrinter, short Orientation, short PaperSize)
+{
+ DEVMODE* lpInitData;
+ char Res;
+ char fDevNamesLocked;
+
+ PrintReset( 1 );
+
+ Res = CreateDevMode( pPrinter, Orientation, PaperSize, 0 );
+ if ( RET_OK != Res )
+ return Res;
+ if ( pdlg.hDevMode == NULL
+ || NULL == ( lpInitData = GlobalLock( pdlg.hDevMode ) ) )
+ {
+ return RET_ERROR_MEMORY;
+ }
+
+ /*
+ * If no printer given, it was loaded by CreateDevMode in
+ * pdlg.hDeviceNames.
*/
- GetTextMetrics(hDC, &tm);
- yChar = tm.tmHeight + tm.tmExternalLeading;
- chars_per_line = GetDeviceCaps(hDC, HORZRES) / tm.tmAveCharWidth;
- lines_per_page = GetDeviceCaps(hDC, VERTRES) / yChar;
- total_pages = (total_lines + lines_per_page - 1) / lines_per_page;
+ if ( pPrinter == NULL || pPrinter[0] == '\0' )
+ {
+ if (pdlg.hDevNames == NULL
+ || NULL == (pPrinter = ReturnLockedDeviceName( pdlg.hDevNames ) ) )
+ {
+ return RET_ERROR_PRINTER_IO;
+ }
+ fDevNamesLocked = 1;
+ } else {
+ fDevNamesLocked = 0;
+ }
- /*
- * Allocate a buffer for each line of text.
+ pdlg.hDC = CreateDC(
+ /* "WINSPOOL", */
+ NULL,
+ pPrinter,
+ NULL,
+ lpInitData);
+
+ GlobalUnlock( pdlg.hDevMode );
+ if ( fDevNamesLocked )
+ GlobalUnlock( pdlg.hDevNames );
+ if ( pdlg.hDC == NULL)
+ return RET_ERROR_PRINTER_IO;
+ return RET_OK;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintOpenJobDialog--
+ *
+ * Open the print job dialog.
+ *
+ * Results:
+ * Opens the job dialog.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintOpenJobDialog(
+ TCHAR * pPrinter,
+ short Orientation,
+ short PaperSize,
+ unsigned short MaxPage
+ )
+{
+ char Res;
+
+ PrintReset( 1 );
+
+ Res = CreateDevMode( pPrinter, Orientation, PaperSize, 0 );
+ if ( RET_OK != Res )
+ return Res;
+
+ if (MaxPage == 0)
+ {
+ pdlg.nFromPage = 0;
+ pdlg.nToPage = 0;
+ pdlg.nMinPage = 0;
+ pdlg.nMaxPage = 0;
+ } else {
+ if (pdlg.nFromPage < 1)
+ pdlg.nFromPage = 1;
+ if (pdlg.nToPage > MaxPage)
+ pdlg.nToPage = MaxPage;
+ pdlg.nMinPage = 1;
+ pdlg.nMaxPage = MaxPage;
+ }
+
+ pdlg.Flags = PD_NOSELECTION | PD_USEDEVMODECOPIESANDCOLLATE | PD_RETURNDC ;
+
+ if ( PrintDlg( &pdlg ) == FALSE)
+ return RET_ERROR_USER;
+
+ return RET_OK;
+}
+
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintReset--
+ *
+ * Free any resource which might be opened by a print command.
+ * Initialise the print dialog structure.
+ *
+ * Results:
+ * Free print resources and re-start the print dialog structure.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintReset( char fPreserveDeviceData )
+{
+ int i;
+ if (hPen != NULL)
+ {
+ SelectObject(pdlg.hDC, GetStockObject (BLACK_PEN));
+ DeleteObject(hPen);
+ hPen = NULL;
+ }
+ if (SelectedFont != -1)
+ {
+ SelectObject(pdlg.hDC, GetStockObject(SYSTEM_FONT));
+ SelectedFont = -1;
+ }
+ for (i = 0; i < 10 ; i++)
+ {
+ if (hFont[i] != NULL)
+ {
+ DeleteObject(hFont[i]);
+ hFont[i] = NULL;
+ }
+ }
+ /*
+ * Free members of the pdlg structure.
+ */
+ if ( fPDLGInitialised )
+ {
+ if (pdlg.hDC != NULL)
+ {
+ DeleteDC(pdlg.hDC);
+ pdlg.hDC = NULL;
+ }
+ if ( ! fPreserveDeviceData )
+ {
+
+ /* Free any Device mode data */
+ if ( pdlg.hDevMode != NULL )
+ {
+ GlobalFree( pdlg.hDevMode );
+ pdlg.hDevMode = NULL;
+ }
+
+ /* Free any Device Names data. */
+ if ( pdlg.hDevNames != NULL )
+ {
+ GlobalFree( pdlg.hDevNames );
+ pdlg.hDevNames = NULL;
+ }
+ }
+ } else {
+ /*
+ * Initialise pdlg structure.
+ */
+ memset( &pdlg, 0, sizeof( PRINTDLG ) );
+ pdlg.lStructSize = sizeof( PRINTDLG );
+ fPDLGInitialised = TRUE;
+ }
+ return RET_OK;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintOpenDoc--
+ *
+ * Opens the document for printing.
+ *
+ * Results:
+ * Opens the print document.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintOpenDoc(Tcl_Obj *resultPtr, TCHAR *DocName)
+{
+ int JobID;
+ DOCINFO di;
+
+ if (pdlg.hDC == NULL)
+ return RET_ERROR_PRINTER_NOT_OPEN;
+
+ memset( &di, 0, sizeof( DOCINFO ) );
+ di.cbSize = sizeof( DOCINFO );
+ di.lpszDocName = DocName;
+ JobID = StartDoc(pdlg.hDC, &di);
+ if ( JobID > 0 )
+ {
+ Tcl_SetIntObj(resultPtr, JobID);
+ return RET_OK;
+ }
+ return RET_ERROR_PRINTER_IO;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintCloseDoc--
+ *
+ * Closes the document for printing.
+ *
+ * Results:
+ * Closes the print document.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+
+static char PrintCloseDoc()
+{
+ if ( EndDoc(pdlg.hDC) > 0)
+ return RET_OK;
+ return RET_ERROR_PRINTER_IO;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintOpenPage--
+ *
+ * Opens a page for printing.
+ *
+ * Results:
+ * Opens the print page.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintOpenPage()
+{
+
+/*
+ * Here we have to (re)set the mapping mode and select all objects
+ * because StartPage starts with default values.
+ */
+ if ( StartPage(pdlg.hDC) <= 0)
+ return RET_ERROR_PRINTER_IO;
+ else {
+ if (0 == SetMapMode(pdlg.hDC, MM_LOMETRIC))
+ return RET_ERROR_PRINTER_IO;
+ if (hPen != NULL)
+ {
+ if (NULL == SelectObject(pdlg.hDC, hPen))
+ return RET_ERROR_PRINTER_IO;
+ }
+ if (SelectedFont != -1)
+ {
+ if ( RET_OK != PrintFontSelect(SelectedFont))
+ return RET_ERROR_PRINTER_IO;
+ }
+ /* Activate Brush where we can set the color. */
+ SelectObject(pdlg.hDC, GetStockObject(DC_BRUSH));
+ }
+ return RET_OK;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintClosePage--
+ *
+ * Closes the printed page.
+ *
+ * Results:
+ * Closes the page.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintClosePage()
+{
+ if ( EndPage(pdlg.hDC) > 0)
+ return RET_OK;
+ return RET_ERROR_PRINTER_IO;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintGetAttr--
+ *
+ * Get the printer attributes.
+ *
+ * Results:
+ * Returns the printer attributes.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintGetAttr(Tcl_Interp *interp, int Index)
+{
+ char Res;
+ DEVMODE * pDevMode;
+
+ /*
+ * State variables.
*/
- linebuffer = ckalloc(sizeof(TCHAR) * (chars_per_line + 1));
+
+ /* Check for open printer when hDC is required. */
+ switch ( Index )
+ {
+ case iMapMode:
+ case iAveCharHeight:
+ case iAveCharWidth:
+ case iHorzRes:
+ case iVertRes:
+ case iDPI:
+ case iPhysicalOffsetX:
+ case iPhysicalOffsetY:
+ case iFonts:
+ case iFontNames:
+ case iFontUnicodeRanges:
+ if (pdlg.hDC == NULL)
+ return RET_ERROR_PRINTER_NOT_OPEN;
+ }
+
+ /* Check for Allocated DeviceMode structure. */
+ switch ( Index )
+ {
+ case iOrientation:
+ case iPaperSize:
+ if (pdlg.hDevMode == NULL)
+ return RET_ERROR_PRINTER_NOT_OPEN;
+ pDevMode = GlobalLock( pdlg.hDevMode );
+ if ( pDevMode == NULL )
+ return RET_ERROR_MEMORY;
+ break;
+ default:
+ pDevMode = NULL;
+ break;
+ }
+
+ /* Choice of option. */
+ Res = RET_OK;
+ switch ( Index )
+ {
+ case iCopies:
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), pdlg.nCopies);
+ return RET_OK;
+ case iFirstPage:
+ Tcl_SetIntObj(Tcl_GetObjResult(interp),
+ 0 != (pdlg.Flags & PD_PAGENUMS) ? pdlg.nFromPage : pdlg.nMinPage);
+ return RET_OK;
+ case iLastPage:
+ Tcl_SetIntObj(Tcl_GetObjResult(interp),
+ 0 != (pdlg.Flags & PD_PAGENUMS) ? pdlg.nToPage : pdlg.nMaxPage);
+ return RET_OK;
+ case iMapMode:
+ {
+ int MapMode;
+ int Pos;
+ MapMode = GetMapMode(pdlg.hDC);
+ if ( 0 == MapMode )
+ return RET_ERROR_PRINTER_IO;
+ for ( Pos = 0 ; NULL != fg_map_modes_sub_cmds[Pos] ; Pos++ )
+ {
+ if ( MapMode == fg_map_modes_i_command[Pos] )
+ {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ fg_map_modes_sub_cmds[Pos], -1);
+ return RET_OK;
+ }
+ }
+ return RET_ERROR_PARAMETER;
+ }
+ case iAveCharHeight:
+ {
+ TEXTMETRIC tm;
+ if( TRUE==GetTextMetrics(pdlg.hDC, &tm))
+ {
+ Tcl_SetIntObj(
+ Tcl_GetObjResult(interp),
+ tm.tmHeight + tm.tmExternalLeading);
+ return RET_OK;
+ }
+ return RET_ERROR_PRINTER_IO;
+ }
+ case iAveCharWidth:
+ {
+ TEXTMETRIC tm;
+ if( TRUE==GetTextMetrics(pdlg.hDC, &tm))
+ {
+ Tcl_SetIntObj(Tcl_GetObjResult( interp ), tm.tmAveCharWidth);
+ return RET_OK;
+ }
+ return RET_ERROR_PRINTER_IO;
+ }
+ case iHorzRes:
+ Tcl_SetIntObj(
+ Tcl_GetObjResult( interp ),
+ GetDeviceCaps(pdlg.hDC, HORZRES));
+ return RET_OK;
+ case iVertRes:
+ Tcl_SetIntObj(
+ Tcl_GetObjResult( interp ),
+ GetDeviceCaps(pdlg.hDC, VERTRES));
+ return RET_OK;
+ case iDPI:
+ Tcl_SetIntObj(
+ Tcl_GetObjResult( interp ),
+ GetDeviceCaps(pdlg.hDC, LOGPIXELSX));
+ return RET_OK;
+ case iPhysicalOffsetX:
+ Tcl_SetIntObj(
+ Tcl_GetObjResult( interp ),
+ GetDeviceCaps(pdlg.hDC, PHYSICALOFFSETX));
+ return RET_OK;
+ case iPhysicalOffsetY:
+ Tcl_SetIntObj(
+ Tcl_GetObjResult( interp ),
+ GetDeviceCaps(pdlg.hDC, PHYSICALOFFSETY));
+ return RET_OK;
+ case iPrinter:
+ if ( fPDLGInitialised
+ && pdlg.hDevNames != NULL)
+ {
+ return GetDeviceName( interp, pdlg.hDevNames, FALSE );
+ } else {
+ return RET_ERROR_PRINTER_IO;
+ }
+ case iOrientation:
+ {
+ Tcl_Obj * pObj;
+ pObj = GetOrientation( pDevMode );
+ if ( pObj != NULL )
+ {
+ Tcl_SetObjResult( interp, pObj );
+ } else {
+ Res = RET_ERROR_PRINTER_IO;
+ }
+ }
+ break;
+ case iPaperSize:
+ {
+ Tcl_Obj * pObj;
+ pObj = GetPaperSize( pDevMode );
+ if ( pObj != NULL )
+ {
+ Tcl_SetObjResult( interp, pObj );
+ } else {
+ Res = RET_ERROR_PRINTER_IO;
+ }
+ }
+ break;
+ case iDefaultPrinter:
+ return DefaultPrinterGet( interp );
+ case iPrinters:
+ return ListPrinters( interp );
+ case iPaperTypes:
+ return ListChoices( interp, fg_papersize_sub_cmds );
+ case iMapModes:
+ return ListChoices( interp, fg_map_modes_sub_cmds );
+ case iFontWeights:
+ return ListChoices( interp, fg_font_weight_sub_cmds );
+ case iFontCharsets:
+ return ListChoices( interp, fg_font_charset_sub_cmds );
+ case iFontPitchValues:
+ return ListChoices( interp, fg_font_pitch_sub_cmds );
+ case iFontFamilies:
+ return ListChoices( interp, fg_font_family_sub_cmds );
+ case iFonts:
+ return ListFonts( interp, pdlg.hDC, 0 );
+ case iFontNames:
+ return ListFonts( interp, pdlg.hDC, 1 );
+ case iFontUnicodeRanges:
+ return ListFontUnicodeRanges( interp, pdlg.hDC);
+ default:
+ Res = RET_ERROR_PARAMETER;
+ break;
+ }
+
+ /* Unlock pDevMode. */
+ if ( NULL != pDevMode )
+ GlobalUnlock( pdlg.hDevMode );
+
+ return Res;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintSetAttr--
+ *
+ * Set the printer attributes.
+ *
+ * Results:
+ * Returns the printer attributes.
+ *
+ * -------------------------------------------------------------------------
+ */
- if (StartDoc(pd.hDC, & di) > 0) {
- for (page = 0 ; page < total_pages ; page++) {
- if (StartPage(hDC) < 0) {
- success = FALSE;
- result = TCL_ERROR;
- return result;
+static char PrintSetAttr(Tcl_Interp *interp, int Index, Tcl_Obj *oParam)
+{
+ switch ( Index )
+ {
+ case iMapMode:
+ {
+ int IndexMapMode;
+ if (RET_ERROR ==
+ Tcl_GetIndexFromObj(
+ interp, oParam, fg_map_modes_sub_cmds,
+ "setmapmode", 1, &IndexMapMode))
+ {
+ return RET_ERROR;
+ }
+ return PrintSetMapMode( fg_map_modes_i_command[IndexMapMode] );
}
+ default:
+ return RET_ERROR_PARAMETER;
+ }
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * LoadDefaultPrinter--
+ *
+ * Loads the default printer in the pdlg structure.
+ *
+ * Results:
+ * Loads the default printer.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char LoadDefaultPrinter( )
+{
+ PrintReset( 1 );
+ pdlg.Flags = PD_RETURNDEFAULT ;
+ if ( PrintDlg( &pdlg ) == FALSE)
+ return RET_ERROR_PRINTER_IO;
+ if ( pdlg.hDevNames == NULL)
+ return RET_ERROR_PRINTER_IO;
+ return RET_OK;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * DefaultPrinterGet--
+ *
+ * Gets the default printer in the pdlg structure.
+ *
+ * Results:
+ * Returns the default printer.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+
+static char DefaultPrinterGet( Tcl_Interp *interp )
+{
+ char Res;
+ Res = LoadDefaultPrinter();
+ if ( Res == RET_OK )
+ Res = GetDeviceName( interp, pdlg.hDevNames, FALSE );
+ return RET_OK;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * ListPrinters--
+ *
+ * Lists all available printers on the system.
+ *
+ * Results:
+ * Returns the printer list.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char ListPrinters(Tcl_Interp *interp)
+{
+ DWORD dwSize = 0;
+ DWORD dwPrinters = 0;
+ PRINTER_INFO_5* pInfo;
+ char Res;
+
+ /* Initialise result value. */
+ Res = RET_OK;
+
+ /* Find required buffer size. */
+ if (! EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_CONNECTIONS,
+ NULL, 5, NULL, 0, &dwSize, &dwPrinters))
+ {
/*
- * For each page, print the lines.
+ * Check for ERROR_INSUFFICIENT_BUFFER.
+ * If something else, then quit.
*/
- for (line = 0; line < lines_per_page; line++) {
- line_number = lines_per_page * page + line;
- if (line_number > total_lines)
+ if ( GetLastError() != ERROR_INSUFFICIENT_BUFFER)
+ {
+ /* No printer. */
+ return RET_ERROR_PRINTER_IO;
+ }
+ /* Fall through */
+ }
+
+ /* Allocate the buffer memory */
+ pInfo = (PRINTER_INFO_5 *) GlobalAlloc(GMEM_FIXED, dwSize);
+ if (pInfo == NULL)
+ {
+ /* Out of memory */
+ return RET_ERROR_MEMORY;
+ }
+
+ /*
+ * Fill the buffer. Again,
+ * this depends on the O/S.
+ */
+ if (EnumPrinters(PRINTER_ENUM_LOCAL|PRINTER_ENUM_CONNECTIONS,
+ NULL, 5, (unsigned char *)pInfo, dwSize, &dwSize, &dwPrinters))
+ {
+ /* We have got the list of printers. */
+ DWORD PrinterCur;
+ Tcl_Obj *lPrinter;
+
+ /* Initialise return list.*/
+ lPrinter = Tcl_GetObjResult( interp );
+
+ /* Loop adding the printers to the list. */
+ for ( PrinterCur = 0; PrinterCur < dwPrinters; PrinterCur++, pInfo++)
+ {
+ Tcl_DString Printer;
+ Tcl_Obj *PrinterObj;
+ Tcl_DStringInit( &Printer );
+ Tcl_WinTCharToUtf(pInfo->pPrinterName, -1, &Printer);
+ PrinterObj = Tcl_NewStringObj(
+ Tcl_DStringValue( &Printer ),
+ Tcl_DStringLength( &Printer ) );
+ Tcl_DStringFree( &Printer );
+ if ( RET_OK != Tcl_ListObjAppendElement( interp, lPrinter, PrinterObj ))
+ {
+ /* Error already set in interp. */
+ Res = RET_ERROR;
+ break;
+ }
+ }
+ } else {
+ /* Error - unlikely though as first call to EnumPrinters succeeded! */
+ return RET_ERROR_PRINTER_IO;
+ }
+
+ GlobalFree( pInfo );
+
+ return Res;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * ListChoices--
+ *
+ * Presents a list of printer choices.
+ *
+ * Results:
+ * Returns the printer choices.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+
+static char ListChoices(Tcl_Interp *interp, char *ppChoiceList[])
+{
+ int Index;
+ Tcl_Obj *lResult;
+
+ /* Initialise return list. */
+ lResult = Tcl_GetObjResult( interp );
+
+ /* Loop adding the printers to the list */
+ for ( Index = 0; ppChoiceList[Index] != NULL; Index++)
+ {
+ Tcl_Obj *ChoiceText;
+ ChoiceText = Tcl_NewStringObj( ppChoiceList[Index], -1 );
+ if ( RET_OK != Tcl_ListObjAppendElement( interp, lResult, ChoiceText))
+ {
+ /* Error already set in interp. */
+ return RET_ERROR;
+ }
+ }
+ return RET_OK;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * ListFonts--
+ *
+ * List fonts on system.
+ *
+ * Results:
+ * Returns the font list.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char ListFonts(Tcl_Interp *interp, HDC hDC, int fFontNameOnly)
+{
+
+/* This function is used by getattr fonts and getattr fontnamestyle.
+ * getattr fonts: lParam is passed as 0 to EnumFontFamExProc.
+ * getattr fontnames: lParam is passed with an initialized last fontname
+ * to EnumFontFamExProc.
+ * This value is used to check for duplicate listed font names. */
+ */
+ LOGFONT LogFont;
+ TCHAR *pCompareFont;
+
+ /* Initialise LogFont */
+ LogFont.lfCharSet = DEFAULT_CHARSET;
+ LogFont.lfPitchAndFamily = 0;
+ LogFont.lfFaceName[0] = '\0';
+
+ /*> Save interpreter ptr in global variable to use it for automatic */
+ /*> error feedback. */
+ fg_interp = interp;
+ if (fFontNameOnly) {
+ pCompareFont = _alloca(sizeof(TCHAR) * LF_FULLFACESIZE);
+ pCompareFont[0] = 0;
+ } else {
+ pCompareFont = 0;
+ }
+
+ /* Initialise return list */
+ if ( EnumFontFamiliesEx(
+ hDC,
+ &LogFont,
+ (FONTENUMPROC) EnumFontFamExProc, /* callback function */
+ (LPARAM) pCompareFont,
+ 0
+ ) )
+ return RET_OK;
+ else
+ return RET_ERROR;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * EnumFontFamExProc --
+ *
+ * Enumerate font families and styles.
+ *
+ * Results:
+ * Returns font families and styles.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static int CALLBACK EnumFontFamExProc(
+ ENUMLOGFONTEX *lpelfe, /* logical-font data */
+ NEWTEXTMETRICEX *lpntme, /* physical-font data */
+ DWORD FontType, /* type of font */
+ LPARAM lParam /* application-defined data */
+)
+{
+
+/*
+ * This function is used by getattr fonts and getattr fontnamestyle.
+ *
+ * getattr fonts: the font attributes name, style, charset and normal/fixed are
+ * added. In this case, the parameter lParam is 0.
+ *
+ * getattr fontnamestyle: it is checked if the current font has different name
+ * or style as the last font. If yes, name and style is added.
+ * If not, nothing is added. In this case, the parameter lParam contains a pointer
+ * to a ENUMLOGFONTEX variable. On a change, the current content is copied into
+ * that variable for the next comparison round.
+ */
+ Tcl_Obj *AppendObj;
+ Tcl_Obj *pResultObj;
+ Tcl_DString dStr;
+
+ if (lParam != 0) {
+ TCHAR *pCompareFont = (TCHAR *)lParam;
+ if ( 0 == _tcscmp(pCompareFont, lpelfe->elfFullName) ) {
+ return TRUE;
+ } else {
+ _tcscpy( pCompareFont, lpelfe->elfFullName );
+ }
+ }
+
+ pResultObj = Tcl_GetObjResult(fg_interp);
+
+ /*> Add font name */
+ Tcl_DStringInit(& dStr);
+ Tcl_WinTCharToUtf(lpelfe->elfFullName,-1, &dStr);
+ AppendObj = Tcl_NewStringObj(Tcl_DStringValue(&dStr),-1);
+ Tcl_DStringFree(& dStr);
+ if (RET_OK != Tcl_ListObjAppendElement(fg_interp, pResultObj, AppendObj))
+ return FALSE;
+
+ /*> For getattr fontnames, end here */
+ if (lParam != 0) {
+ return TRUE;
+ }
+
+ /*
+ * Transform style to weight.
+ *
+ * Style may have other words like condensed etc, so map all unknown weights
+ * to "Normal".
+ */
+
+ if ( 0 == _tcscmp(lpelfe->elfStyle, TEXT("Thin"))
+ || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Light"))
+ || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Medium"))
+ || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Bold")) )
+ {
+ Tcl_DStringInit(& dStr);
+ Tcl_WinTCharToUtf(lpelfe->elfStyle,-1, &dStr);
+ AppendObj = Tcl_NewStringObj(Tcl_DStringValue(&dStr),-1);
+ Tcl_DStringFree(& dStr);
+ } else if ( 0 == _tcscmp(lpelfe->elfStyle, TEXT("Extralight"))
+ || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Ultralight")) ) {
+ AppendObj = Tcl_NewStringObj("Extralight",-1);
+ } else if ( 0 == _tcscmp(lpelfe->elfStyle, TEXT("Semibold"))
+ || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Demibold")) ) {
+ AppendObj = Tcl_NewStringObj("Semibold",-1);
+ } else if ( 0 == _tcscmp(lpelfe->elfStyle, TEXT("Extrabold"))
+ || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Ultrabold")) ) {
+ AppendObj = Tcl_NewStringObj("Extrabold",-1);
+ } else if ( 0 == _tcscmp(lpelfe->elfStyle, TEXT("Heavy"))
+ || 0 == _tcscmp(lpelfe->elfStyle, TEXT("Black")) ) {
+ AppendObj = Tcl_NewStringObj("Heavy",-1);
+ } else {
+ AppendObj = Tcl_NewStringObj("Normal",-1);
+ }
+ if (RET_OK != Tcl_ListObjAppendElement(fg_interp, pResultObj, AppendObj))
+ return FALSE;
+
+ /* Add script. */
+ Tcl_DStringInit(& dStr);
+ Tcl_WinTCharToUtf(lpelfe->elfScript,-1, &dStr);
+ AppendObj = Tcl_NewStringObj(Tcl_DStringValue(&dStr),-1);
+ Tcl_DStringFree(& dStr);
+ if (RET_OK != Tcl_ListObjAppendElement(fg_interp, pResultObj, AppendObj))
+ return FALSE;
+
+ /* Pitch. */
+ switch ( (lpelfe->elfLogFont.lfPitchAndFamily) & 0xf )
+ {
+ case FIXED_PITCH:
+ AppendObj = Tcl_NewStringObj("fixed",-1);
+ break;
+ default:
+ AppendObj = Tcl_NewStringObj("variable",-1);
+ break;
+ }
+ if (RET_OK != Tcl_ListObjAppendElement(fg_interp, pResultObj, AppendObj))
+ return FALSE;
+
+ /* Continue enumeration. */
+ return TRUE;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * ListFontUnicodeRanges --
+ *
+ * Get the unicode ranges of the current font.
+ *
+ * Results:
+ * Returns unicode range.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char ListFontUnicodeRanges(Tcl_Interp *interp, HDC hDC)
+{
+ size_t StructSize;
+ LPGLYPHSET pGlyphSet;
+ int PosCur;
+ Tcl_Obj *oList;
+
+ /* Get structure size. */
+ StructSize = GetFontUnicodeRanges(hDC,NULL);
+ if (StructSize == 0) {
+ return RET_ERROR_PRINTER_IO;
+ }
+ /* Alloc return memory on the stack */
+ pGlyphSet = _alloca(StructSize);
+
+ /* Get glyph set structure */
+ if (0 == GetFontUnicodeRanges(hDC,pGlyphSet)) {
+ return RET_ERROR_PRINTER_IO;
+ }
+
+ /* Prepare result list. */
+ oList = Tcl_NewListObj(0,NULL);
+
+ for (PosCur = 0 ; PosCur < (int)(pGlyphSet->cRanges) ; PosCur++) {
+ /* Starting glyph */
+ if (RET_OK != Tcl_ListObjAppendElement(interp, oList,
+ Tcl_NewIntObj(pGlyphSet->ranges[PosCur].wcLow))) {
+ return RET_ERROR;
+ }
+ /* Length of range */
+ if (RET_OK != Tcl_ListObjAppendElement(interp, oList,
+ Tcl_NewIntObj(pGlyphSet->ranges[PosCur].cGlyphs))) {
+ return RET_ERROR;
+ }
+ }
+
+ Tcl_SetObjResult(interp,oList);
+ return RET_OK;
+}
+
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * GetFirstTextNoChar --
+ *
+ * Get data on glyph structure.
+ *
+ * Results:
+ * Returns glyph structure.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char GetFirstTextNoChar(Tcl_Interp *interp, TCHAR *pText)
+{
+ size_t StructSize;
+ LPGLYPHSET pGlyphSet;
+ int PosCur;
+ int IndexCur;
+ Tcl_Obj *oList;
+
+ /* Get structure size. */
+ StructSize = GetFontUnicodeRanges(pdlg.hDC,NULL);
+ if (StructSize == 0) {
+ return RET_ERROR_PRINTER_IO;
+ }
+ /* Alloc return memory on the stack. */
+ pGlyphSet = _alloca(StructSize);
+
+ /* Get glyph set structure. */
+ if (0 == GetFontUnicodeRanges(pdlg.hDC,pGlyphSet)) {
+ return RET_ERROR_PRINTER_IO;
+ }
+
+ /* Prepare result list. */
+ oList = Tcl_NewListObj(0,NULL);
+
+ /*> Loop over characters. */
+ for (IndexCur = 0;;IndexCur++) {
+ int fFound = 0;
+ /*> Check for end of string */
+ if (pText[IndexCur] == 0) {
break;
- *(int * ) linebuffer = chars_per_line;
- TextOut(hDC, 100, yChar * line, linebuffer,
- (int) SendMessage(hwndEdit, EM_GETLINE,
- (WPARAM) line_number, (LPARAM) linebuffer));
}
- if (EndPage(hDC) < 0) {
- success = FALSE;
- result = TCL_ERROR;
- return result;
+ /* Loop over glyph ranges. */
+ for (PosCur = 0 ; PosCur < (int)(pGlyphSet->cRanges) ; PosCur++) {
+ if ( pText[IndexCur] >= pGlyphSet->ranges[PosCur].wcLow
+ && pText[IndexCur] < pGlyphSet->ranges[PosCur].wcLow
+ + pGlyphSet->ranges[PosCur].cGlyphs )
+ {
+ /* Glyph found. */
+ fFound = 1;
+ break;
+ }
+ }
+ if (!fFound) {
+ Tcl_SetObjResult(interp,Tcl_NewIntObj(IndexCur));
+ return RET_OK;
}
- }
- if (!success) {
- result = TCL_ERROR;
- return result;
- }
- if (success){
- EndDoc(hDC);
- DestroyWindow(hwndEdit);
- }
}
- ckfree(linebuffer);
- DeleteDC(pd.hDC);
- result = TCL_OK;
- return result;
- }
- return result;
+
+ Tcl_SetObjResult(interp,Tcl_NewIntObj(-1));
+ return RET_OK;
}
-
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintSetMapMode --
+ *
+ * Set the map mode for the printer.
+ *
+ * Results:
+ * Returns the map mode.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintSetMapMode( int MapMode )
+{
+ /* Check for open printer when hDC is required. */
+ if (pdlg.hDC == NULL)
+ return RET_ERROR_PRINTER_NOT_OPEN;
+ if ( 0 == SetMapMode( pdlg.hDC, MapMode ) )
+ {
+ return RET_ERROR_PRINTER_IO;
+ }
+ return RET_OK;
+}
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintPen --
+ *
+ * Set the pen for rendering lines.
+ *
+ * Results:
+ * Returns the pen.
+ *
+ * -------------------------------------------------------------------------
+ */
+static char PrintPen(int Width, COLORREF Color)
+{
+ if (hPen != NULL)
+ DeleteObject(hPen);
+ if (Width == 0) {
+ /* Solid Pen */
+ hPen = CreatePen(PS_NULL, 1, 0);
+ } else {
+ /* Solid pen. */
+ LOGBRUSH lb;
+ lb.lbStyle = BS_SOLID;
+ lb.lbColor = Color;
+ lb.lbHatch = 0;
+ hPen = ExtCreatePen(PS_GEOMETRIC|PS_SOLID|PS_ENDCAP_SQUARE|PS_JOIN_MITER
+ , Width, &lb, 0, NULL);
+ }
+ if (NULL == hPen || NULL == SelectObject(pdlg.hDC, hPen) )
+ return RET_ERROR_PRINTER_IO;
+ return RET_OK;
+}
/*
- * ----------------------------------------------------------------------
+ * --------------------------------------------------------------------------
*
- * PrintInit --
+ * PrintBrushColor --
*
- * Initialize this package and create script-level commands.
+ * Set the brush color for the printer.
*
* Results:
- * Initialization of code.
+ * Returns the brush color.
*
- * ----------------------------------------------------------------------
+ * -------------------------------------------------------------------------
*/
+static char PrintBrushColor(COLORREF Color)
+{
+ if (CLR_INVALID == SetDCBrushColor(pdlg.hDC, Color) )
+ return RET_ERROR_PRINTER_IO;
+ return RET_OK;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintBkColor --
+ *
+ * Set the background color for the printer.
+ *
+ * Results:
+ * Returns the background color.
+ *
+ * -------------------------------------------------------------------------
+ */
-int
-PrintInit(
- Tcl_Interp * interp)
+static char PrintBkColor(COLORREF Color)
{
- Tcl_CreateObjCommand(interp, "::tk::print::_printcanvas", WinCanvasPrint, NULL, NULL);
- Tcl_CreateObjCommand(interp, "::tk::print::_printtext", WinTextPrint, NULL, NULL);
- return TCL_OK;
+ if (CLR_INVALID == SetBkColor(pdlg.hDC, Color) )
+ return RET_ERROR_PRINTER_IO;
+ return RET_OK;
}
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintRuler --
+ *
+ * Set the ruler for the printer.
+ *
+ * Results:
+ * Returns the ruler.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintRuler(int X0, int Y0, int LenX, int LenY)
+{
+ POINT pt[2];
+ pt[0].x = X0;
+ pt[0].y = Y0;
+ pt[1].x = X0+LenX;
+ pt[1].y = Y0+LenY;
+ if (FALSE == Polyline(pdlg.hDC, pt, 2))
+ return RET_ERROR_PRINTER_IO;
+ return RET_OK;
+}
/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 79
- * coding: utf-8
- * End:
+ * --------------------------------------------------------------------------
+ *
+ * PrintRectangle --
+ *
+ * Set the print rectangle.
+ *
+ * Results:
+ * Returns the print rectangle.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintRectangle(int X0, int Y0, int X1, int Y1)
+{
+ if (FALSE == Rectangle(pdlg.hDC, X0,Y0,X1,Y1))
+ return RET_ERROR_PRINTER_IO;
+ return RET_OK;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintFontCreate --
+ *
+ * Set the print font.
+ *
+ * Results:
+ * Returns the print font.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintFontCreate(int FontNumber,
+ TCHAR *Name, double dPointSize, int Weight, int Italic, int Charset,
+ int Pitch, int Family)
+{
+
+/*
+ * Charset:
+ * ANSI 0
+ * DEFAULT_ 1
+ * GREEK_ 161 (0xA1)
+ * Italic
+ * 0 No
+ * 1 Yes
+ * Pitch
+ * 0 Default
+ * 1 Fixed
+ * 2 Variable
+ * Family
+ * 0 FF_DONTCARE
+ * 1 FF_ROMAN Variable stroke width, serifed. Times Roman, Century Schoolbook, etc.
+ * 2 FF_SWISS Variable stroke width, sans-serifed. Helvetica, Swiss, etc.
+ * 3 FF_MODERN Constant stroke width, serifed or sans-serifed. Pica, Elite, Courier, etc.
+ * 4 FF_SCRIPT Cursive, etc.
+ * 5 FF_DECORATIVE Old English, etc.
+ */
+
+ POINT pt; /* To convert to logical scale. */
+ LOGFONT lf;
+
+ if (FontNumber < 0 || FontNumber > 9)
+ return RET_ERROR_PARAMETER;
+ if (hFont[FontNumber] != NULL)
+ {
+ if (SelectedFont == FontNumber)
+ {
+ SelectObject(pdlg.hDC, GetStockObject(SYSTEM_FONT));
+ }
+ DeleteObject (hFont[FontNumber]);
+ }
+
+ /* Convert decipoints to the logical device points. */
+ pt.x = 0;
+ pt.y = (int) (dPointSize * GetDeviceCaps(pdlg.hDC, LOGPIXELSY) / 72.0);
+ DPtoLP (pdlg.hDC, &pt, 1);
+
+ lf.lfHeight = - abs(pt.y);
+ lf.lfWidth = 0;
+ lf.lfEscapement = 0;
+ lf.lfOrientation = 0;
+ lf.lfWeight = Weight;
+ lf.lfItalic = (unsigned char) Italic;
+ lf.lfUnderline = 0;
+ lf.lfStrikeOut = 0;
+ lf.lfCharSet = (unsigned char) Charset;
+ lf.lfOutPrecision = OUT_DEVICE_PRECIS;
+ lf.lfClipPrecision = 0;
+ lf.lfQuality = DEFAULT_QUALITY;
+ lf.lfPitchAndFamily = (unsigned char) (Pitch + (Family<<4));
+ _tccpy(lf.lfFaceName, Name);
+
+ hFont[FontNumber] = CreateFontIndirect(&lf);
+ if (NULL == hFont[FontNumber])
+ return RET_ERROR_PRINTER_IO;
+ return RET_OK;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintFontCreate --
+ *
+ * Set the print font.
+ *
+ * Results:
+ * Returns the print font.
+ *
+ * -------------------------------------------------------------------------
*/
+static char PrintFontSelect(int FontNumber)
+{
+ if (FontNumber < 0 || FontNumber > 9 || hFont[FontNumber] == NULL)
+ return RET_ERROR_PARAMETER;
+
+ if (NULL == SelectObject (pdlg.hDC, hFont[FontNumber]))
+ return RET_ERROR_PRINTER_IO;
+
+ SelectedFont = FontNumber;
+ return RET_OK;
+}
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintText --
+ *
+ * Prints a page of text.
+ *
+ * Results:
+ * Returns the printed text.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintText(int X0, int Y0, TCHAR *pText, COLORREF Color )
+{
+ if (CLR_INVALID == SetTextColor(pdlg.hDC, Color ) )
+ return RET_ERROR_PRINTER_IO;
+
+ if (FALSE == ExtTextOut(pdlg.hDC, X0, Y0,
+ 0, /* Options */
+ NULL, /* Clipping rectangle */
+ pText, _tcslen(pText), /* Text and length */
+ NULL ) ) /* Distance array */
+ {
+ return RET_ERROR_PRINTER_IO;
+ }
+ return RET_OK;
+}
+
+
+/*
+ * --------------------------------------------------------------------------
+ *
+ * PrintGetTextSize --
+ *
+ * Gets the text size.
+ *
+ * Results:
+ * Returns the text side.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+static char PrintGetTextSize( Tcl_Interp *interp, TCHAR *pText )
+{
+ SIZE Size;
+
+ int Res;
+ Tcl_Obj *lResult;
+ Tcl_Obj *IntObj;
+
+ if ( FALSE == GetTextExtentPoint32(
+ pdlg.hDC,
+ pText, _tcslen(pText),
+ &Size ) )
+ {
+ return RET_ERROR_PRINTER_IO;
+ }
+
+ /*
+ * We have got the size values.
+ * Initialise return list.
+ */
+ lResult = Tcl_GetObjResult( interp );
+
+ /* X Size */
+ IntObj = Tcl_NewIntObj( Size.cx );
+ if ( RET_OK != Tcl_ListObjAppendElement( interp, lResult, IntObj ))
+ {
+ /* Error already set in interp. */
+ Res = RET_ERROR;
+ }
+
+ /* Y Size */
+ IntObj = Tcl_NewIntObj( Size.cy );
+ if ( RET_OK != Tcl_ListObjAppendElement( interp, lResult, IntObj ))
+ {
+ /* Error already set in interp */
+ Res = RET_ERROR;
+ }
+ return RET_OK;
+}
+
+
+/* Paint a photo image to the printer DC */
+/* @param interp tcl interpreter */
+/* @param oImageName tcl object with tk imsge name */
+/* @param DestPosX Destination X position */
+/* @param DestPosY Destination Y position */
+/* @param DestWidth Width of destination image, or 0 to use original size */
+/* @param DestHeight Height of destination image or 0 to use original size */
+static char PaintPhoto( Tcl_Interp *interp, Tcl_Obj *CONST oImageName,
+ int DestPosX, int DestPosY, int DestWidth, int DestHeight)
+{
+ #if 0
+ Tk_PhotoImageBlock sImageBlock;
+ Tk_PhotoHandle hPhoto;
+ HBITMAP hDIB;
+ int IndexCur;
+ /* Access bgraPixel as void ptr or unsigned char ptr */
+ union {unsigned char *ptr; void *voidPtr;} bgraPixel;
+ BITMAPINFO bmInfo;
+
+ if (pdlg.hDC == NULL)
+ return RET_ERROR_PRINTER_NOT_OPEN;
+
+ /* The creation of the DIP is from */
+ /* tk8.6.9 win/tkWinWm.c, proc WmIconphotoCmd */
+ if ( NULL == (hPhoto = Tk_FindPhoto(interp, Tcl_GetString(oImageName)))) {
+ return RET_ERROR;
+ }
+ Tk_PhotoGetImage(hPhoto, &sImageBlock);
+ /* pixelSize = 4 */
+ /* pitch = width * 4 */
+ /* offset = 0:0,1:1,2:2,3:3 */
+
+ /* Create device-independant color bitmap. */
+ ZeroMemory(&bmInfo, sizeof bmInfo);
+ bmInfo.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
+ bmInfo.bmiHeader.biWidth = sImageBlock.width;
+ bmInfo.bmiHeader.biHeight = -sImageBlock.height;
+ bmInfo.bmiHeader.biPlanes = 1;
+ bmInfo.bmiHeader.biBitCount = 32;
+ bmInfo.bmiHeader.biCompression = BI_RGB;
+
+ /* the first parameter is the dc, which may be 0. */
+ /* no difference to specify it */
+ hDIB = CreateDIBSection(NULL, &bmInfo, DIB_RGB_COLORS,
+ &bgraPixel.voidPtr, NULL, 0);
+ if (!hDIB) {
+ return RET_ERROR_MEMORY;
+ }
+ /* Convert the photo image data into BGRA format (RGBQUAD). */
+ for (IndexCur = 0 ;
+ IndexCur < sImageBlock.height * sImageBlock.width * 4 ;
+ IndexCur += 4)
+ {
+ bgraPixel.ptr[IndexCur] = sImageBlock.pixelPtr[IndexCur+2];
+ bgraPixel.ptr[IndexCur+1] = sImageBlock.pixelPtr[IndexCur+1];
+ bgraPixel.ptr[IndexCur+2] = sImageBlock.pixelPtr[IndexCur+0];
+ bgraPixel.ptr[IndexCur+3] = sImageBlock.pixelPtr[IndexCur+3];
+ }
+ /* Use original width and height if not given */
+ if (DestWidth == 0) { DestWidth = sImageBlock.width; }
+ if (DestHeight == 0) { DestHeight = sImageBlock.height; }
+ /* Use StretchDIBits with full image. */
+ /* The printer driver may use additional color info to do better */
+ /* interpolation */
+ if (GDI_ERROR == StretchDIBits(
+ pdlg.hDC, /* handle to DC */
+ DestPosX, /* x-coord of destination upper-left corner */
+ DestPosY, /* y-coord of destination upper-left corner */
+ DestWidth, /* width of destination rectangle */
+ DestHeight, /* height of destination rectangle */
+ 0, /* x-coord of source upper-left corner */
+ 0, /* y-coord of source upper-left corner */
+ sImageBlock.width, /* width of source rectangle */
+ sImageBlock.height, /* height of source rectangle */
+ bgraPixel.voidPtr, /* bitmap bits */
+ &bmInfo, /* bitmap data */
+ DIB_RGB_COLORS, /* usage options */
+ SRCCOPY /* raster operation code */
+ ) )
+ {
+ DeleteObject(hDIB);
+ /* As this is invoked within the driver, return a driver error */
+ return RET_ERROR_PRINTER_DRIVER;
+ }
+ DeleteObject(hDIB);
+ #endif
+ return RET_OK;
+}
generated by cgit v0.12 at 2024-09-20 03:00:12 (GMT)