#include <tcl.h>
#include <tk.h>
#include <windows.h>
#include <shellapi.h>
#include <stdio.h>

static int GetIcon_Cmd(ClientData cdata, Tcl_Interp *interp, int objc,  Tcl_Obj * const objv[]) {
   SHFILEINFOW shfi;
   ICONINFO iconInfo ;
   BITMAP bmp;
   long imageSize ;
   char * bitBuffer , * byteBuffer ;
   int i, index;
   int result, hasAlpha;
   const char * image_name;
   Tk_PhotoHandle photo;
   Tk_PhotoImageBlock block;
   const char * file_name;
   int bitSize;
   unsigned int uFlags;

   static const char *options[] = {
     "-large", "-open", "-selected", NULL};
   enum IOption {
     ILARGE, IOPEN, ISELECTED
   };

   if (objc < 2) {
     Tcl_WrongNumArgs(interp,1,objv,"?options? fileName");
     return TCL_ERROR;
   }

   /* SHGFI_ICON == SHGFI_LARGEICON so large is the default, select small instead
      then remove the flag if -large is specified
    */

   uFlags = SHGFI_ICON | SHGFI_SMALLICON;

   for (i=1 ; i < objc-1 ; i++) {
     result = Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
                                 (int *) &index);
     if (result != TCL_OK) {
       return result;
     }
     switch (index) {
     case ILARGE:
       /* setting LARGE is equivalent to unsetting SMALL */
       uFlags ^= SHGFI_SMALLICON;
       break;
     case IOPEN:
       uFlags |= SHGFI_OPENICON;
       break;
     case ISELECTED:
       uFlags |= SHGFI_SELECTED;
       break;
     default:
       Tcl_Panic("option lookup failed");
     }
   }

   /* Normalize the filename */
   file_name = Tcl_FSGetNativePath(objv[objc-1]);
   if (file_name == NULL) {
     return TCL_ERROR;
   }

   result = SHGetFileInfoW(
                         (LPCWSTR) file_name,
                         0,
                         &shfi,
                         sizeof(SHFILEINFO),
                         uFlags
                         );

   if (result == 0) {
     WCHAR msg[255];
     int l;
     Tcl_SetResult(interp, "failed to load icon: ",NULL);
     FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,0,GetLastError(),0,msg,255,0);

     /* lose the newline */
     l = 0;
     while (msg[l]!='\r' && msg[l]!='\n' && msg[l]!='\0') {
       l++;
     }
     msg[l]='\0';
     Tcl_AppendResult(interp, msg,NULL);
     return TCL_ERROR;
   }

   GetIconInfo(shfi.hIcon, &iconInfo);

   result = GetObject(
                     iconInfo.hbmMask,
                     sizeof(BITMAP),
                     (void *)&bmp
                     );

   bitSize = bmp.bmWidth * bmp.bmHeight * bmp.bmBitsPixel / 8;

   bitBuffer = ckalloc(bitSize);
   GetBitmapBits(iconInfo.hbmMask,bitSize,bitBuffer);

   result = GetObject(
                     iconInfo.hbmColor,
                     sizeof(BITMAP),
                     (void *)&bmp
                     );

   imageSize = bmp.bmWidth * bmp.bmHeight * bmp.bmBitsPixel / 8;
   byteBuffer = ckalloc(imageSize);
   GetBitmapBits(iconInfo.hbmColor,imageSize,byteBuffer);

   /* Do some mask and Alpha channel voodoo, because not all Icons define an alpha channel
      and MS has decided to make completely transparent the default in that case, AAARGGH
      Might be some bit masking I am missing here though.
    */

   hasAlpha = 0;
   for (i = 0 ; i < imageSize ; i+=4) {
     if (byteBuffer[i+offsetof(RGBQUAD,rgbReserved)]!=0) {
       hasAlpha = 1;
       break;
     }
   }

 #define BIT_SET(x,y) (((x) >> (8-(y)) ) & 1 )

   for (i=0;i<bitSize;i++) {
     if (hasAlpha) break;
     // if (i%2==0) {fprintf(stderr,"\n");}
     int bit = 0;
     for (bit=0; bit < 8 ; bit++) {
       if (BIT_SET(bitBuffer[i],bit)) {
        // fprintf(stderr,"0");
        byteBuffer[(i*8+bit)*4+3] = 0;
       } else {
        // fprintf(stderr,"1");
        byteBuffer[(i*8+bit)*4+3] = 255;
       }
     }
   }

   /* setup the Tk block structure */
   block.pixelPtr = byteBuffer;
   block.width = bmp.bmWidth;
   block.height = bmp.bmHeight;
   block.pitch = bmp.bmWidthBytes;
   block.pixelSize = bmp.bmBitsPixel/8;
   block.offset[0]  = offsetof(RGBQUAD,rgbRed);
   block.offset[1]  = offsetof(RGBQUAD,rgbGreen);
   block.offset[2]  = offsetof(RGBQUAD,rgbBlue);
   block.offset[3] = offsetof(RGBQUAD,rgbReserved);

   /* Create the image */
   result = Tcl_Eval(interp,"image create photo");
   if (result != TCL_OK) {
     return TCL_ERROR;
   }
   image_name = Tcl_GetStringResult(interp);
   photo = Tk_FindPhoto(interp, image_name);

   result = Tk_PhotoPutBlock( interp,photo, &block ,0,0,block.width, block.height,TK_PHOTO_COMPOSITE_SET);

   if (result != TCL_OK) {
     return TCL_ERROR;
   }

   //cleanup
   ckfree(bitBuffer);
   ckfree(byteBuffer);

   DeleteObject(iconInfo.hbmMask);
   DeleteObject(iconInfo.hbmColor);
   DestroyIcon(shfi.hIcon);

   /* Was Tcl_AppendResult */
   Tcl_SetResult(interp, image_name, NULL);
   return TCL_OK;
 }

 int DLLEXPORT
 Shellicon_Init(Tcl_Interp *interp)
 {
   if (Tcl_InitStubs(interp, "8.4-", 0) == 0L) {
     return TCL_ERROR;
   }
   if (Tk_InitStubs(interp, "8.4-", 0) == 0L) {
     return TCL_ERROR;
   }
   Tcl_CreateObjCommand(interp, "shellicon::get", GetIcon_Cmd, NULL, NULL);
   Tcl_PkgProvide(interp, "shellicon", "0.1.1");
   return TCL_OK;
}
