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)') 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)') 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