C***********************************************************************
C 
C_TITLE: MDIMDISP - Display an MDIM image on a Micro-VAX/GPX workstation 
C
C_DESCR: This software is a highly-simplified example program for display
C        of MDIM images located on CDROM media. The program is designed
C        to demonstrate how to extract image data from an MDIM file and 
C        then display the data.
C
C        The program was developed exclusively for a VAX-station with a
C        GPX color display. See Micro-VMS Workstation Software: Graphics
C        Programming Guide (version 3.0, May 1986) for a description
C        of the graphics routines used in this program.
C
C        The program assumes there is a standard VAX/VMS software 
C        interface to the CDROM disc. Currently, under version 5 of
C        VMS there is not a system interface to the ISO/CDROM standard.
C        However, there is a DEC beta-test version CDROM interface,
C        "VFS Mount Field Test Tool Kit", that provides access to ISO
C        standard disks. The driver software is not generally available
C        from DEC. It can be obtained from Jason Hyon, PDS, at the 
C        following address:
C 
C        Jason Hyon
C        Jet Propulsion Laboratory
C        MS 168-514
C        4800 Oak Grove Drive
C        Pasadena, CA 91109
C
C        The program functions as follows:
C        1) MDIMDISP will prompt the user for the desired size of the
C           window used for display of the image. The default display
C           size is 15 centimeters.
C        2) Next the users is prompted to input the name of the
C           CDROM image file to display.
C        3) The display window is then created for eventual display
C           of the image data.
C        4) The program reads the entire image into memory
C        5) An "auto-stretch" is performed on the image data to generate
C           an optimum display of the data.
C        6) The image is then send to the display window.
C        7) The program prompts the user for the next image to display.
C
C        The program works best with the 1/64-th degree scale MDIM images 
C        because these images fit nicely into the default window size. It
C        is possible to display larger images with MDIMDISP. However, only
C        a part of the whole image can be viewed at any given time. The
C        program initially displays as much data as can be viewed in the
C        display window. The lower-left part of the image will be displayed.
C        Other parts of the image can be display by altering the size of the
C        window with the mouse control (the standard mouse control features
C        are utilized.)
C
C        The program can be complied and linked with the simple commands:
C        $FOR  MDIMDISP
C        $LINK MDIMDISP
C
C        This program was adapted from the CDIMAGE software created by
C        Robert Mehlman at UCLA/IGPP.
C
C_HIST   28May87 RMehlman, UCLA/IGPP, Original version called CDIMAGE
C        21Jul91 EEliason, USGS, Modified to work on MDIM images
C
C***************************************************************************
      PROGRAM MDIMDISP
      IMPLICIT INTEGER(U-W)
      INCLUDE 'SYS$LIBRARY:UISENTRY'
      INCLUDE 'SYS$LIBRARY:UISUSRDEF'
      PARAMETER (MCOUNT=256)
      CHARACTER*64 IFILE
      REAL*4 R(0:MCOUNT),G(0:MCOUNT),B(0:MCOUNT)
      INTEGER*4 VCM_ATT(3),CMS_ID
      
      BYTE KBUF(8000000)

      INTEGER*4      IHIST(256)
      CHARACTER*4096 HSTR
      EQUIVALENCE (HSTR,IHIST)

      CHARACTER*4096 STR
      BYTE BUF(4096)
      EQUIVALENCE (STR,BUF)

      REAL*4 HIST(256),XHIST(256)

      REAL*4 X1,Y1,X2,Y2,WIDTH,HEIGHT,SIZE,DEFSIZ
      DATA  X1, Y1,  X2,  Y2,DEFSIZ
     1    /0.0,0.0,100.0,100.0,  15./

      DATA IIN,IOUT,LBLK,ICOUNT, IEXCL,NLEV
     1    /  5,   6, 512,   128,-32768, 128/


      DATA NHIST/256/
      COMMON/PRT/ IOUT,IIN

C***********************************************************************
C Enter the viewport size in centimeters
C***********************************************************************
      WRITE (IOUT,900)
 900  FORMAT ('$Enter side of viewport in centimeters (default 15.): ')
      READ (IIN,901) SIZE
 901  FORMAT (F10.0)

      IF (SIZE.LE.0.) SIZE=DEFSIZ
      WIDTH=SIZE
      HEIGHT=SIZE

      IFIRST = 0

