{--------------------------------------------------------}
{
{    Mini gravador de som
{
{    Por José Antonio Borges
{
{    Em 29/05/98
{
{--------------------------------------------------------}

{$M 16384, 8192}
program minigrav;
uses winprocs, wintypes, strings, win31, mmsystem,
     dvcrt, dvwin, dvexec, dvmacro,
     mggrava, mgMsg;

var
    janAnterior, minhaJan, janGrav: hwnd;
    nomeArq: string;
    bits, canais: word;
    veloc: longint;
    arq: file;
    dirTrab: string;
    qualidade: char;
    tipoWin: string [20];

label fim;

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

procedure normalizaNome (var nomeArq: string);
begin
    if (pos ('\', nomeArq) = 0) and (pos (':', nomeArq) = 0) then
        nomeArq := dirTrab + nomeArq;
    if pos ('.', nomeArq) = 0 then
        nomeArq := nomeArq + '.WAV';
end;

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

procedure trocaJan (j: hWnd);
begin
    calaBoca;

    setActiveWindow (j);
    repeat
        delay (100)
    until keypressed or (getActiveWindow = j);
end;

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

procedure altSeq (c1, c2: char; comEnter: boolean);
begin
    trocaJan (janGrav);

    playInit (300);
    playAltKey (c1 , 1);
    playKey (c2, 100);
    if comEnter then
        playKey (ENTER, 1);
    playStart;
    while  playIsActive do;

    trocaJan (minhaJan);
end;

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

const
    REWIND   = 0;
    FASTFORW = 1;
    PLAY     = 2;
    STOP     = 3;
    REC      = 4;
    FORW     = 5;
    BACKW    = 6;

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

procedure botao (n: integer);
var rectg: TRECT;
    x, y: integer;
begin
    getWindowRect (janGrav, rectg);
    if (n = FORW) or (n = BACKW) then
        begin
            x := rectg.left + 17;
            y := rectg.bottom - 50;
        end
    else
        begin
            x := rectg.left + ((rectg.right-rectg.left-20) div 5) * n + 38;
            y := rectg.bottom - 20;
        end;

    trocaJan (janGrav);

    playInit (30);
    playMouse (WM_MOUSEMOVE, x, y, 1);
    playStart;
    while  playIsActive do;

    playInit (30);
    playMouse (WM_LBUTTONDOWN, x, y, 1);
    playStart;
    while  playIsActive do;

    playInit (30);
    playMouse (WM_LBUTTONUP, x, y, 1);
    playStart;
    while  playIsActive do;

    if n = BACKW then
        begin
            playInit (30);
            playVirtKey (VK_PRIOR, false, false, false, 1);
            playStart;
            while  playIsActive do;
        end
    else
    if n = FORW then
        begin
            playInit (30);
            playVirtKey (VK_NEXT, false, false, false, 1);
            playStart;
            while  playIsActive do;
        end;

    trocaJan (minhaJan);
end;

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

procedure inicializa;
var dir: string;
begin
    janAnterior := getActiveWindow;
    screenSize.y := 10;

    clrscr;
    setWindowText (crtWindow, msgTitulo);
    minhaJan := getActiveWindow;

    getDir (0, dirTrab);
    if dirTrab [length (dirTrab)] <> '\' then dirTrab := dirTrab + '\';

    dir := sintAmbiente ('MINIGRAV', 'DIRMINIGRAV');
    if dir = '' then
        dir := 'c:\winvox\som\minigrav';
    sintInic (0, dir);

    tipoWin := copy (sintAmbiente ('DOSVOX', 'WINDOWS'), 1, 2);
    if tipoWin = '' then tipoWin := '95';

    mensagem ('MGINIC', 2);  {'Mini gravador de som'}
    while sintFalando do;
end;

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

procedure carregaSom;
var j2: hwnd;
begin
    if nomeArq = '' then
        begin
            mensagem ('MGNOMCRG', 1);  {'Qual o arquivo a carregar'}
            sintReadln (nomeArq);
            if nomeArq = '' then exit;
            normalizaNome (nomeArq);

            assign (arq, nomeArq);
            {$I-} reset (arq); {$I+}
            if ioresult <> 0 then
                begin
                    mensagem ('MGERRNOM', 1);  {'Nome de arquivo incorreto'}
                    nomeArq := '';
                    exit;
                end;

            close (arq);
        end;

    mensagem ('MGCRGSOM', 1);   {'Carregando som'}

    trocaJan (janGrav);

    playInit (300);
    playAltKey ('A', 50);
    playKey ('A', 50);
    playStart;
    calaboca;
    while  playIsActive do;

    delay (1000);

    j2 := getActiveWindow;

    playInit (300);
    playString (nomeArq, 1);
    playKey (ENTER, 1);
    playStart;
    calaboca;
    while  playIsActive do;

    while j2 = getActiveWindow do
        begin
            calaboca;
            keypressed;
        end;

    delay (100);
    if getActiveWindow <> janGrav then
        begin
            trocaJan (minhaJan);
            mensagem ('MGERRNOM', 1);  {'Nome de arquivo incorreto'}
        end;

    trocaJan (minhaJan);
end;
{--------------------------------------------------------}

procedure gravaSomInicial;
var
    gravando: boolean;
    c, c2: char;
    result: integer;
    arq: file;

label inicio;
begin
    trocaJan (minhaJan);

inicio:
    mensagem ('MGNOMGRV', 1);            {'Qual o arquivo a gravar ? '}
    sintReadln (nomeArq);
    if nomeArq = '' then exit;
    normalizaNome (nomeArq);

    assign (arq, nomeArq);
    {$I-}  reset (arq);  {$I+}
    if ioresult = 0 then
        begin
            close (arq);
            mensagem ('MGARQEXI', 0);    {'Quer destruir arquivo existente ?'}
            sintLeTecla (c, c2);
            writeln;
            if upcase(c) <> 'S' then exit;
        end;

    mensagem ('MGRADTEL', 0);  {'Qualidade estéreo, radio ou telefone ? '}
    sintLeTecla (c, c2);
    writeln;
    if c = ESC then
        begin
             nomeArq := '';
             exit;
        end;

    qualidade := upcase (c);

    case qualidade of
        'S', 'E':  begin
                  veloc := 22050;  canais := 2;  bits:= 16;
              end;

        'R':  begin
                  veloc := 22050;  canais := 1;  bits := 16;
              end;
        else
            begin
                  veloc := 11025;  canais := 1;  bits := 8;
            end;
    end;

    mensagem ('MGINIGRV', 1);   {'Tecle Enter para iniciar, ESC termina'}
    repeat
        c := readkey;
    until (c = ESC) or (c = ENTER);
    if c = ESC then
        begin
            nomeArq := '';
            exit;
        end;

    result := gravaSom (nomeArq, veloc, bits, canais);
    if result = 0 then
        mensagem ('MGOK', 1)
    else
    if result < 0 then
        mensagem ('MGERRGRV', 1)
    else
        begin
             case result of
                 MMSYSERR_NODRIVER:    writeln ('Driver não instalado');
                 MMSYSERR_BADDEVICEID: writeln ('Device ID inválido');
                 MMSYSERR_ALLOCATED:   writeln ('Recurso já alocado');
                 MMSYSERR_NOMEM:       writeln ('Não conseguir alocar memória');
                 WAVERR_BADFORMAT:     ;
                 WAVERR_SYNC:          writeln ('Erro em abertura de driver síncrono');
             end;
             mensagem ('MGNAOSUP', 1);    {'Formato não suportado pela placa de som'}
             goto inicio;
        end;
end;

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

procedure gravaSom;
var c: char;
    gravando: boolean;
begin
    trocaJan (minhaJan);

    mensagem ('MGGRVPAR', 1);  {'Aperte enter para gravar e parar, ESC termina'}

    gravando := false;
    repeat
        c := readkey;
        if sintFalando then
             sintetiza ('');    { para eventual fala }

        if c = ENTER then
            begin
                gravando := not gravando;
                if gravando then
                    botao (REC)
                else
                    begin
                        botao (STOP);
                        sintBip;
                    end;
            end;
    until c = #$1b;

    botao (STOP);

    trocaJan (minhaJan);
    writeln;
end;

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

procedure tocaSom;
var c, c2: char;
    tocando: boolean;
begin
    trocaJan (minhaJan);
    mensagem ('MGESCPAR', 1);  {'Aperte enter para tocar, F1 ajuda'}

    tocando := false;
    repeat
        c := readkey;
        if c = #$0 then c2 := readkey;

        if sintFalando then;    { para eventual fala }

        if c = ENTER then
            begin
                tocando := not tocando;
                if tocando then
                    botao (PLAY)
                else
                    botao (STOP);
            end
        else
        if upcase(c) = 'I' then
            botao (REWIND)
        else
        if upcase(c) = 'F' then
            botao (FASTFORW)
        else
        if c = #$0 then
            begin
                botao (STOP);
                tocando := false;
                if c2 = F1 then
                    begin
                        botao (STOP);
                        mensagem ('MGAJUTOC', 1)
                         {Enter toca e para, esc termina; posicione com direita, esquerda, home e end.}
                    end
                else
                if (c2 = DIR) or (c2 = PGDN) then
                    botao (FORW)
                else
                if (c2 = ESQ) or (c2 = PGUP) then
                    botao (BACKW)
                else
                if c2 = HOME then
                    botao (REWIND)
                else
                if c2 = TEND then
                    botao (FASTFORW);
            end;

    until c = #$1b;

    botao (STOP);

    writeln;
end;

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

procedure salvaArquivo;
var j2: hwnd;
begin
    if nomeArq <> '' then
        begin
            trocaJan (janGrav);
            playInit (300);
            playAltKey ('A', 50);
            playKey ('S', 50);
            playStart;
            calaboca;
            while  playIsActive do;

            delay (2000);
            trocaJan (minhaJan);
            exit;
        end;

    mensagem ('MGNOMGRV', 1);  {'Qual o arquivo a gravar'}
    sintReadln (nomeArq);
    if nomeArq = '' then exit;
    normalizaNome (nomeArq);

    trocaJan (janGrav);
    playInit (300);
    playAltKey ('A', 50);
    playKey ('A', 50);
    playStart;
    calaboca;
    while  playIsActive do;
    delay (1000);

    j2 := getActiveWindow;

    playInit (300);
    playString (nomeArq, 50);
    playKey (ENTER, 100);
    playStart;
    calaboca;
    while  playIsActive do;

    while j2 = getActiveWindow do
        begin
            calaboca;
            keypressed;
        end;

    delay (100);
    if getActiveWindow <> janGrav then
        begin
            mensagem ('MGERRNOM', 1);  {'Nome de arquivo incorreto'}
            playInit (300);
            playKey (ESC, 100);
            playKey (ESC, 100);
            playKey (ESC, 100);
            playStart;
            while  playIsActive do;
        end;

    trocaJan (minhaJan);
end;

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

procedure adicionaEco;
begin
    if tipoWin = '95' then
        altSeq ('F', 'A', false)
    else
        altSeq ('F', 'E', false);
    mensagem ('MGECO', 1);  {'Eco adicionado'}
end;

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

procedure sobeVolume;
begin
    if tipoWin = '95' then
        altSeq ('F', 'V', false)
    else
        altSeq ('F', 'A', false);
    mensagem ('MGVOLSUB', 1);  {'Volume subido em 25 por cento'}
end;

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

procedure desceVolume;
begin
    altSeq ('F', 'D', false);
    mensagem ('MGVOLDES', 1);  {'Volume descido em 25 por cento'}
end;

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

procedure retrogado;
begin
    if tipoWin = '95' then
        altSeq ('F', 'R', false)
    else
        altSeq ('F', 'V', false);
    mensagem ('MGSOMINV', 1);  {'Som invertido'}
end;

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

procedure removeAnterior;
begin
    if tipoWin = '95' then
        altSeq ('E', 'P', true)
    else
        altSeq ('E', 'A', true);
    mensagem ('MGREMANT', 1);  {'Trecho anterior removido'}
end;

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

procedure removePosterior;
begin
    if tipoWin = '95' then
        altSeq ('E', 'A', true)
    else
        altSeq ('E', 'D', true);
    mensagem ('MGREMPOS', 1);  {'Trecho posterior removido'}
end;

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

procedure undo;
begin
    altSeq ('A', 'V', true);
    playInit (300);
    playKey (ENTER, 1);
    playStart;
    while  playIsActive do;
    delay (100);
    while keypressed do readkey;
    mensagem ('MGUNDO', 1);  {'Voltei ao último arquivo gravado'}
end;

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

procedure novaGravacao;
begin
    trocaJan (janGrav);

    playInit (300);
    playAltKey ('A', 1);
    playKey ('N', 100);
    playKey ('N', 1);
    playStart;

    calaboca;
    while  playIsActive do;

    trocaJan (minhaJan);
    delay (200);
    mensagem ('MGNOVSOM', 1);  {'Novo som criado'}
    nomeArq := '';

    gravaSomInicial;
    carregaSom;
    while sintFalando do;
    delay (500);
end;

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

procedure mixarOutroSom;
var arq: file;
    nomeMist: string;
begin
    mensagem ('MGNOMMIS', 1);   {'Qual o arquivo de som a misturar ?'}
    sintReadln (nomeMist);
    if nomeMist = '' then exit;

    normalizaNome (nomeMist);
    assign (arq, nomeMist);
    {$I-}  reset (arq);  {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('MGERRNOM', 1);   {'Erro no nome do arquivo'}
            exit;
        end;
    close (arq);

    trocaJan (janGrav);
    playInit (300);
    playAltKey ('E', 1);
    if tipoWin = '95' then
        playKey ('O', 100)
    else
        playKey ('M', 100);
    playStart;
    calaboca;
    delay (1000);

    playInit (300);
    playString (nomeMist, 1);
    playKey (ENTER, 1);
    playStart;
    calaboca;
    delay (1000);

    trocaJan (minhaJan);
    mensagem ('MGMISTUR', 1);   {'Sons misturados'}

    if false then   { verificar eventual possibilidade }
        mensagem ('MGERRMIS', 1);    {'Erro: não foi possível misturar'}
end;

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

procedure finaliza;
begin
    trocaJan (janGrav);

    if getActiveWindow = janGrav then
        begin
            playInit (300);
            playVirtKey (VK_F4, false, false, true, 1);
            playKey ('N', 1);
            playStart;
            while  playIsActive do;
            calaboca;
            delay (1000);
        end;

    trocajan (minhaJan);

    mensagem ('MGOK', 1);      {'OK'}
    while sintFalando do;
    sintFim;
    doneWinCrt;
end;

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

procedure ajuda;
begin
    mensagem ('MGAJUDA', 0);
end;

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

procedure iniciaSoundRec32;
begin
    mensagem ('MGUMMOME', 1);       { Iniciando gravador do Windows }

    if executaProg ('sndrec32', '.', '') <= 32 then
    begin
         mensagem ('MGERRCRG', 1);  {'Erro ao carregar o gravador do Windows'}
         sintFim;
         doneWinCrt;
    end;

    repeat keypressed until getActiveWindow <> minhaJan;
    janGrav := getActiveWindow;
    trocaJan (minhaJan);
end;

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

var c, c2: char;
    processando: boolean;
begin
    inicializa;

    gravaSomInicial;

    mensagem ('MGQUERED', 0);     {'Quer editar o som gravado ? '}
    sintLeTecla (c, c2);
    writeln;
    if upcase(c) = 'N' then
        begin
            mensagem ('MGOK', 1);      {'OK'}
            sintFim;
            doneWinCrt;
        end;

    iniciaSoundRec32;
    carregaSom;
    while sintFalando do;
    delay (500);

    processando := true;
    repeat
        mensagem ('MGOPCAO', 0);   {'Qual sua opção  '}
        sintLeTecla (c, c2);
        writeln;
        case upcase(c) of
             #$0:  if c2 = F2 then
                       salvaArquivo
                   else
                       ajuda;

             ESC: processando := false;

             'T': tocaSom;
             'G': gravaSom;
             'M': mixarOutroSom;
             'S': salvaArquivo;
             'E': adicionaEco;
             '+': sobeVolume;
             '-': desceVolume;
             'R': retrogado;
             'A': removeAnterior;
             'P': removePosterior;
             'N': novaGravacao;
             'U': undo;
        else
             mensagem ('MGOPINV', 1);
        end;
    until not processando;

    mensagem ('MGQUERSV', 0);  {'Quer salvar o arquivo ? '}
    sintLeTecla (c, c2);
    writeln;

    if upcase (c) <> 'N' then salvaArquivo;
    finaliza;
end.
