    {===========================================================================

      wavio.pas  -  Copyright (C) 1996-1999 by Don Cross <dcross@intersrv.com>
                    http://www.intersrv.com/~dcross

        This is a Turbo Pascal Unit which allows the user to read and write
        WAV format audio files.  See the following web page for more
        information, or for the latest version of this source code.

        http://www.intersrv.com/~dcross/wavio.html

        Revision history:

    1999 November 6 [Don Cross]
        Fixed a horrible bug in WaveFile.WriteSampleData:
        I was using a bogus, uninitialized variable to indicate
        how much memory to allocate to the array of bytes when
        the output was 8-bit samples.  Yuck!

    1997 January 11 [Don Cross]
        Fixed a bug in initializing 'WaveFile.riffHeader.ckSize'.
        (Should start at 36, not 0, to account for size of entire file.)

    1996 December 21 [Don Cross]
        First published on the World Wide Web.

    ===========================================================================}

    unit WavIO;

    interface

    const
        MaxWaveChannels = 4;    { increase if necessary }

    type
        WaveFileSample = array [0 .. MaxWaveChannels-1] of integer;

        RiffChunkHeader = record
            ckID:     longint;    { four-character chunk ID }
            ckSize:   longint;    { length of data in chunk }
        end;

        WaveFormat_ChunkData = record
            wFormatTag:         word;
            nChannels:          word;
            nSamplesPerSec:     longint;
            nAvgBytesPerSec:    longint;
            nBlockAlign:        word;
            nBitsPerSample:     word;
        end;

        WaveFormat_Chunk = record
            header:   RiffChunkHeader;
            data:     WaveFormat_ChunkData;
        end;

        WaveFile = object
            {------- data ---------------------------------------------}
        private
            f: file;
            fileOpen: boolean;
            writeMode: boolean;

            riffHeader: RiffChunkHeader;
            waveFormat: WaveFormat_Chunk;
            pcmDataOffset: longint;
            pcmData: RiffChunkHeader;

        public
            numSamples: longint;

            {------- methods ------------------------------------------}

            constructor Init;
            destructor  Destroy;

            procedure OpenForRead (
                Filename: string;
                var success: boolean );

            procedure Seek (
                sampleIndex: longint;
                var success: boolean );

            procedure OpenForWrite (
                Filename: string;
                _SamplingRate:   longint;
                _BitsPerSample:  word;
                _NumChannels:    word;
                var success:     boolean );

            procedure OpenForWrite_BasedOn (
                Filename: string;
                var inWave: WaveFile;
                var success: boolean );

            procedure ReadSampleData (
                numToRead: word;               { NumChannels * NumSamples }
                var  numActuallyRead: word;
                var  data: array of integer );

            procedure WriteSampleData (
                numToWrite:  word;             { NumChannels * NumSamples }
                var  numActuallyWritten: word;
                var  data: array of integer );

            procedure ReadSample (
                var  sample: WaveFileSample;
                var  success: boolean );

            procedure WriteSample (
                var  sample: WaveFileSample;
                var  success: boolean );

            procedure Close;

            function SamplingRate:  longint;
            function BitsPerSample: word;
            function NumChannels:   word;
        end;

    implementation

    {$R-}

    {========================================================================}
    {                             Private types                              }
    {========================================================================}

    {------------------------------------------------------------------------}
    {                             Helper functions                           }
    {------------------------------------------------------------------------}

    function FourCC ( ChunkName: string ): longint;
    var    retbuf: longint;
           i, shift: integer;
           c: char;

    begin
        retbuf := 0;
        for i := 4 downto 1 do begin
            retbuf := retbuf SHL 8;
            if i <= Length(ChunkName) then
                c := ChunkName[i]
            else
                c := ' ';
            retbuf := retbuf OR longint(c);
        end;
        FourCC := retbuf;
    end;

    {------------------------------------------------------------------------}
    {                            Method implementation                       }
    {------------------------------------------------------------------------}

    constructor WaveFile.Init;
    begin
        fileOpen := FALSE;
        writeMode := FALSE;
        riffHeader.ckID := FourCC('RIFF');
        riffHeader.ckSize := 4 + sizeof(waveFormat) + sizeof(riffHeader);
        pcmDataOffset := 0;
        numSamples := 0;
        pcmData.ckID := FourCC('data');
        pcmData.ckSize := 0;
        waveFormat.header.ckID := FourCC('fmt');
        waveFormat.header.ckSize := sizeof(waveFormat.data);
    end; { WaveFile.Init }

    destructor WaveFile.Destroy;
    begin
        Close;
    end; { WaveFile.Destroy }

    procedure WaveFile.OpenForRead (
        filename: string;
        var success: boolean );
    var
        numRead: word;
        signature: array [0..3] of char;
    begin
        if fileOpen then Close;
        assign ( f, filename );
        {$I-}
        reset (f, 1);
        {$I+}
        success := (IOResult = 0);
        if not success then exit;
        fileOpen := TRUE;

        BlockRead ( f, riffHeader, sizeof(riffHeader), numRead );
        if (numRead <> sizeof(riffHeader)) or
           (riffHeader.ckID <> FourCC('RIFF')) then begin
            success := FALSE;
            exit;
        end;

        BlockRead ( f, signature, 4, numRead );
        if (numRead <> 4) or
           (signature[0] <> 'W') or
           (signature[1] <> 'A') or
           (signature[2] <> 'V') or
           (signature[3] <> 'E') then begin
            success := FALSE;
            exit;
        end;

        BlockRead ( f, waveFormat, sizeof(waveFormat), numRead );
        if (numRead <> sizeof(waveFormat)) or
           (waveFormat.header.ckID <> FourCC('fmt')) or
           (waveFormat.data.nChannels < 1) or
           (waveFormat.data.nChannels > MaxWaveChannels) then begin
            success := FALSE;
            exit;
        end;

        pcmDataOffset := FilePos(f);
        BlockRead ( f, pcmData, sizeof(pcmData), numRead );
        if numRead <> sizeof(pcmData) then begin
            success := FALSE;
            exit;
        end;

        numSamples :=
            (FileSize(f) - FilePos(f)) DIV (NumChannels * BitsPerSample DIV 8);
    end; { WaveFile.OpenForRead }

    procedure WaveFile.Seek (
        sampleIndex: longint;
        var success: boolean );
    var
        sampleSize: word;
        fileOffset: longint;
    begin
        if not fileOpen then begin
            success := FALSE;
            exit;
        end;
        sampleSize := (BitsPerSample + 7) DIV 8;
        fileOffset := pcmDataOffset +
                      sizeof(pcmData) +
                      sampleSize * NumChannels * sampleIndex;
        System.Seek ( f, fileOffset );
        success := TRUE;
    end; { WaveFile.Seek }

    procedure WaveFile.OpenForWrite (
        Filename: string;
        _SamplingRate:   longint;
        _BitsPerSample:  word;
        _NumChannels:    word;
        var success:     boolean );
    var
        result: word;
        signature: array [0..3] of char;
    begin
        if fileOpen then Close;
        assign ( f, filename );
        {$I-}
        rewrite (f, 1);
        {$I+}
        success := (IOResult = 0);
        if success then begin
            fileOpen := TRUE;
            writeMode := TRUE;
            BlockWrite ( f, riffHeader, sizeof(riffHeader), result );
            if result <> sizeof(riffHeader) then begin
                success := FALSE;
                exit;
            end;

            signature[0] := 'W';
            signature[1] := 'A';
            signature[2] := 'V';
            signature[3] := 'E';
            BlockWrite ( f, signature, 4, result );
            if result <> 4 then begin
                success := FALSE;
                exit;
            end;

            waveFormat.header.ckID := FourCC('fmt');
            waveFormat.header.ckSize := sizeof(waveFormat.data);
            waveFormat.data.wFormatTag := 1;  {PCM}
            waveFormat.data.nSamplesPerSec := _SamplingRate;
            waveFormat.data.nChannels := _NumChannels;
            waveFormat.data.nBitsPerSample := _BitsPerSample;
            waveFormat.data.nAvgBytesPerSec := (_NumChannels * _SamplingRate * _BitsPerSample) DIV 8;
            waveFormat.data.nBlockAlign := (_NumChannels * _BitsPerSample) DIV 8;

            BlockWrite ( f, waveFormat, sizeof(waveFormat), result );
            if result <> sizeof(waveFormat) then begin
                success := FALSE;
                exit;
            end;

            pcmDataOffset := FilePos(f);
            pcmData.ckID := FourCC('data');
            pcmData.ckSize := 0;   {will need to be backpatched later}
            BlockWrite ( f, pcmData, sizeof(pcmData), result );
            if result <> sizeof(pcmData) then begin
                success := FALSE;
                exit;
            end;
        end;
    end; { WaveFile.OpenForWrite }

    procedure WaveFile.OpenForWrite_BasedOn (
        Filename: string;
        var inWave: WaveFile;
        var success: boolean );
    begin
        OpenForWrite (
            Filename,
            inWave.SamplingRate,
            inWave.BitsPerSample,
            inWave.NumChannels,
            success );
    end;

    procedure WaveFile.Close;
    var
        result: word;
    begin
        if fileOpen then begin
            if writeMode then begin
                {need to backpatch the riff header}
                System.Seek ( f, 0 );
                BlockWrite ( f, riffHeader, sizeof(riffHeader), result );

                {now backpatch the PCM data chunk}
                System.Seek ( f, pcmDataOffset );
                BlockWrite ( f, pcmData, sizeof(pcmData), result );
            end;

            System.close(f);
            fileOpen := FALSE;
        end;
    end; { WaveFile.Close }

    function WaveFile.BitsPerSample: word;
    begin
        BitsPerSample := waveFormat.data.nBitsPerSample;
    end; { WaveFile.BitsPerSample }

    function WaveFile.NumChannels: word;
    begin
        NumChannels := waveFormat.data.nChannels;
    end; { WaveFile.NumChannels }

    function WaveFile.SamplingRate: longint;
    begin
        SamplingRate := waveFormat.data.nSamplesPerSec;
    end; { WaveFile.SamplingRate }

    procedure WaveFile.ReadSampleData (
        numToRead: word;               { NumChannels * NumSamples }
        var  numActuallyRead: word;
        var  data: array of integer );
    type
        bufferType = array [0..0] of byte;
    var
        buffer: ^bufferType;
        i: integer;
    begin
        if BitsPerSample = 16 then begin
            BlockRead ( f, data, numToRead * sizeof(integer), numActuallyRead );
            numActuallyRead := numActuallyRead DIV sizeof(integer);
        end else if BitsPerSample = 8 then begin
            GetMem ( buffer, numToRead );
            BlockRead ( f, buffer^, numToRead, numActuallyRead );
            for i := 0 to numActuallyRead-1 do begin
                data[i] := buffer^[i];
            end;
            for i := numActuallyRead to numToRead do begin
                data[i] := 0;
            end;
            FreeMem ( buffer, numToRead );
        end else begin
            writeln ( 'Error in WavIO.WaveFile.ReadSampleData:' );
            writeln ( 'Unknown sample size = ', BitsPerSample, ' bits' );
            halt;
        end;
    end; { WaveFile.ReadSampleData }

    procedure WaveFile.WriteSampleData (
        numToWrite:  word;             { NumChannels * NumSamples }
        var  numActuallyWritten: word;
        var  data: array of integer );
    type
        bufferType = array [0..0] of byte;
    var
        buffer: ^bufferType;
        i: integer;
    begin
        if BitsPerSample = 16 then begin
            BlockWrite ( f, data, numToWrite * sizeof(integer), numActuallyWritten );
            INC ( riffHeader.ckSize, numActuallyWritten );
            INC ( pcmData.ckSize, numActuallyWritten );
            numActuallyWritten := numActuallyWritten DIV sizeof(integer);
        end else if BitsPerSample = 8 then begin
            GetMem ( buffer, numToWrite );
            for i := 0 to numToWrite-1 do begin
                buffer^[i] := BYTE(data[i]);
            end;
            BlockWrite ( f, buffer^, numToWrite, numActuallyWritten );
            INC ( riffHeader.ckSize, numActuallyWritten );
            INC ( pcmData.ckSize, numActuallyWritten );
            FreeMem ( buffer, numToWrite );
        end else begin
            writeln ( 'Error in WavIO.WaveFile.WriteSampleData:' );
            writeln ( 'Unknown sample size = ', BitsPerSample, ' bits' );
            halt;
        end;
    end; { WaveFile.WriteSampleData }

    procedure WaveFile.WriteSample (
        var sample: WaveFileSample;
        var success: boolean );
    var
        numWritten: word;
    begin
        WriteSampleData ( NumChannels, numWritten, sample );
        success := (numWritten = NumChannels);
    end;

    procedure WaveFile.ReadSample (
        var sample: WaveFileSample;
        var success: boolean );
    var
        numRead: word;
    begin
        ReadSampleData ( NumChannels, numRead, sample );
        success := (numRead = NumChannels);
    end;

    begin
    end.  { unit WavIO }

    {--- end of file wavio.pas ---}