C***********************************************************************
C Top of loop. Prompt user for the name of the MDIM file 
C***********************************************************************
 1000 CONTINUE

      WRITE(IOUT,903)
  903 FORMAT('$Enter MDIM input file to display: ')
      READ(IIN,904,END=9000) IFILE
  904 FORMAT(A)

      ID=10
      OPEN (UNIT=ID,NAME=IFILE,STATUS='OLD',ACCESS='SEQUENTIAL',
     . FORM='FORMATTED',READONLY)

C************************************************************************
C  Set up for colors and for display
C************************************************************************
      IF (IFIRST.EQ.0) THEN
        IFIRST = 1
        VCM_ATT(1)=VCMAL$C_ATTRIBUTES
        VCM_ATT(2)=VCMAL$M_NO_BIND
        VCM_ATT(3)=VCMAL$C_END_OF_LIST
        VCM_ID=UIS$CREATE_COLOR_MAP(ICOUNT,,VCM_ATT)
        CMS_ID=UIS$CREATE_COLOR_MAP_SEG(VCM_ID,'SYS$WORKSTATION',
     .   UIS$C_COLOR_GENERAL)
        VD_ID=UIS$CREATE_DISPLAY(X1,Y1,X2,Y2,WIDTH,HEIGHT,VCM_ID)
        WD_ID=UIS$CREATE_WINDOW(VD_ID,'SYS$WORKSTATION','IMAGE')
        CALL COLORSET(R,G,B,ICOUNT)
        CALL UIS$SET_COLORS(VD_ID,0,ICOUNT,R,G,B)
        CALL UIS$SET_WRITING_MODE(VD_ID,1,1,UIS$C_MODE_COPY)
      END IF


C***********************************************************************
C Read the PDS label, make tests, return the following information.
C
C NLREC   = number of label records in file
C NHREC   = number of histogram records in file
C NIREC   = number of image records in file
C ICHKSUM = check sum of image found on labels
C INL     = number of lines in image
C INS     = number of samples in image
C IERROR  = error return code
C***************************************************************************
      CALL RDLAB(ID, NLREC, NHREC, NIREC, ICHKSUM, INL, INS, IERROR)
      IF (IERROR.NE.0) GOTO 9010

      WRITE(IOUT,975) INL,INS
  975 FORMAT(' Number of lines and samples: ',2i5)

C***********************************************************************
C Read the image histogram object
C***********************************************************************
      DO I = 1,NHREC
         READ(ID,'(A)',END=9015) HSTR((I-1)*INS+1:(I-1)*INS+INS)
      END DO

C**********************************************************************
C Read the image data
C**********************************************************************
      DO I = 1,NIREC
         READ(ID,'(A)',END=9015) STR(1:INS)
         CALL B2B(BUF,KBUF((I-1)*INS+1),INS)
      END DO

      CLOSE (UNIT=ID)

      NCOL = INS
      NROW = INL
      NPIXEL = NROW*NCOL
      IQ=0

C***************************************************************************
C Find low 0.1% of histogram maximum
C***************************************************************************
      ICNT = 0
      IMINMAX = NPIXEL*0.001
      LSMIN = 0
      DO I = 2,NHIST
         ICNT = ICNT + IHIST(I)
         IF (ICNT.GT.IMINMAX) THEN
            LSMIN = I
            IF (LSMIN.LT.0) LSMIN = 0
            GOTO 1010
         END IF
      END DO
 1010 CONTINUE

C***************************************************************************
C Find the high 0.1% of histogram maximum
C***************************************************************************
      ICNT = 0
      LSMAX = 255
      DO I = NHIST,2,-1
         ICNT = ICNT + IHIST(I)
         IF (ICNT.GT.IMINMAX) THEN
            LSMAX = I
            IF (LSMAX.GT.255) LSMAX = 255
            GOTO 1020
         END IF
      END DO
 1020 CONTINUE

C**************************************************************************
C  Perform an  auto-stretch before display of the data.
C  The LSMIN and LSMAX parameters specify the range of data for stretch.
C**************************************************************************
      CALL LINSTR(KBUF,KBUF,NPIXEL,IEXCL,LSMIN,LSMAX,NLEV)

C***************************************************************************
C Display the image
C***************************************************************************
      CALL UIS$IMAGE(VD_ID,1,X1,Y1,X2,Y2,NCOL,NROW,8,KBUF)

C****************************************************************************
C All done
C***************************************************************************
      GOTO 1000

 9000 CONTINUE
      CALL UIS$DELETE_DISPLAY(VD_ID)
      STOP
