1 /*
2 * tkOldTest.c --
3 *
4 * This file contains C command functions for additional Tcl
5 * commands that are used to test Tk's support for legacy
6 * interfaces. These commands are not normally included in Tcl/Tk
7 * applications; they're only used for testing.
8 *
9 * Copyright (c) 1993-1994 The Regents of the University of California.
10 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
11 * Copyright (c) 1998-1999 by Scriptics Corporation.
12 * Contributions by Don Porter, NIST, 2007. (not subject to US copyright)
13 *
14 * See the file "license.terms" for information on usage and redistribution of
15 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
16 */
17
18 #define USE_OLD_IMAGE
19 #ifndef USE_TCL_STUBS
20 # define USE_TCL_STUBS
21 #endif
22 #ifndef USE_TK_STUBS
23 # define USE_TK_STUBS
24 #endif
25 #include "tkInt.h"
26
27 /*
28 * The following data structure represents the model for a test image:
29 */
30
31 typedef struct TImageModel {
32 Tk_ImageModel model; /* Tk's token for image model. */
33 Tcl_Interp *interp; /* Interpreter for application. */
34 int width, height; /* Dimensions of image. */
35 char *imageName; /* Name of image (malloc-ed). */
36 char *varName; /* Name of variable in which to log events for
37 * image (malloc-ed). */
38 } TImageModel;
39
40 /*
41 * The following data structure represents a particular use of a particular
42 * test image.
43 */
44
45 typedef struct TImageInstance {
46 TImageModel *modelPtr; /* Pointer to model for image. */
47 XColor *fg; /* Foreground color for drawing in image. */
48 GC gc; /* Graphics context for drawing in image. */
49 } TImageInstance;
50
51 /*
52 * The type record for test images:
53 */
54
55 static int ImageCreate(Tcl_Interp *interp,
56 char *name, int argc, char **argv,
57 Tk_ImageType *typePtr, Tk_ImageModel model,
58 ClientData *clientDataPtr);
59 static ClientData ImageGet(Tk_Window tkwin, ClientData clientData);
60 static void ImageDisplay(ClientData clientData,
61 Display *display, Drawable drawable,
62 int imageX, int imageY, int width,
63 int height, int drawableX,
64 int drawableY);
65 static void ImageFree(ClientData clientData, Display *display);
66 static void ImageDelete(ClientData clientData);
67
68 static Tk_ImageType imageType = {
69 "oldtest", /* name */
70 (Tk_ImageCreateProc *) ImageCreate, /* createProc */
71 ImageGet, /* getProc */
72 ImageDisplay, /* displayProc */
73 ImageFree, /* freeProc */
74 ImageDelete, /* deleteProc */
75 NULL, /* postscriptPtr */
76 NULL, /* nextPtr */
77 NULL
78 };
79
80 /*
81 * Forward declarations for functions defined later in this file:
82 */
83
84 static int ImageObjCmd(ClientData dummy,
85 Tcl_Interp *interp, int objc,
86 Tcl_Obj * const objv[]);
87
88
89 /*
90 *----------------------------------------------------------------------
91 *
92 * TkOldTestInit --
93 *
94 * This function performs initialization for the Tk test suite
95 * extensions for testing support for legacy interfaces.
96 *
97 * Results:
98 * Returns a standard Tcl completion code, and leaves an error message in
99 * the interp's result if an error occurs.
100 *
101 * Side effects:
102 * Creates several test commands.
103 *
104 *----------------------------------------------------------------------
105 */
106
107 int
TkOldTestInit(Tcl_Interp * interp)108 TkOldTestInit(
109 Tcl_Interp *interp)
110 {
111 static int initialized = 0;
112
113 if (!initialized) {
114 initialized = 1;
115 Tk_CreateImageType(&imageType);
116 }
117 return TCL_OK;
118 }
119
120 /*
121 *----------------------------------------------------------------------
122 *
123 * ImageCreate --
124 *
125 * This function is called by the Tk image code to create "oldtest" images.
126 *
127 * Results:
128 * A standard Tcl result.
129 *
130 * Side effects:
131 * The data structure for a new image is allocated.
132 *
133 *----------------------------------------------------------------------
134 */
135
136 /* ARGSUSED */
137 static int
ImageCreate(Tcl_Interp * interp,char * name,int argc,char ** argv,Tk_ImageType * typePtr,Tk_ImageModel model,ClientData * clientDataPtr)138 ImageCreate(
139 Tcl_Interp *interp, /* Interpreter for application containing
140 * image. */
141 char *name, /* Name to use for image. */
142 int argc, /* Number of arguments. */
143 char **argv, /* Argument strings for options (doesn't
144 * include image name or type). */
145 Tk_ImageType *typePtr, /* Pointer to our type record (not used). */
146 Tk_ImageModel model, /* Token for image, to be used by us in later
147 * callbacks. */
148 ClientData *clientDataPtr) /* Store manager's token for image here; it
149 * will be returned in later callbacks. */
150 {
151 TImageModel *timPtr;
152 const char *varName;
153 int i;
154
155 varName = "log";
156 for (i = 0; i < argc; i += 2) {
157 if (strcmp(argv[i], "-variable") != 0) {
158 Tcl_AppendResult(interp, "bad option name \"",
159 argv[i], "\"", NULL);
160 return TCL_ERROR;
161 }
162 if ((i+1) == argc) {
163 Tcl_AppendResult(interp, "no value given for \"",
164 argv[i], "\" option", NULL);
165 return TCL_ERROR;
166 }
167 varName = argv[i+1];
168 }
169
170 timPtr = ckalloc(sizeof(TImageModel));
171 timPtr->model = model;
172 timPtr->interp = interp;
173 timPtr->width = 30;
174 timPtr->height = 15;
175 timPtr->imageName = ckalloc(strlen(name) + 1);
176 strcpy(timPtr->imageName, name);
177 timPtr->varName = ckalloc(strlen(varName) + 1);
178 strcpy(timPtr->varName, varName);
179 Tcl_CreateObjCommand(interp, name, ImageObjCmd, timPtr, NULL);
180 *clientDataPtr = timPtr;
181 Tk_ImageChanged(model, 0, 0, 30, 15, 30, 15);
182 return TCL_OK;
183 }
184
185 /*
186 *----------------------------------------------------------------------
187 *
188 * ImageObjCmd --
189 *
190 * This function implements the commands corresponding to individual
191 * images.
192 *
193 * Results:
194 * A standard Tcl result.
195 *
196 * Side effects:
197 * Forces windows to be created.
198 *
199 *----------------------------------------------------------------------
200 */
201
202 /* ARGSUSED */
203 static int
ImageObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])204 ImageObjCmd(
205 ClientData clientData, /* Main window for application. */
206 Tcl_Interp *interp, /* Current interpreter. */
207 int objc, /* Number of arguments. */
208 Tcl_Obj *const objv[]) /* Argument strings. */
209 {
210 TImageModel *timPtr = clientData;
211 int x, y, width, height;
212
213 if (objc < 2) {
214 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
215 return TCL_ERROR;
216 }
217 if (strcmp(Tcl_GetString(objv[1]), "changed") == 0) {
218 if (objc != 8) {
219 Tcl_WrongNumArgs(interp, 1, objv, "changed x y width height"
220 " imageWidth imageHeight");
221 return TCL_ERROR;
222 }
223 if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
224 || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)
225 || (Tcl_GetIntFromObj(interp, objv[4], &width) != TCL_OK)
226 || (Tcl_GetIntFromObj(interp, objv[5], &height) != TCL_OK)
227 || (Tcl_GetIntFromObj(interp, objv[6], &timPtr->width) != TCL_OK)
228 || (Tcl_GetIntFromObj(interp, objv[7], &timPtr->height) != TCL_OK)) {
229 return TCL_ERROR;
230 }
231 Tk_ImageChanged(timPtr->model, x, y, width, height, timPtr->width,
232 timPtr->height);
233 } else {
234 Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
235 "\": must be changed", NULL);
236 return TCL_ERROR;
237 }
238 return TCL_OK;
239 }
240
241 /*
242 *----------------------------------------------------------------------
243 *
244 * ImageGet --
245 *
246 * This function is called by Tk to set things up for using a test image
247 * in a particular widget.
248 *
249 * Results:
250 * The return value is a token for the image instance, which is used in
251 * future callbacks to ImageDisplay and ImageFree.
252 *
253 * Side effects:
254 * None.
255 *
256 *----------------------------------------------------------------------
257 */
258
259 static ClientData
ImageGet(Tk_Window tkwin,ClientData clientData)260 ImageGet(
261 Tk_Window tkwin, /* Token for window in which image will be
262 * used. */
263 ClientData clientData) /* Pointer to TImageModel for image. */
264 {
265 TImageModel *timPtr = clientData;
266 TImageInstance *instPtr;
267 char buffer[100];
268 XGCValues gcValues;
269
270 sprintf(buffer, "%s get", timPtr->imageName);
271 Tcl_SetVar2(timPtr->interp, timPtr->varName, NULL, buffer,
272 TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
273
274 instPtr = ckalloc(sizeof(TImageInstance));
275 instPtr->modelPtr = timPtr;
276 instPtr->fg = Tk_GetColor(timPtr->interp, tkwin, "#ff0000");
277 gcValues.foreground = instPtr->fg->pixel;
278 instPtr->gc = Tk_GetGC(tkwin, GCForeground, &gcValues);
279 return instPtr;
280 }
281
282 /*
283 *----------------------------------------------------------------------
284 *
285 * ImageDisplay --
286 *
287 * This function is invoked to redisplay part or all of an image in a
288 * given drawable.
289 *
290 * Results:
291 * None.
292 *
293 * Side effects:
294 * The image gets partially redrawn, as an "X" that shows the exact
295 * redraw area.
296 *
297 *----------------------------------------------------------------------
298 */
299
300 static void
ImageDisplay(ClientData clientData,Display * display,Drawable drawable,int imageX,int imageY,int width,int height,int drawableX,int drawableY)301 ImageDisplay(
302 ClientData clientData, /* Pointer to TImageInstance for image. */
303 Display *display, /* Display to use for drawing. */
304 Drawable drawable, /* Where to redraw image. */
305 int imageX, int imageY, /* Origin of area to redraw, relative to
306 * origin of image. */
307 int width, int height, /* Dimensions of area to redraw. */
308 int drawableX, int drawableY)
309 /* Coordinates in drawable corresponding to
310 * imageX and imageY. */
311 {
312 TImageInstance *instPtr = clientData;
313 char buffer[200 + TCL_INTEGER_SPACE * 6];
314
315 sprintf(buffer, "%s display %d %d %d %d %d %d",
316 instPtr->modelPtr->imageName, imageX, imageY, width, height,
317 drawableX, drawableY);
318 Tcl_SetVar2(instPtr->modelPtr->interp, instPtr->modelPtr->varName, NULL,
319 buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
320 if (width > (instPtr->modelPtr->width - imageX)) {
321 width = instPtr->modelPtr->width - imageX;
322 }
323 if (height > (instPtr->modelPtr->height - imageY)) {
324 height = instPtr->modelPtr->height - imageY;
325 }
326 XDrawRectangle(display, drawable, instPtr->gc, drawableX, drawableY,
327 (unsigned) (width-1), (unsigned) (height-1));
328 XDrawLine(display, drawable, instPtr->gc, drawableX, drawableY,
329 (int) (drawableX + width - 1), (int) (drawableY + height - 1));
330 XDrawLine(display, drawable, instPtr->gc, drawableX,
331 (int) (drawableY + height - 1),
332 (int) (drawableX + width - 1), drawableY);
333 }
334
335 /*
336 *----------------------------------------------------------------------
337 *
338 * ImageFree --
339 *
340 * This function is called when an instance of an image is no longer
341 * used.
342 *
343 * Results:
344 * None.
345 *
346 * Side effects:
347 * Information related to the instance is freed.
348 *
349 *----------------------------------------------------------------------
350 */
351
352 static void
ImageFree(ClientData clientData,Display * display)353 ImageFree(
354 ClientData clientData, /* Pointer to TImageInstance for instance. */
355 Display *display) /* Display where image was to be drawn. */
356 {
357 TImageInstance *instPtr = clientData;
358 char buffer[200];
359
360 sprintf(buffer, "%s free", instPtr->modelPtr->imageName);
361 Tcl_SetVar2(instPtr->modelPtr->interp, instPtr->modelPtr->varName, NULL,
362 buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
363 Tk_FreeColor(instPtr->fg);
364 Tk_FreeGC(display, instPtr->gc);
365 ckfree(instPtr);
366 }
367
368 /*
369 *----------------------------------------------------------------------
370 *
371 * ImageDelete --
372 *
373 * This function is called to clean up a test image when an application
374 * goes away.
375 *
376 * Results:
377 * None.
378 *
379 * Side effects:
380 * Information about the image is deleted.
381 *
382 *----------------------------------------------------------------------
383 */
384
385 static void
ImageDelete(ClientData clientData)386 ImageDelete(
387 ClientData clientData) /* Pointer to TImageModel for image. When
388 * this function is called, no more instances
389 * exist. */
390 {
391 TImageModel *timPtr = clientData;
392 char buffer[100];
393
394 sprintf(buffer, "%s delete", timPtr->imageName);
395 Tcl_SetVar2(timPtr->interp, timPtr->varName, NULL, buffer,
396 TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
397
398 Tcl_DeleteCommand(timPtr->interp, timPtr->imageName);
399 ckfree(timPtr->imageName);
400 ckfree(timPtr->varName);
401 ckfree(timPtr);
402 }
403
404 /*
405 * Local Variables:
406 * mode: c
407 * c-basic-offset: 4
408 * fill-column: 78
409 * End:
410 */
411