[GPS] Sep 27, 2002 : I was curious the other day about how Tk's image functions/procedures work at the C level. I spent two days off-and-on working on a little extension for displaying Xpm images. Tk makes this much simpler than I thought it would. The implementation below even handles transparency properly. ---- [https://web.archive.org/web/20040117162725/www.xmission.com/~georgeps/Tk_Xpm/Tk_Xpm.png] ---- [[Anyone have an updated url for the above? Is this something that [critcl] can compile?]] ---- ======c #include #include #include #include #include #include #include #include #define OBJ_CMD_ARGS (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) typedef struct Tk_XpmInstance { int refCount; Display *dis; Pixmap pix; Pixmap pixMask; Tk_Window tkwin; Tk_ImageMaster master; Tcl_Command cmd; } Tk_XpmInstance; static int GetPixmapSize (Display *dis, Pixmap p, int *width, int *height) { Window root; int x, y; int bd; int depth; if (!XGetGeometry (dis, p, &root, &x, &y, width, height, &bd, &depth)) { return 0; } return 1; } static void FreePixmapsIfNeeded (Tk_XpmInstance *xinst) { /*An image may already have been loaded, so we should free the Pixmap's if so.*/ if (xinst->pix != None) { XFreePixmap (xinst->dis, xinst->pix); xinst->pix = None; } if (xinst->pixMask != None) { XFreePixmap (xinst->dis, xinst->pixMask); xinst->pixMask = None; } } static int UpdateSize (Tcl_Interp *interp, Tk_XpmInstance *xinst) { int width; int height; if (!GetPixmapSize (xinst->dis, xinst->pix, &width, &height)) { Tcl_SetResult (interp, "unable to query pixmap size", TCL_STATIC); return TCL_ERROR; } Tk_ImageChanged (xinst->master, 0, 0, 0, 0, width, height); return TCL_OK; } static int Tk_XpmMakePixmapFromBuffer (Tcl_Interp *interp, char *buf, Tk_XpmInstance *xinst) { Tk_Window tkmain; Window xWin; tkmain = Tk_MainWindow (interp); Tk_MakeWindowExist (tkmain); xWin = Tk_WindowId (tkmain); if (XpmCreatePixmapFromBuffer (xinst->dis, xWin, buf, &xinst->pix, &xinst->pixMask, NULL)) { Tcl_SetResult (interp, "bad xpm", TCL_STATIC); xinst->pix = None; xinst->pixMask = None; return TCL_ERROR; } return TCL_OK; } static int Tk_XpmReadFileToPixmap (Tcl_Interp *interp, char *fileName, Tk_XpmInstance *xinst) { Tcl_Channel chan = NULL; Tcl_Obj *xpmBufObj; struct stat statBuf; xpmBufObj = Tcl_NewObj (); if (Tcl_Stat (fileName, &statBuf)) { Tcl_SetResult (interp, (char *) Tcl_ErrnoMsg (errno), TCL_VOLATILE); return TCL_ERROR; } chan = Tcl_OpenFileChannel (interp, fileName, "r", 0); if (chan == NULL) { return TCL_ERROR; } if (Tcl_ReadChars (chan, xpmBufObj, statBuf.st_size, 0) != statBuf.st_size) { Tcl_SetResult (interp, (char *) Tcl_ErrnoMsg (errno), TCL_VOLATILE); return TCL_ERROR; } if (Tcl_Close (interp, chan) != TCL_OK) { return TCL_ERROR; } FreePixmapsIfNeeded (xinst); if (Tk_XpmMakePixmapFromBuffer (interp, Tcl_GetString (xpmBufObj), xinst) != TCL_OK) { return TCL_ERROR; } Tcl_DecrRefCount (xpmBufObj); return UpdateSize (interp, xinst); } static int Tk_XpmBufferToPixmap (Tcl_Interp *interp, char *xpmBuf, Tk_XpmInstance *xinst) { FreePixmapsIfNeeded (xinst); if (Tk_XpmMakePixmapFromBuffer (interp, xpmBuf, xinst) != TCL_OK) { return TCL_ERROR; } return UpdateSize (interp, xinst); } static int Tk_XpmInstanceCmd OBJ_CMD_ARGS { Tk_XpmInstance *xinst = (Tk_XpmInstance *) clientData; char *subCmd = NULL; int len = 0; fprintf (stderr, "InstanceCmd\n"); if (objc != 3) { Tcl_WrongNumArgs (interp, 1, objv, "file|data fileName|xpmData"); return TCL_ERROR; } subCmd = Tcl_GetStringFromObj (objv[1], &len); if (strncmp (subCmd, "file", len) == 0) { return Tk_XpmReadFileToPixmap (interp, Tcl_GetString (objv[2]), xinst); } else if (strncmp (subCmd, "data", len) == 0) { return Tk_XpmBufferToPixmap (interp, Tcl_GetString (objv[2]), xinst); } Tcl_SetResult (interp, "bad instance subcommand", TCL_STATIC); return TCL_ERROR; } static void Tk_XpmFree (ClientData clientData, Display *dis) { /*I don't do anything specific for widgets that use images, *so AFAIK this doesn't need to do anything. */ /*fprintf (stderr, "FREE\n");*/ } static void Tk_XpmDelete (ClientData clientData) { Tk_XpmInstance *xinst = (Tk_XpmInstance *) clientData; /*fprintf (stderr, "DELETE\n");*/ FreePixmapsIfNeeded (xinst); if (xinst != NULL) { Tcl_DeleteCommandFromToken (NULL, xinst->cmd); Tcl_Free (clientData); clientData = NULL; } } static int Tk_XpmCreate ( Tcl_Interp *interp, char *name, int objc, Tcl_Obj *CONST objv[], Tk_ImageType *typePtr, Tk_ImageMaster master, ClientData *clientDataPtr ) { Tk_XpmInstance *xinst = (Tk_XpmInstance *) Tcl_Alloc (sizeof (Tk_XpmInstance)); xinst->cmd = Tcl_CreateObjCommand (interp, name, Tk_XpmInstanceCmd, (ClientData) xinst, (Tcl_CmdDeleteProc *) NULL); xinst->master = master; xinst->dis = Tk_Display (Tk_MainWindow (interp)); xinst->pix = None; xinst->pixMask = None; Tk_ImageChanged (master, 0, 0, 1, 1, 1, 1); *clientDataPtr = (ClientData) xinst; return TCL_OK; } static ClientData Tk_XpmGet (Tk_Window tkwin, ClientData clientData) { return clientData; } static void Tk_XpmDisplay ( ClientData clientData, Display *dis, Drawable d, int x, int y, int width, int height, int destX, int destY ) { Tk_XpmInstance *xinst = clientData; int nScreen = 0; GC copyGC; XGCValues xgcval; /* fprintf (stderr, "x %d y %d width %d height %d destX %d destY %d\n", x, y, width, height, destX, destY); */ xgcval.clip_x_origin = destX; xgcval.clip_y_origin = destY; nScreen = DefaultScreen (dis); copyGC = XCreateGC (dis, d, GCClipXOrigin | GCClipYOrigin, &xgcval); if (xinst->pixMask != None) { XSetClipMask (dis, copyGC, xinst->pixMask); } XCopyArea (dis, xinst->pix, d, copyGC, x, y, width, height, destX, destY); XFreeGC (dis, copyGC); XFlush (dis); } Tk_ImageType Tk_XpmImageType = { "xpm", Tk_XpmCreate, Tk_XpmGet, Tk_XpmDisplay, Tk_XpmFree, Tk_XpmDelete, NULL, (Tk_ImageType *) NULL }; int Tk_Xpm_Init (Tcl_Interp *interp) { Tk_CreateImageType (&Tk_XpmImageType); return TCL_OK; } ====== ---- You can download a demo here: [https://web.archive.org/web/20040221205424/www.xmission.com/~georgeps/Tk_Xpm/] Any comments? <> Graphics | File | Package