/*
 * shellicon.c --
 *
 * Main file for the shellicon Tcl extension.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */

#include "shellicon.h"

#include <tk.h>

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

/*
 * Metainfo for a pkgconfig command for the extension via Tcl_RegisterConfig
 * Must only have const static UTF-8 encoded char pointers.
 */
Tcl_Config shelliconConfig[] = {
    {"version", PACKAGE_VERSION},
    /* Add additional configuration or feature information if relevant */
    {NULL, NULL}
};

#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
# if TCL_UTF_MAX > 3
#   define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
#   define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
# else
#   define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
#   define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
# endif
#endif

/* Taken from file tclWinReg.c */
static void
AppendSystemError(
    Tcl_Interp *interp,         /* Current interpreter. */
    const char *prefix,         /* Message print in front of system error. */
    DWORD error)                /* Result code from error. */
{
    Tcl_Size length;
    WCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr;
    const char *msg;
    char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
    Tcl_DString ds;
    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);

    if (Tcl_IsShared(resultPtr)) {
        resultPtr = Tcl_DuplicateObj(resultPtr);
    }
    Tcl_AppendToObj(resultPtr, prefix, strlen(prefix));

    length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
            | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
            MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) tMsgPtrPtr,
            0, NULL);
    if (length == 0) {
        snprintf(msgBuf, sizeof(msgBuf), "unknown error: %ld", error);
        msg = msgBuf;
    } else {
        char *msgPtr;

        Tcl_DStringInit(&ds);
        Tcl_WCharToUtfDString(tMsgPtr, wcslen(tMsgPtr), &ds);
        LocalFree(tMsgPtr);

        msgPtr = Tcl_DStringValue(&ds);
        length = Tcl_DStringLength(&ds);

        /*
         * Trim the trailing CR/LF from the system message.
         */

        if (msgPtr[length-1] == '\n') {
            --length;
        }
        if (msgPtr[length-1] == '\r') {
            --length;
        }
        msgPtr[length] = 0;
        msg = msgPtr;
    }

    snprintf(id, sizeof(id), "%ld", error);
    Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *)NULL);
    Tcl_AppendToObj(resultPtr, msg, length);
    Tcl_SetObjResult(interp, resultPtr);

    if (length != 0) {
        Tcl_DStringFree(&ds);
    }
}

/*
 * GetIconObjCmd --
 *
 *       Get an icon from a directory or file.
 *
 * Results:
 *      A standard Tcl result
 *
 * Side effects:
 *      None.
 */

int
GetIconObjCmd(
    void *dummy,                /* Not used. */
    Tcl_Interp *interp,         /* Current interpreter */
    int objc,                   /* Number of arguments */
    Tcl_Obj *const objv[]       /* Argument strings */
    )
{
    SHFILEINFOW shfi;
    ICONINFO iconInfo;
    BITMAP bmp;
    long imageSize;
    char * bitBuffer;
    unsigned char * byteBuffer;
    int i, index;
    int result, hasAlpha;
    DWORD_PTR resultFileInfo;
    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;
    }

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

    if (resultFileInfo == 0) {
        AppendSystemError(interp, "failed to load icon: ", GetLastError());
        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;
        }
        int bit = 0;
        for (bit=0; bit < 8 ; bit++) {
            if (BIT_SET(bitBuffer[i],bit)) {
                byteBuffer[(i*8+bit)*4+3] = 0;
            } else {
                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;
}

/*
 * Shellicon_Init --
 *
 *      Initialize the extension.
 *
 * Results:
 *      A standard Tcl result
 *
 * Side effects:
 *      The package is registered with the interpreter.
 *      Command shellicon is added to the interpreter.
 */

DLLEXPORT int
Shellicon_Init(
    Tcl_Interp* interp)         /* Tcl interpreter */
{
    /*
     * Support any Tcl version compatible with the version against which the
     * extension is being built.
     */
    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
        return TCL_ERROR;
    }
    if (Tk_InitStubs(interp, TK_VERSION, 0) == NULL) {
        return TCL_ERROR;
    }

    /*
     * Register the commands added by the package.
     */
    Tcl_CreateObjCommand(interp, PACKAGE_NAME "::" "get",        GetIconObjCmd,   NULL, NULL);
    Tcl_CreateObjCommand(interp, PACKAGE_NAME "::" "build-info", BuildInfoObjCmd, NULL, NULL);

    /* Register feature configuration  */
    Tcl_RegisterConfig(interp, PACKAGE_NAME, shelliconConfig, "utf-8");

    /*
     * Inform Tcl the package is available. PACKAGE_NAME and PACKAGE_VERSION
     * are set by the build system (autoconf or nmake)
     */
    if (Tcl_PkgProvideEx(interp, PACKAGE_NAME, PACKAGE_VERSION, NULL) != TCL_OK) {
        return TCL_ERROR;
    }
    return TCL_OK;
}
