Posted to tcl by patthoyts at Tue Sep 15 23:27:54 GMT 2009view pretty

/* spcmap $channel image index ?-factor factor? ?-method method? ?-from from -to to?
 *   build a map image - the image must already be the right size.
 */
static int
SpcMapCmd(ClientData UNUSED(clientData), Tcl_Interp *interp, 
          int objc, Tcl_Obj *const objv[])
{
    Tcl_Channel channel;
    Tk_PhotoHandle photo;
    Tk_PhotoImageBlock block;
    Tcl_Obj *spcObj = NULL, *valuesObj = NULL, *listObj = NULL;
    int i, mode = 0, index = 0, method = METHOD_SIMPLE, point = -1, row, col;
    long subsample = 1;
    long limit[2] = {0, 0};
    SPCHDR *spcPtr = NULL;
    double factor = 0;
    float *valuesPtr = NULL;
    float low = (float)1e14, high = (float)1e-14;
    enum {OPT_FACTOR, OPT_METHOD, OPT_POINT, OPT_FROM, OPT_TO, OPT_SUBSAMPLE };
    const char * options[] = {"-factor", "-method", "-point", "-from", "-to", "-subsample", NULL };
    Tcl_WideInt perf[4];
    
    if (objc < 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "channel image "
                         "?-factor factor -method method -point index -from index -to index?");
        return TCL_ERROR;
    }

    for (i = 3; i < objc; ++i) {
        if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) {
            return TCL_ERROR;
        }
        ++i;
        switch (index) {
            case OPT_POINT:
                if (Tcl_GetIntFromObj(interp, objv[i], &point) != TCL_OK) {
                    return TCL_ERROR;
                }
                break;
            case OPT_FROM:
                if (Tcl_GetLongFromObj(interp, objv[i], &limit[0]) != TCL_OK) {
                    return TCL_ERROR;
                }
                break;
            case OPT_TO:
                if (Tcl_GetLongFromObj(interp, objv[i], &limit[1]) != TCL_OK) {
                    return TCL_ERROR;
                }
                break;
            case OPT_FACTOR:
                if (Tcl_GetDoubleFromObj(interp, objv[i], &factor) != TCL_OK) {
                    return TCL_ERROR;
                }
                break;
            case OPT_METHOD:
                if (Spc_GetMethodFromObj(interp, objv[i], &method) != TCL_OK) {
                    return TCL_ERROR;
                }
                break;
            case OPT_SUBSAMPLE:
                if (Tcl_GetLongFromObj(interp, objv[i], &subsample) != TCL_OK) {
                    return TCL_ERROR;
                }
                break;
        }
    }

    if (method == METHOD_SIMPLE && point == -1) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("-point must be set for simple method", -1));
        return TCL_ERROR;
    }

    channel = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), &mode);
    if (channel == NULL) {
        return TCL_ERROR;
    }
    Tcl_SetChannelOption(interp, channel, "-encoding", "binary");

    photo = Tk_FindPhoto(interp, Tcl_GetString(objv[2]));
    if (photo == NULL) {
        return TCL_ERROR;
    }
    Tk_PhotoGetImage(photo, &block);

    if (Tcl_Seek(channel, 0, SEEK_SET) == -1) {
        return TCL_ERROR;
    }

    spcObj = Tcl_NewObj();
    if (Tcl_ReadChars(channel, spcObj, 512, 0) == -1) {
        Tcl_DecrRefCount(spcObj);
        return TCL_ERROR;
    }
    spcPtr = (SPCHDR *)Tcl_GetByteArrayFromObj(spcObj, NULL);
    
    log_time(&perf[0]);

    switch (method) {
        case METHOD_SIMPLE:
            if (SpcCreateSimpleMap(interp, spcPtr, channel, point, block.width, subsample,
                                   &valuesObj, &low, &high) != TCL_OK)
                return TCL_ERROR;
            break;
        case METHOD_SIGNALTOAXIS:
        case METHOD_SIGNALTOBASELINE:
            if (SpcCreateSigBaselineMap(interp, spcPtr, channel, method, block.width, subsample,
                                        limit, &valuesObj, &low, &high) != TCL_OK)
                return TCL_ERROR;
            break;
        default:
            Tcl_SetObjResult(interp, Tcl_NewStringObj("method not implemented yet", -1));
            return TCL_ERROR;
    }
    valuesPtr = (float *)Tcl_GetByteArrayFromObj(valuesObj, NULL);
    Tcl_DecrRefCount(spcObj);

    if (factor == 0)
        factor = 255.0 / (high - low);

    log_time(&perf[1]);

    for (row = 0; row < block.height; ++row) {
        if ((row % subsample) == 0) {
            for (col = 0; col < block.width; ++col) {
                unsigned char *pixel;
                double value;
                //size_t ndx = row * block.width + col;
                size_t ndx = (row/subsample)*(block.width/subsample)+(col/subsample);

                pixel = block.pixelPtr + (((block.height - row - 1) * block.pitch) 
                                          + (col * block.pixelSize));
                
                value = valuesPtr[ndx];
                pixel[block.offset[0]] = (unsigned char)fmin(255,((value - low) * factor));
                pixel[block.offset[1]] = 0;
                pixel[block.offset[2]] = 0;
                pixel[block.offset[3]] = (unsigned char)255;
            }
        } else {
            // memcopy last row onto this row
            long last = row - (row%subsample);
            unsigned char *lastRow = block.pixelPtr + ((block.height - last- 1) * block.pitch);
            unsigned char *thisRow = block.pixelPtr + ((block.height - row - 1) * block.pitch);
            memcpy(thisRow, lastRow, block.pitch);
        }
    }

    log_time(&perf[2]);

    Tk_PhotoPutBlock(
#if 10 * TK_MAJOR_VERSION + TK_MINOR_VERSION >= 85
                     interp,
#endif
                     photo, &block,
                     0, 0, block.width, block.height,
                     TK_PHOTO_COMPOSITE_SET);
    Tcl_DecrRefCount(valuesObj);

    log_time(&perf[3]);
    debug_print("a: %" LL_FORMAT "d b:%" LL_FORMAT "d c:%" LL_FORMAT "d\n",
                perf[1]-perf[0], perf[2]-perf[1], perf[3]-perf[2]);
    
    listObj = Tcl_NewListObj(0, NULL);
    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewDoubleObj(low));
    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewDoubleObj(high));
    Tcl_SetObjResult(interp, listObj);

    return TCL_OK;
}