WSJT-X/lib/readwav.f90
Bill Somerville 92e1f70b8f Some docs and enhancements for WAV reading
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@6336 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2016-01-02 15:04:26 +00:00

72 lines
1.7 KiB
Fortran

!
! readwav - open and read the header of a WAV format file
!
! On successful exit the file is left positioned at the start of the
! data.
!
! Example of usage:
!
! use readwav
! integer*2 sample
! type(wav_header) wav
! call wav%read ('file.wav')
! write (*,*) 'Sample rate is: ', wav%audio_format%sample_rate
! do i=0,wav%data_size
! read (unit=wav%lun) sample
! ! process sample
! end do
!
module readwav
implicit none
type format_chunk
integer*2 audio_format
integer*2 num_channels
integer sample_rate
integer byte_rate
integer*2 block_align
integer*2 bits_per_sample
end type format_chunk
type, public :: wav_header
integer :: lun
type(format_chunk) :: audio_format
integer :: data_size
contains
procedure :: read
end type wav_header
private
contains
subroutine read (this, filename)
implicit none
type riff_descriptor
character(len=4) :: id
integer :: size
end type riff_descriptor
class(wav_header), intent(inout) :: this
character(len=*), intent(in) :: filename
integer :: filepos
type(riff_descriptor) :: desc
character(len=4) :: riff_type
open (newunit=this%lun, file=filename, access='stream', form='unformatted', status='old')
read (unit=this%lun) desc,riff_type
inquire (unit=this%lun, pos=filepos)
do
read (unit=this%lun, pos=filepos) desc
inquire (unit=this%lun, pos=filepos)
if (desc%id .eq. 'fmt ') then
read (unit=this%lun) this%audio_format
else if (desc%id .eq. 'data') then
this%data_size = desc%size
exit
end if
filepos = filepos + (desc%size + 1) / 2 * 2 ! pad to even alignment
end do
end subroutine read
end module readwav