home | O'Reilly's CD bookshelfs | FreeBSD | Linux | Cisco | Cisco Exam  


Book HomeMastering Perl/TkSearch this book

Chapter 21. C Widget Internals

Chances are you'll never have to deal with Tk widgets at the C level, because the existing toolkit is so rich, and because you can quickly and efficiently build new mega-widgets using the powerful techniques described in Chapter 14, "Creating Custom Widgets in Pure Perl/Tk". But there may come a time when you have to leave the cozy world of Perl and delve into C, perhaps because of efficiency considerations, or a missing system call, or maybe because you have an existing Tcl/Tk C widget you'd like to port to Perl/Tk.

In this chapter, we'll closely examine a simple (but real) C widget and see how to package, build, test, and install it. This is a Unix-centric chapter, because we have no Win32 development environment. But the porting essentials are still relevant.

21.1. The Tk::Square Widget

The Tcl/Tk distribution contains a Square widget that demonstrates the basic structure of a C widget. It's a simple square of variable size and color that can be moved around a window by dragging it with a mouse. It has a keyboard binding to an "a" that starts and stops an animation that varies the widget's size over time, so that it appears to throb.

21.1.1. Tcl/Tk Example

Although Perl/Tk code produced Figure 21-1, this Tcl/Tk example creates an identical window. The square widget, .s, is packed, assigned three bindings, and given the keyboard focus. The mouse button bindings move the square to the cursor's current position, and the "a" binding toggles the animation's state. In the Perl/Tk version, we'll see how to move the bindings into the Tk::Square class proper (seems reasonable, since it's unclear exactly what a square widget should do anyway).

square .s
pack .s -expand yes -fill both

bind .s <1> {move %x %y}
bind .s <B1-Motion> {move %x %y}
bind .s a animate
focus .s 
Figure 21-1

Figure 21-1. A Tk::Square with a raised relief

This procedure moves the square to a given position. The (x, y) coordinate comes from the %x and %y binding codes, analogous to the $Tk::event->x and $Tk::event->y calls. The size method returns the pixel length of the square's side, and the position method actually repositions the square.

proc move {x y} {
    set a [.s size]
    .s position [expr $x-($a/2)] [expr $y-($a/2)]
}

These procedures start and stop a 30-millisecond timer event that makes the square throb, cyclically changing its size from small to large. Trying to translate this Tcl/Tk code directly to Perl/Tk leads to deep recursion in the timer procedure, but we'll see the Perlish way around this problem in a later section. Note that size is a dual-purpose get/get command.

set inc 0
proc animate {} {
    global inc
    if {$inc == 0} {
        set inc 3
        timer
    } else {
        set inc 0
    }
}

proc timer {} {
    global inc
    set s [.s size]
    if {$inc == 0} return
    if {$s >= 40} {set inc -3}
    if {$s <= 10} {set inc 3}
    .s size [expr {$s+$inc}]
    after 30 timer
}

21.1.2. Overview of the Perl/Tk Distribution

A global view of the Perl/Tk distribution will prove useful as we develop C widgets, primarily because we need to pattern our new widgets' directory structures after the Perl/Tk core structure. There are also similarities in filenames and file contents we can use. The entire distribution is quite intimidating when you first see it, so let's weed out the chaff and see what's really important.

Perl/Tk for Unix is distributed as a gzipped tar file, which, after unpacking, leaves us with a distribution directory containing 201 files.[57]

[57] Tk 800.017 was used for this test.

If we eliminate all the demo and test programs, we're down to 161 files. Now get rid of all the bug programs, miscellaneous scripts Nick uses for routine maintenance and debugging, change logs, widget demos, tests, and README files, and we're down to 43 files, the heart of Tk extension for Perl:

