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; }