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

  1. /* spcmap $channel image index ?-factor factor? ?-method method? ?-from from -to to?
  2. * build a map image - the image must already be the right size.
  3. */
  4. static int
  5. SpcMapCmd(ClientData UNUSED(clientData), Tcl_Interp *interp,
  6. int objc, Tcl_Obj *const objv[])
  7. {
  8. Tcl_Channel channel;
  9. Tk_PhotoHandle photo;
  10. Tk_PhotoImageBlock block;
  11. Tcl_Obj *spcObj = NULL, *valuesObj = NULL, *listObj = NULL;
  12. int i, mode = 0, index = 0, method = METHOD_SIMPLE, point = -1, row, col;
  13. long subsample = 1;
  14. long limit[2] = {0, 0};
  15. SPCHDR *spcPtr = NULL;
  16. double factor = 0;
  17. float *valuesPtr = NULL;
  18. float low = (float)1e14, high = (float)1e-14;
  19. enum {OPT_FACTOR, OPT_METHOD, OPT_POINT, OPT_FROM, OPT_TO, OPT_SUBSAMPLE };
  20. const char * options[] = {"-factor", "-method", "-point", "-from", "-to", "-subsample", NULL };
  21. Tcl_WideInt perf[4];
  22.  
  23. if (objc < 3) {
  24. Tcl_WrongNumArgs(interp, 1, objv, "channel image "
  25. "?-factor factor -method method -point index -from index -to index?");
  26. return TCL_ERROR;
  27. }
  28.  
  29. for (i = 3; i < objc; ++i) {
  30. if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) {
  31. return TCL_ERROR;
  32. }
  33. ++i;
  34. switch (index) {
  35. case OPT_POINT:
  36. if (Tcl_GetIntFromObj(interp, objv[i], &point) != TCL_OK) {
  37. return TCL_ERROR;
  38. }
  39. break;
  40. case OPT_FROM:
  41. if (Tcl_GetLongFromObj(interp, objv[i], &limit[0]) != TCL_OK) {
  42. return TCL_ERROR;
  43. }
  44. break;
  45. case OPT_TO:
  46. if (Tcl_GetLongFromObj(interp, objv[i], &limit[1]) != TCL_OK) {
  47. return TCL_ERROR;
  48. }
  49. break;
  50. case OPT_FACTOR:
  51. if (Tcl_GetDoubleFromObj(interp, objv[i], &factor) != TCL_OK) {
  52. return TCL_ERROR;
  53. }
  54. break;
  55. case OPT_METHOD:
  56. if (Spc_GetMethodFromObj(interp, objv[i], &method) != TCL_OK) {
  57. return TCL_ERROR;
  58. }
  59. break;
  60. case OPT_SUBSAMPLE:
  61. if (Tcl_GetLongFromObj(interp, objv[i], &subsample) != TCL_OK) {
  62. return TCL_ERROR;
  63. }
  64. break;
  65. }
  66. }
  67.  
  68. if (method == METHOD_SIMPLE && point == -1) {
  69. Tcl_SetObjResult(interp, Tcl_NewStringObj("-point must be set for simple method", -1));
  70. return TCL_ERROR;
  71. }
  72.  
  73. channel = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), &mode);
  74. if (channel == NULL) {
  75. return TCL_ERROR;
  76. }
  77. Tcl_SetChannelOption(interp, channel, "-encoding", "binary");
  78.  
  79. photo = Tk_FindPhoto(interp, Tcl_GetString(objv[2]));
  80. if (photo == NULL) {
  81. return TCL_ERROR;
  82. }
  83. Tk_PhotoGetImage(photo, &block);
  84.  
  85. if (Tcl_Seek(channel, 0, SEEK_SET) == -1) {
  86. return TCL_ERROR;
  87. }
  88.  
  89. spcObj = Tcl_NewObj();
  90. if (Tcl_ReadChars(channel, spcObj, 512, 0) == -1) {
  91. Tcl_DecrRefCount(spcObj);
  92. return TCL_ERROR;
  93. }
  94. spcPtr = (SPCHDR *)Tcl_GetByteArrayFromObj(spcObj, NULL);
  95.  
  96. log_time(&perf[0]);
  97.  
  98. switch (method) {
  99. case METHOD_SIMPLE:
  100. if (SpcCreateSimpleMap(interp, spcPtr, channel, point, block.width, subsample,
  101. &valuesObj, &low, &high) != TCL_OK)
  102. return TCL_ERROR;
  103. break;
  104. case METHOD_SIGNALTOAXIS:
  105. case METHOD_SIGNALTOBASELINE:
  106. if (SpcCreateSigBaselineMap(interp, spcPtr, channel, method, block.width, subsample,
  107. limit, &valuesObj, &low, &high) != TCL_OK)
  108. return TCL_ERROR;
  109. break;
  110. default:
  111. Tcl_SetObjResult(interp, Tcl_NewStringObj("method not implemented yet", -1));
  112. return TCL_ERROR;
  113. }
  114. valuesPtr = (float *)Tcl_GetByteArrayFromObj(valuesObj, NULL);
  115. Tcl_DecrRefCount(spcObj);
  116.  
  117. if (factor == 0)
  118. factor = 255.0 / (high - low);
  119.  
  120. log_time(&perf[1]);
  121.  
  122. for (row = 0; row < block.height; ++row) {
  123. if ((row % subsample) == 0) {
  124. for (col = 0; col < block.width; ++col) {
  125. unsigned char *pixel;
  126. double value;
  127. //size_t ndx = row * block.width + col;
  128. size_t ndx = (row/subsample)*(block.width/subsample)+(col/subsample);
  129.  
  130. pixel = block.pixelPtr + (((block.height - row - 1) * block.pitch)
  131. + (col * block.pixelSize));
  132.  
  133. value = valuesPtr[ndx];
  134. pixel[block.offset[0]] = (unsigned char)fmin(255,((value - low) * factor));
  135. pixel[block.offset[1]] = 0;
  136. pixel[block.offset[2]] = 0;
  137. pixel[block.offset[3]] = (unsigned char)255;
  138. }
  139. } else {
  140. // memcopy last row onto this row
  141. long last = row - (row%subsample);
  142. unsigned char *lastRow = block.pixelPtr + ((block.height - last- 1) * block.pitch);
  143. unsigned char *thisRow = block.pixelPtr + ((block.height - row - 1) * block.pitch);
  144. memcpy(thisRow, lastRow, block.pitch);
  145. }
  146. }
  147.  
  148. log_time(&perf[2]);
  149.  
  150. Tk_PhotoPutBlock(
  151. #if 10 * TK_MAJOR_VERSION + TK_MINOR_VERSION >= 85
  152. interp,
  153. #endif
  154. photo, &block,
  155. 0, 0, block.width, block.height,
  156. TK_PHOTO_COMPOSITE_SET);
  157. Tcl_DecrRefCount(valuesObj);
  158.  
  159. log_time(&perf[3]);
  160. debug_print("a: %" LL_FORMAT "d b:%" LL_FORMAT "d c:%" LL_FORMAT "d\n",
  161. perf[1]-perf[0], perf[2]-perf[1], perf[3]-perf[2]);
  162.  
  163. listObj = Tcl_NewListObj(0, NULL);
  164. Tcl_ListObjAppendElement(interp, listObj, Tcl_NewDoubleObj(low));
  165. Tcl_ListObjAppendElement(interp, listObj, Tcl_NewDoubleObj(high));
  166. Tcl_SetObjResult(interp, listObj);
  167.  
  168. return TCL_OK;
  169. }