drwxr-xr-x  2 bug  users     65 Jan 18 14:45 Bitmap
drwxr-xr-x  2 bug  users     98 Jan 18 14:45 Canvas
drwxr-xr-x  2 bug  users     91 Jan 18 14:45 Compound
drwxr-xr-x  3 bug  users    101 Jan 18 14:45 Contrib
drwxr-xr-x  4 bug  users   4096 Jan 18 14:45 DragDrop
drwxr-xr-x  2 bug  users     63 Jan 18 14:45 Entry
drwxr-xr-x  3 bug  users   4096 Jan 18 14:45 Event
drwxr-xr-x  3 bug  users     27 Jan 18 13:11 Extensions
drwxr-xr-x  2 bug  users     80 Jan 18 14:45 HList
drwxr-xr-x  2 bug  users     57 Jan 18 14:45 IO
drwxr-xr-x  2 bug  users     84 Jan 18 14:45 InputO
drwxr-xr-x  2 bug  users     67 Jan 18 14:45 Listbox
-r--r--r--  1 bug  users  32646 Jan  8 07:21 MANIFEST
-r--r--r--  1 bug  users   3964 Dec 12 08:58 Makefile.PL
drwxr-xr-x  2 bug  users     73 Jan 18 14:45 Menubutton
drwxr-xr-x  2 bug  users     78 Jan 18 14:45 Mwm
drwxr-xr-x  2 bug  users     67 Jan 18 14:45 NBFrame
drwxr-xr-x  2 bug  users     63 Jan 18 14:45 Photo
drwxr-xr-x  2 bug  users     63 Jan 18 14:45 Scale
drwxr-xr-x  2 bug  users     71 Jan 18 14:45 Scrollbar
drwxr-xr-x  2 bug  users     63 Jan 18 14:45 TList
drwxr-xr-x  3 bug  users     89 Jan 18 14:45 Text
drwxr-xr-x  2 bug  users   4096 Jan 18 14:45 TixGrid
drwxr-xr-x  2 bug  users     65 Jan 18 14:45 TixPixmap
drwxr-xr-x  4 bug  users   4096 Jan 18 14:45 Tixish
drwxr-xr-x  3 bug  users   4096 Jan 18 14:45 Tk
-r--r--r--  1 bug  users  14457 Dec 23 17:22 Tk.pm
drwxr-xr-x  2 bug  users    100 Jan 18 14:45 WinPhoto
drwxr-xr-x  3 bug  users   4096 Jan 18 14:45 Xlib
-r--r--r--  1 bug  users   2029 Jul 27 14:20 chnGlue.c
-r--r--r--  1 bug  users   2944 Jul 27 14:20 evtGlue.c
-r--r--r--  1 bug  users  18202 Dec 12 08:58 objGlue.c
drwxr-xr-x  6 bug  users   4096 Jan 18 14:45 pTk
drwxr-xr-x  5 bug  users   4096 Jan 18 14:45 pod
-r--r--r--  1 bug  users    910 Jul 27 14:21 tixGlue.c
-r--r--r--  1 bug  users 104480 Jan  5 15:14 tkGlue.c
-r--r--r--  1 bug  users   2061 Nov 19 07:30 tkGlue.def
-r--r--r--  1 bug  users     55 Nov 20 16:19 tkGlue.exc
-r--r--r--  1 bug  users   3744 Dec 19 10:49 tkGlue.h
-r--r--r--  1 bug  users   1418 Dec 19 10:49 tkGlue.m
-r--r--r--  1 bug  users   1780 Dec 19 10:49 tkGlue.t
-r--r--r--  1 bug  users    562 Jul 27 14:21 tkGlue_f.c
-r--r--r--  1 bug  users    327 Jul 27 14:21 tkGlue_f.h

There are lots of familiar terms and widget names in that list, mostly directories containing .xs, .pm, and make files. Then there are the glue files that act as intermediaries between the Tcl C code and Perl. Tk.pm is important because it acts as the lowest Tk base class, even more basic than Widget.pm. And of course, where would we be without the pod directory of documentation? Important as these files and directories are, for our current task, this is all we are interested in:

-r--r--r--  1 bug  users  32646 Jan  8 07:21 MANIFEST
-r--r--r--  1 bug  users   3964 Dec 12 08:58 Makefile.PL
drwxr-xr-x  6 bug  users   4096 Jan 18 14:45 pTk

