Xlib_TclTk.c:
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <tcl.h>
#include <tk.h>
GC green_gc;
GC red_gc;
int create_colors (Tcl_Interp *interp) {
XColor *col;
Tk_Window tkwin;
tkwin = Tk_MainWindow (interp);
Tk_MakeWindowExist (tkwin);
col = Tk_GetColor (interp, tkwin, "green");
if (NULL == col)
return TCL_ERROR;
green_gc = Tk_GCForColor (col, Tk_WindowId (tkwin));
col = Tk_GetColor (interp, tkwin, "red");
if (NULL == col)
return TCL_ERROR;
red_gc = Tk_GCForColor (col, Tk_WindowId (tkwin));
return TCL_OK;
}
int draw_pattern_cmd (
ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]
) {
Display *dis;
Tk_Window tkwin;
int i;
if (2 != objc) {
Tcl_WrongNumArgs (interp, 1, objv, "window-path");
return TCL_ERROR;
}
tkwin = Tk_NameToWindow (interp, Tcl_GetString (objv[1]), Tk_MainWindow (interp));
if (NULL == tkwin)
return TCL_ERROR;
Tk_MakeWindowExist (tkwin);
dis = Tk_Display (tkwin);
XClearWindow (dis, Tk_WindowId (tkwin));
for (i = 0; i < 150; (i += 3)) {
XFillRectangle (dis, Tk_WindowId (tkwin), green_gc, 1, 1, i, i);
XFlush (dis);
usleep (1);
}
for (i = 0; i < 150; (i += 3)) {
XFillRectangle (dis, Tk_WindowId (tkwin), red_gc, 150, 150, i, i);
XFlush (dis);
usleep (1);
}
return TCL_OK;
}
int create_window_cmd (
ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]
) {
Tcl_Obj *r;
Tk_Window tkwin;
if (2 != objc) {
Tcl_WrongNumArgs (interp, 1, objv, "window-path");
return TCL_ERROR;
}
tkwin = Tk_CreateWindowFromPath (
interp, Tk_MainWindow (interp), Tcl_GetString (objv[1]), NULL);
r = Tcl_DuplicateObj (objv[1]);
Tcl_SetObjResult (interp, r);
return TCL_OK;
}
int app_init (Tcl_Interp *interp) {
Tk_Window tkwin;
if (TCL_OK != Tcl_Init (interp)) {
fprintf (stderr, "Tcl_Init error: %s\n", Tcl_GetStringResult (interp));
exit (EXIT_FAILURE);
}
if (TCL_OK != Tk_Init (interp)) {
fprintf (stderr, "Tk_Init error: %s\n", Tcl_GetStringResult (interp));
exit (EXIT_FAILURE);
}
Tcl_CreateObjCommand (interp, "create_window", create_window_cmd,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand (interp, "draw_pattern", draw_pattern_cmd,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
if (TCL_OK != create_colors (interp))
return TCL_ERROR;
Tcl_EvalFile (interp, "script.tcl");
Tk_MainLoop ();
return TCL_OK;
}
int main(int argc, char *argv[]) {
Tk_Main(argc, argv, app_init);
return EXIT_SUCCESS;
}script.tcl:
pack [create_window .w] -fill both -expand 1
pack [button .b -text Draw -command {draw_pattern .w}]
wm geometry . 400x400See also: Drawing Into Foreign Windows. Also, BLT has a "container" widget, about which George Howlett has written [1].

