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 #include #include @@ -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", TCL_STATIC); + 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 + gd create ?true? Return a handle to a new gdImage that is width X height. + If "true" is specified, the new image is "TrueColor". - - gd createFromPNG - - gd createFromGD - - gd createFromXBM + + gd createFromGD + gd createFromGD2 + gd createFromGIF + gd createFromJPG + gd createFromPNG + gd createFromWBMP + gd createFromXBM + gd createFromXPM + 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 , which is either + a TCl filehandle, or a filename (except for XPM, which only + accepts filenames). + gd destroy Destroy the gdImage referred to by gdhandle. - - gd writePNG - - gd writeGD - Write the image in gdhandle to filehandle as a PNG (resp. GD) - file. + + gd writeGD + gd writeGD2 + gd writeGIF + gd writeJPG ?quality? + gd writePNG + gd writeWBMP fgpixel + + Write the image in gdhandle to (filehandle or filename) + in one of the specified formats. gd writePNGvar Write the image in gdhandle to Tcl variable "varname" as a binary coded PNG object. - + gd interlace Make the output image interlaced (if on-off is true) or not (if on-off is false). - + gd color new Allocate a new color with the given RGB values. Returns the color_idx, or -1 on failure (256 colors already allocated). - + gd color exact - 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 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 Free the color at the given color_idx for reuse. - + gd color transparent [] Mark the color at as the transparent background color. Or, return the transparent color_idx if no color_idx specified. - + gd color get [] Return the RGB value at , or {} if it is not allocated. If is not specified, return a list of {color_idx R G B} values for all allocated colors. - + gd brush 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 ... 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 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 Set the pixel at (x,y) to color . - + gd line - + gd rectangle - + gd fillrectangle Draw the outline of (resp. fill) a rectangle in color with corners at (x1,y1) and (x2,y2). - + gd arc Draw an arc in color , 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 ... - + gd fillpolygon ... 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 - + gd fill Fill with color , 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 Returns a list {width height} of the image. - - gd text - Draw text using the .ttf font in in color , - with pointsize , rotation in radians , with lower left + + gd text + Draw text using the .ttf font in in color , + with pointsize , rotation in radians , with lower left corner at (x,y). String may contain UTF8 sequences like: "À" Returns 4 corner coords of bounding rectangle. Use gdhandle = {} to get boundary without rendering. Use negative of color_idx to disable antialiasing. - + gd copy - - gd copy \ - Copy a subimage from - srchandle(srcx, srcy) to desthandle(destx, desty), size w x h. + + gd copy \\ + + 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.