The MANIFEST is a MakeMaker utility file that lists the files and directories that must be in the distribution for Perl/Tk to build and function properly. Makefile.PL is an actual Perl program that uses MakeMaker commands to produce a customized Makefile suitable for maintaining, building, and installing a Perl extension. The pTk directory contains most of the Perl-ized C source code, and its subdirectory pTk/mTk ("m" for munge, modify, or mainline) contains the original Tcl/Tk (and Tix) C source code, with minimal hand edits.

We are going to build a parallel directory structure outside the Perl/Tk distribution (named Tk-Square-1.0), assemble required components, and port Tk::Square there (see Figure 21-2). And although, in practice, you shouldn't actually merge the code with the Perl/Tk core, we'll still review the requisite steps.

Figure 21-2

Figure 21-2. Tk::Square directory structure parallels core Tk

21.1.3. Layout of a Typical C Widget

Let's see how real C widgets are written. Typical Tcl/Tk widgets begin life in the directory pTk/mTk/generic, so we want to store tkSquare.c, the Tk::Square Tcl C source code, in a similar location. In its raw form, this C code has no hope of interfacing with Perl, but there's a tiny translator that handles the grunt work. The program, pTk/Tcl-pTk, works best on Tcl/Tk 8 source files, but can be of use even for Tix and Tcl/Tk 3/4 source files.[58] We don't usually run this program by hand, because the build process does it for us automatically. The translated source file is stored in the pTk directory.[59]

[58] Unfortunately it only makes simple syntax changes. The Tcl/Tk API changed so radically for Tk 8 that you'll be forced to make many more changes by hand. Common items include font structure and method changes, and API calls whose names changed from Tk_ to Tcl_ when the Tk event loop was moved into Tcl. Your best source of information will be the Perl/Tk discussion group and mailing list.

[59] Essentially, make runs Tcl-pTk/mTk/generic/tkSquare.c tkSquare.c.

But the translator most likely won't do a perfect job, so any hand edits we make must be done to pTk/mTk/generic/tkSquare.c, and the make repeated. For instance, the Tcl name for the widget creation subroutine is SquareCmd, but the Perl/Tk convention requires it be Tk_SquareCmd. And the original include directives:

/*#include "tkPort.h"*/
/*#include "tk.h"*/

