summaryrefslogtreecommitdiffstats
path: root/generic/tkOldTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkOldTest.c')
-rw-r--r--generic/tkOldTest.c406
1 files changed, 406 insertions, 0 deletions
diff --git a/generic/tkOldTest.c b/generic/tkOldTest.c
new file mode 100644
index 0000000..473d92c
--- /dev/null
+++ b/generic/tkOldTest.c
@@ -0,0 +1,406 @@
+/*
+ * tkOldTest.c --
+ *
+ * This file contains C command functions for additional Tcl
+ * commands that are used to test Tk's support for legacy
+ * interfaces. These commands are not normally included in Tcl/Tk
+ * applications; they're only used for testing.
+ *
+ * Copyright (c) 1993-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Contributions by Don Porter, NIST, 2007. (not subject to US copyright)
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tkOldTest.c,v 1.1 2007/05/14 20:58:27 dgp Exp $
+ */
+
+#define USE_OLD_IMAGE
+#include "tkInt.h"
+
+/*
+ * The following data structure represents the master for a test image:
+ */
+
+typedef struct TImageMaster {
+ Tk_ImageMaster master; /* Tk's token for image master. */
+ Tcl_Interp *interp; /* Interpreter for application. */
+ int width, height; /* Dimensions of image. */
+ char *imageName; /* Name of image (malloc-ed). */
+ char *varName; /* Name of variable in which to log events for
+ * image (malloc-ed). */
+} TImageMaster;
+
+/*
+ * The following data structure represents a particular use of a particular
+ * test image.
+ */
+
+typedef struct TImageInstance {
+ TImageMaster *masterPtr; /* Pointer to master for image. */
+ XColor *fg; /* Foreground color for drawing in image. */
+ GC gc; /* Graphics context for drawing in image. */
+} TImageInstance;
+
+/*
+ * The type record for test images:
+ */
+
+static int ImageCreate(Tcl_Interp *interp,
+ char *name, int argc, char **argv,
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr);
+static ClientData ImageGet(Tk_Window tkwin, ClientData clientData);
+static void ImageDisplay(ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width,
+ int height, int drawableX,
+ int drawableY);
+static void ImageFree(ClientData clientData, Display *display);
+static void ImageDelete(ClientData clientData);
+
+static Tk_ImageType imageType = {
+ "oldtest", /* name */
+ (Tk_ImageCreateProc *) ImageCreate, /* createProc */
+ ImageGet, /* getProc */
+ ImageDisplay, /* displayProc */
+ ImageFree, /* freeProc */
+ ImageDelete, /* deleteProc */
+ NULL, /* postscriptPtr */
+ NULL /* nextPtr */
+};
+
+/*
+ * Forward declarations for functions defined later in this file:
+ */
+
+static int ImageCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, CONST char **argv);
+MODULE_SCOPE int TkOldTestInit(Tcl_Interp *interp);
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkOldTestInit --
+ *
+ * This function performs intialization for the Tk test suite
+ * extensions for testing support for legacy interfaces.
+ *
+ * Results:
+ * Returns a standard Tcl completion code, and leaves an error message in
+ * the interp's result if an error occurs.
+ *
+ * Side effects:
+ * Creates several test commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkOldTestInit(
+ Tcl_Interp *interp)
+{
+ static int initialized = 0;
+
+ if (!initialized) {
+ initialized = 1;
+ Tk_CreateImageType(&imageType);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageCreate --
+ *
+ * This function is called by the Tk image code to create "oldtest" images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new image is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImageCreate(
+ Tcl_Interp *interp, /* Interpreter for application containing
+ * image. */
+ char *name, /* Name to use for image. */
+ int argc, /* Number of arguments. */
+ char **argv, /* Argument strings for options (doesn't
+ * include image name or type). */
+ Tk_ImageType *typePtr, /* Pointer to our type record (not used). */
+ Tk_ImageMaster master, /* Token for image, to be used by us in later
+ * callbacks. */
+ ClientData *clientDataPtr) /* Store manager's token for image here; it
+ * will be returned in later callbacks. */
+{
+ TImageMaster *timPtr;
+ char *varName;
+ int i;
+
+ varName = "log";
+ for (i = 0; i < argc; i += 2) {
+ if (strcmp(argv[i], "-variable") != 0) {
+ Tcl_AppendResult(interp, "bad option name \"",
+ argv[i], "\"", NULL);
+ return TCL_ERROR;
+ }
+ if ((i+1) == argc) {
+ Tcl_AppendResult(interp, "no value given for \"",
+ argv[i], "\" option", NULL);
+ return TCL_ERROR;
+ }
+ varName = argv[i+1];
+ }
+
+ timPtr = (TImageMaster *) ckalloc(sizeof(TImageMaster));
+ timPtr->master = master;
+ timPtr->interp = interp;
+ timPtr->width = 30;
+ timPtr->height = 15;
+ timPtr->imageName = (char *) ckalloc((unsigned) (strlen(name) + 1));
+ strcpy(timPtr->imageName, name);
+ timPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1));
+ strcpy(timPtr->varName, varName);
+ Tcl_CreateCommand(interp, name, ImageCmd, (ClientData) timPtr, NULL);
+ *clientDataPtr = (ClientData) timPtr;
+ Tk_ImageChanged(master, 0, 0, 30, 15, 30, 15);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageCmd --
+ *
+ * This function implements the commands corresponding to individual
+ * images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Forces windows to be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImageCmd(
+ ClientData clientData, /* Main window for application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ CONST char **argv) /* Argument strings. */
+{
+ TImageMaster *timPtr = (TImageMaster *) clientData;
+ int x, y, width, height;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], "option ?arg arg ...?", NULL);
+ return TCL_ERROR;
+ }
+ if (strcmp(argv[1], "changed") == 0) {
+ if (argc != 8) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " changed x y width height imageWidth imageHeight", NULL);
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[4], &width) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[5], &height) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[6], &timPtr->width) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[7], &timPtr->height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width,
+ timPtr->height);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be changed", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageGet --
+ *
+ * This function is called by Tk to set things up for using a test image
+ * in a particular widget.
+ *
+ * Results:
+ * The return value is a token for the image instance, which is used in
+ * future callbacks to ImageDisplay and ImageFree.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+ImageGet(
+ Tk_Window tkwin, /* Token for window in which image will be
+ * used. */
+ ClientData clientData) /* Pointer to TImageMaster for image. */
+{
+ TImageMaster *timPtr = (TImageMaster *) clientData;
+ TImageInstance *instPtr;
+ char buffer[100];
+ XGCValues gcValues;
+
+ sprintf(buffer, "%s get", timPtr->imageName);
+ Tcl_SetVar(timPtr->interp, timPtr->varName, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+
+ instPtr = (TImageInstance *) ckalloc(sizeof(TImageInstance));
+ instPtr->masterPtr = timPtr;
+ instPtr->fg = Tk_GetColor(timPtr->interp, tkwin, "#ff0000");
+ gcValues.foreground = instPtr->fg->pixel;
+ instPtr->gc = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ return (ClientData) instPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageDisplay --
+ *
+ * This function is invoked to redisplay part or all of an image in a
+ * given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image gets partially redrawn, as an "X" that shows the exact
+ * redraw area.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageDisplay(
+ ClientData clientData, /* Pointer to TImageInstance for image. */
+ Display *display, /* Display to use for drawing. */
+ Drawable drawable, /* Where to redraw image. */
+ int imageX, int imageY, /* Origin of area to redraw, relative to
+ * origin of image. */
+ int width, int height, /* Dimensions of area to redraw. */
+ int drawableX, int drawableY)
+ /* Coordinates in drawable corresponding to
+ * imageX and imageY. */
+{
+ TImageInstance *instPtr = (TImageInstance *) clientData;
+ char buffer[200 + TCL_INTEGER_SPACE * 6];
+
+ sprintf(buffer, "%s display %d %d %d %d %d %d",
+ instPtr->masterPtr->imageName, imageX, imageY, width, height,
+ drawableX, drawableY);
+ Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ if (width > (instPtr->masterPtr->width - imageX)) {
+ width = instPtr->masterPtr->width - imageX;
+ }
+ if (height > (instPtr->masterPtr->height - imageY)) {
+ height = instPtr->masterPtr->height - imageY;
+ }
+ XDrawRectangle(display, drawable, instPtr->gc, drawableX, drawableY,
+ (unsigned) (width-1), (unsigned) (height-1));
+ XDrawLine(display, drawable, instPtr->gc, drawableX, drawableY,
+ (int) (drawableX + width - 1), (int) (drawableY + height - 1));
+ XDrawLine(display, drawable, instPtr->gc, drawableX,
+ (int) (drawableY + height - 1),
+ (int) (drawableX + width - 1), drawableY);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageFree --
+ *
+ * This function is called when an instance of an image is no longer
+ * used.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information related to the instance is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageFree(
+ ClientData clientData, /* Pointer to TImageInstance for instance. */
+ Display *display) /* Display where image was to be drawn. */
+{
+ TImageInstance *instPtr = (TImageInstance *) clientData;
+ char buffer[200];
+
+ sprintf(buffer, "%s free", instPtr->masterPtr->imageName);
+ Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ Tk_FreeColor(instPtr->fg);
+ Tk_FreeGC(display, instPtr->gc);
+ ckfree((char *) instPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageDelete --
+ *
+ * This function is called to clean up a test image when an application
+ * goes away.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information about the image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageDelete(
+ ClientData clientData) /* Pointer to TImageMaster for image. When
+ * this function is called, no more instances
+ * exist. */
+{
+ TImageMaster *timPtr = (TImageMaster *) clientData;
+ char buffer[100];
+
+ sprintf(buffer, "%s delete", timPtr->imageName);
+ Tcl_SetVar(timPtr->interp, timPtr->varName, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+
+ Tcl_DeleteCommand(timPtr->interp, timPtr->imageName);
+ ckfree(timPtr->imageName);
+ ckfree(timPtr->varName);
+ ckfree((char *) timPtr);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */