! Decodes up to 2048 digits from recorded DTMF tones ! Tones must be recorded in Microsoft WAV file format ! Any sampling rate >= 8000 Hz is OK ! If the WAV file is stereo, the tones must be on the left channel ! Maximun length of the WAV file is 6615000 samples (5 minutes @ 22050 samples/sec) ! ! Attempts to format the output like 1-800-555-1212 or 904-873-9820 or 729-8264 ! A pause of > 1 second between digits starts a new number ! ! Drag the WAV file to the icon for this program to begin decoding ! use dflib ! for getarg, getfileinfoqq IMPLICIT REAL*8(A-H), REAL*8(O-Z) PARAMETER (MAXPTS = 6615000) ! 5 minutes max @ 22050 samples/sec COMPLEX*16, ALLOCATABLE :: Y1(:) CHARACTER*256 fileIn, ERMSG PARAMETER(HAFPI=1.570796326794896D0) PARAMETER (PI=3.141592653589793D0) PARAMETER(TWOPI=6.283185307179586D0) PARAMETER(TC = .023D0) ! TIME CONSTANT FOR 1ST ORDER LPFs character*1 matrix(4,4) ! character for each combination of (low,high) tones character*2048 string ! output data character*64 wstr STRUCTURE /struct/ real*8 w ! frequency (rad/sec) real*8 i ! I component real*8 q ! q component real*8 a ! amplitude (squared) component END STRUCTURE RECORD /struct/ x(8) ! one element for each frequency to detect TYPE (FILE$INFO) finfo INTEGER(4) handle, flength ALLOCATE(Y1(MAXPTS), STAT=ierr) if(ierr .ne. 0) then write(6,*) '****Allocation error: ',ierr write(6,*)' to continue ...' read(5,*) stop end if matrix(1,1) = '1' ! 697 Hz, 1209 Hz matrix(1,2) = '2' matrix(1,3) = '3' matrix(1,4) = 'A' ! 697 Hz, 1633 Hz matrix(2,1) = '4' ! 770 Hz, 1209 Hz matrix(2,2) = '5' matrix(2,3) = '6' matrix(2,4) = 'B' ! 770 Hz, 1633 Hz matrix(3,1) = '7' ! 852 Hz, 1209 Hz matrix(3,2) = '8' matrix(3,3) = '9' matrix(3,4) = 'C' ! 852 Hz, 1633 Hz matrix(4,1) = '*' ! 941 Hz, 1209 Hz matrix(4,2) = '0' matrix(4,3) = '#' matrix(4,4) = 'D' ! 941 Hz, 1633 Hz ! low group x(1).w = 697 x(2).w = 770 x(3).w = 852 x(4).w = 941 ! high group x(5).w = 1209 x(6).w = 1336 x(7).w = 1477 x(8).w = 1633 do k = 1,8 ! convert frequencies to radians x(k).w = x(k).w*TWOPI end do IERR = SETEXITQQ (QWIN$EXITNOPERSIST) ! DON'T PROMPT TO CLOSE program fileIn = ' ' call getarg(int2(1), fileIn) ! get file name to process if(fileIn.eq.' ') then write(6,*)'Must specify input file (drag to icon)' write(6,*)' to continue ...' read(5,*) stop end if handle = FILE$FIRST flength = GETFILEINFOQQ(trim(fileIn), finfo, handle) if(flength.eq.0) then write(6,*)'File not found: '//trim(fileIn) write(6,*)' to continue ...' read(5,*) stop end if write(6,*)'Reading file ...' CALL WAVREAD(Y1,fileIn,MAXPTS,NPTS,XMIN,DX,KERR,ERMSG) if(KERR .ne. 0) then write(6,*) trim(ERMSG) write(6,*)' to continue ...' read(5,*) stop end if write(6,*)'Computing ...' string = ' ' jstr = 0 dfract = 2.7182818d0 ** (-DX/TC) ! fractional discharge of filter per sampling interval ! Effective filter +/- 3 dB bandwidth is 1/(2*PI*TC) = +/- 6.9 Hz itone = 0 ! tone currently detected ampmax = 0.d0 amppeak = 0.d0 xxi = 0 xxq = 0 do J = 1,NPTS ! find max amplitude to set a threshold t = (J-1)*DX do k = 1, 8 ! each dtmf tone xxi = xxi*dfract + cos(x(k).w*t)*dreal(Y1(j)) ! mix down to I & Q baseband xxq = xxq*dfract + sin(x(k).w*t)*dreal(Y1(j)) ! first order LPFs with time constant TC xxa = xxi ** 2 + xxq ** 2 ! amplitude squared end do if(xxa .gt. amppeak) amppeak = xxa end do ampthresh = .25 * amppeak ! minimum amplitude at output of filter for detection ampoff = .1 * amppeak toff = -10. do J = 1,NPTS ! each data point t = (J-1)*DX do k = 1, 8 ! each dtmf tone x(k).i = x(k).i*dfract + cos(x(k).w*t)*dreal(Y1(j)) ! mix down to I & Q baseband x(k).q = x(k).q*dfract + sin(x(k).w*t)*dreal(Y1(j)) ! first order LPFs with time constant TC x(k).a = x(k).i ** 2 + x(k).q ** 2 ! amplitude squared end do indAmax = 0 ! find highest & second highest signal in low tone series indA2nd = 0 ampAmax = 0.d0 ampA2nd = 0.d0 do k = 1,4 if(x(k).a .gt. ampAmax) then ampAmax = x(k).a indAmax = k end if end do do k = 1,4 if(k.ne.indAmax .and. x(k).a .gt. ampA2nd) then ampA2nd = x(k).a indA2nd = k end if end do indBmax = 0 ! find highest & second highest signal in high tone series indB2nd = 0 ampBmax = 0.d0 ampB2nd = 0.d0 do k = 5,8 if(x(k).a .gt. ampBmax) then ampBmax = x(k).a indBmax = k end if end do do k = 5,8 if(k.ne.indBmax .and. x(k).a .gt. ampB2nd) then ampB2nd = x(k).a indB2nd = k end if end do ampmax = max(ampmax, ampAmax, ampBmax) ! maximun amplitude during tone if(itone .eq. 0) then ! looking for beginning of a tone if(ampAmax .ge. ampthresh .and. ampBmax .ge. ampthresh) then ! both tones above detection threshold if(ampmax .ge. 3.d0*ampoff) then ! a new tone has started if(ampAmax .ge. 10.d0*ampA2nd .and. ampBmax .ge. 10.d0*ampB2nd) then ! >= 10 dB ratio between highest & second highest itone = 1 if(t .gt. toff + 1.d0) then ! start a new line if > 1 sec between tones jstr = jstr + 1 string(jstr:jstr) = '|' ! | is line separator marker end if jstr = jstr + 1 string(jstr:jstr) = matrix(indAmax, indBmax - 4) end if end if end if else ! looking for end of tone ampnow = max(ampAmax, ampBmax) if(ampnow .le. .135335*ampmax) then ! 1 time constant delay (squared) itone = 0 toff = t ampoff = ampnow ampmax = ampnow end if end if end do ndx = 2 ! position 1 always has | in it do k = 2, jstr+1 if(k.eq.jstr+1 .or. string(k:k) .eq. '|') then if(k-ndx .eq. 11) then wstr = string(ndx:ndx)//"-"//string(ndx+1:ndx+3)//"-"//string(ndx+4:ndx+6)//"-"//string(ndx+7:ndx+10) else if(k-ndx .eq. 10) then wstr = string(ndx+0:ndx+2)//"-"//string(ndx+3:ndx+5)//"-"//string(ndx+6:ndx+9) else if(k-ndx .eq. 7) then wstr = string(ndx+0:ndx+2)//"-"//string(ndx+3:ndx+6) else wstr = string(ndx:k-1) end if write(6,*) trim(wstr) ndx = k+1 end if end do write(6,*) write(6,*)' to close ...' read(*,*) END SUBROUTINE WAVREAD(A,FNAM,MAXPTS,NPTS,XMIN,DX,KERR,ERMSG) C READS MICROSOFT WAV FORMAT FILE, MONO OR STEREO C A: COMPLEX*16: ARRAY TO RECEIVE DATA C FNAM: CHAR*(*): FILENAME OF INPUT FILE C MAXPTS: INTEGER: MAXIMUM NUMBER POINTS TO BE READ C NPTS: INTEGER: ACTUAL NUMBER OF POINTS READ (RETURNED TO CALLING C PROGRAM) C XMIN: REAL*8: X VALUE FOR FIRST POINT (RETURNED TO CALLING PGM) C DX: REAL*8: X INTERVAL, ASSUMED EQUALLY SPACED (RETURNED TO C CALLING PGM) C KERR: INTEGER: (RETURNED TO CALLING PROGRAM) C 0: READ WITH NO ERRORS C 1: FILE DOES NOT EXIST, OR ERROR OPENING FILE C 2: ERROR READING FILE C ERMSG: CHAR*(*) ERROR MESSAGE, RETURNED TO CALLING PROGRAM COMPLEX*16 A(*) CHARACTER*(*) FNAM INTEGER MAXPTS INTEGER NPTS REAL*8 XMIN REAL*8 DX INTEGER KERR CHARACTER*(*) ERMSG LOGICAL XST, OPN CHARACTER*1 CDUM INTEGER*2 IBUF(128) C WAV FILE HEADER CHARACTER*4 ChunkID ! Contains the letters "RIFF" in ASCII form ! (0x52494646 big-endian form). INTEGER*4 ChunkSize ! 36 + SubChunk2Size, or more precisely: ! 4 + (8 + SubChunk1Size) + (8 + SubChunk2Size) ! This is the size of the rest of the chunk ! following this number. This is the size of the ! entire file in bytes minus 8 bytes for the ! two fields not included in this count: ! ChunkID and ChunkSize. CHARACTER*4 wFormat ! Contains the letters "WAVE" ! (0x57415645 big-endian form). C The "WAVE" format consists of two subchunks: "fmt " and "data": C The "fmt " subchunk describes the sound data's format: CHARACTER*4 Subchunk1ID ! Contains the letters "fmt " ! (0x666d7420 big-endian form). INTEGER*4 Subchunk1Size ! 16 for PCM. This is the size of the ! rest of the Subchunk which follows this number. INTEGER*2 AudioFormat ! PCM = 1 (i.e. Linear quantization) ! Values other than 1 indicate some ! form of compression. INTEGER*2 NumChannels ! Mono = 1, Stereo = 2, etc. INTEGER*4 SampleRate ! 8000, 44100, etc. INTEGER*4 ByteRate ! == SampleRate * NumChannels * BitsPerSample/8 INTEGER*2 BlockAlign ! == NumChannels * BitsPerSample/8 ! The number of bytes for one sample including ! all channels. I wonder what happens when ! this number isn't an integer? INTEGER*2 BitsPerSample ! 8 bits = 8, 16 bits = 16, etc. CHARACTER*4 Subchunk2ID ! Contains the letters "data" !(0x64617461 big-endian form). INTEGER*4 Subchunk2Size ! == NumSamples * NumChannels * BitsPerSample/8 ! This is the number of bytes in the data. ! You can also think of this as the size ! of the read of the subchunk following this ! number. KERR = 0 ERMSG = ' ' C FIND AN UNUSED UNIT NUMBER DO LU = 99,1,-1 INQUIRE(LU,OPENED=OPN) IF(.NOT.OPN) GO TO 30 END DO 30 OPEN(LU,FILE=FNAM,MODE='READ',FORM='BINARY',ERR=998) C READ FILE HEADER READ(LU)ChunkID,ChunkSize,wFormat,Subchunk1ID,Subchunk1Size, +AudioFormat,NumChannels,SampleRate,ByteRate,BlockAlign, +BitsPerSample IF(ChunkID.NE.'RIFF' .OR. wFormat.NE.'WAVE') THEN ERMSG = 'File format not recognized.' KERR = 2 RETURN END IF IF(AudioFormat.NE.1) THEN ERMSG = 'Cannot read compressed WAV files.' KERR = 2 RETURN END IF IF(BitsPerSample.NE.16) THEN ERMSG = 'Can only read 16 bit/sample WAV files.' KERR = 2 RETURN END IF IF(NumChannels.GT.2) THEN ERMSG = 'Cannot read more than 2 channels from WAV files.' KERR = 2 RETURN END IF IF(Subchunk1Size.GT.16) THEN DO JJ = 17, Subchunk1Size READ(LU)CDUM END DO END IF READ(LU)Subchunk2ID,Subchunk2Size NPTS = MIN(MAXPTS, Subchunk2Size/(NumChannels * BitsPerSample/8)) XMIN = 0. DX = 1.D0/DFLOAT(SampleRate) NPTX = 0 ! POINTS READ SO FAR 100 NPREAD = MIN (NPTS-NPTX, 64) IF(NPREAD.LE.0) THEN CLOSE(LU) RETURN END IF IF(NumChannels.EQ.1) THEN ! MONO FILE READ(LU,ERR=999,END=999) (IBUF(JJ), JJ = 1, NPREAD) DO JJ = 1, NPREAD NPTX = NPTX + 1 A(NPTX) = DCMPLX(IBUF(JJ),0.D0) END DO ELSE ! STEREO FILE READ(LU,ERR=999,END=999) (IBUF(JJ), JJ = 1, 2*NPREAD) DO JJ = 1, 2*NPREAD, 2 NPTX = NPTX + 1 A(NPTX) = DCMPLX(IBUF(JJ),IBUF(JJ+1)) END DO END IF GO TO 100 998 ERMSG='Cannot find file: '//FNAM(1:LEN_TRIM(FNAM)) KERR = 1 CLOSE(LU) RETURN 999 ERMSG='Error reading file: '//FNAM(1:LEN_TRIM(FNAM)) KERR = 1 CLOSE(LU) RETURN END