will not work and must be replaced with the following (it's critical to have all these includes in the proper order):

#include "tkPort.h"
#include "default.h"
#include "tkInt.h"
#include "tkVMacro.h"

To fully understand the following code, you should be familiar with Xlib programming and the Tk toolkit library. All the Tk documents have been podified and are located in the directory pod/pTk. Note that this code is the fully functioning Perl/Tk version, not the original Tcl/Tk source.

21.1.3.1. Tk::Square instance structure

Every Tk::Square instance is in reality modeled by a C Square structure. The widget creation subroutine, Tk_SquareCmd, mallocs memory for the structure, then initializes its members. Although programming at the C level is not object oriented, we can think of the Square structure as an object that maintains the widget's entire state. During widget destruction, we must release the structure's allocated memory.

typedef struct {
    Tk_Window tkwin;        /* Window that embodies the square.  NULL
                             * means window has been deleted but
                             * widget record hasn't been cleaned up yet. */
    Display *display;       /* X's token for the window's display. */
    Tcl_Interp *interp;     /* Interpreter associated with widget. */
    Tcl_Command widgetCmd;  /* Token for square's widget command. */
    int x, y;               /* Position of square's upper-left corner
                             * within widget. */
    int size;               /* Width and height of square. */

    int borderWidth;        /* Width of 3-D border around whole widget. */
    Tk_3DBorder bgBorder;   /* Used for drawing background. */
    Tk_3DBorder fgBorder;   /* For drawing square. */
    int relief;             /* Indicates whether window as a whole is
                             * raised, sunken, or flat. */
    GC gc;                  /* Graphics context for copying from
                             * off-screen pixmap onto screen. */
    int doubleBuffer;       /* Non-zero means double-buffer redisplay
                             * with pixmap;  zero means draw straight
                             * onto the display. */
    int updatePending;      /* Non-zero means a call to SquareDisplay
                             * has already been scheduled. */
} Square;

21.1.3.2. Tk::Square configuration specifications

The following table of configuration specifications should look strikingly familiar. Yes, here we define the legal widget options, which can appear on the widget creation command, or cget and configure methods. The first element of each option describes what it is, followed by the option name, resource DB name, resource DB class, and default value (the same as a ConfigSpecs entry for a Perl mega-widget).

One interesting option is -dbl, which specifies how the widget is displayed. For efficiency, and to reduce flicker, widgets are often double buffered; that is, drawn in an off-screen pixmap and then displayed. If -dbl is disabled (false), the widget is drawn directly to the screen.

static Tk_ConfigSpec configSpecs[] = {
    {TK_CONFIG_BORDER, "-background", "background", "Background",
            "#d9d9d9", Tk_Offset(Square, bgBorder), TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_BORDER, "-background", "background", "Background",
            "white", Tk_Offset(Square, bgBorder), TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_SYNONYM, "-bd", "borderWidth", NULL,
            NULL, 0, 0},
    {TK_CONFIG_SYNONYM, "-bg", "background", NULL,
            NULL, 0, 0},
    {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
            "2", Tk_Offset(Square, borderWidth), 0},
    {TK_CONFIG_INT, "-dbl", "doubleBuffer", "DoubleBuffer",
            "1", Tk_Offset(Square, doubleBuffer), 0},
    {TK_CONFIG_SYNONYM, "-fg", "foreground", NULL,
            NULL, 0, 0},
    {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground",
            "#b03060", Tk_Offset(Square, fgBorder), TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground",
            "black", Tk_Offset(Square, fgBorder), TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
            "raised", Tk_Offset(Square, relief), 0},
    {TK_CONFIG_END, NULL, NULL, NULL,
             NULL, 0, 0}
};

21.1.3.3. Tk::Square instance constructor

All C widgets have a creation command of the form 'Tk_' . $widget_class . 'Cmd', in this case, Tk_SquareCmd. When an object of class Square is instantiated, the subroutine is called and it allocates, initializes, and configures a Square struct, and returns a standard Tcl integer result. The next section describes how the function is advertised so the rest of Tk can see it, and we can create widgets.

In Tcl, the ClientData parameter is a single word that can hold an integer or pointer value. Its interpretation is application specific, and Tk uses it to hold various data, such as the Tk_Window or Square struct pointers. If this were Tcl/Tk code, Tcl_Interp would point to an instance of the wish interpreter, but in Perl/Tk, it's a private Perl object[60] that should be left alone. Arguments are passed just like shell command-line arguments, with an argument count and a pointer to a list of strings.

[60] As of Tk 800.018, it maps Tk_Window pathnames to Perl objects and is subject to change without notice.

int
Tk_SquareCmd(clientData, interp, argc, args)
    ClientData clientData;   /* Main window associated with
                              * interpreter. */
    Tcl_Interp *interp;      /* Current interpreter. */
    int argc;                /* Number of arguments. */
    Arg *args;               /* Argument strings. */
{
    Tk_Window mainw = (Tk_Window) clientData;
    Square *squarePtr;
    Tk_Window tkwin;
    char *name;

    if (argc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"",
                LangString(args[0]), " pathName ?options?\"",  NULL);
        return TCL_ERROR;
    }

Create the Square's window and initialize its class, used for resource database lookups. The window isn't visible on the display, because it hasn't been mapped by a geometry manager. Note how users can change the widget's class by using -class.

    tkwin = Tk_CreateWindowFromPath(interp, mainw, LangString(args[1]), 
            NULL);
    if (tkwin == NULL) {
        return TCL_ERROR;
    }
    name = "Square";
    if ((argc>3) && !strcmp(LangString(args[2]),"-class")) {
        argc -= 2;
        args += 2;
        name = LangString(args[1]);
    }
    Tk_SetClass(tkwin, name);

Allocate the Square structure and initialize it:

    squarePtr = (Square *) ckalloc(sizeof(Square));
    squarePtr->tkwin = tkwin;
    squarePtr->display = Tk_Display(tkwin);
    squarePtr->interp = interp;
    squarePtr->widgetCmd = Lang_CreateWidget(interp,squarePtr->tkwin, 
            SquareWidgetCmd, (ClientData) squarePtr,
            SquareCmdDeletedProc);

    squarePtr->x = 0;
    squarePtr->y = 0;
    squarePtr->size = 20;
    squarePtr->borderWidth = 0;
    squarePtr->bgBorder = NULL;
    squarePtr->fgBorder = NULL;
    squarePtr->relief = TK_RELIEF_FLAT;
    squarePtr->gc = None;
    squarePtr->doubleBuffer = 1;
    squarePtr->updatePending = 0;

Register the event processing subroutine SquareEventProc and the events that interest it. The ExposureMask bit selects Expose events, and the StructureNotifyMask bit selects both ConfigureNotify and DestroyNotify events. When SquareEventProc is called, its ClientData argument is the widget's structure pointer, squarePtr.

    Tk_CreateEventHandler(squarePtr->tkwin,
        ExposureMask|StructureNotifyMask,
        SquareEventProc, (ClientData) squarePtr);

Perform the initial widget configuration, using values from argc and resource database lookups.

    if (SquareConfigure(interp, squarePtr, argc-2, args+2, 0) != TCL_OK) {
        Tk_DestroyWindow(squarePtr->tkwin);
        return TCL_ERROR;
    }

    Tcl_ArgResult(interp,LangWidgetArg(interp,squarePtr->tkwin));
    return TCL_OK;
}

