Posted to tcl by patthoyts at Tue Sep 15 23:27:54 GMT 2009view raw
- /* 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;
- }