This patch adds support for GIF, XPM, WBMP, and JPEG file formats, which are supported 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. Dispense with our own table of handles and use Tcl-objects capability instead. Compiler-warning fixes now allow compiling on FreeBSD with WARNS=3. When used in a safe interpreter, the functionality is limited to disallow access to filesystem. 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 2014-04-29 19:42:13.000000000 -0400 @@ -19,4 +19,5 @@ */ +#include #include #include @@ -24,5 +25,4 @@ #include #include "gd.h" -#include "gdhandle.h" #ifdef WIN32 @@ -30,28 +30,47 @@ #endif -void *GDHandleTable; +static Tcl_UpdateStringProc GdPtrTypeUpdate; +static Tcl_SetFromAnyProc GdPtrTypeSet; +static Tcl_ObjType GdPtrType = { + .name = "gd", + .updateStringProc = GdPtrTypeUpdate, + .setFromAnyProc = GdPtrTypeSet +}; +#define IMGPTR(O) (O->internalRep.otherValuePtr) -/* global data */ -typedef struct { - tblHeader_pt handleTbl; -} GdData; +/* The only two symbols exported */ +Tcl_AppInitProc Gdtclft_Init, Gdtclft_SafeInit; -static int tclGdCreateCmd(), tclGdDestroyCmd(), tclGdWriteCmd(), - tclGdColorCmd(), tclGdInterlaceCmd(), tclGdSetCmd(), tclGdLineCmd(), - tclGdRectCmd(), tclGdArcCmd(), tclGdFillCmd(), tclGdSizeCmd(), - tclGdTextCmd(), tclGdCopyCmd(), tclGdGetCmd(), - tclGdBrushCmd(), tclGdStyleCmd(), tclGdTileCmd(), tclGdPolygonCmd(), - tclGdColorNewCmd(), tclGdColorExactCmd(), tclGdColorClosestCmd(), - tclGdColorResolveCmd(), tclGdColorFreeCmd(), tclGdColorTranspCmd(), - tclGdColorGetCmd(), tclGdWriteBufCmd(); +typedef int (GdDataFunction)(Tcl_Interp *interp, + int argc, Tcl_Obj *CONST objv[]); +typedef int (GdImgFunction)(Tcl_Interp *interp, gdImagePtr gdImg, + int argc, const int args[]); + +static GdDataFunction tclGdCreateCmd, tclGdDestroyCmd, tclGdWriteCmd, + tclGdColorCmd, tclGdInterlaceCmd, tclGdSetCmd, tclGdLineCmd, + tclGdRectCmd, tclGdArcCmd, tclGdFillCmd, tclGdSizeCmd, + tclGdTextCmd, tclGdCopyCmd, tclGdGetCmd, tclGdWriteBufCmd, + tclGdBrushCmd, tclGdStyleCmd, tclGdTileCmd, tclGdPolygonCmd; + +static GdImgFunction tclGdColorNewCmd, tclGdColorExactCmd, + tclGdColorClosestCmd, tclGdColorResolveCmd, tclGdColorFreeCmd, + tclGdColorTranspCmd, tclGdColorGetCmd; typedef struct { - char *cmd; - int (*f)(); - int minargs, maxargs; - int subcmds; - int ishandle; - char *usage; -} cmdOptions; + const char *cmd; + GdDataFunction *f; + unsigned int minargs, maxargs; + unsigned int subcmds; + unsigned int ishandle; + unsigned int unsafearg; + const char *usage; +} cmdDataOptions; + +typedef struct { + const char *cmd; + GdImgFunction *f; + unsigned int minargs, maxargs; + const char *usage; +} cmdImgOptions; typedef struct { @@ -60,53 +79,81 @@ } BuffSinkContext; -static cmdOptions subcmdVec[] = { - {"create", tclGdCreateCmd, 2, 2, 0, 0, - "width height"}, - {"createFromPNG", tclGdCreateCmd, 1, 1, 0, 0, +static cmdDataOptions subcmdVec[] = { + {"create", tclGdCreateCmd, 2, 3, 0, 0, 0, + "width height ?true?"}, + {"createFromPNG", tclGdCreateCmd, 1, 1, 0, 0, 2, + "filehandle"}, + {"createFromGIF", tclGdCreateCmd, 1, 1, 0, 0, 2, + "filehandle"}, + {"createFromGD", tclGdCreateCmd, 1, 1, 0, 0, 2, "filehandle"}, - {"createFromGD", tclGdCreateCmd, 1, 1, 0, 0, + {"createFromGD2", tclGdCreateCmd, 1, 1, 0, 0, 2, "filehandle"}, - {"createFromXBM", tclGdCreateCmd, 1, 1, 0, 0, + {"createFromXBM", tclGdCreateCmd, 1, 1, 0, 0, 2, + "filehandle"}, +#ifdef NOX11 + {"createFromXPM-NOT-AVAILABLE", tclGdCreateCmd, 1, 1, 0, 0, 2, + "filename"}, +#else + {"createFromXPM", tclGdCreateCmd, 1, 1, 0, 0, 2, + "filename"}, +#endif + {"createFromJPG", tclGdCreateCmd, 1, 1, 0, 0, 2, + "filehandle"}, + {"createFromJPEG", tclGdCreateCmd, 1, 1, 0, 0, 2, + "filehandle"}, + {"createFromWBMP", tclGdCreateCmd, 1, 1, 0, 0, 2, "filehandle"}, - {"destroy", tclGdDestroyCmd, 1, 1, 0, 1, + {"destroy", tclGdDestroyCmd, 1, 1, 0, 1, 0, "gdhandle"}, - {"writePNG", tclGdWriteCmd, 2, 2, 0, 1, + {"writeGIF", tclGdWriteCmd, 2, 2, 0, 1, 3, + "gdhandle filehandle"}, + {"writeJPG", tclGdWriteCmd, 2, 3, 0, 1, 3, + "gdhandle filehandle ?quality?"}, + {"writeJPEG", tclGdWriteCmd, 2, 3, 0, 1, 3, + "gdhandle filehandle ?quality?"}, + {"writePNG", tclGdWriteCmd, 2, 2, 0, 1, 3, "gdhandle filehandle"}, - {"writePNGvar", tclGdWriteBufCmd, 2, 2, 0, 1, + {"writePNGvar", tclGdWriteBufCmd, 2, 2, 0, 1, 0, "gdhandle var"}, - {"writeGD", tclGdWriteCmd, 2, 2, 0, 1, + {"writeGD", tclGdWriteCmd, 2, 2, 0, 1, 3, "gdhandle filehandle"}, - - {"interlace", tclGdInterlaceCmd, 1, 2, 0, 1, + {"writeGD2", tclGdWriteCmd, 2, 2, 0, 1, 3, + "gdhandle filehandle"}, + {"writeWBMP", tclGdWriteCmd, 3, 3, 0, 1, 3, + "gdhandle filehandle foreground"}, + {"writeGD2", tclGdWriteCmd, 2, 2, 0, 1, 3, + "gdhandle filehandle"}, + {"interlace", tclGdInterlaceCmd, 1, 2, 0, 1, 0, "gdhandle ?on-off?"}, - {"color", tclGdColorCmd, 2, 5, 1, 1, + {"color", tclGdColorCmd, 2, 5, 1, 1, 0, "option values..."}, - {"brush", tclGdBrushCmd, 2, 2, 0, 2, + {"brush", tclGdBrushCmd, 2, 2, 0, 2, 0, "gdhandle brushhandle"}, - {"style", tclGdStyleCmd, 2, 999, 0, 1, + {"style", tclGdStyleCmd, 2, 999, 0, 1, 0, "gdhandle color..."}, - {"tile", tclGdTileCmd, 2, 2, 0, 2, + {"tile", tclGdTileCmd, 2, 2, 0, 2, 0, "gdhandle tilehandle"}, - {"set", tclGdSetCmd, 4, 4, 0, 1, + {"set", tclGdSetCmd, 4, 4, 0, 1, 0, "gdhandle color x y"}, - {"line", tclGdLineCmd, 6, 6, 0, 1, + {"line", tclGdLineCmd, 6, 6, 0, 1, 0, "gdhandle color x1 y1 x2 y2"}, - {"rectangle", tclGdRectCmd, 6, 6, 0, 1, + {"rectangle", tclGdRectCmd, 6, 6, 0, 1, 0, "gdhandle color x1 y1 x2 y2"}, - {"fillrectangle", tclGdRectCmd, 6, 6, 0, 1, + {"fillrectangle", tclGdRectCmd, 6, 6, 0, 1, 0, "gdhandle color x1 y1 x2 y2"}, - {"arc", tclGdArcCmd, 8, 8, 0, 1, + {"arc", tclGdArcCmd, 8, 8, 0, 1, 0, "gdhandle color cx cy width height start end"}, - {"fillarc", tclGdArcCmd, 8, 8, 0, 1, + {"fillarc", tclGdArcCmd, 8, 8, 0, 1, 0, "gdhandle color cx cy width height start end"}, - {"polygon", tclGdPolygonCmd, 2, 999, 0, 1, + {"polygon", tclGdPolygonCmd, 2, 999, 0, 1, 0, "gdhandle color x1 y1 x2 y2 x3 y3 ..."}, - {"fillpolygon", tclGdPolygonCmd, 3, 999, 0, 1, + {"fillpolygon", tclGdPolygonCmd, 3, 999, 0, 1, 0, "gdhandle color x1 y1 x2 y2 x3 y3 ..."}, - {"fill", tclGdFillCmd, 4, 5, 0, 1, + {"fill", tclGdFillCmd, 4, 5, 0, 1, 0, "gdhandle color x y ?bordercolor?"}, /* @@ -114,32 +161,25 @@ * of text string, so the text command provides its own handle processing and checking */ - {"text", tclGdTextCmd, 8, 8, 0, 0, + {"text", tclGdTextCmd, 8, 8, 0, 0, 4, "gdhandle color fontpathname size angle x y string"}, - {"copy", tclGdCopyCmd, 8, 10, 0, 2, + {"copy", tclGdCopyCmd, 8, 10, 0, 2, 0, "desthandle srchandle destx desty srcx srcy destw desth ?srcw srch?"}, - {"get", tclGdGetCmd, 3, 3, 0, 1, + {"get", tclGdGetCmd, 3, 3, 0, 1, 0, "gdhandle x y"}, - {"size", tclGdSizeCmd, 1, 1, 0, 1, + {"size", tclGdSizeCmd, 1, 1, 0, 1, 0, "gdhandle"}, }; -static cmdOptions colorCmdVec[] = { - {"new", tclGdColorNewCmd, 5, 5, 1, 1, - "gdhandle red green blue"}, - {"exact", tclGdColorExactCmd, 5, 5, 1, 1, - "gdhandle red green blue"}, - {"closest", tclGdColorClosestCmd, 5, 5, 1, 1, - "gdhandle red green blue"}, - {"resolve", tclGdColorResolveCmd, 5, 5, 1, 1, - "gdhandle red green blue"}, - {"free", tclGdColorFreeCmd, 3, 3, 1, 1, - "gdhandle color"}, - {"transparent", tclGdColorTranspCmd, 2, 3, 1, 1, - "gdhandle ?color?"}, - {"get", tclGdColorGetCmd, 2, 3, 1, 1, - "gdhandle ?color?"} +static cmdImgOptions colorCmdVec[] = { + {"new", tclGdColorNewCmd, 5, 5, "red green blue"}, + {"exact", tclGdColorExactCmd, 5, 5, "red green blue"}, + {"closest", tclGdColorClosestCmd, 5, 5, "red green blue"}, + {"resolve", tclGdColorResolveCmd, 5, 5, "red green blue"}, + {"free", tclGdColorFreeCmd, 3, 3, "color"}, + {"transparent", tclGdColorTranspCmd, 2, 3, "?color?"}, + {"get", tclGdColorGetCmd, 2, 3, "?color?"} }; @@ -317,11 +357,10 @@ * */ -int +static int gdCmd(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { - GdData *gdData = (GdData *)clientData; - int argi, subi; - char buf[100]; + unsigned int argi; + size_t subi; /* Check for subcommand. */ if (argc < 2) { @@ -336,9 +375,7 @@ /* Check arg count. */ - if (argc - 2 < subcmdVec[subi].minargs || - argc - 2 > subcmdVec[subi].maxargs) { - sprintf(buf, "wrong # args: should be \"gd %s %s\"", - subcmdVec[subi].cmd, subcmdVec[subi].usage); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + if ((unsigned)argc - 2 < subcmdVec[subi].minargs || + (unsigned)argc - 2 > subcmdVec[subi].maxargs) { + Tcl_WrongNumArgs(interp, 2, objv, subcmdVec[subi].usage); return TCL_ERROR; } @@ -346,20 +383,6 @@ /* Check for valid handle(s). */ if (subcmdVec[subi].ishandle > 0) { - /* Are any handles allocated? */ - if (gdData->handleTbl == NULL) { - sprintf(buf, "no such handle%s: ", - subcmdVec[subi].ishandle > 1 ? "s" : ""); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - for (argi = 2 + subcmdVec[subi].subcmds; - argi < 2 + subcmdVec[subi].subcmds + - subcmdVec[subi].ishandle; - argi++) { - Tcl_AppendResult(interp, - Tcl_GetString(objv[argi]), " ", 0); - } - return TCL_ERROR; - } /* Check each handle to see if it's a valid handle. */ - if (2+subcmdVec[subi].subcmds+subcmdVec[subi].ishandle > argc) { + if (2+subcmdVec[subi].subcmds+subcmdVec[subi].ishandle > (unsigned)argc) { Tcl_SetResult(interp, "GD handle(s) not specified", TCL_STATIC); return TCL_ERROR; @@ -369,12 +392,27 @@ subcmdVec[subi].ishandle); argi++) { - if (! gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[argi]))) + if (objv[argi]->typePtr != &GdPtrType && + GdPtrTypeSet(interp, objv[argi]) != TCL_OK) return TCL_ERROR; } } + /* + * If we are operating in a safe interpreter, check, + * if this command is suspect -- and only let existing + * filehandles through, if so. + */ + if (clientData != NULL && subcmdVec[subi].unsafearg != 0) { + const char *fname = + Tcl_GetString(objv[subcmdVec[subi].unsafearg]); + if (!Tcl_IsChannelExisting(fname)) { + Tcl_AppendResult(interp, "Access to ", fname, + " not allowed in safe interpreter", TCL_STATIC); + return TCL_ERROR; + } + } + /* Call the subcommand function. */ - return (*subcmdVec[subi].f)(interp, gdData, argc, objv); + return (*subcmdVec[subi].f)(interp, argc, objv); } } @@ -390,5 +427,5 @@ static int -tclGdCreateCmd(Tcl_Interp *interp, GdData *gdData, +tclGdCreateCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { @@ -397,16 +434,29 @@ FILE *filePtr; ClientData clientdata; - char *cmd, buf[50]; + char *cmd; + Tcl_Obj *result; int fileByName; 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; + /* 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) { + char buf[255]; sprintf(buf, "GD unable to allocate %d X %d image", w, h); Tcl_SetResult(interp, buf, TCL_VOLATILE); @@ -414,6 +464,19 @@ } } 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) { + + 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 { @@ -422,43 +485,68 @@ */ fileByName++; - if ((filePtr = fopen(Tcl_GetString(objv[2]),"rb")) == NULL) { + 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? */ - if (cmd[10] == 'P') { + switch (cmd[10]) { + case 'P': im = gdImageCreateFromPng(filePtr); - } else if (cmd[10] == 'X') { + break; + case 'X': im = gdImageCreateFromXbm(filePtr); - } else { + 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; } 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; } } - *(gdImagePtr *)(gdHandleAlloc(gdData->handleTbl, buf)) = im; - Tcl_SetResult(interp, buf, TCL_VOLATILE); + result = Tcl_NewObj(); + IMGPTR(result) = im; + result->typePtr = &GdPtrType; + result->bytes = NULL; + Tcl_SetObjResult(interp, result); return TCL_OK; } static int -tclGdDestroyCmd(Tcl_Interp *interp, GdData *gdData, int argc, Tcl_Obj *CONST objv[]) +tclGdDestroyCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { gdImagePtr im; - void *hdl; - /* Get the handle, and the image pointer. */ - hdl = (void *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); - im = *(gdImagePtr *)hdl; - /* Release the handle, destroy the image. */ - gdHandleFree(gdData->handleTbl, hdl); + /* Get the image pointer and destroy it */ + im = IMGPTR(objv[2]); gdImageDestroy(im); @@ -467,20 +555,45 @@ static int -tclGdWriteCmd(Tcl_Interp *interp, GdData *gdData, int argc, Tcl_Obj *CONST objv[]) +tclGdWriteCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { gdImagePtr im; 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])); + im = IMGPTR(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 +602,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 +611,22 @@ /* Do it. */ - if (cmd[5] == 'P') { + switch (cmd[5]) { + case 'P': gdImagePng(im, filePtr); - } else { + 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) { @@ -510,5 +639,5 @@ static int -tclGdInterlaceCmd(Tcl_Interp *interp, GdData *gdData, +tclGdInterlaceCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { @@ -517,6 +646,5 @@ /* Get the image pointer. */ - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); + im = IMGPTR(objv[2]); if (argc == 4) { @@ -535,7 +663,6 @@ } - static int -tclGdColorCmd(Tcl_Interp *interp, GdData *gdData, +tclGdColorCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { @@ -551,17 +678,14 @@ { /* Check arg count. */ - if (argc - 2 < colorCmdVec[subi].minargs || - argc - 2 > colorCmdVec[subi].maxargs) + if ((unsigned)argc - 2 < colorCmdVec[subi].minargs || + (unsigned)argc - 2 > colorCmdVec[subi].maxargs) { - Tcl_AppendResult(interp, - "wrong # args: should be \"gd color ", - colorCmdVec[subi].cmd, " ", - colorCmdVec[subi].usage, "\"", 0); + Tcl_WrongNumArgs(interp, 3, objv, + colorCmdVec[subi].usage); return TCL_ERROR; } /* Get the image pointer. */ - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[3])); + im = IMGPTR(objv[3]); /* Parse off integer arguments. * 1st 4 are gd color @@ -605,5 +729,5 @@ static int -tclGdColorNewCmd(Tcl_Interp *interp, gdImagePtr im, int argc, int args[]) +tclGdColorNewCmd(Tcl_Interp *interp, gdImagePtr im, int argc, const int args[]) { int color; @@ -615,5 +739,5 @@ static int -tclGdColorExactCmd(Tcl_Interp *interp, gdImagePtr im, int argc, int args[]) +tclGdColorExactCmd(Tcl_Interp *interp, gdImagePtr im, int argc, const int args[]) { int color; @@ -625,5 +749,5 @@ static int -tclGdColorClosestCmd(Tcl_Interp *interp, gdImagePtr im, int argc, int args[]) +tclGdColorClosestCmd(Tcl_Interp *interp, gdImagePtr im, int argc, const int args[]) { int color; @@ -635,5 +759,5 @@ static int -tclGdColorResolveCmd(Tcl_Interp *interp, gdImagePtr im, int argc, int args[]) +tclGdColorResolveCmd(Tcl_Interp *interp, gdImagePtr im, int argc, const int args[]) { int color; @@ -645,5 +769,5 @@ static int -tclGdColorFreeCmd(Tcl_Interp *interp, gdImagePtr im, int argc, int args[]) +tclGdColorFreeCmd(Tcl_Interp *interp, gdImagePtr im, int argc, const int args[]) { gdImageColorDeallocate(im, args[0]); @@ -652,5 +776,5 @@ static int -tclGdColorTranspCmd(Tcl_Interp *interp, gdImagePtr im, int argc, int args[]) +tclGdColorTranspCmd(Tcl_Interp *interp, gdImagePtr im, int argc, const int args[]) { int color; @@ -668,33 +792,37 @@ static int -tclGdColorGetCmd(Tcl_Interp *interp, gdImagePtr im, int argc, int args[]) +tclGdColorGetCmd(Tcl_Interp *interp, gdImagePtr im, int argc, const int args[]) { - char buf[30]; - int i; + int i, ncolors; + Tcl_Obj *tuple[4], *result; + ncolors = gdImageColorsTotal(im); /* IF one arg, return the single color, else return list of all colors. */ if (argc == 1) { i = args[0]; - if (i >= gdImageColorsTotal(im) || im->open[i]) { + if (i >= ncolors || im->open[i]) { Tcl_SetResult(interp, "No such color", TCL_STATIC); return TCL_ERROR; } - sprintf(buf, "%d %d %d %d", i, - gdImageRed(im,i), - gdImageGreen(im,i), - gdImageBlue(im,i)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + tuple[0] = Tcl_NewIntObj(i); + tuple[1] = Tcl_NewIntObj(gdImageRed(im,i)); + tuple[2] = Tcl_NewIntObj(gdImageGreen(im,i)); + tuple[3] = Tcl_NewIntObj(gdImageBlue(im,i)); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, tuple)); } else { - for (i = 0; i < gdImageColorsTotal(im); i++) + result = Tcl_NewListObj(0, NULL); + for (i = 0; i < ncolors; i++) { if (im->open[i]) continue; - sprintf(buf, "%d %d %d %d", i, - gdImageRed(im,i), - gdImageGreen(im,i), - gdImageBlue(im,i)); - Tcl_AppendElement(interp, buf); + tuple[0] = Tcl_NewIntObj(i); + tuple[1] = Tcl_NewIntObj(gdImageRed(im,i)); + tuple[2] = Tcl_NewIntObj(gdImageGreen(im,i)); + tuple[3] = Tcl_NewIntObj(gdImageBlue(im,i)); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewListObj(4, tuple)); } + Tcl_SetObjResult(interp, result); } @@ -703,5 +831,5 @@ static int -tclGdBrushCmd(Tcl_Interp *interp, GdData *gdData, +tclGdBrushCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { @@ -709,8 +837,6 @@ /* Get the image pointers. */ - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); - imbrush = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[3])); + im = IMGPTR(objv[2]); + imbrush = IMGPTR(objv[3]); /* Do it. */ @@ -721,5 +847,5 @@ static int -tclGdTileCmd(Tcl_Interp *interp, GdData *gdData, +tclGdTileCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { @@ -727,8 +853,6 @@ /* Get the image pointers. */ - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); - tile = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[3])); + im = IMGPTR(objv[2]); + tile = IMGPTR(objv[3]); /* Do it. */ @@ -740,5 +864,5 @@ static int -tclGdStyleCmd(Tcl_Interp *interp, GdData *gdData, +tclGdStyleCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { @@ -749,6 +873,5 @@ /* Get the image pointer. */ - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); + im = IMGPTR(objv[2]); /* Figure out how many colors in the style list and allocate memory. */ @@ -788,5 +911,5 @@ static int -tclGdSetCmd(Tcl_Interp *interp, GdData *gdData, +tclGdSetCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { @@ -795,6 +918,5 @@ /* Get the image pointer. */ - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); + im = IMGPTR(objv[2]); /* Get the color, x, y values. */ @@ -813,5 +935,5 @@ static int -tclGdLineCmd(Tcl_Interp *interp, GdData *gdData, +tclGdLineCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { @@ -820,6 +942,5 @@ /* Get the image pointer. */ - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); + im = IMGPTR(objv[2]); /* Get the color, x, y values. */ @@ -842,14 +963,13 @@ static int -tclGdRectCmd(Tcl_Interp *interp, GdData *gdData, +tclGdRectCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { gdImagePtr im; int color, x1, y1, x2, y2; - char *cmd; + const char *cmd; /* Get the image pointer. */ - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); + im = IMGPTR(objv[2]); /* Get the color, x, y values. */ @@ -876,14 +996,13 @@ static int -tclGdArcCmd(Tcl_Interp *interp, GdData *gdData, +tclGdArcCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { gdImagePtr im; int color, cx, cy, width, height, start, end; - char *cmd; + const char *cmd; /* Get the image pointer. */ - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); + im = IMGPTR(objv[2]); /* Get the color, x, y values. */ @@ -917,5 +1036,5 @@ static int -tclGdPolygonCmd(Tcl_Interp *interp, GdData *gdData, +tclGdPolygonCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { @@ -925,9 +1044,8 @@ gdPointPtr points = NULL; int retval = TCL_OK; - char *cmd; + const char *cmd; /* Get the image pointer. */ - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); + im = IMGPTR(objv[2]); /* Get the color, x, y values. */ @@ -974,5 +1092,5 @@ { retval = TCL_ERROR; - break; + goto out; } @@ -989,9 +1107,9 @@ Tcl_Free((char *)points); - return TCL_OK; + return retval; } static int -tclGdFillCmd(Tcl_Interp *interp, GdData *gdData, +tclGdFillCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { @@ -1000,6 +1118,5 @@ /* Get the image pointer. */ - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); + im = IMGPTR(objv[2]); /* Get the color, x, y and possibly bordercolor values. */ @@ -1024,5 +1141,5 @@ static int -tclGdCopyCmd(Tcl_Interp *interp, GdData *gdData, +tclGdCopyCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { @@ -1031,8 +1148,6 @@ /* Get the image pointer. */ - imdest = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); - imsrc = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[3])); + imdest = IMGPTR(objv[2]); + imsrc = IMGPTR(objv[3]); /* Get the x, y, etc. values. */ @@ -1067,5 +1182,5 @@ static int -tclGdGetCmd(Tcl_Interp *interp, GdData *gdData, +tclGdGetCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { @@ -1074,6 +1189,5 @@ /* Get the image pointer. */ - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); + im = IMGPTR(objv[2]); /* Get the x, y values. */ @@ -1090,21 +1204,21 @@ static int -tclGdSizeCmd(Tcl_Interp *interp, GdData *gdData, +tclGdSizeCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { gdImagePtr im; - char buf[30]; + Tcl_Obj *answers[2]; /* Get the image pointer. */ - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); + im = IMGPTR(objv[2]); - sprintf(buf, "%d %d", gdImageSX(im), gdImageSY(im)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + answers[0] = Tcl_NewIntObj(gdImageSX(im)); + answers[1] = Tcl_NewIntObj(gdImageSY(im)); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, answers)); return TCL_OK; } static int -tclGdTextCmd(Tcl_Interp *interp, GdData *gdData, +tclGdTextCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { @@ -1113,16 +1227,17 @@ int color, x, y; double ptsize, angle; - char *error, buf[32], *font, *handle; + char *error, *font; int i, brect[8], len; unsigned char *str; + Tcl_Obj *orect[8]; /* Get the image pointer. (an invalid or null arg[2] will result in string size calculation but no rendering */ - handle = Tcl_GetString(objv[2]); - if (! handle || *handle == '\0') { - im = (gdImagePtr)NULL; + if (argc == 2 || (objv[2]->typePtr != &GdPtrType && + GdPtrTypeSet(NULL, objv[2]) != TCL_OK)) { + im = NULL; } else { - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, handle); + im = IMGPTR(objv[2]); } @@ -1159,8 +1274,8 @@ return TCL_ERROR; } - for (i=0; i<8; i++) { - sprintf(buf, "%d", brect[i]); - Tcl_AppendElement(interp, buf); - } + for (i=0; i<8; i++) + orect[i] = Tcl_NewIntObj(brect[i]); + + Tcl_SetObjResult(interp, Tcl_NewListObj(8, orect)); return TCL_OK; } @@ -1176,6 +1291,4 @@ #endif { - static GdData gdData; - #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { @@ -1183,5 +1296,5 @@ } #else - if (Tcl_PkgRequired(interp, "Tcl", TCL_VERSION, 0) == NULL) { + if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) { return TCL_ERROR; } @@ -1191,11 +1304,5 @@ } - GDHandleTable = gdData.handleTbl = gdHandleTblInit("gd", sizeof(gdImagePtr), 1); - if (gdData.handleTbl == NULL) { - Tcl_AppendResult(interp, "unable to create table for GD handles.", 0); - return TCL_ERROR; - } - - Tcl_CreateObjCommand(interp, "gd", gdCmd, (ClientData)&gdData, (Tcl_CmdDeleteProc *)NULL); + Tcl_CreateObjCommand(interp, "gd", gdCmd, NULL, (Tcl_CmdDeleteProc *)NULL); return TCL_OK; } @@ -1207,5 +1314,12 @@ #endif { - return Gdtclft_Init(interp); + Tcl_CmdInfo info; + if (Gdtclft_Init(interp) != TCL_OK || + Tcl_GetCommandInfo(interp, "gd", &info) != 1) + return TCL_ERROR; + info.objClientData = (char *)info.objClientData + 1; /* Non-NULL */ + if (Tcl_SetCommandInfo(interp, "gd", &info) != 1) + return TCL_ERROR; + return TCL_OK; } @@ -1264,9 +1378,8 @@ static int -tclGdWriteBufCmd(Tcl_Interp *interp, GdData *gdData, int argc, Tcl_Obj *CONST objv[]) +tclGdWriteBufCmd(Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]) { gdImagePtr im; Tcl_Obj *output; - char *cmd; char *result = NULL; @@ -1282,8 +1395,6 @@ }; - cmd = Tcl_GetString(objv[1]); /* Get the image pointer. */ - im = *(gdImagePtr *)gdHandleXlate(interp, gdData->handleTbl, - Tcl_GetString(objv[2])); + im = IMGPTR(objv[2]); gdImagePngToSink(im, &buffsink); @@ -1305,2 +1416,26 @@ return TCL_OK; } + +static void +GdPtrTypeUpdate(struct Tcl_Obj *O) +{ + O->bytes = Tcl_Alloc(strlen(GdPtrType.name) + + (sizeof(void *) + 1) * 2 + 1); + O->length = sprintf(O->bytes, "%s%p", GdPtrType.name, IMGPTR(O)); +} + +static int +GdPtrTypeSet(Tcl_Interp *I, struct Tcl_Obj *O) +{ + if (O->bytes == NULL || O->bytes[0] == '\0' || + strncmp(GdPtrType.name, O->bytes, strlen(GdPtrType.name)) != 0 || + sscanf(O->bytes + strlen(GdPtrType.name), "%p", &IMGPTR(O)) != 1) { + if (I != NULL) + Tcl_AppendResult(I, O->bytes, " is not a ", + GdPtrType.name, "-handle", NULL); + return TCL_ERROR; + } + + O->typePtr = &GdPtrType; + return TCL_OK; +} --- 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. --- gdhandle.c 2000-02-11 00:24:31.000000000 -0500 +++ gdhandle.c 2014-04-29 13:25:00.000000000 -0400 @@ -45,5 +45,5 @@ * It is set on the first table initialization. */ -static int entryAlignment = 0; +static size_t entryAlignment = 0; /*