21.1.3.4. Tk::Square method processors

Now that we can create a Tk::Square widget, we need to write C code to handle method calls against it. Every C widget has a subroutine name of the form $widget_class.'WidgetCmd'; in this case, SquareWidgetCmd.

static int
SquareWidgetCmd(clientData, interp, argc, args)
    ClientData clientData;          /* Information about square widget. */
    Tcl_Interp *interp;             /* Current interpreter. */
    int argc;                       /* Number of arguments. */
    Arg *args;                      /* Argument strings. */
{
    Square *squarePtr = (Square *) clientData;
    int result = TCL_OK;
    size_t length;
    char c;

    if (argc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"",
                LangString(args[0]), " option ?arg arg ...?\"", NULL);
        return TCL_ERROR;
    }
    Tcl_Preserve((ClientData) squarePtr);
    c = LangString(args[1])[0];
    length = strlen(LangString(args[1]));

Here is the method processing code for the cget, configure, position, and size methods. Hopefully the code is obvious.

    if ((c == 'c') &&
            (strncmp(LangString(args[1]), "cget", length) == 0) && 
            (length >= 2)) {
        if (argc != 3) {
            Tcl_AppendResult(interp, "wrong # args: should be \"",
                    LangString(args[0]), " cget option\"", NULL);
            goto error;
        }
        result = Tk_ConfigureValue(interp, squarePtr->tkwin, configSpecs,
                (char *) squarePtr, LangString(args[2]), 0);
    } else if ((c == 'c') &&
            (strncmp(LangString(args[1]), "configure", length) == 0) &&
            (length >= 2)) {
        if (argc == 2) {
            result = Tk_ConfigureInfo(interp, squarePtr->tkwin,
                     configSpecs, (char *) squarePtr, NULL, 0);
        } else if (argc == 3) {
            result = Tk_ConfigureInfo(interp, squarePtr->tkwin,
                     configSpecs, (char *) squarePtr,
                     LangString(args[2]), 0);
        } else {
            result = SquareConfigure(interp, squarePtr, argc-2, args+2,
                    TK_CONFIG_ARGV_ONLY);
        }
    } else if ((c == 'p') &&
            (strncmp(LangString(args[1]), "position", length) == 0)) {
        if ((argc != 2) && (argc != 4)) {
            Tcl_AppendResult(interp, "wrong # args: should be \"",
                    LangString(args[0]), " position ?x y?\"", NULL);
            goto error;
        }
        if (argc == 4) {
            if ((Tk_GetPixels(interp, squarePtr->tkwin, LangString(args[2]),
                    &squarePtr->x) != TCL_OK) || (Tk_GetPixels(interp,
                    squarePtr->tkwin, LangString(args[3]), &squarePtr->y) 
                    != TCL_OK)) {
                goto error;
            }
            KeepInWindow(squarePtr);
        }
        Tcl_IntResults(interp,2,0, squarePtr->x, squarePtr->y);
    } else if ((c == 's') &&
            (strncmp(LangString(args[1]), "size", length) == 0)) {
        if ((argc != 2) && (argc != 3)) {
            Tcl_AppendResult(interp, "wrong # args: should be \"",
                    LangString(args[0]), " size ?amount?\"", NULL);
            goto error;
        }
        if (argc == 3) {
            int i;

            if (Tk_GetPixels(interp, squarePtr->tkwin, LangString(args[2]), 
                    &i) != TCL_OK) {
                goto error;
            }
            if ((i <= 0) || (i > 100)) {
                Tcl_AppendResult(interp, "bad size \"", LangString(args[2]),
                        "\"", NULL);
               goto error;
            }
            squarePtr->size = i;
            KeepInWindow(squarePtr);
        }
        Tcl_IntResults(interp,1,0, squarePtr->size);
    } else {
        Tcl_AppendResult(interp, "bad option \"", LangString(args[1]),
                "\": must be cget, configure, position, or size", NULL);
        goto error;
    }

