Graphviz 13.0.0~dev.20250424.1043
Loading...
Searching...
No Matches
gdtclft.c
Go to the documentation of this file.
1/*************************************************************************
2 * Copyright (c) 2011 AT&T Intellectual Property
3 * All rights reserved. This program and the accompanying materials
4 * are made available under the terms of the Eclipse Public License v1.0
5 * which accompanies this distribution, and is available at
6 * https://www.eclipse.org/legal/epl-v10.html
7 *
8 * Contributors: Details at https://graphviz.org
9 *************************************************************************/
10
11#include "config.h"
12
13#include "../tcl-compat.h"
14#include "gd.h"
15#include <assert.h>
16#include <errno.h>
17#include <limits.h>
18#include <math.h>
19#include <stdio.h>
20#include <stdlib.h>
21#include <string.h>
22#include <tcl.h>
23#include <util/agxbuf.h>
24#include <util/startswith.h>
25#include <util/streq.h>
26
27#ifdef _WIN32
28#include <windows.h>
29#endif
30
31static Tcl_UpdateStringProc GdPtrTypeUpdate;
32static Tcl_SetFromAnyProc GdPtrTypeSet;
33static Tcl_ObjType GdPtrType = {.name = "gd",
34 .updateStringProc = GdPtrTypeUpdate,
35 .setFromAnyProc = GdPtrTypeSet};
36#define IMGPTR(O) (O->internalRep.otherValuePtr)
37
38/* The only two symbols exported */
39#ifdef GVDLL
40__declspec(dllexport)
41#endif
42Tcl_AppInitProc Gdtclft_Init;
43#ifdef GVDLL
44__declspec(dllexport)
45#endif
46Tcl_AppInitProc Gdtclft_SafeInit;
47
48typedef int(GdDataFunction)(Tcl_Interp *interp, int argc,
49 Tcl_Obj *const objv[]);
50typedef int(GdImgFunction)(Tcl_Interp *interp, gdImagePtr gdImg, int argc,
51 const int args[]);
52
58
62
63typedef struct {
64 const char *cmd;
66 unsigned int minargs, maxargs;
67 unsigned int subcmds;
68 unsigned int ishandle;
69 unsigned int unsafearg;
70 const char *usage;
72
73typedef struct {
74 const char *cmd;
76 unsigned int minargs, maxargs;
77 const char *usage;
79
81 {"create", tclGdCreateCmd, 2, 3, 0, 0, 0, "width heighti ?true?"},
82 {"createTrueColor", tclGdCreateCmd, 2, 2, 0, 0, 2, "width height"},
83 {"createFromGD", tclGdCreateCmd, 1, 1, 0, 0, 2, "filehandle"},
84#ifdef HAVE_LIBZ
85 {"createFromGD2", tclGdCreateCmd, 1, 1, 0, 0, 2, "filehandle"},
86#endif
87#ifdef HAVE_GD_GIF
88 {"createFromGIF", tclGdCreateCmd, 1, 1, 0, 0, 2, "filehandle"},
89#endif
90#ifdef HAVE_GD_JPEG
91 {"createFromJPEG", tclGdCreateCmd, 1, 1, 0, 0, 2, "filehandle"},
92#endif
93#ifdef HAVE_GD_PNG
94 {"createFromPNG", tclGdCreateCmd, 1, 1, 0, 0, 2, "filehandle"},
95#endif
96 {"createFromWBMP", tclGdCreateCmd, 1, 1, 0, 0, 2, "filehandle"},
97#ifdef HAVE_GD_XPM
98 {"createFromXBM", tclGdCreateCmd, 1, 1, 0, 0, 2, "filehandle"},
99#endif
100
101 {"destroy", tclGdDestroyCmd, 1, 1, 0, 1, 0, "gdhandle"},
102 {"writeGD", tclGdWriteCmd, 2, 2, 0, 1, 3, "gdhandle filehandle"},
103#ifdef HAVE_LIBZ
104 {"writeGD2", tclGdWriteCmd, 2, 2, 0, 1, 3, "gdhandle filehandle"},
105#endif
106#ifdef HAVE_GD_GIF
107 {"writeGIF", tclGdWriteCmd, 2, 2, 0, 1, 3, "gdhandle filehandle"},
108#endif
109#ifdef HAVE_GD_JPEG
110 {"writeJPEG", tclGdWriteCmd, 2, 2, 0, 1, 3, "gdhandle filehandle"},
111#endif
112#ifdef HAVE_GD_PNG
113 {"writePNG", tclGdWriteCmd, 2, 2, 0, 1, 3, "gdhandle filehandle"},
114#endif
115 {"writeWBMP", tclGdWriteCmd, 2, 2, 0, 1, 3, "gdhandle filehandle"},
116#ifdef HAVE_GD_XPM
117 {"writeXBM", tclGdWriteCmd, 2, 2, 0, 1, 3, "gdhandle filehandle"},
118#endif
119#ifdef HAVE_GD_PNG
120 {"writePNGvar", tclGdWriteBufCmd, 2, 2, 0, 1, 0, "gdhandle var"},
121#endif
122 {"interlace", tclGdInterlaceCmd, 1, 2, 0, 1, 0, "gdhandle ?on-off?"},
123 {"color", tclGdColorCmd, 2, 5, 1, 1, 0, "option values..."},
124 {"brush", tclGdBrushCmd, 2, 2, 0, 2, 0, "gdhandle brushhandle"},
125 {"style", tclGdStyleCmd, 2, 999, 0, 1, 0, "gdhandle color..."},
126 {"tile", tclGdTileCmd, 2, 2, 0, 2, 0, "gdhandle tilehandle"},
127 {"set", tclGdSetCmd, 4, 4, 0, 1, 0, "gdhandle color x y"},
128 {"line", tclGdLineCmd, 6, 6, 0, 1, 0, "gdhandle color x1 y1 x2 y2"},
129 {"rectangle", tclGdRectCmd, 6, 6, 0, 1, 0, "gdhandle color x1 y1 x2 y2"},
130 {"fillrectangle", tclGdRectCmd, 6, 6, 0, 1, 0,
131 "gdhandle color x1 y1 x2 y2"},
132 {"arc", tclGdArcCmd, 8, 8, 0, 1, 0,
133 "gdhandle color cx cy width height start end"},
134 {"fillarc", tclGdArcCmd, 8, 8, 0, 1, 0,
135 "gdhandle color cx cy width height start end"},
136 {"openarc", tclGdArcCmd, 8, 8, 0, 1, 0,
137 "gdhandle color cx cy width height start end"},
138 {"chord", tclGdArcCmd, 8, 8, 0, 1, 0,
139 "gdhandle color cx cy width height start end"},
140 {"fillchord", tclGdArcCmd, 8, 8, 0, 1, 0,
141 "gdhandle color cx cy width height start end"},
142 {"openchord", tclGdArcCmd, 8, 8, 0, 1, 0,
143 "gdhandle color cx cy width height start end"},
144 {"pie", tclGdArcCmd, 8, 8, 0, 1, 0,
145 "gdhandle color cx cy width height start end"},
146 {"fillpie", tclGdArcCmd, 8, 8, 0, 1, 0,
147 "gdhandle color cx cy width height start end"},
148 {"openpie", tclGdArcCmd, 8, 8, 0, 1, 0,
149 "gdhandle color cx cy width height start end"},
150 {"polygon", tclGdPolygonCmd, 2, 999, 0, 1, 0,
151 "gdhandle color x1 y1 x2 y2 x3 y3 ..."},
152 {"fillpolygon", tclGdPolygonCmd, 3, 999, 0, 1, 0,
153 "gdhandle color x1 y1 x2 y2 x3 y3 ..."},
154 {"fill", tclGdFillCmd, 4, 5, 0, 1, 0, "gdhandle color x y ?bordercolor?"},
155 /*
156 * we allow null gd handles to the text command to allow program to get size
157 * of text string, so the text command provides its own handle processing
158 * and checking
159 */
160 {"text", tclGdTextCmd, 8, 8, 0, 0, 4,
161 "gdhandle color fontname size angle x y string"},
162 {"copy", tclGdCopyCmd, 8, 10, 0, 2, 0,
163 "desthandle srchandle destx desty srcx srcy destw desth ?srcw srch?"},
164 {"get", tclGdGetCmd, 3, 3, 0, 1, 0, "gdhandle x y"},
165 {"size", tclGdSizeCmd, 1, 1, 0, 1, 0, "gdhandle"},
166};
167
169 {"new", tclGdColorNewCmd, 5, 5, "red green blue"},
170 {"exact", tclGdColorExactCmd, 5, 5, "red green blue"},
171 {"closest", tclGdColorClosestCmd, 5, 5, "red green blue"},
172 {"resolve", tclGdColorResolveCmd, 5, 5, "red green blue"},
173 {"free", tclGdColorFreeCmd, 3, 3, "color"},
174 {"transparent", tclGdColorTranspCmd, 2, 3, "?color?"},
175 {"get", tclGdColorGetCmd, 2, 3, "?color?"}};
176
177/*
178 * Helper function to interpret color_idx values.
179 */
180static int tclGd_GetColor(Tcl_Interp *interp, Tcl_Obj *obj, int *color) {
181 int retval = TCL_OK;
182 Tcl_Obj **theList;
183
184 /* Assume it's an integer, check other cases on failure. */
185 if (Tcl_GetIntFromObj(interp, obj, color) == TCL_OK)
186 return TCL_OK;
187 else {
188 Tcl_ResetResult(interp);
189 Tcl_Size nlist;
190 if (Tcl_ListObjGetElements(interp, obj, &nlist, &theList) != TCL_OK)
191 return TCL_ERROR;
192 if (nlist < 1 || nlist > 2)
193 retval = TCL_ERROR;
194 else {
195 char *firsttag = Tcl_GetString(theList[0]);
196 switch (firsttag[0]) {
197 case 'b':
198 *color = gdBrushed;
199 if (nlist == 2) {
200 char *secondtag = Tcl_GetString(theList[1]);
201 if (secondtag[0] == 's') {
202 *color = gdStyledBrushed;
203 } else {
204 retval = TCL_ERROR;
205 }
206 }
207 break;
208
209 case 's':
210 *color = gdStyled;
211 if (nlist == 2) {
212 char *secondtag = Tcl_GetString(theList[1]);
213 if (secondtag[0] == 'b') {
214 *color = gdStyledBrushed;
215 } else {
216 retval = TCL_ERROR;
217 }
218 }
219 break;
220
221 case 't':
222 *color = gdTiled;
223 break;
224
225 default:
226 retval = TCL_ERROR;
227 }
228 }
229 }
230 if (retval == TCL_ERROR)
231 Tcl_SetResult(interp, "Malformed special color value", TCL_STATIC);
232
233 return retval;
234}
235
236/*
237 * GD composite command:
238 *
239 * gd create <width> <height>
240 * Return a handle to a new gdImage that is width X height.
241 * gd createTrueColor <width> <height>
242 * Return a handle to a new trueColor gdImage that is width X
243 * height. gd createFromGD <filehandle> gd createFromGD2 <filehandle> gd
244 * createFromGIF <filehandle> gd createFromJPEG <filehandle> gd createFromPNG
245 * <filehandle> gd createFromWBMP <filehandle> gd createFromXBM <filehandle>
246 * Return a handle to a new gdImage created by reading an
247 * image from the file of the indicated format
248 * open on filehandle.
249 *
250 * gd destroy <gdhandle>
251 * Destroy the gdImage referred to by gdhandle.
252 *
253 * gd writeGD <gdhandle> <filehandle>
254 * gd writeGD2 <gdhandle> <filehandle>
255 * gd writeGIF <gdhandle> <filehandle>
256 * gd writeJPEG <gdhandle> <filehandle>
257 * gd writePNG <gdhandle> <filehandle>
258 * gd writeWBMP <gdhandle> <filehandle>
259 * gd writeXBM <gdhandle> <filehandle>
260 * Write the image in gdhandle to filehandle in the
261 * format indicated.
262 *
263 * gd color new <gdhandle> <red> <green> <blue>
264 * Allocate a new color with the given RGB values. Returns the
265 * color_idx, or -1 on failure (256 colors already allocated).
266 * gd color exact <gdhandle> <red> <green> <blue>
267 * Find a color_idx in the image that exactly matches the given RGB
268 * color. Returns the color_idx, or -1 if no exact match. gd color closest
269 * <gdhandle> <red> <green> <blue> Find a color in the image that is closest to
270 * the given RGB color. Guaranteed to return a color idx. gd color resolve
271 * <gdhandle> <red> <green> <blue> Return the index of the best possible effort
272 * to get a color. Guaranteed to return a color idx. Equivalent to: if {[set
273 * idx [gd color exact $gd $r $g $b]] == -1} { if {[set idx [gd color neW $Gd $r
274 * $g $b]] == -1} { set idx [gd color closest $gd $r $g $b]
275 * }
276 * }
277 * gd color free <gdhandle> <color_idx>
278 * Free the color at the given color_idx for reuse.
279 * gd color transparent <gdhandle> <color_idx>
280 * Mark the color_idx as the transparent background color.
281 * gd color get <gdhandle> [<color_idx>]
282 * Return the RGB value at <color_idx>, or {} if it is not
283 * allocated. If <color_idx> is not specified, return a list of {color_idx R G
284 * B} values for all allocated colors. gd color gettransparent <gdhandle> Return
285 * the color_idx of the transparent color.
286 *
287 * gd brush <gdhandle> <brushhandle>
288 * Set the brush image to be used for brushed lines. Transparent
289 * pixels in the brush will not change the image when the brush
290 * is applied.
291 * gd style <gdhandle> <color_idx> ...
292 * Set the line style to the list of color indices. This is
293 * interpreted in one of two ways. For a simple styled line, each color is
294 * applied to points along the line in turn. The transparent color
295 * value may be used to leave gaps in the line. For a styled,
296 * brushed line, a 0 (or the transparent color_idx) means not to fill the pixel,
297 * and a non-zero value means to apply the brush.
298 * gd tile <gdhandle> <tilehandle>
299 * Set the tile image to be used for tiled fills. Transparent
300 * pixels in the tile will not change the underlying image during tiling.
301 *
302 * In all drawing functions, the color_idx is a number, or may be one of the
303 * strings styled, brushed, tiled, "styled brushed" or "brushed styled". The
304 * style, brush, or tile currently in effect will be used. Brushing and
305 * styling apply to lines, tiling to filled areas.
306 *
307 * gd set <gdhandle> <color_idx> <x> <y>
308 * Set the pixel at (x,y) to color <color_idx>.
309 * gd line <gdhandle> <color_idx> <x1> <y1> <x2> <y2>
310 * Draw a line in color <color_idx> from (x1,y1) to (x2,y2).
311 * gd rectangle <gdhandle> <color_idx> <x1> <y1> <x2> <y2>
312 * gd fillrectangle <gdhandle> <color_idx> <x1> <y1> <x2> <y2>
313 * Draw the outline of (resp. fill) a rectangle in color
314 * <color_idx> with corners at (x1,y1) and (x2,y2). gd arc <gdhandle>
315 * <color_idx> <cx> <cy> <width> <height> <start> <end> gd fillarc <gdhandle>
316 * <color_idx> <cx> <cy> <width> <height> <start> <end> Draw an arc, or filled
317 * segment, in color <color_idx>, centered at (cx,cy) in a rectangle width x
318 * height, starting at start degrees and ending at end degrees.
319 * Start must be > end. gd polygon <gdhandle> <color_idx> <x1> <y1> ... gd
320 * fillpolygon <gdhandle> <color_idx> <x1> <y1> ... Draw the outline of, or
321 * fill, a polygon specified by the x, y coordinate list.
322 *
323 * gd fill <gdhandle> <color_idx> <x> <y>
324 * gd fill <gdhandle> <color_idx> <x> <y> <borderindex>
325 * Fill with color <color_idx>, starting from (x,y) within a region
326 * of pixels all the color of the pixel at (x,y) (resp., within a
327 * border colored borderindex).
328 *
329 * gd size <gdhandle>
330 * Returns a list {width height} of the image.
331 *
332 * gd text <gdhandle> <color_idx> <fontname> <size> <angle> <x> <y> <string>
333 * Draw text using <fontname> in color <color_idx>,
334 * with pointsize <size>, rotation in radians <angle>, with lower left
335 * corner at (x,y). String may contain UTF8 sequences like: "&#192;"
336 * Returns 4 corner coords of bounding rectangle.
337 * Use gdhandle = {} to get boundary without rendering.
338 * Use negative of color_idx to disable antialiasing.
339 *
340 * The file <fontname>.ttf must be found in the builtin DEFAULT_FONTPATH
341 * or in the fontpath specified in a GDFONTPATH environment variable.
342 *
343 * gd copy <desthandle> <srchandle> <destx> <desty> <srcx> <srcy> <w> <h>
344 * gd copy <desthandle> <srchandle> <destx> <desty> <srcx> <srcy> \
345 * <destw> <desth> <srcw> <srch>
346 * Copy a subimage from srchandle(srcx, srcy) to
347 * desthandle(destx, desty), size w x h. Or, resize the subimage
348 * in copying from srcw x srch to destw x desth.
349 *
350 */
351static int gdCmd(ClientData clientData, Tcl_Interp *interp, int argc,
352 Tcl_Obj *const objv[]) {
353 /* Check for subcommand. */
354 if (argc < 2) {
355 Tcl_SetResult(interp, "wrong # args: should be \"gd option ...\"",
356 TCL_STATIC);
357 return TCL_ERROR;
358 }
359
360 /* Find the subcommand. */
361 for (size_t subi = 0; subi < sizeof(subcmdVec) / sizeof(subcmdVec[0]);
362 subi++) {
363 if (streq(subcmdVec[subi].cmd, Tcl_GetString(objv[1]))) {
364
365 /* Check arg count. */
366 if ((unsigned)argc - 2 < subcmdVec[subi].minargs ||
367 (unsigned)argc - 2 > subcmdVec[subi].maxargs) {
368 Tcl_WrongNumArgs(interp, 2, objv, subcmdVec[subi].usage);
369 return TCL_ERROR;
370 }
371
372 /* Check for valid handle(s). */
373 if (subcmdVec[subi].ishandle > 0) {
374 /* Check each handle to see if it's a valid handle. */
375 if (2 + subcmdVec[subi].subcmds + subcmdVec[subi].ishandle >
376 (unsigned)argc) {
377 Tcl_SetResult(interp, "GD handle(s) not specified", TCL_STATIC);
378 return TCL_ERROR;
379 }
380 for (unsigned argi = 2 + subcmdVec[subi].subcmds;
381 argi < 2 + subcmdVec[subi].subcmds + subcmdVec[subi].ishandle;
382 argi++) {
383 if (objv[argi]->typePtr != &GdPtrType &&
384 GdPtrTypeSet(interp, objv[argi]) != TCL_OK)
385 return TCL_ERROR;
386 }
387 }
388 /*
389 * If we are operating in a safe interpreter, check,
390 * if this command is suspect -- and only let existing
391 * filehandles through, if so.
392 */
393 if (clientData != NULL && subcmdVec[subi].unsafearg != 0) {
394 const char *fname = Tcl_GetString(objv[subcmdVec[subi].unsafearg]);
395 if (!Tcl_IsChannelExisting(fname)) {
396 Tcl_AppendResult(interp, "Access to ", fname,
397 " not allowed in safe interpreter", NULL);
398 return TCL_ERROR;
399 }
400 }
401 /* Call the subcommand function. */
402 return subcmdVec[subi].f(interp, argc, objv);
403 }
404 }
405
406 /* If we get here, the option doesn't match. */
407 Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
408 "\": should be ", 0);
409 for (size_t subi = 0; subi < sizeof(subcmdVec) / sizeof(subcmdVec[0]); subi++)
410 Tcl_AppendResult(interp, (subi > 0 ? ", " : ""), subcmdVec[subi].cmd, 0);
411 return TCL_ERROR;
412}
413
414static int tclGdCreateCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
415 int w, h;
416 gdImagePtr im = NULL;
417 int fileByName;
418
419 char *cmd = Tcl_GetString(objv[1]);
420 if (streq(cmd, "create")) {
421 int trueColor = 0;
422 if (Tcl_GetIntFromObj(interp, objv[2], &w) != TCL_OK)
423 return TCL_ERROR;
424 if (Tcl_GetIntFromObj(interp, objv[3], &h) != TCL_OK)
425 return TCL_ERROR;
426 /* An optional argument may specify true for "TrueColor" */
427 if (argc == 5 &&
428 Tcl_GetBooleanFromObj(interp, objv[4], &trueColor) == TCL_ERROR)
429 return TCL_ERROR;
430 if (trueColor)
431 im = gdImageCreateTrueColor(w, h);
432 else
433 im = gdImageCreate(w, h);
434 if (im == NULL) {
435 char buf[255];
436 snprintf(buf, sizeof(buf), "GD unable to allocate %d X %d image", w, h);
437 Tcl_SetResult(interp, buf, TCL_VOLATILE);
438 return TCL_ERROR;
439 }
440 } else if (streq(cmd, "createTrueColor")) {
441 if (Tcl_GetIntFromObj(interp, objv[2], &w) != TCL_OK)
442 return TCL_ERROR;
443 if (Tcl_GetIntFromObj(interp, objv[3], &h) != TCL_OK)
444 return TCL_ERROR;
445 im = gdImageCreateTrueColor(w, h);
446 if (im == NULL) {
447 char buf[255];
448 snprintf(buf, sizeof(buf), "GD unable to allocate %d X %d image", w, h);
449 Tcl_SetResult(interp, buf, TCL_VOLATILE);
450 return TCL_ERROR;
451 }
452 } else {
453 char *arg2 = Tcl_GetString(objv[2]);
454 fileByName = 0; /* first try to get file from open channel */
455 FILE *filePtr = NULL;
456#if !defined(_WIN32)
457 ClientData clientdata;
458 if (Tcl_GetOpenFile(interp, arg2, 0, 1, &clientdata) == TCL_OK) {
459 filePtr = (FILE *)clientdata;
460 }
461#endif
462 if (filePtr == NULL) {
463 /* Not a channel, or Tcl_GetOpenFile() not supported.
464 * See if we can open directly.
465 */
466 if ((filePtr = fopen(arg2, "rb")) == NULL) {
467 return TCL_ERROR;
468 }
469 fileByName++;
470 Tcl_ResetResult(interp);
471 }
472
473 /* Read file */
474 if (streq(&cmd[10], "GD")) {
475 im = gdImageCreateFromGd(filePtr);
476#ifdef HAVE_LIBZ
477 } else if (streq(&cmd[10], "GD2")) {
478 im = gdImageCreateFromGd2(filePtr);
479#endif
480#ifdef HAVE_GD_GIF
481 } else if (streq(&cmd[10], "GIF")) {
482 im = gdImageCreateFromGif(filePtr);
483#endif
484#ifdef HAVE_GD_JPEG
485 } else if (streq(&cmd[10], "JPEG")) {
486 im = gdImageCreateFromJpeg(filePtr);
487#endif
488#ifdef HAVE_GD_PNG
489 } else if (streq(&cmd[10], "PNG")) {
490 im = gdImageCreateFromPng(filePtr);
491#endif
492 } else if (streq(&cmd[10], "WBMP")) {
493 im = gdImageCreateFromWBMP(filePtr);
494#ifdef HAVE_GD_XPM
495 } else if (streq(&cmd[10], "XBM")) {
496 im = gdImageCreateFromXbm(filePtr);
497#endif
498 } else {
499 Tcl_AppendResult(interp, cmd + 10, "unrecognizable format requested",
500 NULL);
501 if (fileByName) {
502 fclose(filePtr);
503 }
504 return TCL_ERROR;
505 }
506 if (fileByName) {
507 fclose(filePtr);
508 }
509 if (im == NULL) {
510 Tcl_AppendResult(interp, "GD unable to read image file '", arg2, "` as ",
511 cmd + 10, NULL);
512 return TCL_ERROR;
513 }
514 }
515
516 Tcl_Obj *result = Tcl_NewObj();
517 IMGPTR(result) = im;
518 result->typePtr = &GdPtrType;
519 result->bytes = NULL;
520 Tcl_SetObjResult(interp, result);
521 return TCL_OK;
522}
523
524static int tclGdDestroyCmd(Tcl_Interp *interp, int argc,
525 Tcl_Obj *const objv[]) {
526 (void)interp;
527 (void)argc;
528
529 /* Get the image pointer and destroy it */
530 gdImagePtr im = IMGPTR(objv[2]);
531 gdImageDestroy(im);
532
533 return TCL_OK;
534}
535
536static int tclGdWriteCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
537 int arg4;
538
539 const char *cmd = Tcl_GetString(objv[1]);
540 if (cmd[5] == 'J' || cmd[5] == 'W') {
541 /* JPEG and WBMP expect an extra (integer) argument */
542 if (argc < 5) {
543 if (cmd[5] == 'J')
544 arg4 = -1; /* default quality-level */
545 else {
546 Tcl_SetResult(interp, "WBMP saving requires the foreground pixel value",
547 TCL_STATIC);
548 return TCL_ERROR;
549 }
550 } else if (Tcl_GetIntFromObj(interp, objv[4], &arg4) != TCL_OK)
551 return TCL_ERROR;
552
553 if (cmd[5] == 'J' && argc > 4 && (arg4 > 100 || arg4 < 1)) {
554 Tcl_SetObjResult(interp, objv[4]);
555 Tcl_AppendResult(interp,
556 ": JPEG image quality, if specified, must be an integer "
557 "from 1 to 100, or -1 for default",
558 NULL);
559 return TCL_ERROR;
560 }
561 /* XXX no error-checking for the WBMP case here */
562 }
563 /* Get the image pointer. */
564 gdImagePtr im = IMGPTR(objv[2]);
565 const char *fname = Tcl_GetString(objv[3]);
566
567 /* Get the file reference. */
568 int fileByName = 0; // first try to get file from open channel
569 FILE *filePtr = NULL;
570#if !defined(_WIN32)
571 ClientData clientdata;
572 if (Tcl_GetOpenFile(interp, fname, 1, 1, &clientdata) == TCL_OK) {
573 filePtr = (FILE *)clientdata;
574 }
575#endif
576 if (filePtr == NULL) {
577 /* Not a channel, or Tcl_GetOpenFile() not supported.
578 * See if we can open directly.
579 */
580 fileByName++;
581 if ((filePtr = fopen(fname, "wb")) == NULL) {
582 Tcl_AppendResult(interp, "could not open :", fname,
583 "': ", strerror(errno), NULL);
584 return TCL_ERROR;
585 }
586 Tcl_ResetResult(interp);
587 }
588
589 /*
590 * Write IM to OUTFILE as a JFIF-formatted JPEG image, using quality
591 * JPEG_QUALITY. If JPEG_QUALITY is in the range 0-100, increasing values
592 * represent higher quality but also larger image size. If JPEG_QUALITY is
593 * negative, the IJG JPEG library's default quality is used (which
594 * should be near optimal for many applications). See the IJG JPEG
595 * library documentation for more details. */
596
597 /* Do it. */
598 if (streq(&cmd[5], "GD")) {
599 gdImageGd(im, filePtr);
600 } else if (streq(&cmd[5], "GD2")) {
601#ifdef HAVE_LIBZ
602#define GD2_CHUNKSIZE 128
603#define GD2_COMPRESSED 2
604 gdImageGd2(im, filePtr, GD2_CHUNKSIZE, GD2_COMPRESSED);
605#endif
606#ifdef HAVE_GD_GIF
607 } else if (streq(&cmd[5], "GIF")) {
608 gdImageGif(im, filePtr);
609#endif
610#ifdef HAVE_GD_JPEG
611 } else if (streq(&cmd[5], "JPEG")) {
612#define JPEG_QUALITY -1
613 gdImageJpeg(im, filePtr, JPEG_QUALITY);
614#endif
615#ifdef HAVE_GD_PNG
616 } else if (streq(&cmd[5], "PNG")) {
617 gdImagePng(im, filePtr);
618#endif
619 } else if (streq(&cmd[5], "WBMP")) {
620 /* Assume the color closest to black is the foreground
621 color for the B&W wbmp image. */
622 int foreground = gdImageColorClosest(im, 0, 0, 0);
623 gdImageWBMP(im, foreground, filePtr);
624 } else {
625 /* cannot happen - but would result in an empty output file */
626 }
627 if (fileByName) {
628 fclose(filePtr);
629 } else {
630 fflush(filePtr);
631 }
632 return TCL_OK;
633}
634
635static int tclGdInterlaceCmd(Tcl_Interp *interp, int argc,
636 Tcl_Obj *const objv[]) {
637 int on_off;
638
639 /* Get the image pointer. */
640 gdImagePtr im = IMGPTR(objv[2]);
641
642 if (argc == 4) {
643 /* Get the on_off values. */
644 if (Tcl_GetBooleanFromObj(interp, objv[3], &on_off) != TCL_OK)
645 return TCL_ERROR;
646
647 /* Do it. */
648 gdImageInterlace(im, on_off);
649 } else {
650 /* Get the current state. */
651 on_off = gdImageGetInterlaced(im);
652 }
653 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(on_off));
654 return TCL_OK;
655}
656
657static int tclGdColorCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
658 int args[3];
659
660 int nsub = sizeof(colorCmdVec) / sizeof(colorCmdVec[0]);
661 if (argc >= 3) {
662 /* Find the subcommand. */
663 for (int subi = 0; subi < nsub; subi++) {
664 if (streq(colorCmdVec[subi].cmd, Tcl_GetString(objv[2]))) {
665 /* Check arg count. */
666 if ((unsigned)argc - 2 < colorCmdVec[subi].minargs ||
667 (unsigned)argc - 2 > colorCmdVec[subi].maxargs) {
668 Tcl_WrongNumArgs(interp, 3, objv, colorCmdVec[subi].usage);
669 return TCL_ERROR;
670 }
671
672 /* Get the image pointer. */
673 gdImagePtr im = IMGPTR(objv[3]);
674
675 /* Parse off integer arguments.
676 * 1st 4 are gd color <opt> <handle>
677 */
678 for (int i = 0; i < argc - 4; i++) {
679 if (Tcl_GetIntFromObj(interp, objv[i + 4], &args[i]) != TCL_OK) {
680
681 /* gd text uses -ve colors to turn off anti-aliasing */
682 if (args[i] < -255 || args[i] > 255) {
683 Tcl_SetResult(interp, "argument out of range 0-255", TCL_STATIC);
684 return TCL_ERROR;
685 }
686 }
687 }
688
689 /* Call the subcommand function. */
690 return colorCmdVec[subi].f(interp, im, argc - 4, args);
691 }
692 }
693 }
694
695 /* If we get here, the option doesn't match. */
696 if (argc > 2) {
697 Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[2]),
698 "\": ", 0);
699 } else {
700 Tcl_AppendResult(interp, "wrong # args: ", 0);
701 }
702 Tcl_AppendResult(interp, "should be ", 0);
703 for (int subi = 0; subi < nsub; subi++)
704 Tcl_AppendResult(interp, subi > 0 ? ", " : "", colorCmdVec[subi].cmd, 0);
705
706 return TCL_ERROR;
707}
708
709static int tclGdColorNewCmd(Tcl_Interp *interp, gdImagePtr im, int argc,
710 const int args[]) {
711 (void)argc;
712
713 int color = gdImageColorAllocate(im, args[0], args[1], args[2]);
714 Tcl_SetObjResult(interp, Tcl_NewIntObj(color));
715 return TCL_OK;
716}
717
718static int tclGdColorExactCmd(Tcl_Interp *interp, gdImagePtr im, int argc,
719 const int args[]) {
720 (void)argc;
721
722 int color = gdImageColorExact(im, args[0], args[1], args[2]);
723 Tcl_SetObjResult(interp, Tcl_NewIntObj(color));
724 return TCL_OK;
725}
726
727static int tclGdColorClosestCmd(Tcl_Interp *interp, gdImagePtr im, int argc,
728 const int args[]) {
729 (void)argc;
730
731 int color = gdImageColorClosest(im, args[0], args[1], args[2]);
732 Tcl_SetObjResult(interp, Tcl_NewIntObj(color));
733 return TCL_OK;
734}
735
736static int tclGdColorResolveCmd(Tcl_Interp *interp, gdImagePtr im, int argc,
737 const int args[]) {
738 (void)argc;
739
740 int color = gdImageColorResolve(im, args[0], args[1], args[2]);
741 Tcl_SetObjResult(interp, Tcl_NewIntObj(color));
742 return TCL_OK;
743}
744
745static int tclGdColorFreeCmd(Tcl_Interp *interp, gdImagePtr im, int argc,
746 const int args[]) {
747 (void)interp;
748 (void)argc;
749
750 gdImageColorDeallocate(im, args[0]);
751 return TCL_OK;
752}
753
754static int tclGdColorTranspCmd(Tcl_Interp *interp, gdImagePtr im, int argc,
755 const int args[]) {
756 int color;
757
758 if (argc > 0) {
759 color = args[0];
760 gdImageColorTransparent(im, color);
761 } else {
762 color = gdImageGetTransparent(im);
763 }
764 Tcl_SetObjResult(interp, Tcl_NewIntObj(color));
765 return TCL_OK;
766}
767
768static int tclGdColorGetCmd(Tcl_Interp *interp, gdImagePtr im, int argc,
769 const int args[]) {
770 Tcl_Obj *result;
771
772 int ncolors = gdImageColorsTotal(im);
773 /* IF one arg, return the single color, else return list of all colors. */
774 if (argc == 1) {
775 int i = args[0];
776 if (i >= ncolors || im->open[i]) {
777 Tcl_SetResult(interp, "No such color", TCL_STATIC);
778 return TCL_ERROR;
779 }
780 Tcl_Obj *tuple[] = {Tcl_NewIntObj(i), Tcl_NewIntObj(gdImageRed(im, i)),
781 Tcl_NewIntObj(gdImageGreen(im, i)),
782 Tcl_NewIntObj(gdImageBlue(im, i))};
783 const Tcl_Size tuple_size = sizeof(tuple) / sizeof(tuple[0]);
784 Tcl_SetObjResult(interp, Tcl_NewListObj(tuple_size, tuple));
785 } else {
786 result = Tcl_NewListObj(0, NULL);
787 for (int i = 0; i < ncolors; i++) {
788 if (im->open[i])
789 continue;
790 Tcl_Obj *tuple[] = {Tcl_NewIntObj(i), Tcl_NewIntObj(gdImageRed(im, i)),
791 Tcl_NewIntObj(gdImageGreen(im, i)),
792 Tcl_NewIntObj(gdImageBlue(im, i))};
793 const Tcl_Size tuple_size = sizeof(tuple) / sizeof(tuple[0]);
794 Tcl_ListObjAppendElement(NULL, result, Tcl_NewListObj(tuple_size, tuple));
795 }
796 Tcl_SetObjResult(interp, result);
797 }
798
799 return TCL_OK;
800}
801
802static int tclGdBrushCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
803 (void)interp;
804 (void)argc;
805
806 /* Get the image pointers. */
807 gdImagePtr im = IMGPTR(objv[2]);
808 gdImagePtr imbrush = IMGPTR(objv[3]);
809
810 /* Do it. */
811 gdImageSetBrush(im, imbrush);
812
813 return TCL_OK;
814}
815
816static int tclGdTileCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
817 (void)interp;
818 (void)argc;
819
820 /* Get the image pointers. */
821 gdImagePtr im = IMGPTR(objv[2]);
822 gdImagePtr tile = IMGPTR(objv[3]);
823
824 /* Do it. */
825 gdImageSetTile(im, tile);
826
827 return TCL_OK;
828}
829
830static int tclGdStyleCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
831 Tcl_Obj *const *colorObjv = &objv[3]; // by default, colors are listed in objv
832 int retval = TCL_OK;
833
834 /* Get the image pointer. */
835 gdImagePtr im = IMGPTR(objv[2]);
836
837 /* Figure out how many colors in the style list and allocate memory. */
838 Tcl_Size ncolor = (Tcl_Size)argc - 3;
839 /* If only one argument, treat it as a list. */
840 if (ncolor == 1) {
841 Tcl_Obj **colorObjp;
842 if (Tcl_ListObjGetElements(interp, objv[3], &ncolor, &colorObjp) != TCL_OK)
843 return TCL_ERROR;
844 colorObjv = colorObjp;
845 }
846
847 int *colors = (int *)Tcl_Alloc((size_t)ncolor * sizeof(int));
848 /* Get the color values. */
849 for (Tcl_Size i = 0; i < ncolor; i++)
850 if (Tcl_GetIntFromObj(interp, colorObjv[i], &colors[i]) != TCL_OK) {
851 retval = TCL_ERROR;
852 break;
853 }
854
855 /* Call the Style function if no error. */
856 if (retval == TCL_OK)
857 gdImageSetStyle(im, colors, (int)ncolor);
858
859 /* Free the colors. */
860 if (colors != NULL)
861 Tcl_Free((char *)colors);
862
863 return retval;
864}
865
866static int tclGdSetCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
867 (void)argc;
868
869 gdImagePtr im;
870 int color, x, y;
871
872 /* Get the image pointer. */
873 im = IMGPTR(objv[2]);
874
875 /* Get the color, x, y values. */
876 if (tclGd_GetColor(interp, objv[3], &color) != TCL_OK)
877 return TCL_ERROR;
878 if (Tcl_GetIntFromObj(interp, objv[4], &x) != TCL_OK)
879 return TCL_ERROR;
880 if (Tcl_GetIntFromObj(interp, objv[5], &y) != TCL_OK)
881 return TCL_ERROR;
882
883 /* Call the Set function. */
884 gdImageSetPixel(im, x, y, color);
885
886 return TCL_OK;
887}
888
889static int tclGdLineCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
890 (void)argc;
891
892 gdImagePtr im;
893 int color, x1, y1, x2, y2;
894
895 /* Get the image pointer. */
896 im = IMGPTR(objv[2]);
897
898 /* Get the color, x, y values. */
899 if (tclGd_GetColor(interp, objv[3], &color) != TCL_OK)
900 return TCL_ERROR;
901 if (Tcl_GetIntFromObj(interp, objv[4], &x1) != TCL_OK)
902 return TCL_ERROR;
903 if (Tcl_GetIntFromObj(interp, objv[5], &y1) != TCL_OK)
904 return TCL_ERROR;
905 if (Tcl_GetIntFromObj(interp, objv[6], &x2) != TCL_OK)
906 return TCL_ERROR;
907 if (Tcl_GetIntFromObj(interp, objv[7], &y2) != TCL_OK)
908 return TCL_ERROR;
909
910 /* Call the appropriate Line function. */
911 gdImageLine(im, x1, y1, x2, y2, color);
912
913 return TCL_OK;
914}
915
916static int tclGdRectCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
917 (void)argc;
918
919 gdImagePtr im;
920 int color, x1, y1, x2, y2;
921 const char *cmd;
922
923 /* Get the image pointer. */
924 im = IMGPTR(objv[2]);
925
926 /* Get the color, x, y values. */
927 if (tclGd_GetColor(interp, objv[3], &color) != TCL_OK)
928 return TCL_ERROR;
929 if (Tcl_GetIntFromObj(interp, objv[4], &x1) != TCL_OK)
930 return TCL_ERROR;
931 if (Tcl_GetIntFromObj(interp, objv[5], &y1) != TCL_OK)
932 return TCL_ERROR;
933 if (Tcl_GetIntFromObj(interp, objv[6], &x2) != TCL_OK)
934 return TCL_ERROR;
935 if (Tcl_GetIntFromObj(interp, objv[7], &y2) != TCL_OK)
936 return TCL_ERROR;
937
938 /* Call the appropriate rectangle function. */
939 cmd = Tcl_GetString(objv[1]);
940 if (cmd[0] == 'r')
941 gdImageRectangle(im, x1, y1, x2, y2, color);
942 else
943 gdImageFilledRectangle(im, x1, y1, x2, y2, color);
944
945 return TCL_OK;
946}
947
948static int tclGdArcCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
949 (void)argc;
950
951 gdImagePtr im;
952 int color, cx, cy, width, height, start, end;
953 const char *cmd;
954
955 /* Get the image pointer. */
956 im = IMGPTR(objv[2]);
957
958 /* Get the color, x, y values. */
959 if (tclGd_GetColor(interp, objv[3], &color) != TCL_OK)
960 return TCL_ERROR;
961 if (Tcl_GetIntFromObj(interp, objv[4], &cx) != TCL_OK)
962 return TCL_ERROR;
963 if (Tcl_GetIntFromObj(interp, objv[5], &cy) != TCL_OK)
964 return TCL_ERROR;
965 if (Tcl_GetIntFromObj(interp, objv[6], &width) != TCL_OK)
966 return TCL_ERROR;
967 if (Tcl_GetIntFromObj(interp, objv[7], &height) != TCL_OK)
968 return TCL_ERROR;
969 if (Tcl_GetIntFromObj(interp, objv[8], &start) != TCL_OK)
970 return TCL_ERROR;
971 if (Tcl_GetIntFromObj(interp, objv[9], &end) != TCL_OK)
972 return TCL_ERROR;
973
974 /* Call the appropriate arc function. */
975 cmd = Tcl_GetString(objv[1]);
976 if (cmd[0] == 'a') /* arc */
977 gdImageArc(im, cx, cy, width, height, start, end, color);
978 /* This one is not really useful as gd renderers it the same as fillpie */
979 /* It would be more useful if gd provided fill between arc and chord */
980 else if (cmd[0] == 'f' && cmd[4] == 'a') /* fill arc */
981 gdImageFilledArc(im, cx, cy, width, height, start, end, color, gdArc);
982 /* this one is a kludge */
983 else if (cmd[0] == 'o' && cmd[4] == 'a') { /* open arc */
984 gdImageArc(im, cx, cy, width, height, start, end, color);
985 gdImageFilledArc(im, cx, cy, width, height, start, end, color,
986 gdChord | gdNoFill);
987 } else if (cmd[0] == 'c') /* chord */
988 gdImageFilledArc(im, cx, cy, width, height, start, end, color,
989 gdChord | gdNoFill);
990 else if (cmd[0] == 'f' && cmd[4] == 'c') /* fill chord */
991 gdImageFilledArc(im, cx, cy, width, height, start, end, color, gdChord);
992 else if (cmd[0] == 'o' && cmd[4] == 'c') /* open chord */
993 gdImageFilledArc(im, cx, cy, width, height, start, end, color,
994 gdChord | gdEdged | gdNoFill);
995 else if (cmd[0] == 'p' ||
996 (cmd[0] == 'f' && cmd[4] == 'p')) /* pie or fill pie */
997 gdImageFilledArc(im, cx, cy, width, height, start, end, color, gdPie);
998 else if (cmd[0] == 'o' && cmd[4] == 'p') /* open pie */
999 gdImageFilledArc(im, cx, cy, width, height, start, end, color,
1000 gdPie | gdEdged | gdNoFill);
1001
1002 return TCL_OK;
1003}
1004
1005static int tclGdPolygonCmd(Tcl_Interp *interp, int argc,
1006 Tcl_Obj *const objv[]) {
1007 gdImagePtr im;
1008 int color;
1009 Tcl_Obj *const *pointObjv = &objv[4];
1010 gdPointPtr points = NULL;
1011 int retval = TCL_OK;
1012 char *cmd;
1013
1014 /* Get the image pointer. */
1015 im = IMGPTR(objv[2]);
1016
1017 /* Get the color, x, y values. */
1018 if (tclGd_GetColor(interp, objv[3], &color) != TCL_OK)
1019 return TCL_ERROR;
1020
1021 /* Figure out how many points in the list and allocate memory. */
1022 Tcl_Size npoints = (Tcl_Size)argc - 4;
1023 /* If only one argument, treat it as a list. */
1024 if (npoints == 1) {
1025 Tcl_Obj **pointObjp;
1026 if (Tcl_ListObjGetElements(interp, objv[4], &npoints, &pointObjp) != TCL_OK)
1027 return TCL_ERROR;
1028 pointObjv = pointObjp;
1029 }
1030
1031 /* Error check size of point list. */
1032 if (npoints % 2 != 0) {
1033 Tcl_SetResult(interp, "Number of coordinates must be even", TCL_STATIC);
1034 retval = TCL_ERROR;
1035 goto out;
1036 }
1037
1038 /* Divide by 2 to get number of points, and final error check. */
1039 npoints /= 2;
1040 if (npoints < 3) {
1041 Tcl_SetResult(interp, "Must specify at least 3 points.", TCL_STATIC);
1042 retval = TCL_ERROR;
1043 goto out;
1044 }
1045
1046 points = (gdPointPtr)Tcl_Alloc((size_t)npoints * sizeof(gdPoint));
1047
1048 /* Get the point values. */
1049 for (Tcl_Size i = 0; i < npoints; i++)
1050 if (Tcl_GetIntFromObj(interp, pointObjv[i * 2], &points[i].x) != TCL_OK ||
1051 Tcl_GetIntFromObj(interp, pointObjv[i * 2 + 1], &points[i].y) !=
1052 TCL_OK) {
1053 retval = TCL_ERROR;
1054 goto out;
1055 }
1056
1057 /* Call the appropriate polygon function. */
1058 cmd = Tcl_GetString(objv[1]);
1059 if (cmd[0] == 'p')
1060 gdImagePolygon(im, points, (int)npoints, color);
1061 else
1062 gdImageFilledPolygon(im, points, (int)npoints, color);
1063
1064out:
1065 /* Free the points. */
1066 if (points != NULL)
1067 Tcl_Free((char *)points);
1068
1069 /* return TCL_OK; */
1070 return retval;
1071}
1072
1073static int tclGdFillCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
1074 gdImagePtr im;
1075 int color, x, y, border;
1076
1077 /* Get the image pointer. */
1078 im = IMGPTR(objv[2]);
1079
1080 /* Get the color, x, y and possibly bordercolor values. */
1081 if (tclGd_GetColor(interp, objv[3], &color) != TCL_OK)
1082 return TCL_ERROR;
1083 if (Tcl_GetIntFromObj(interp, objv[4], &x) != TCL_OK)
1084 return TCL_ERROR;
1085 if (Tcl_GetIntFromObj(interp, objv[5], &y) != TCL_OK)
1086 return TCL_ERROR;
1087
1088 /* Call the appropriate fill function. */
1089 if (argc - 2 == 5) {
1090 if (Tcl_GetIntFromObj(interp, objv[6], &border) != TCL_OK)
1091 return TCL_ERROR;
1092 gdImageFillToBorder(im, x, y, border, color);
1093 } else {
1094 gdImageFill(im, x, y, color);
1095 }
1096
1097 return TCL_OK;
1098}
1099
1100static int tclGdCopyCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
1101 gdImagePtr imdest, imsrc;
1102 int destx, desty, srcx, srcy, destw, desth, srcw, srch;
1103
1104 /* Get the image pointer. */
1105 imdest = IMGPTR(objv[2]);
1106 imsrc = IMGPTR(objv[3]);
1107
1108 /* Get the x, y, etc. values. */
1109 if (Tcl_GetIntFromObj(interp, objv[4], &destx) != TCL_OK)
1110 return TCL_ERROR;
1111 if (Tcl_GetIntFromObj(interp, objv[5], &desty) != TCL_OK)
1112 return TCL_ERROR;
1113 if (Tcl_GetIntFromObj(interp, objv[6], &srcx) != TCL_OK)
1114 return TCL_ERROR;
1115 if (Tcl_GetIntFromObj(interp, objv[7], &srcy) != TCL_OK)
1116 return TCL_ERROR;
1117 if (Tcl_GetIntFromObj(interp, objv[8], &destw) != TCL_OK)
1118 return TCL_ERROR;
1119 if (Tcl_GetIntFromObj(interp, objv[9], &desth) != TCL_OK)
1120 return TCL_ERROR;
1121
1122 /* Call the appropriate copy function. */
1123 if (argc - 2 == 10) {
1124 if (Tcl_GetIntFromObj(interp, objv[10], &srcw) != TCL_OK)
1125 return TCL_ERROR;
1126 if (Tcl_GetIntFromObj(interp, objv[11], &srch) != TCL_OK)
1127 return TCL_ERROR;
1128
1129 gdImageCopyResized(imdest, imsrc, destx, desty, srcx, srcy, destw, desth,
1130 srcw, srch);
1131 } else
1132 gdImageCopy(imdest, imsrc, destx, desty, srcx, srcy, destw, desth);
1133
1134 return TCL_OK;
1135}
1136
1137static int tclGdGetCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
1138 (void)argc;
1139
1140 gdImagePtr im;
1141 int color, x, y;
1142
1143 /* Get the image pointer. */
1144 im = IMGPTR(objv[2]);
1145
1146 /* Get the x, y values. */
1147 if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK)
1148 return TCL_ERROR;
1149 if (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)
1150 return TCL_ERROR;
1151
1152 /* Call the Get function. */
1153 color = gdImageGetPixel(im, x, y);
1154 Tcl_SetObjResult(interp, Tcl_NewIntObj(color));
1155 return TCL_OK;
1156}
1157
1158static int tclGdSizeCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
1159 (void)argc;
1160
1161 gdImagePtr im;
1162 Tcl_Obj *answers[2];
1163
1164 /* Get the image pointer. */
1165 im = IMGPTR(objv[2]);
1166
1167 answers[0] = Tcl_NewIntObj(gdImageSX(im));
1168 answers[1] = Tcl_NewIntObj(gdImageSY(im));
1169 Tcl_SetObjResult(interp, Tcl_NewListObj(2, answers));
1170 return TCL_OK;
1171}
1172
1173static int tclGdTextCmd(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]) {
1174 /* gd gdhandle color fontname size angle x y string */
1175 gdImagePtr im;
1176 int color, x, y;
1177 double ptsize, angle;
1178 char *error, *fontname;
1179 int i, brect[8];
1180 char *str;
1181 Tcl_Obj *orect[8];
1182
1183 /* Get the image pointer. (an invalid or null arg[2] will result in string
1184 size calculation but no rendering */
1185 if (argc == 2 || (objv[2]->typePtr != &GdPtrType &&
1186 GdPtrTypeSet(NULL, objv[2]) != TCL_OK)) {
1187 im = NULL;
1188 } else {
1189 im = IMGPTR(objv[2]);
1190 }
1191
1192 /* Get the color, values. */
1193 if (tclGd_GetColor(interp, objv[3], &color) != TCL_OK) {
1194 return TCL_ERROR;
1195 }
1196
1197 /* Get point size */
1198 if (Tcl_GetDoubleFromObj(interp, objv[5], &ptsize) != TCL_OK) {
1199 return TCL_ERROR;
1200 }
1201
1202 /* Get rotation (radians) */
1203 if (Tcl_GetDoubleFromObj(interp, objv[6], &angle) != TCL_OK) {
1204 return TCL_ERROR;
1205 }
1206
1207 /* get x, y position */
1208 if (Tcl_GetIntFromObj(interp, objv[7], &x) != TCL_OK) {
1209 return TCL_ERROR;
1210 }
1211 if (Tcl_GetIntFromObj(interp, objv[8], &y) != TCL_OK) {
1212 return TCL_ERROR;
1213 }
1214
1215 str = Tcl_GetStringFromObj(objv[9], NULL);
1216 fontname = Tcl_GetString(objv[4]);
1217
1218 gdFTUseFontConfig(1);
1219 error = gdImageStringFT(im, brect, color, fontname, ptsize, angle, x, y, str);
1220
1221 if (error) {
1222 Tcl_SetResult(interp, error, TCL_VOLATILE);
1223 return TCL_ERROR;
1224 }
1225 for (i = 0; i < 8; i++) {
1226 orect[i] = Tcl_NewIntObj(brect[i]);
1227 }
1228 Tcl_SetObjResult(interp, Tcl_NewListObj(8, orect));
1229 return TCL_OK;
1230}
1231
1232/*
1233 * Initialize the package.
1234 */
1235int Gdtclft_Init(Tcl_Interp *interp) {
1236#ifdef USE_TCL_STUBS
1237 if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
1238 return TCL_ERROR;
1239 }
1240#else
1241 if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
1242 return TCL_ERROR;
1243 }
1244#endif
1245 // inter-release Graphviz versions have a number including '~dev.' that does
1246 // not comply with TCL version number rules, so replace this with 'b'
1247 char adjusted_version[sizeof(PACKAGE_VERSION)] = PACKAGE_VERSION;
1248 char *tilde_dev = strstr(adjusted_version, "~dev.");
1249 if (tilde_dev != NULL) {
1250 *tilde_dev = 'b';
1251 memmove(tilde_dev + 1, tilde_dev + strlen("~dev."),
1252 strlen(tilde_dev + strlen("~dev.")) + 1);
1253 }
1254 if (Tcl_PkgProvide(interp, "Gdtclft", adjusted_version) != TCL_OK) {
1255 return TCL_ERROR;
1256 }
1257 Tcl_CreateObjCommand(interp, "gd", gdCmd, NULL, (Tcl_CmdDeleteProc *)NULL);
1258 return TCL_OK;
1259}
1260
1261int Gdtclft_SafeInit(Tcl_Interp *interp) {
1262 Tcl_CmdInfo info;
1263 if (Gdtclft_Init(interp) != TCL_OK ||
1264 Tcl_GetCommandInfo(interp, "gd", &info) != 1)
1265 return TCL_ERROR;
1266 info.objClientData = (char *)info.objClientData + 1; /* Non-NULL */
1267 if (Tcl_SetCommandInfo(interp, "gd", &info) != 1)
1268 return TCL_ERROR;
1269 return TCL_OK;
1270}
1271
1272#ifndef __CYGWIN__
1273#ifdef __WIN32__
1274/* Define DLL entry point, standard macro */
1275
1276/*
1277 *----------------------------------------------------------------------
1278 *
1279 * DllEntryPoint --
1280 *
1281 * This wrapper function is used by Windows to invoke the
1282 * initialization code for the DLL. If we are compiling
1283 * with Visual C++, this routine will be renamed to DllMain.
1284 * routine.
1285 *
1286 * Results:
1287 * Returns TRUE;
1288 *
1289 * Side effects:
1290 * None.
1291 *
1292 *----------------------------------------------------------------------
1293 *
1294 * @param hInst Library instance handle
1295 * @param reason Reason this function is being called
1296 * @param reserved Not used
1297 */
1298BOOL APIENTRY DllEntryPoint(HINSTANCE hInst, DWORD reason, LPVOID reserved);
1299BOOL APIENTRY DllEntryPoint(HINSTANCE hInst, DWORD reason, LPVOID reserved) {
1300 (void)hInst;
1301 (void)reason;
1302 (void)reserved;
1303
1304 return TRUE;
1305}
1306#endif
1307#endif
1308
1309#ifdef HAVE_GD_PNG
1310static int BufferSinkFunc(void *context, const char *buffer, int len) {
1311 agxbuf *p = context;
1312 if (len > 0) {
1313 agxbput_n(p, buffer, (size_t)len);
1314 }
1315 return len;
1316}
1317
1318static int tclGdWriteBufCmd(Tcl_Interp *interp, int argc,
1319 Tcl_Obj *const objv[]) {
1320 (void)argc;
1321
1322 agxbuf buffer = {0};
1323 gdSink buffsink = {.sink = BufferSinkFunc, .context = &buffer};
1324 /* Get the image pointer. */
1325 gdImagePtr im = IMGPTR(objv[2]);
1326
1327 gdImagePngToSink(im, &buffsink);
1328
1329 const size_t buffer_length = agxblen(&buffer);
1330 void *const result = agxbuse(&buffer);
1331
1332 assert(buffer_length <= INT_MAX);
1333 Tcl_Obj *output = Tcl_NewByteArrayObj(result, (Tcl_Size)buffer_length);
1334 agxbfree(&buffer);
1335 if (output == NULL)
1336 return TCL_ERROR;
1337 else
1338 Tcl_IncrRefCount(output);
1339
1340 if (Tcl_ObjSetVar2(interp, objv[3], NULL, output, 0) == NULL)
1341 return TCL_ERROR;
1342 else
1343 return TCL_OK;
1344}
1345
1346static void GdPtrTypeUpdate(struct Tcl_Obj *O) {
1347 size_t len = strlen(GdPtrType.name) + (sizeof(void *) + 1) * 2 + 1;
1348 O->bytes = Tcl_Alloc(len);
1349 O->length = snprintf(O->bytes, len, "%s%p", GdPtrType.name, IMGPTR(O));
1350}
1351
1352static int GdPtrTypeSet(Tcl_Interp *I, struct Tcl_Obj *O) {
1353 if (O->bytes == NULL || O->bytes[0] == '\0' ||
1354 !startswith(O->bytes, GdPtrType.name) ||
1355 sscanf(O->bytes + strlen(GdPtrType.name), "%p", &IMGPTR(O)) != 1) {
1356 if (I != NULL)
1357 Tcl_AppendResult(I, O->bytes, " is not a ", GdPtrType.name, "-handle",
1358 NULL);
1359 return TCL_ERROR;
1360 }
1361 O->typePtr = &GdPtrType;
1362 return TCL_OK;
1363}
1364#endif
static void out(agerrlevel_t level, const char *fmt, va_list args)
Report messages using a user-supplied or default write function.
Definition agerror.c:84
static void agxbfree(agxbuf *xb)
free any malloced resources
Definition agxbuf.h:78
static size_t agxbput_n(agxbuf *xb, const char *s, size_t ssz)
append string s of length ssz into xb
Definition agxbuf.h:250
static WUR char * agxbuse(agxbuf *xb)
Definition agxbuf.h:307
static size_t agxblen(const agxbuf *xb)
return number of characters currently stored
Definition agxbuf.h:89
static char * cmd
Definition acyclic.c:40
static char * fname
#define I
Definition expr.h:71
#define O
Definition gdefs.h:8
static GdDataFunction tclGdCopyCmd
Definition gdtclft.c:55
static Tcl_ObjType GdPtrType
Definition gdtclft.c:33
static GdImgFunction tclGdColorGetCmd
Definition gdtclft.c:61
static GdDataFunction tclGdInterlaceCmd
Definition gdtclft.c:54
static cmdDataOptions subcmdVec[]
Definition gdtclft.c:80
static GdImgFunction tclGdColorTranspCmd
Definition gdtclft.c:60
static GdDataFunction tclGdSetCmd
Definition gdtclft.c:54
Tcl_AppInitProc Gdtclft_SafeInit
Definition gdtclft.c:46
static GdDataFunction tclGdRectCmd
Definition gdtclft.c:54
static GdDataFunction tclGdLineCmd
Definition gdtclft.c:54
static Tcl_UpdateStringProc GdPtrTypeUpdate
Definition gdtclft.c:31
static GdDataFunction tclGdStyleCmd
Definition gdtclft.c:56
static GdDataFunction tclGdBrushCmd
Definition gdtclft.c:56
static GdImgFunction tclGdColorResolveCmd
Definition gdtclft.c:60
static GdImgFunction tclGdColorNewCmd
Definition gdtclft.c:59
static GdDataFunction tclGdCreateCmd
Definition gdtclft.c:53
static GdImgFunction tclGdColorFreeCmd
Definition gdtclft.c:60
static GdImgFunction tclGdColorExactCmd
Definition gdtclft.c:59
static GdDataFunction tclGdDestroyCmd
Definition gdtclft.c:53
int() GdImgFunction(Tcl_Interp *interp, gdImagePtr gdImg, int argc, const int args[])
Definition gdtclft.c:50
static GdDataFunction tclGdArcCmd
Definition gdtclft.c:55
static int gdCmd(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[])
Definition gdtclft.c:351
static GdDataFunction tclGdPolygonCmd
Definition gdtclft.c:57
#define IMGPTR(O)
Definition gdtclft.c:36
static GdDataFunction tclGdSizeCmd
Definition gdtclft.c:55
static GdDataFunction tclGdWriteBufCmd
Definition gdtclft.c:56
Tcl_AppInitProc Gdtclft_Init
Definition gdtclft.c:42
static GdDataFunction tclGdWriteCmd
Definition gdtclft.c:53
static GdDataFunction tclGdGetCmd
Definition gdtclft.c:56
static GdDataFunction tclGdTextCmd
Definition gdtclft.c:55
static int tclGd_GetColor(Tcl_Interp *interp, Tcl_Obj *obj, int *color)
Definition gdtclft.c:180
static GdImgFunction tclGdColorClosestCmd
Definition gdtclft.c:59
static GdDataFunction tclGdTileCmd
Definition gdtclft.c:56
static cmdImgOptions colorCmdVec[]
Definition gdtclft.c:168
static Tcl_SetFromAnyProc GdPtrTypeSet
Definition gdtclft.c:32
static GdDataFunction tclGdFillCmd
Definition gdtclft.c:55
int() GdDataFunction(Tcl_Interp *interp, int argc, Tcl_Obj *const objv[])
Definition gdtclft.c:48
static GdDataFunction tclGdColorCmd
Definition gdtclft.c:54
static double len(glCompPoint p)
Definition glutils.c:150
node NULL
Definition grammar.y:163
static void color(Agraph_t *g)
Definition gvcolor.c:129
static const char * usage
Definition gvpr.c:47
static gdPoint * points
textitem scanner parser str
Definition htmlparse.y:224
table Syntax error
Definition htmlparse.y:294
static bool startswith(const char *s, const char *prefix)
does the string s begin with the string prefix?
Definition startswith.h:11
static bool streq(const char *a, const char *b)
are a and b equal?
Definition streq.h:11
const char * cmd
Definition gdtclft.c:64
const char * usage
Definition gdtclft.c:70
unsigned int unsafearg
Definition gdtclft.c:69
unsigned int minargs
Definition gdtclft.c:66
unsigned int maxargs
Definition gdtclft.c:66
unsigned int ishandle
Definition gdtclft.c:68
unsigned int subcmds
Definition gdtclft.c:67
GdDataFunction * f
Definition gdtclft.c:65
unsigned int minargs
Definition gdtclft.c:76
const char * cmd
Definition gdtclft.c:74
const char * usage
Definition gdtclft.c:77
unsigned int maxargs
Definition gdtclft.c:76
GdImgFunction * f
Definition gdtclft.c:75
#define Tcl_Size
Definition tcl-compat.h:33