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 . 400x400
See also: Drawing Into Foreign Windows. Also, BLT has a "container" widget, about which George Howlett has written [1].