{--------------------------------------------------------}
{
{     Rotinas de aquisição em baixo nível
{
{     Autor: José Antonio Borges
{
{     Em 13/6/99
{
{--------------------------------------------------------}

unit mgGrava;
interface
uses winprocs, wintypes, dvcrt, mmsystem;

function gravaSom (nomeArq: string; veloc: longint; bits, canais: word): integer;
{ retornos:  0: ok;  >0: não inicializou som;   -1: erro de escrita }

implementation

const
    maxBuf = 8;
    size = 8192;

var
    ndev: integer;
    hWavIn: HWaveIn;

    f: file;

    hbuf: array [0..maxBuf-1] of THandle;
    pBuf: array [0..maxBuf-1] of pChar;
    hhdr: array [0..maxBuf-1] of THandle;
    lpWaveInHdr: array [0..maxBuf-1] of PWaveHdr;
    pin: integer;

    hdr: array [0..43] of char;

    totalSize: longint;
    listening: boolean;

{-------------------------------------------------------------}

{ esta função não estava declarada em mmSystem.pas }

function waveInClose(hWaveIn: HWaveIn): Word; far; external 'MMSYSTEM' index 505;

{-------------------------------------------------------------}

function openWaveDevice (uDeviceId: word; veloc: longint; bits, channels: integer): word;
var
    lpFormat: PPcmWaveFormat;
    dwCallback, dwInstance, dwFlags: longint;
    status: word;
begin
    new (lpFormat);
    with lpFormat^, lpFormat^.wf do
        begin
            wFormatTag := WAVE_FORMAT_PCM;
            nSamplesPerSec := veloc;
            wBitsPerSample := bits;
            nChannels := channels;
            nBlockAlign := (wBitsPerSample div 8) * nChannels;
            nAvgBytesPerSec := nBlockAlign * nSamplesPerSec;
        end;

    dwCallBack := 0;
    dwInstance := 0;
    dwFlags := 0 { CALLBACK_WINDOW };

    status := waveInOpen(@hWavIn, uDeviceID, @lpFormat^,
                          dwCallback, dwInstance, dwFlags);

    openWaveDevice := status;    {zero significa ok}

    dispose (lpformat);
end;

{-------------------------------------------------------------}

procedure genWavHdr (pvet: pchar; veloc: longint; bits, channels: word; size: longint);
const
    wavHdr: array [0..43] of byte = (
        $52, $49, $46, $46,    {'RIFF'}
        $ff, $ff, $ff, $ff,    {riff size}
        $57, $41, $56, $45, $66, $6d, $74, $20,    {'WAVEFMT '}
        $10, $00, $00, $00,    {hdr size}
        $01, $00, $01, $00, $11, $2b, $00, $00, $11, $2b, $00, $00, $01, $00, $08, $00,  {reg}
        $64, $61, $74, $61,    {'data'}
        $ff, $ff, $ff, $ff);   {data size}



var l: longint;
    lpFormat: PPCMWAVEFORMAT;

begin
    new (lpFormat);
    with lpFormat^, lpFormat^.wf do
        begin
            wFormatTag := WAVE_FORMAT_PCM;
            nSamplesPerSec := veloc;
            wBitsPerSample := bits;
            nChannels := channels;
            nBlockAlign := (wBitsPerSample div 8) * nChannels;
            nAvgBytesPerSec := nBlockAlign * nSamplesPerSec;
        end;

    move (lpFormat^, wavHdr[20], sizeof (lpFormat^));
    l := size + 36;
    move (l, wavHdr[4], sizeof (l));
    move (size, wavHdr[40], sizeof (size));

    move (wavHdr, pvet^, sizeof (wavHdr));
    dispose (lpFormat);
end;

{-------------------------------------------------------------}

procedure PrepareBuffer (i: integer);
begin
    fillChar (lpWaveInHdr [i]^, sizeof (TWaveHdr), 0);
    with lpWaveInHdr [i]^ do
        begin
            lpData := pBuf[i];       { pointer to locked data buffer }
            dwBufferLength := size;
        end;

    if waveInPrepareHeader(hWavIn, lpWaveInHdr [i], sizeof (TWaveHdr)) <> 0 then
        begin
            writeln (#$07, #$07, #$07, 'Falha na preparação do buffer de gravação #', i);
            exit;
        end;

    waveInAddBuffer (hWavIn, lpWaveInHdr [i], sizeof (TWaveHdr));
end;

{-------------------------------------------------------------}

function getBuffer: boolean;
begin
    getBuffer := true;

    if lpWaveInHdr [pin] = NIL then exit;

    with lpWaveInHdr [pin]^ do
        begin
            if (dwFlags and WHDR_DONE) <> 0 then
                begin
                    {$I-}  blockWrite (f, lpdata^, dwBytesRecorded);  {$I+}
                    if ioresult <> 0 then
                       begin
                           waveInStop (hWavIn);
                           waveInReset (hWavIn);
                           listening := false;
                           getBuffer := false;
                       end
                    else
                        totalSize := totalSize + dwBytesRecorded;

                    waveInUnPrepareHeader(hWavIn, lpWaveInHdr [pin], sizeof (TWaveHdr));

                    if listening then
                        prepareBuffer (pin)
                    else
                        begin
                            globalUnlock (hbuf[pin]);  globalFree (hbuf[pin]);
                            globalUnlock (hhdr[pin]);  globalFree (hhdr[pin]);
                            lpWaveInHdr [pin] := NIL;
                        end;

                    pin := (pin + 1) mod maxBuf;
               end;
        end;
end;

{-------------------------------------------------------------}

function gravaSom (nomeArq: string; veloc: longint; bits, canais: word): integer;
label fim, erro;
var i, status: integer;
begin
    gravaSom := 0;
    status := openWaveDevice ($FFFF, veloc, bits, canais);   { $FFFF = Wave Mapper }
    if status <> 0 then
        begin
            gravaSom := status;  {não conseguiu abrir canal}
            exit;
        end;

    assign (f, nomeArq);
    {$I-} rewrite (f, 1);  {$I+}
    if ioresult <> 0 then goto erro;

    {$I-}   blockWrite (f, hdr, 44);  {$I+}   { espaço para o cabecalho }
    if ioresult <> 0 then goto erro;

    totalSize := 0;

    for i := 0 to maxBuf-1 do
        begin
            hbuf[i] := globalAlloc (GMEM_MOVEABLE or GMEM_SHARE, size);
            pBuf[i] := globalLock (hbuf[i]);
            hhdr[i] := globalAlloc (GMEM_MOVEABLE or GMEM_SHARE, sizeof (TWaveHdr));
            lpWaveInHdr [i] := globalLock (hhdr[i]);
            prepareBuffer (i);
        end;

    waveInStart (hWavIn);

    pin := 0;
    listening := true;
    while listening do
        begin
            getBuffer;
            if keypressed and (readkey = #$1b) then
                   begin
                       waveInStop (hWavIn);
                       waveInReset (hWavIn);
                       listening := false;
                       while lpWaveInHdr [pin] <> NIL do
                           if not getBuffer then goto erro;
                   end;
        end;

fim:
    genWavHdr (@Hdr, veloc, bits, canais, totalSize);
    {$I-} close (f);  {$I+}
    if ioresult <> 0 then goto erro;

    {$I-}  reset (f, 1);  {$I+}
    if ioresult <> 0 then goto erro;
    {$I-} blockWrite (f, Hdr, 44);  {$I+}
    if ioresult <> 0 then goto erro;
    {$I-} close (f);  {$I+}
    if ioresult <> 0 then goto erro;

    waveInClose (hWavIn);
    exit;

erro:
    waveInClose (hWavIn);
    {$I-} close (f);  {$I+}
    if ioresult <> 0 then;
    gravaSom := -1;
end;

end.