Queue a DoWhenIdle callback to display the Square unless an update is already pending.

    if (!squarePtr->updatePending) {
        Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
        squarePtr->updatePending = 1;
    }
    Tcl_Release((ClientData) squarePtr);
    return result;

    error:
    Tcl_Release((ClientData) squarePtr);
    return TCL_ERROR;
}

21.1.3.5. Tk::Square option configurator

Subroutine SquareConfigure handles all configuration requests for a Tk::Square widget:

static int
SquareConfigure(interp, squarePtr, argc, args, flags)
    Tcl_Interp *interp;      /* Used for error reporting. */
    Square *squarePtr;       /* Information about widget. */
    int argc;                /* Number of valid entries in args. */
    Arg *args;               /* Arguments. */
    int flags;               /* Flags to pass to
                              * Tk_ConfigureWidget. */
{
    if (Tk_ConfigureWidget(interp, squarePtr->tkwin, configSpecs,
            argc, args, (char *) squarePtr, flags) != TCL_OK) {
        return TCL_ERROR;
    }

Set the window's background color. If double buffering, create a graphics context:

    Tk_SetWindowBackground(squarePtr->tkwin,
            Tk_3DBorderColor(squarePtr->bgBorder)->pixel);
    if ((squarePtr->gc == None) && (squarePtr->doubleBuffer)) {
        XGCValues gcValues;
        gcValues.function = GXcopy;
        gcValues.graphics_exposures = False;
        squarePtr->gc = Tk_GetGC(squarePtr->tkwin,
                GCFunction|GCGraphicsExposures, &gcValues);
    }

Set the window's geometry and queue a DoWhenIdle event to display it:

    Tk_GeometryRequest(squarePtr->tkwin, 200, 150);
    Tk_SetInternalBorder(squarePtr->tkwin, squarePtr->borderWidth);
    if (!squarePtr->updatePending) {
        Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
        squarePtr->updatePending = 1;
    }
    return TCL_OK;
}

21.1.3.6. Tk::Square event handler

Subroutine SquareEventProc is invoked by Tk's event dispatcher, based on the events selected when Tk_SquareCmd queued this handler. If you've run the square demonstration program and tried to drag the square outside its window, then you've noticed that you can't. That's because the ConfigureNotify event makes calls to KeepInWindow, the subroutine that enforces that rule.

static void
SquareEventProc(clientData, eventPtr)
    ClientData clientData;   /* Information about window. */
    XEvent *eventPtr;        /* Information about event. */
{
    Square *squarePtr = (Square *) clientData;

    if (eventPtr->type == Expose) {
        if (!squarePtr->updatePending) {
            Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
            squarePtr->updatePending = 1;
        }
    } else if (eventPtr->type == ConfigureNotify) {
        KeepInWindow(squarePtr);
        if (!squarePtr->updatePending) {
            Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
            squarePtr->updatePending = 1;
        }
    } else if (eventPtr->type == DestroyNotify) {
        if (squarePtr->tkwin != NULL) {
            squarePtr->tkwin = NULL;
            Lang_DeleteWidget(squarePtr->interp, squarePtr->widgetCmd);
        }
        if (squarePtr->updatePending) {
            Tcl_CancelIdleCall(SquareDisplay, (ClientData) squarePtr);
        }
        Tcl_EventuallyFree((ClientData) squarePtr, SquareDestroy);
    }
}

