C This program reads the IMAGE and IMAGE_HISTOGRAM object from the attached C label file V1.LBL, calculates the histogram of the image, and compares it C with the IMAGE_HISTOGRAM read from the file - the two should be identical. C The file V1.LBL must be present in the default directory the program is C run from. C C Platforms this has been tested on are: C 1) SGI/Irix C 2) Sun Sparc/Solaris C 3) VAX/VMS C 4) Dec 3100/Ultrix C 5) Dec Alpha/OpenVMS C implicit none INCLUDE 'OAL_FORTRAN.INC' INCLUDE 'L3_FORTRAN.INC' C These variables must be the same size as C long's or pointers. C On a Dec Alpha they should be integer*8; on all other platforms they C should be integer*4. integer*4 ODLTREE, SIZE integer*4 ROOT_NODE, ODLTREENODE, IMAGE_NODE integer*4 HISTOGRAM_NODE integer*4 IMAGE_OBJECT1, HISTOGRAM_OBJECT integer*4 IMAGE_OBJECT2, IMAGE_HANDLE integer*4 IMAGE_HISTOGRAM_PTR, IMAGE_PTR integer*4 START_LINE, STOP_LINE integer*4 START_SAMPLE, STOP_SAMPLE C These variables must be the same size as C int's. integer*4 OBJECT_POSITION, ERR integer*4 HISTOGRAM(256) C These variables must be the same size as C short's. integer*2 EXPAND, NOMSGS, SEARCH_SCOPE byte IS_IN_MEMORY character*80 LABEL_FILENAME, ERRFILESPEC character*128 STR character*50 KEYWORD_NAME, KEYWORD_VALUE, OBJECT_CLASS C Local function declarations: integer*4 COMPARE_HISTOGRAMS C Read in the label from V1.LBL. This is an attatched label with variable- C length records, containing a HFD compressed Voyager image of miranda, C an engineering table and two histograms. type *,'Reading V1.LBL' LABEL_FILENAME = 'V1.LBL' ERRFILESPEC = ' ' EXPAND = 0 NOMSGS = 0 ROOT_NODE = OaFortParseLabelFile( LABEL_FILENAME, ERRFILESPEC, 1 EXPAND, NOMSGS) if (ROOT_NODE .eq. NULL) then call OaFortReportError( 'Error: OaFortParseLabelFile ' // 1 'returned 0!') go to 999 end if C Print out the class names of all the root node's children. ODLTREENODE = OdlFortLeftmostChild( ROOT_NODE) call OaFortReportError( 'Children of root node are:') do while (ODLTREENODE .ne. NULL) ERR = OdlFortGetObjDescClassName( ODLTREENODE, OBJECT_CLASS) call OaFortReportError( 'OBJECT_CLASS = ' // OBJECT_CLASS) ODLTREENODE = OdlFortRightSibling( ODLTREENODE) end do type *,' ' C Get the IMAGE node. OBJECT_CLASS = 'IMAGE' KEYWORD_NAME = ' ' KEYWORD_VALUE = ' ' OBJECT_POSITION = 0 SEARCH_SCOPE = ODL_RECURSIVE_DOWN IMAGE_NODE = OdlFortFindObjDesc( ROOT_NODE, OBJECT_CLASS, 1 KEYWORD_NAME, KEYWORD_VALUE, 2 OBJECT_POSITION, SEARCH_SCOPE) if (IMAGE_NODE .eq. NULL) then call OaFortReportError( 'Error: OdlFortFindObjDesc ' // 1 'could not find IMAGE node!') go to 999 end if C Read the IMAGE into memory two different ways. type *,'Reading in IMAGE with OaFortReadImage...' IMAGE_OBJECT1 = OaFortReadImage( IMAGE_NODE) if (IMAGE_OBJECT1 .eq. NULL) then call OaFortReportError( 'Error: OdlFortReadImage failed!') go to 999 end if type *,'Reading in IMAGE with OaFortReadPartialImage...' IMAGE_HANDLE = OaFortOpenImage( IMAGE_NODE) if (IMAGE_HANDLE .eq. NULL) then call OaFortReportError( 'Error: OaFortOpenImage ' // 1 'failed!') go to 999 end if START_LINE = 1 STOP_LINE = 800 START_SAMPLE = 1 STOP_SAMPLE = 800 IMAGE_OBJECT2 = OaFortReadPartialImage( IMAGE_HANDLE, 1 START_LINE, 2 STOP_LINE, 3 START_SAMPLE, 4 STOP_SAMPLE) if (IMAGE_OBJECT2 .eq. NULL) then call OaFortReportError( 'Error: OdlFortReadPartialImage ' // 1 'failed!') go to 999 end if ERR = OaFortCloseImage( IMAGE_HANDLE) C Get the IMAGE_HISTOGRAM node. OBJECT_CLASS = 'IMAGE_HISTOGRAM' HISTOGRAM_NODE = OdlFortFindObjDesc( ROOT_NODE, OBJECT_CLASS, 1 KEYWORD_NAME, KEYWORD_VALUE, 2 OBJECT_POSITION, SEARCH_SCOPE) if (HISTOGRAM_NODE .eq. NULL) then call OaFortReportError( 'Error: OdlFortFindObjDesc ' // 1 'could not find IMAGE_HISTOGRAM node!') go to 999 end if C Read the IMAGE_HISTOGRAM into memory. type *,'Reading in HISTOGRAM' HISTOGRAM_OBJECT = OaFortReadHistogram( HISTOGRAM_NODE) if (HISTOGRAM_OBJECT .eq. NULL) then call OaFortReportError( 'Error: OdlFortReadHistogram ' // 1 ' failed!') go to 999 end if C Strip the HISTOGRAM object of everything but the data. The returned value C is a pointer to the data. IMAGE_HISTOGRAM_PTR = OaFortExportObject( HISTOGRAM_OBJECT) C Print out a few values to see if it worked. call OaFortReportError( 'First 5 values should be: ' // 1 '529 182 139 284 315') STR = 'First 5 histogram values are: ' call PRINT_HISTOGRAM_VALUES( %val( IMAGE_HISTOGRAM_PTR)) C Calculate the histogram from the image, and put the result in HISTOGRAM. C Instead of calling OaFortExportObject to get the data_ptr, get values from C the Oa_object structure, just to show a different way of doing it. C Then pass the data_ptr into CALCULATE_HISTOGRAM. call OaFortGetObjectInfo( IMAGE_OBJECT1, ODLTREE, IMAGE_PTR, 1 SIZE, IS_IN_MEMORY) call CALCULATE_HISTOGRAM( %val(IMAGE_PTR), HISTOGRAM) C Compare the calculated histogram with the histogram read from the file. ERR = COMPARE_HISTOGRAMS( %val(IMAGE_HISTOGRAM_PTR), HISTOGRAM) if (ERR .ne. 0) then go to 999 !Error message already printed end if C Free all the objects. HISTOGRAM_OBJECT was already freed by export call. call OaFortDeleteObject( IMAGE_OBJECT1) call OaFortDeleteObject( IMAGE_OBJECT2) type *,'All tests worked!' 999 end subroutine PRINT_HISTOGRAM_VALUES( IMAGE_HISTOGRAM) integer*4 IMAGE_HISTOGRAM(*) character*32 TMP_STR character*128 STR integer*4 I do I = 1,5 write( TMP_STR, '(I5)') IMAGE_HISTOGRAM(I) STR = STR(1:index( STR, ' ')) // TMP_STR end do STR = 'First 5 values are: ' // STR call OaFortReportError( STR) end subroutine CALCULATE_HISTOGRAM( IMAGE, HISTOGRAM) byte IMAGE(800,800) integer*4 HISTOGRAM(256) C Define an equivalence (overlay) so that can access the MSB and LSB bytes C of a 2-byte integer independently. By setting the 2-byte integer to 1, C then testing which byte is 1, you can find whether the platform you're C running on uses MSB integers or LSB integers, and thus which byte of a C 2-byte integer is the MSB byte. C When calculating the histogram, each 1-byte image pixel is copied into a C 2-byte integer, then the integer's MSB byte set to 0. This is then used to C index the HISTOGRAM array. Indexing the array with a byte directly from the C image doesn't work because pixel values between 128 and 255 give negative C numbers, and an error when trying to index. byte PIXEL_BYTE_MASK(2) integer*2 PIXEL, I, J equivalence( PIXEL, PIXEL_BYTE_MASK) byte MSB_BYTE PIXEL = 1 if (PIXEL_BYTE_MASK(1) .eq. 1) then MSB_BYTE = 2 else MSB_BYTE = 1 end if C Initialize output HISTOGRAM. do I = 1,256 HISTOGRAM(I) = 0 end do do I = 1,800 do J = 1,800 PIXEL = IMAGE(I,J) PIXEL_BYTE_MASK( MSB_BYTE) = 0 HISTOGRAM( PIXEL+1) = HISTOGRAM( PIXEL+1) + 1 end do end do end integer*4 function COMPARE_HISTOGRAMS( HISTOGRAM1, HISTOGRAM2) integer*4 HISTOGRAM1(256) integer*4 HISTOGRAM2(256) integer*4 I do I = 1,256 if (HISTOGRAM1(I) .ne. HISTOGRAM2(I)) then type *,'Error: histograms do not match; I = ',I COMPARE_HISTOGRAMS = 1 return end if end do type *,'histograms match' COMPARE_HISTOGRAMS = 0 return end