[Richard Suchenwirth] 2010-03-23 - I needed a fast [photo image rotation] quite badly at work, which would rotate fairly large images (say 2000 * 3000 pixels) by 90 degrees, in place. So after a long while, I did some C coding again, and some hours later, there it was: implementing a single command
 rphoto imname ccw
where ''imname'' is the name of a [photo] image, and ''ccw'' is 1 for counter-clockwise, 0 for clockwise. This is a standalone extension, but come to think, wouldn't it be nice to have this functionality as an option for ''image copy'' ? :^)
===
/* rphoto.c - extension to make Tk photo images rotatable by 90 degrees */
/* $Id: rphoto.c,v 1.2 2010/03/23 15:07:30 suchenwi Exp $ */
#include <tk.h>

#define RPHOTO_VERSION "1.0"

#ifdef __WIN32__
#   include <windows.h>
#   ifndef DECLSPEC_EXPORT
#      define DECLSPEC_EXPORT __declspec(dllexport)
#   endif /* DECLSPEC_EXPORT */

BOOL APIENTRY DllMain(HANDLE hModule, DWORD dwReason, LPVOID lpReserved) {
  return TRUE;
}
#else
#   define DECLSPEC_EXPORT
#endif
/*------------------------------------------------------------- Worker function*/

static int rphoto(Tk_PhotoHandle imgin, int ccw) {
  /* Rotate a photo image by 90 degrees in place.
     ccw: 1 for counter-clockwise, 0 for clockwise */
  Tk_PhotoImageBlock inblock;
  int rc;
  int width, height;
  int i, j, k, ii, jj;
  unsigned char *cp, aByte;
  Tk_PhotoImageBlock pixel;
  unsigned char *buf;
    
  rc = Tk_PhotoGetImage(imgin, &inblock);
  if(rc != 1) return TCL_ERROR;
  width  = inblock.width;
  height = inblock.height;
  buf = malloc(width * height * 4);
  if(buf == NULL) return TCL_ERROR;
  pixel.pixelPtr = buf;
  pixel.width  = height;
  pixel.height = width;
  pixel.pitch  = height * 4;
  pixel.pixelSize = 4;
  pixel.offset[0] = 0;
  pixel.offset[1] = 1;
  pixel.offset[2] = 2;
  pixel.offset[3] = 3;
  
  for(i = 0; i < height; i++) {
    ii = (ccw? i: height-i-1);
    for (j = 0; j < width; j++) {
      jj = (ccw? width-j-1: j);
      for (k = 0; k < inblock.pixelSize; k++) {
        aByte = *(inblock.pixelPtr
                  + ii * inblock.pitch
                  + jj * inblock.pixelSize
                  + inblock.offset[k]);
        cp = pixel.pixelPtr
          + j * pixel.pitch
          + i * pixel.pixelSize
          + pixel.offset[k];
        *cp = aByte;
      }
    }
  }
  Tk_PhotoSetSize(imgin, height, width); /* swapped */
  Tk_PhotoPutBlock(imgin, &pixel, 0, 0, height, width, TK_PHOTO_COMPOSITE_SET);
  free(buf);
  Tk_PhotoSetSize(imgin, 0, 0); /* allow resizing by others */
  return TCL_OK;
}
/*------------------------------------------------------------ Command wrapper */
static int rphotoCmd(ClientData clientdata, Tcl_Interp *interp,
                     int objc, Tcl_Obj *CONST objv[]) {
  Tk_PhotoHandle imgin;
  int ccw;
  int rc;
  Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);

  if(objc != 3) {
    Tcl_WrongNumArgs(interp, 1, objv, "imgin imgout ccw");
    return TCL_ERROR;
  }
  imgin = Tk_FindPhoto(interp,Tcl_GetStringFromObj(objv[1], NULL));
  if (imgin == NULL) {
    Tcl_SetStringObj(resultPtr, "input image does not exist",-1);
    return TCL_ERROR;
  }
  rc = Tcl_GetIntFromObj(interp,objv[2],&ccw);
  if(rc != TCL_OK) return TCL_ERROR;

  rc = rphoto(imgin, ccw);
  if(rc != TCL_OK) {
    Tcl_SetStringObj(resultPtr, "out of memory",-1);
    return TCL_ERROR;
  }
  return TCL_OK;
}
/* --------------------------------------------- Package & command registration */
EXTERN_C int DECLSPEC_EXPORT Rphoto_Init(Tcl_Interp* interp) {
  int r;
  const char *tkversion;
  
#ifdef USE_TCL_STUBS
  Tcl_InitStubs(interp, "8.3", 0);
#endif
#ifdef USE_TK_STUBS
  Tk_InitStubs(interp, "8.3", 0);
#endif

  tkversion = Tcl_PkgRequire(interp, "Tk", "8.4", 0);
  if (tkversion == NULL) return TCL_ERROR;

  r = Tcl_PkgProvide(interp, "rphoto", RPHOTO_VERSION);
  
  Tcl_CreateObjCommand(interp, "rphoto", (Tcl_ObjCmdProc *)rphotoCmd,
                       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
  return r;
}

EXTERN_C int DECLSPEC_EXPORT Rphoto_SafeInit(Tcl_Interp* interp) {
  /* We don't need to be specially safe so... */
  return Rphoto_Init(interp);
}
===
----
[MHo]
===
..\tcc -v  -o photorot.dll -Ic:/Programme/Tcl/Include -DUSE_TCL_STUBS -L
c:/Programme/Tcl/lib -shared -rdynamic photorot.c
tcc version 0.9.25
-> photorot.c
photorot.c:37: warning: assignment makes pointer from integer without a cast
photorot.c:46: field not found: offset2
===
Shouldn't it be 
===
offset[[2]]
===
??? I also couldn't locate '''offsetk'''...?

[RS] 2010-09-14 If you look at the source of this page (with the Edit link), you see that
 offset[2] and offset[k]
are correct there, but the code prettifier seems to play some silly games with it :/

----
<<categories>> Example | Graphics | Image Processing