path: root/graphics/gdtclft/files/patch-gif

This patch adds support for GIF, XPM, WBMP, and JPEG file formats, which
are support by the underlying GD.

GIF, JPEG, and WBMP formats are also added as _output_ formats.

Also, in case of file-opening failure, a useful error string is
returned.

Use freely and get yourself a pademelon...

	-mi (http://cafepress.com/buy/pademelon?pid=5934485)

--- gdCmd.c	Fri Aug  4 17:11:05 2000
+++ gdCmd.c	Mon Dec  4 03:50:17 2006
@@ -19,4 +19,5 @@
  */
 
+#include <errno.h>
 #include <stdio.h>
 #include <string.h>
@@ -47,10 +48,10 @@
 
 typedef  struct {
-	char *cmd;
+	const char *cmd;
 	int (*f)();
 	int minargs, maxargs;
 	int subcmds;
 	int ishandle;
-	char *usage;
+	const char *usage;
 } cmdOptions;
 
@@ -61,16 +62,39 @@
 
 static cmdOptions subcmdVec[] = {
-	{"create",			tclGdCreateCmd,			2, 2,	0, 0,
-			"width height"},
+	{"create",			tclGdCreateCmd,			2, 3,	0, 0,
+			"width height ?true?"},
 	{"createFromPNG",	tclGdCreateCmd, 		1, 1,	0, 0,
 			"filehandle"},
+	{"createFromGIF",	tclGdCreateCmd, 		1, 1,	0, 0,
+			"filehandle"},
 	{"createFromGD",	tclGdCreateCmd, 		1, 1,	0, 0,
 			"filehandle"},
+	{"createFromGD2",	tclGdCreateCmd, 		1, 1,	0, 0,
+			"filehandle"},
 	{"createFromXBM",	tclGdCreateCmd, 		1, 1,	0, 0,
 			"filehandle"},
+#ifdef NOX11
+	{"createFromXPM-NOT-AVAILABLE",	tclGdCreateCmd,		1, 1,	0, 0,
+			"filename"},
+#else
+	{"createFromXPM",	tclGdCreateCmd, 		1, 1,	0, 0,
+			"filename"},
+#endif
+	{"createFromJPG",	tclGdCreateCmd, 		1, 1,	0, 0,
+			"filehandle"},
+	{"createFromJPEG",	tclGdCreateCmd, 		1, 1,	0, 0,
+			"filehandle"},
+	{"createFromWBMP",	tclGdCreateCmd, 		1, 1,	0, 0,
+			"filehandle"},
 
 	{"destroy",			tclGdDestroyCmd,		1, 1,	0, 1,
 			"gdhandle"},
 
+	{"writeGIF",		tclGdWriteCmd,			2, 2,	0, 1,
+			"gdhandle filehandle"},
+	{"writeJPG",		tclGdWriteCmd,			2, 3,	0, 1,
+			"gdhandle filehandle ?quality?"},
+	{"writeJPEG",		tclGdWriteCmd,			2, 3,	0, 1,
+			"gdhandle filehandle ?quality?"},
 	{"writePNG",		tclGdWriteCmd,			2, 2,	0, 1,
 			"gdhandle filehandle"},
@@ -79,4 +103,8 @@
 	{"writeGD",			tclGdWriteCmd,			2, 2,	0, 1,
 			"gdhandle filehandle"},
+	{"writeGD2",			tclGdWriteCmd,			2, 2,	0, 1,
+			"gdhandle filehandle"},
+	{"writeWBMP",		tclGdWriteCmd,			3, 3,	0, 1,
+			"gdhandle filehandle foreground"},
 
 	{"interlace",		tclGdInterlaceCmd,		1, 2,	0, 1,
@@ -79,4 +103,8 @@
 	{"writeGD",			tclGdWriteCmd,			2, 2,	0, 1,
 			"gdhandle filehandle"},
+	{"writeGD2",			tclGdWriteCmd,			2, 2,	0, 1,
+			"gdhandle filehandle"},
+	{"writeWBMP",		tclGdWriteCmd,			3, 3,	0, 1,
+			"gdhandle filehandle foreground"},
 
 	{"interlace",		tclGdInterlaceCmd,		1, 2,	0, 1,
@@ -402,9 +430,20 @@
 	cmd = Tcl_GetString(objv[1]);
 	if (strcmp(cmd, "create") == 0) {
+		int	trueColor = 0;
+
 		if (Tcl_GetIntFromObj(interp, objv[2], &w) != TCL_OK)
 			return TCL_ERROR;
 		if (Tcl_GetIntFromObj(interp, objv[3], &h) != TCL_OK)
 			return TCL_ERROR;
-		im = gdImageCreate(w, h);
+		/* An optional argument may specify true for "TrueColor" */
+		if (argc == 5 && Tcl_GetBooleanFromObj(interp, objv[4],
+		    &trueColor) == TCL_ERROR)
+			return TCL_ERROR;
+
+		if (trueColor)
+			im = gdImageCreateTrueColor(w, h);
+		else
+			im = gdImageCreate(w, h);
+
 		if (im == NULL)
 		{
@@ -414,30 +453,70 @@
 		}
 	} else {
+		char *arg2 = Tcl_GetString(objv[2]);
 		fileByName = 0;  /* first try to get file from open channel */
-		if (Tcl_GetOpenFile(interp, Tcl_GetString(objv[2]), 0, 1, &clientdata) == TCL_OK) {
-			filePtr = (FILE *)clientdata;
-		} else {
-			/* Not a channel, or Tcl_GetOpenFile() not supported.
-			 *   See if we can open directly.
-			 */
-			fileByName++;
-			if ((filePtr = fopen(Tcl_GetString(objv[2]),"rb")) == NULL) {
+
+		if (cmd[10] == 'X' && cmd[11] == 'P' && cmd[12] == 'M')
+#ifdef NOX11
+			Tcl_SetResult(interp, "Support for XPM-files not "
+			    "compiled in");
+			return TCL_ERROR;
+#else
+			/* gdImageCreateFromXpm() takes fileNAME */
+			im = gdImageCreateFromXpm(arg2);
+#endif
+		else {
+			if (Tcl_GetOpenFile(interp, arg2, 0, 1, &clientdata)
+			    == TCL_OK) {
+				filePtr = (FILE *)clientdata;
+			} else {
+				/* Not a channel, or Tcl_GetOpenFile() not supported.
+				 *   See if we can open directly.
+				 */
+				fileByName++;
+				if ((filePtr = fopen(arg2, "rb")) == NULL) {
+					Tcl_AppendResult(interp,
+					    "could not open :", arg2, "': ",
+					    strerror(errno), NULL);
+					return TCL_ERROR;
+				}
+				Tcl_ResetResult(interp);
+			}
+
+			/* Read PNG, XBM, or GD file? */
+			switch (cmd[10]) {
+			case 'P':
+				im = gdImageCreateFromPng(filePtr);
+				break;
+			case 'X':
+				im = gdImageCreateFromXbm(filePtr);
+				break;
+			case 'G': /* GIF, GD2, and GD */
+				if (cmd[11] == 'I')
+					im = gdImageCreateFromGif(filePtr);
+				else if (cmd[12] == '2')
+					im = gdImageCreateFromGd2(filePtr);
+				else
+					im = gdImageCreateFromGd(filePtr);
+				break;
+			case 'J':
+				im = gdImageCreateFromJpeg(filePtr);
+				break;
+			case 'W':
+				im = gdImageCreateFromWBMP(filePtr);
+				break;
+			default:
+				Tcl_AppendResult(interp, cmd + 10,
+				    "unrecognizable format requested", NULL);
 				return TCL_ERROR;
 			}
-			Tcl_ResetResult(interp);
-		}
-		/* Read PNG, XBM, or GD file? */
-		if (cmd[10] == 'P') {
-			im = gdImageCreateFromPng(filePtr);
-		} else if (cmd[10] == 'X') {
-			im = gdImageCreateFromXbm(filePtr);
-		} else {
-			im = gdImageCreateFromGd(filePtr);
-		}
-		if (fileByName) {
-			fclose(filePtr);
+			if (fileByName) {
+				fclose(filePtr);
+			}
 		}
+
 		if (im == NULL) {
-			Tcl_SetResult(interp,"GD unable to read image file", TCL_STATIC);
+			Tcl_AppendResult(interp,
+			    "GD unable to read image file `", arg2, "' as ",
+			    cmd + 10, NULL);
 			return TCL_ERROR;
 		}
@@ -472,15 +551,41 @@
 	FILE *filePtr;
 	ClientData clientdata;
-	char *cmd;
+	const char *cmd, *fname;
 	int fileByName;
+	int arg4;
 
 	cmd = Tcl_GetString(objv[1]);
+	if (cmd[5] == 'J' || cmd[5] == 'W') {
+		/* JPEG and WBMP expect an extra (integer) argument */
+		if (argc < 5) {
+			if (cmd[5] == 'J')
+				arg4 = -1; /* default quality-level */
+			else {
+				Tcl_SetResult(interp, "WBMP saving requires"
+				    " the foreground pixel value", TCL_STATIC);
+				return TCL_ERROR;
+			}
+		} else if (Tcl_GetIntFromObj(interp, objv[4], &arg4) != TCL_OK)
+			return TCL_ERROR;
+
+		if (cmd[5] == 'J' && argc > 4 && (arg4 > 100 || arg4 < 1)) {
+			Tcl_SetObjResult(interp, objv[4]);
+			Tcl_AppendResult(interp, ": JPEG image quality, if "
+			    "specified, must be an integer from 1 to 100, "
+			    "or -1 for default", NULL);
+			return TCL_ERROR;
+		}
+		/* XXX no error-checking for the WBMP case here */
+	}
+
 	/* Get the image pointer. */
 	im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, 
 		Tcl_GetString(objv[2]));
 
+	fname = Tcl_GetString(objv[3]);
+
 	/* Get the file reference. */
 	fileByName = 0;  /* first try to get file from open channel */
-	if (Tcl_GetOpenFile(interp, Tcl_GetString(objv[3]), 1, 1, &clientdata) == TCL_OK) {
+	if (Tcl_GetOpenFile(interp, fname, 1, 1, &clientdata) == TCL_OK) {
 		filePtr = (FILE *)clientdata;
 	} else {
@@ -489,5 +594,7 @@
 		 */
 		fileByName++;
-		if ((filePtr = fopen(Tcl_GetString(objv[3]),"wb")) == NULL) {
+		if ((filePtr = fopen(fname, "wb")) == NULL) {
+			Tcl_AppendResult(interp, "could not open :", fname,
+			    "': ", strerror(errno), NULL);
 			return TCL_ERROR;
 		}
@@ -496,8 +603,22 @@
 
 	/* Do it. */
-	if (cmd[5] == 'P') {
+	switch (cmd[5]) {
+	case 'P':
 		gdImagePng(im, filePtr);
-	} else {
-		gdImageGd(im, filePtr);
+		break;
+	case 'G':
+		if (cmd[6] == 'I')
+			gdImageGif(im, filePtr);
+		else if (cmd[7] == '2')
+			gdImageGd2(im, filePtr, GD2_CHUNKSIZE, GD2_FMT_COMPRESSED);
+		else
+			gdImageGd(im, filePtr);
+		break;
+	case 'J':
+		gdImageJpeg(im, filePtr, arg4);
+		break;
+	case 'B':
+		gdImageWBMP(im, arg4, filePtr);
+		break;
 	}
 	if (fileByName) {
--- gdtclft.n	Fri Aug  4 17:11:41 2000
+++ gdtclft.n	Mon Dec  4 03:52:10 2006
@@ -9,98 +9,89 @@
 
                              TCL GD EXTENSION
-                                       
+
    Thomas Boutell's Gd package provides a convenient way to generate
    PNG images with a C program. If you, like me, prefer Tcl for CGI
-   applications, you'll want my TCL GD extension. You can get it by
-   anonymous FTP from ftp://guraldi.hgp.med.umich.edu/pub/gdtcl.shar.
-   
-   Here's a quick overview of the package.
-     * Overview
-     * Installation
-     * Reference
-     * Examples
-          + gdsample -- sample program written in Tcl.
-          + Gddemo -- demo program written in Tcl.
-          + gdshow -- procedure to display an image.
-            
+   applications, you'll want my TCL GD extension.
+
                        A TCL INTERFACE TO THE GD PACKAGE
-                                       
+
     Spencer W. Thomas
     Human Genome Center
     University of Michigan
     Ann Arbor, MI 48109
-    
+
     spencer.thomas@med.umich.edu
 
     TrueType font support using the FreeType library was added by
-    John Ellson (ellson@graphviz.org)
+    John Ellson (ellson@graphviz.org).
 
-    Latest sources available from:
+    FreeBSD port maintained by Mikhail Teterin (mi@aldan.algebra.com).
 
-        http://www.graphviz.org/pub/
-   
-   
 Overview
 
    This package provides a simple Tcl interface to the gd (PNG drawing)
-   package, version 1.1. It includes an interface to all the gd functions
+   package. It includes an interface to most of the gd functions
    and data structures from Tcl commands.
-   
-   
-   
-Installation
-
-      ./configure
-    make
-    make install
-   
+
+
 Reference
 
    One Tcl command, 'gd', is added. All gd package actions are
    sub-commands (or "options" in Tcl terminology) of this command.
-   
+
    Each active gd image is referred to with a "handle". The handle is a
    name of the form gd# (e.g., gd0) returned by the gd create options.
-   
+
    Almost all the gd commands take a handle as the first argument (after
    the option). All the drawing commands take a color_idx as the next
    argument.
-   
+
-   gd create <width> <height>
+   gd create <width> <height> ?true?
           Return a handle to a new gdImage that is width X height.
+          If "true" is specified, the new image is "TrueColor".
-          
-   gd createFromPNG <filehandle>
-          
-   gd createFromGD <filehandle>
-          
-   gd createFromXBM <filehandle>
+
+   gd createFromGD <file>
+   gd createFromGD2 <file>
+   gd createFromGIF <file>
+   gd createFromJPG <file>
+   gd createFromPNG <file>
+   gd createFromWBMP <file>
+   gd createFromXBM <file>
+   gd createFromXPM <filename>
+
           Return a handle to a new gdImage created by reading a PNG
-          (resp. GD or XBM) image from the file open on filehandle.
-          
+          (resp. GD or XBM) image from the <file>, which is either
+          a TCl filehandle, or a filename (except for XPM, which only
+          accepts filenames).
+
    gd destroy <gdhandle>
           Destroy the gdImage referred to by gdhandle.
-          
-   gd writePNG <gdhandle> <filehandle>
-          
-   gd writeGD <gdhandle> <filehandle>
-          Write the image in gdhandle to filehandle as a PNG (resp. GD)
-          file.
+
+   gd writeGD <gdhandle> <file>
+   gd writeGD2 <gdhandle> <file>
+   gd writeGIF <gdhandle> <file>
+   gd writeJPG <gdhandle> <file> ?quality?
+   gd writePNG <gdhandle> <file>
+   gd writeWBMP <gdhandle> <file> fgpixel
+
+          Write the image in gdhandle to <file> (filehandle or filename)
+          in one of the specified formats.
 
    gd writePNGvar <gdhandle> <varname>
           Write the image in gdhandle to Tcl variable "varname" as a binary
           coded PNG object.
-          
+
    gd interlace <gdhandle> <on-off>
           Make the output image interlaced (if on-off is true) or not (if
           on-off is false).
-          
+
    gd color new <gdhandle> <red> <green> <blue>
           Allocate a new color with the given RGB values.  Returns the
           color_idx, or -1 on failure (256 colors already allocated).
-          
+
    gd color exact <gdhandle> <red> <green> <blue>
-          Find a color_idx in the image that exactly matches the given RGB 
+          Find a color_idx in the image that exactly matches the given RGB
           color.  Returns the color_idx, or -1 if no exact match.
-          
+
    gd color closest <gdhandle> <red> <green> <blue>
           Find a color in the image that is closest to the given RGB color.
@@ -114,23 +104,23 @@
                        set idx [gd color closest $gd $r $g $b]
                    }
-               } 
-         
+               }
+
    gd color free <gdhandle> <color_idx>
           Free the color at the given color_idx for reuse.
-          
+
    gd color transparent <gdhandle> [<color_idx>]
           Mark the color at <color_idx> as the transparent background color. Or,
           return the transparent color_idx if no color_idx specified.
-          
+
    gd color get <gdhandle> [<color_idx>]
           Return the RGB value at <color_idx>, or {} if it is not allocated.
           If <color_idx> is not specified, return a list of {color_idx R G B}
           values for all allocated colors.
-          
+
    gd brush <gdhandle> <brushhandle>
           Set the brush image to be used for brushed lines. Transparent
           pixels in the brush will not change the image when the brush is
           applied.
-          
+
    gd style <gdhandle> <color_idx> ...
           Set the line style to the list of color indices. This is
@@ -141,10 +131,10 @@
           means not to fill the pixel, and a non-zero value means to
           apply the brush.
-          
+
    gd tile <gdhandle> <tilehandle>
           Set the tile image to be used for tiled fills. Transparent
           pixels in the tile will not change the underlying image during
           tiling.
-          
+
           In all drawing functions, the color_idx is a number, or may
           be one of the strings styled, brushed, tiled, "styled brushed"
@@ -152,56 +142,55 @@
           effect will be used. Brushing and styling apply to lines,
           tiling to filled areas.
-          
+
    gd set <gdhandle> <color_idx> <x> <y>
           Set the pixel at (x,y) to color <color_idx>.
-          
+
    gd line <gdhandle> <color_idx> <x1> <y1> <x2> <y2>
-          
+
    gd rectangle <gdhandle> <color_idx> <x1> <y1> <x2> <y2>
-          
+
    gd fillrectangle <gdhandle> <color_idx> <x1> <y1> <x2> <y2>
           Draw the outline of (resp. fill) a rectangle in color <color_idx>
           with corners at (x1,y1) and (x2,y2).
-          
+
    gd arc <gdhandle> <color_idx> <cx> <cy> <width> <height> <start> <end>
           Draw an arc in color <color_idx>, centered at (cx,cy) in a rectangle width
           x height, starting at start degrees and ending at end degrees.
           start must be > end.
-          
+
    gd polygon <gdhandle> <color_idx> <x1> <y1> ...
-          
+
    gd fillpolygon <gdhandle> <color_idx> <x1> <y1> ...
           Draw the outline of, or fill, a polygon specified by the x, y
           coordinate list. There must be at least 3 points specified.
-          
+
    gd fill <gdhandle> <color_idx> <x> <y>
-          
+
    gd fill <gdhandle> <color_idx> <x> <y> <borderindex>
           Fill with color <color_idx>, starting from (x,y) within a region of
           pixels all the color of the pixel at (x,y) (resp., within a
           border colored borderindex).
-          
+
    gd size <gdhandle>
           Returns a list {width height} of the image.
-          
-   gd text <gdhandle> <color_idx> <fontpath> <size> <angle> <x> <y> <string>  
-          Draw text using the .ttf font in <fontpath> in color <color_idx>, 
-          with pointsize <size>, rotation in radians <angle>, with lower left 
+
+   gd text <gdhandle> <color_idx> <fontpath> <size> <angle> <x> <y> <string>
+          Draw text using the .ttf font in <fontpath> in color <color_idx>,
+          with pointsize <size>, rotation in radians <angle>, with lower left
           corner at (x,y).  String may contain UTF8 sequences like: "&#192;"
           Returns 4 corner coords of bounding rectangle.
           Use gdhandle = {} to get boundary without rendering.
           Use negative of color_idx to disable antialiasing.
- 
+
    gd copy <desthandle> <srchandle> <destx> <desty> <srcx> <srcy> <w> <h>
-          
-   gd copy <desthandle> <srchandle> <destx> <desty> <srcx> <srcy> \
-          <destw> <desth> <srcw> <srch> Copy a subimage from
-          srchandle(srcx, srcy) to desthandle(destx, desty), size w x h.
+
+   gd copy <desthandle> <srchandle> <destx> <desty> <srcx> <srcy> \\
+       <destw> <desth> <srcw> <srch>
+          Copy a subimage from srchandle(srcx, srcy) to desthandle(destx,
+          desty), size w x h.
           Or, resize the subimage in copying from srcw x srch to destw x
           desth.
-          
-   
-   
-Examples
+
+.SH EXAMPLES
 
    The sample program from the gd documentation can be written thusly:
@@ -234,8 +223,8 @@
 gd destroy $im
 
-   
-   
+
+
   GDDEMO
-  
+
    Here's the gddemo.c program translated to tcl.
 
@@ -312,8 +301,8 @@
 gd destroy $im_out
 
-   
-   
+
+
   GDSHOW
-  
+
    A quick Tcl procedure to display a GD image using the xv program.
 
@@ -331,2 +320,6 @@
   }
 }
+
+.SH SEE ALSO
+	You will find Thomas Boutell's documentation for the underlying GD
+	library quite useful, especially, if you are dealing with WBMP format.