static void
KeepInWindow(squarePtr)
    register Square *squarePtr;         /* Pointer to widget record. */
{
    int i, bd;
    bd = 0;
    if (squarePtr->relief != TK_RELIEF_FLAT) {
        bd = squarePtr->borderWidth;
    }
    i = (Tk_Width(squarePtr->tkwin) - bd) - (squarePtr->x + squarePtr->size);
    if (i < 0) {
        squarePtr->x += i;
    }
    i = (Tk_Height(squarePtr->tkwin) - bd) - (squarePtr->y + squarePtr->size);
    if (i < 0) {
        squarePtr->y += i;
    }
    if (squarePtr->x < bd) {
        squarePtr->x = bd;
    }
    if (squarePtr->y < bd) {
        squarePtr->y = bd;
    }
}

21.1.3.7. Tk::Square drawing handler

Subroutine SquareDisplay runs as a DoWhenIdle handler. This is the code responsible for displaying the widget. Note that a Drawable is either the actual display or an off-screen pixmap.

static void
SquareDisplay(clientData)
    ClientData clientData;      /* Information about window. */
{
    Square *squarePtr = (Square *) clientData;
    Tk_Window tkwin = squarePtr->tkwin;
    Pixmap pm = None;
    Drawable d;

    squarePtr->updatePending = 0;
    if (!Tk_IsMapped(tkwin)) {
        return;
    }

If required, create the off-screen pixmap for double-buffering:

if (squarePtr->doubleBuffer) {
        pm = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
                Tk_Width(tkwin), Tk_Height(tkwin),
                DefaultDepthOfScreen(Tk_Screen(tkwin)));
        d = pm;
    } else {
        d = Tk_WindowId(tkwin);
    }

Redraw the widget's background and border, and display the square:

    Tk_Fill3DRectangle(tkwin, d, squarePtr->bgBorder, 0, 0, Tk_Width(tkwin),
            Tk_Height(tkwin), squarePtr->borderWidth, squarePtr->relief);

    Tk_Fill3DRectangle(tkwin, d, squarePtr->fgBorder, squarePtr->x,
            squarePtr->y, squarePtr->size, squarePtr->size,
            squarePtr->borderWidth, TK_RELIEF_RAISED);

Copy the pixmap to the display if double buffering:

    if (squarePtr->doubleBuffer) {
        XCopyArea(Tk_Display(tkwin), pm, Tk_WindowId(tkwin), squarePtr->gc,
                0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
                0, 0);
        Tk_FreePixmap(Tk_Display(tkwin), pm);
    }
}

21.1.3.8. Tk::Square destructor

Subroutine SquareCmdDeletedProc is called by core Tk to destroy a Tk::Square widget:

static void
SquareCmdDeletedProc(clientData)
    ClientData clientData;    /* Pointer to widget record for widget. */
{
    Square *squarePtr = (Square *) clientData;
    Tk_Window tkwin = squarePtr->tkwin;

    if (tkwin != NULL) {
        squarePtr->tkwin = NULL;
        Tk_DestroyWindow(tkwin);
    }
}

Subroutine SquareDestroy is called in response to a DestroyNotify event and frees the Square structure and any graphics context.

static void
SquareDestroy(memPtr)
    char *memPtr;        /* Info about square widget. */
{
    Square *squarePtr = (Square *) memPtr;

    Tk_FreeOptions(configSpecs, (char *) squarePtr, squarePtr->display, 0);
    if (squarePtr->gc != None) {
        Tk_FreeGC(squarePtr->display, squarePtr->gc);
    }
    ckfree((char *) squarePtr);
}


Library Navigation Links

Copyright © 2002 O'Reilly & Associates. All rights reserved.