HC***********************************************************************C IC_TITLE: MDIMDISP - Display an MDIM image on a Micro-VAX/GPX workstation CIC_DESCR: This software is a highly-simplified example program for displayGC of MDIM images located on CDROM media. The program is designedHC to demonstrate how to extract image data from an MDIM file and C then display the data.CGC The program was developed exclusively for a VAX-station with aHC GPX color display. See Micro-VMS Workstation Software: GraphicsDC Programming Guide (version 3.0, May 1986) for a description7C of the graphics routines used in this program.CBC The program assumes there is a standard VAX/VMS software CC interface to the CDROM disc. Currently, under version 5 ofGC VMS there is not a system interface to the ISO/CDROM standard.CC However, there is a DEC beta-test version CDROM interface,EC "VFS Mount Field Test Tool Kit", that provides access to ISOGC standard disks. The driver software is not generally availableCC from DEC. It can be obtained from Jason Hyon, PDS, at the C following address:C C Jason Hyon"C Jet Propulsion LaboratoryC MS 168-514C 4800 Oak Grove DriveC Pasadena, CA 91109C*C The program functions as follows:EC 1) MDIMDISP will prompt the user for the desired size of theEC 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.CC 3) The display window is then created for eventual displayC of the image data.:C 4) The program reads the entire image into memoryHC 5) An "auto-stretch" is performed on the image data to generate+C an optimum display of the data.9C 6) The image is then send to the display window.GC 7) The program prompts the user for the next image to display.CJC The program works best with the 1/64-th degree scale MDIM images IC because these images fit nicely into the default window size. ItJC is possible to display larger images with MDIMDISP. However, onlyGC a part of the whole image can be viewed at any given time. TheHC program initially displays as much data as can be viewed in theLC display window. The lower-left part of the image will be displayed.LC Other parts of the image can be display by altering the size of theKC window with the mouse control (the standard mouse control featuresC are utilized.)CIC The program can be complied and linked with the simple commands:C $FOR MDIMDISPC $LINK MDIMDISPCFC This program was adapted from the CDIMAGE software created by%C Robert Mehlman at UCLA/IGPP.CEC_HIST 28May87 RMehlman, UCLA/IGPP, Original version called CDIMAGE@C 21Jul91 EEliason, USGS, Modified to work on MDIM imagesCLC*************************************************************************** PROGRAM MDIMDISP IMPLICIT INTEGER(U-W)$ INCLUDE 'SYS$LIBRARY:UISENTRY'% INCLUDE 'SYS$LIBRARY:UISUSRDEF' PARAMETER (MCOUNT=256) CHARACTER*64 IFILE0 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)1 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,IINHC***********************************************************************(C Enter the viewport size in centimetersHC*********************************************************************** WRITE (IOUT,900)G 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 = 0HC***********************************************************************9C Top of loop. Prompt user for the name of the MDIM file HC*********************************************************************** 1000 CONTINUE WRITE(IOUT,903)3 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)IC************************************************************************$C Set up for colors and for displayIC************************************************************************ 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_LIST4 VCM_ID=UIS$CREATE_COLOR_MAP(ICOUNT,,VCM_ATT)A CMS_ID=UIS$CREATE_COLOR_MAP_SEG(VCM_ID,'SYS$WORKSTATION', . UIS$C_COLOR_GENERAL)A 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)1 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 IFHC***********************************************************************CC 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 imageC IERROR = error return codeLC***************************************************************************D CALL RDLAB(ID, NLREC, NHREC, NIREC, ICHKSUM, INL, INS, IERROR) IF (IERROR.NE.0) GOTO 9010 WRITE(IOUT,975) INL,INS2 975 FORMAT(' Number of lines and samples: ',2i5)HC***********************************************************************!C Read the image histogram objectHC*********************************************************************** DO I = 1,NHREC@ READ(ID,'(A)',END=9015) HSTR((I-1)*INS+1:(I-1)*INS+INS) END DOGC**********************************************************************C Read the image dataGC********************************************************************** 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=0LC***************************************************************************$C Find low 0.1% of histogram maximumLC*************************************************************************** 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 CONTINUELC***************************************************************************)C Find the high 0.1% of histogram maximumLC*************************************************************************** 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 CONTINUEKC**************************************************************************7C Perform an auto-stretch before display of the data.HC The LSMIN and LSMAX parameters specify the range of data for stretch.KC**************************************************************************: CALL LINSTR(KBUF,KBUF,NPIXEL,IEXCL,LSMIN,LSMAX,NLEV)LC***************************************************************************C Display the imageLC***************************************************************************: CALL UIS$IMAGE(VD_ID,1,X1,Y1,X2,Y2,NCOL,NROW,8,KBUF)MC**************************************************************************** C All doneLC*************************************************************************** GOTO 1000 9000 CONTINUE$ CALL UIS$DELETE_DISPLAY(VD_ID) STOPJC*************************************************************************C Handle some errorsJC************************************************************************* 9010 CONTINUE WRITE(IOUT,810)D 810 FORMAT(' *** ERROR *** Can not read PDS labels on MDIM input') GOTO 9000 9015 CONTINUE WRITE(IOUT,815)C 815 FORMAT(' *** ERROR *** Unexpected end-of-file in MDIM input') GOTO 9000 END3 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 ENDC SUBROUTINE RDLAB(ID,NLREC,NHREC,NIREC,ICHKSUM,INL,INS,IERROR)HC***********************************************************************FC 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 fileC INL = number of linesC INS = number of samplesC IERROR = error return codeKC************************************************************************** COMMON /PRT/ IPR,IIN CHARACTER*32768 LABSTR IERROR = 0 LABSTR = ' ' IREC = 11 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*NCHAR2 READ(ID,900,END=9005) NCHAR,LABSTR(I1:I2) END IFIC************************************************************************'C Determine the number of label recordsIC************************************************************************6 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)') NLRECHC***********************************************************************"C Read the remaining label recordsHC*********************************************************************** IB = 1 NBYTES = IREC*NCHAR KREC = IREC DO ILAB = 1,NLREC-KREC IB = IB + IREC*NCHAR IREC = 18 READ(ID,900,END=9005) NCHAR,LABSTR(IB:IB+NCHAR) NBYTES = NBYTES + NCHAR END DO NCHAR = NBYTES IC************************************************************************!C Find pointer to IMAGE_HISTOGRAMIC************************************************************************4 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)') IHPOINTJC*************************************************************************C Find pointer to IMAGEIC************************************************************************* 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)') IMPOINTIC************************************************************************C Find CHECKSUM IC************************************************************************, 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)') ICHKSUMIC************************************************************************C Find LINESIC************************************************************************* 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 IC************************************************************************C Find LINE_SAMPLESIC************************************************************************1 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)') INSLC************************************************************************* "C Find the number of FILE_RECORDS JC*************************************************************************0 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)') IFRECSGC**********************************************************************$C Make sure END/cr/lf sequence exitsGC**********************************************************************: I = INDEX(LABSTR(1:NCHAR),'END'//CHAR(13)//CHAR(10)) IF (I.EQ.0) GOTO 9080HC***********************************************************************(C Let's do some calculations. Determine: C NHREC,NIRECGC********************************************************************** NHREC = IMPOINT - IHPOINT! NIREC = IFRECS - IMPOINT +1 RETURN HC***********************************************************************C Handle some errorsIC************************************************************************ 9005 CONTINUE WRITE(IPR,7005) 7005 FORMAT(C .' *** ERROR *** Unexpected end-of-file encountered in RDLAB') IERROR = 1 RETURN 9010 CONTINUE WRITE(IPR,7010) 7010 FORMAT(8 .' *** ERROR *** Error with LABEL_RECORDS keyword') IERROR = 1 RETURN 9020 CONTINUE WRITE(IPR,7020) 7020 FORMAT(9 .' *** 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(1 .' *** 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(5 .' *** ERROR *** Error in LINE_SAMPLES keyword') IERROR = 1 RETURN 9070 CONTINUE WRITE(IPR,7070) 7070 FORMAT(5 .' *** ERROR *** Error in FILE_RECORDS keyword') IERROR = 1 RETURN 9080 CONTINUE WRITE(IPR,7080)* 7080 FORMAT(M@ .' *** ERROR *** END//cr//lf sequence not found in labels') IERROR = 1 RETURN ENDl( SUBROUTINE COLORSET(R,G,B,MAPSIZE)3 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)a) B(IR) = FLOAT(IR)/FLOAT(MAPSIZE)d END DO RETURN END SUBROUTINE B2B(IN,OUT,INS)MC****************************************************************************,MC B2B simply moves data from the input buffer (IN) to the output buffer (OUT)oMC**************************************************************************** BYTE IN(1),OUT(1) INTEGER*4 INS, DO I = 1, INS OUT(I) = IN(I) END DO RETURN ENDn