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