C*************************************************************************
C Handle some errors
C*************************************************************************
 9010 CONTINUE
      WRITE(IOUT,810)
  810 FORMAT(' *** ERROR *** Can not read PDS labels on MDIM input')
      GOTO 9000

 9015 CONTINUE
      WRITE(IOUT,815)
  815 FORMAT(' *** ERROR *** Unexpected end-of-file in MDIM input')
      GOTO 9000

      END
      SUBROUTINE LINSTR(IA,JA,N,IEXCL,MIN,MAX,NLEV)
      BYTE IA(N),JA(N)

      F=FLOAT(NLEV-1)/(MAX-MIN)

      DO 40 I = 1,N
         J=IA(I)
         IF (J.LT.0) J=J+256
         IF (J.LE.MIN) J=MIN
         IF (J.GE.MAX) J=MAX
         J=F*(J-MIN)+.5
         J = J + 128
         IF (J.GE.128) J=J-256
         JA(I)=J
 40   CONTINUE
      RETURN
      END
      SUBROUTINE RDLAB(ID,NLREC,NHREC,NIREC,ICHKSUM,INL,INS,IERROR)
C***********************************************************************
C Read image label records and test for errors, return the parameters:
C
C NLREC   = number of label records
C NHREC   = number of histogram records
C NIREC   = number of image records
C ICHKSUM = check sum in image file
C INL     = number of lines
C INS     = number of samples
C IERROR  = error return code
C**************************************************************************
      COMMON /PRT/ IPR,IIN
      CHARACTER*32768 LABSTR
      
      IERROR = 0
      LABSTR = ' '

      IREC = 1
      READ(ID,900,END=9005) NCHAR,LABSTR(1:NCHAR)
  900 FORMAT(Q,A)

      IF (NCHAR.LE.250) THEN
         IREC = 2
         I1 = NCHAR + 1
         I2 = 2*NCHAR
         READ(ID,900,END=9005) NCHAR,LABSTR(I1:I2)
      END IF

C************************************************************************
C Determine the number of label records
C************************************************************************
      I = INDEX(LABSTR(1:IREC*NCHAR),'LABEL_RECORDS ')
      IF (I.EQ.0) GOTO 9010
      J = INDEX(LABSTR(I:IREC*NCHAR),'=')
      IF (J.EQ.0) GOTO 9010
      READ(LABSTR(I+J+1:I+J+2),'(i2)') NLREC

C***********************************************************************
C Read the remaining label records
C***********************************************************************
      IB = 1
      NBYTES = IREC*NCHAR
      KREC = IREC
      DO ILAB = 1,NLREC-KREC
         IB = IB + IREC*NCHAR
         IREC = 1
         READ(ID,900,END=9005) NCHAR,LABSTR(IB:IB+NCHAR)
         NBYTES = NBYTES + NCHAR
      END DO
      NCHAR = NBYTES
      
C************************************************************************
C Find pointer to IMAGE_HISTOGRAM
C************************************************************************
      I = INDEX(LABSTR(1:NCHAR),'^IMAGE_HISTOGRAM ')
      IF (I.EQ.0) GOTO 9020
      J = INDEX(LABSTR(I:NCHAR),'=')
      IF (J.EQ.0) GOTO 9020
      READ(LABSTR(I+J+1:I+J+2),'(i2)') IHPOINT

C*************************************************************************
C Find pointer to IMAGE
C************************************************************************
      I = INDEX(LABSTR(1:NCHAR),'^IMAGE ')
      IF (I.EQ.0) GOTO 9030
      J = INDEX(LABSTR(I:),'=')
      IF (J.EQ.0) GOTO 9030
      READ(LABSTR(I+J+1:I+J+2),'(I2)') IMPOINT

C************************************************************************
C Find CHECKSUM 
C************************************************************************
      I = INDEX(LABSTR(1:NCHAR),'CHECKSUM ')
      IF (I.EQ.0) GOTO 9040
      J = INDEX(LABSTR(I:),'=')
      IF (J.EQ.0) GOTO 9040
      READ(LABSTR(I+J+1:I+J+9),'(I9)') ICHKSUM

C************************************************************************
C Find LINES
C************************************************************************
      I = INDEX(LABSTR(1:NCHAR),' LINES ')
      IF (I.EQ.0) GOTO 9050
      J = INDEX(LABSTR(I:),'=')
      IF (J.EQ.0) GOTO 9050
      IFIRST = I + J + 1
      ILAST = 0
      I = IFIRST
      DO WHILE(ILAST.EQ.0)
         IF (LABSTR(I:I).NE.' ') THEN
            IF (LABSTR(I:I).LT.'0'.OR.LABSTR(I:I).GT.'9') THEN
               ILAST = I - 1
            END IF
         END IF      
         I = I + 1
      END DO     

      N = ILAST-IFIRST+1
      READ(LABSTR(IFIRST:ILAST),'(I<N>)') INL
      
C************************************************************************
C Find LINE_SAMPLES
C************************************************************************
      I = INDEX(LABSTR(1:NCHAR),' LINE_SAMPLES ')
      IF (I.EQ.0) GOTO 9060
      J = INDEX(LABSTR(I:),'=')
      IF (J.EQ.0) GOTO 9060
      IFIRST = I + J + 1
      ILAST = 0
      I = IFIRST
      DO WHILE(ILAST.EQ.0)
         IF (LABSTR(I:I).NE.' ') THEN
            IF (LABSTR(I:I).LT.'0'.OR.LABSTR(I:I).GT.'9') THEN
               ILAST = I - 1
            END IF
         END IF      
         I = I + 1
      END DO     

      N = ILAST-IFIRST+1
      READ(LABSTR(IFIRST:ILAST),'(I<N>)') INS

C*************************************************************************  
C Find the number of FILE_RECORDS 
C*************************************************************************
      I = INDEX(LABSTR(1:NCHAR),'FILE_RECORDS ')
      IF (I.EQ.0) GOTO 9070
      J = INDEX(LABSTR(I:),'=')
      IF (J.EQ.0) GOTO 9070
      READ(LABSTR(I+J+1:I+J+4),'(I4)') IFRECS

C**********************************************************************
C Make sure END/cr/lf sequence exits
C**********************************************************************
      I = INDEX(LABSTR(1:NCHAR),'END'//CHAR(13)//CHAR(10))
      IF (I.EQ.0) GOTO 9080

C***********************************************************************
C Let's do some calculations. Determine:
C NHREC,NIREC
C**********************************************************************
      NHREC = IMPOINT - IHPOINT
      NIREC = IFRECS - IMPOINT +1
      RETURN 

C***********************************************************************
C Handle some errors
C************************************************************************
 9005 CONTINUE
      WRITE(IPR,7005)
 7005 FORMAT(
     .' *** ERROR *** Unexpected end-of-file encountered in RDLAB')
      IERROR = 1
      RETURN

 9010 CONTINUE
      WRITE(IPR,7010)
 7010 FORMAT(
     .' *** ERROR *** Error with LABEL_RECORDS keyword')
      IERROR = 1
      RETURN

 9020 CONTINUE
      WRITE(IPR,7020)
 7020 FORMAT(
     .' *** ERROR *** Error in ^IMAGE_HISTOGRAM keyword')
      IERROR = 1
      RETURN

 9030 CONTINUE
      WRITE(IPR,7030)
 7030 FORMAT(
     .' *** ERROR *** Error in ^IMAGE keyword')
      IERROR = 1
      RETURN

 9040 CONTINUE
      WRITE(IPR,7040)
 7040 FORMAT(
     .' *** ERROR *** Error in CHECKSUM keyword')
      IERROR = 1
      RETURN

 9050 CONTINUE
      WRITE(IPR,7050)
 7050 FORMAT(
     .' *** ERROR *** Error in LINES keyword')
      IERROR = 1
      RETURN

 9060 CONTINUE
      WRITE(IPR,7060)
 7060 FORMAT(
     .' *** ERROR *** Error in LINE_SAMPLES keyword')
      IERROR = 1
      RETURN

 9070 CONTINUE
      WRITE(IPR,7070)
 7070 FORMAT(
     .' *** ERROR *** Error in FILE_RECORDS keyword')
      IERROR = 1
      RETURN

 9080 CONTINUE
      WRITE(IPR,7080)
 7080 FORMAT(
     .' *** ERROR *** END//cr//lf sequence not found in labels')
      IERROR = 1
      RETURN
      END
      SUBROUTINE COLORSET(R,G,B,MAPSIZE)
      REAL*4 R(0:MAPSIZE),G(0:MAPSIZE),B(0:MAPSIZE)
      DO IR = 0, MAPSIZE-1
         R(IR) = FLOAT(IR)/FLOAT(MAPSIZE)
         G(IR) = FLOAT(IR)/FLOAT(MAPSIZE)
         B(IR) = FLOAT(IR)/FLOAT(MAPSIZE)
      END DO
      RETURN
      END
      SUBROUTINE B2B(IN,OUT,INS)
C****************************************************************************
C B2B simply moves data from the input buffer (IN) to the output buffer (OUT)
C****************************************************************************
      BYTE IN(1),OUT(1)
      INTEGER*4 INS
      DO I = 1, INS
         OUT(I) = IN(I)
      END DO
      RETURN
      END