{--------------------------------------------------------}
{   Exibidor do manual do DOSVOX
{   Por José Antonio Borges
{   Em 29/05/1998
{--------------------------------------------------------}

{$M 16536,8192}
program manvox;

uses dvcrt, dvWin, winDos, strings, mmsystem;

const
    maxManuais = 100;

var respMci: array [0..80] of char;
    nomeMan: string;
    processando: boolean;
    c: char;

    numManuais: integer;
    nomeManual: array [1..maxManuais] of string [20];

{-------------------------------------------------------------}
{                 escreve e/ou sintetiza um texto
{-------------------------------------------------------------}

procedure mensagem (nomeArq: string; npula: integer; falando: boolean);
var s: string;
    i: integer;
begin
    s := 'Mensagem inexistente: ' + nomeArq;

    if nomeArq = 'MAINIC'   then  s := 'Tocador de manuais e arquivos sonoros'
    else
    if nomeArq = 'MAQUESOM' then  s := 'Informe o nome do arquivo de som: '
    else
    if nomeArq = 'MAAJUDA1' then  s := 'Controles:'
    else
    if nomeArq = 'MAAJUDA2' then  s := '  cima      toca'
    else
    if nomeArq = 'MAAJUDA3' then  s := '  baixo     para'
    else
    if nomeArq = 'MAAJUDA4' then  s := '  direita   avança'
    else
    if nomeArq = 'MAAJUDA5' then  s := '  esquerda  recua'
    else
    if nomeArq = 'MAAJUDA6' then  s := '  home      posiciona no inicio'
    else
    if nomeArq = 'MAAJUDA7' then  s := '  end       posiciona no fim'
    else
    if nomeArq = 'MAAJUDA8' then  s := '  esc       termina o programa'
    else
    if nomeArq = 'MAVOLINI' then  s := 'Voltei ao inicio'
    else
    if nomeArq = 'MAPOSFIM' then  s := 'Posicionei no fim'
    else
    if nomeArq = 'MAARQNAO' then  s := 'Arquivo de som não está no disco'
    else
    if nomeArq = 'MASINTO'  then  s := 'Sinto muito'
    else
    if nomeArq = 'MAUSESET'  then  s := 'Use as setas para selecionar e depois ENTER'
    ;

    write (s);
    for i := 1 to npula do writeln;

    if falando then
        if existeArqSom (nomeArq) then
            sintSom (nomeArq)
        else
            sintetiza (s);
end;

{-------------------------------------------------------------}
{                 envia um comando para o MCI
{-------------------------------------------------------------}

function enviaMci (s: string): longint;
var cmd: array [0..80] of char;
    retorno: longint;
begin
    strPCopy (cmd, s);
    retorno := mciSendString (cmd, respMci, 80, 0);
    enviaMci := retorno;
end;

{-------------------------------------------------------------}
{                 abre o arquivo do manual
{-------------------------------------------------------------}

function abreSom (nomeSom: string): boolean;
var cmd, dirMan: string;
begin
    if pos ('\', nomeSom) <> 0 then
       abreSom := enviaMci ('open ' + nomeSom + ' alias som') = 0
    else
        begin
            dirMan := sintAmbiente ('DOSVOX', 'DIRMANUAL');
            cmd := 'open ' + dirMan + '\' + nomeSom + '.wav alias som';
            abreSom := enviaMci (cmd) = 0;
        end;
end;

{-------------------------------------------------------------}
{                         avanca o som
{-------------------------------------------------------------}

procedure avancaSom;
var s: string;
    p: longint;
    erro: word;
begin
    enviaMci ('pause som');
    enviaMci ('status som position');
    val (respMci, p, erro);
    p := p + 10000;
    str (p, s);
    enviaMci ('seek som to ' + s);
end;

{-------------------------------------------------------------}
{                     recua o som
{-------------------------------------------------------------}

procedure recuaSom;
var p: longint;
    erro: word;
    s: string;
begin
    enviaMci ('pause som');
    enviaMci ('status som position');
    val (respMci, p, erro);
    p := p - 10000;
    if p < 0 then p := 0;
    str (p, s);
    enviaMci ('seek som to ' + s);
end;

{-------------------------------------------------------------}
{                        toca o som
{-------------------------------------------------------------}

procedure toca;
begin
    enviaMci ('play som');
end;

{-------------------------------------------------------------}
{                 vai para o inicio do som
{-------------------------------------------------------------}

procedure inicioSom;
begin
    enviaMci ('pause som');
    enviaMci ('seek som to 0');
    sintBip;
    mensagem ('MAVOLINI', 1, true);     {'Voltei ao inicio'}
end;

{-------------------------------------------------------------}
{                   vai para o fim do som
{-------------------------------------------------------------}

procedure fimSom;
begin
    enviaMci ('pause som');
    enviaMci ('seek som to end');
    sintBip;
    mensagem ('MAPOSFIM', 1, true);     {'Posicionei no fim'}
end;

{-------------------------------------------------------------}
{                      da uma pausa no som
{-------------------------------------------------------------}

procedure pausaSom;
begin
    enviaMci ('pause som');
end;

{-------------------------------------------------------------}
{                          fecha o som
{-------------------------------------------------------------}

procedure fechaSom;
begin
    enviaMci ('close som');
    delay (500);
end;

{--------------------------------------------------------}
{                 monta lista de manuais
{--------------------------------------------------------}

procedure montaListaDeManuais;
var
    DirInfo: TSearchRec;
    i, j: integer;
    nome: string;
    diret: string;

begin
    diret := sintAmbiente ('DOSVOX', 'DIRMANUAL');
    numManuais := 0;

    {$I-} chdir (diret);  {$I+}
    if ioresult <> 0 then exit;

    FindFirst ('*.WAV', FaArchive, DirInfo);
    while (DosError = 0) and (numManuais < maxManuais) do
            begin
                numManuais := numManuais + 1;
                nome := strPas (dirInfo.name);
                while (nome <> '') and (nome [length (nome)] = ' ') do
                    delete (nome, length (nome), 1);
                delete (nome, length (nome)-3, 4);
                nomeManual [numManuais] := nome;
                FindNext (DirInfo);
            end;
end;

{-------------------------------------------------------------}
{                     le nome do manual
{-------------------------------------------------------------}

procedure leNomeManual (nomeMan: string);
var
    arq: text;
    nomeArq, s: string;
    i, p: integer;

label prox, achou, fim;

begin
    s := '';
    nomeArq := sintAmbiente ('MANVOX', 'ARQMANVOX');
    if nomeArq = '' then goto fim;

    assign (arq, nomeArq);
    {$I-} reset (arq); {$I+}
    if ioresult <> 0 then goto fim;

    nomeMan := nomeMan + ' ';
    while not eof (arq) do
        begin
            readln (arq, s);
            if (s <> ' ') and (s [1] <> ';') and (pos (' ', s) <> 0) then
                begin
                    p := pos (' ', nomeMan);
                    for i := 1 to length (nomeMan) do
                        if upcase(nomeMan [i]) <> upcase (s[i]) then
                            goto prox;
                    goto achou;
                end;

prox:
            s := '';
        end;

achou:
    close (arq);

fim:
    if s = '' then
        sintWriteln (nomeMan)
    else
        begin
            s := (copy (s, p, length (s)-p+1));
            while (s <> '') and (s[1] = ' ') do delete (s, 1, 1);
            sintWriteln (s);
        end;
end;

{-------------------------------------------------------------}
{                  seleciona o nome do manual
{-------------------------------------------------------------}

function selecManual: string;
var
    nman: integer;
label pedeNome;

begin
    montaListaDeManuais;

    if numManuais = 0 then
        begin
pedeNome:
            mensagem ('MAQUESOM', 1, true);    {'Informe o nome do arquivo de som: '}
            sintReadln (nomeMan);
            selecManual := nomeMan;
            exit;
        end;

    mensagem ('MAUSESET', 2, true);  {'Use: use as setas, depois enter'}
    nman := 0;
    nomeMan := '';

    repeat
        c := readkey;
        if c = #0 then
            begin
                c := readkey;
                case c of
                    BAIX:   begin
                                nman := nman + 1;
                                if nman > numManuais then
                                    begin  nman := numManuais + 1;   sintBip;  end
                                else
                                    leNomeManual (nomeManual [nman]);
                            end;

                    CIMA:   begin
                                nman := nman - 1;
                                if nman < 1 then
                                    begin  nman := 0;  sintBip;  end
                                else
                                    leNomeManual (nomeManual [nman]);
                            end;

                    ESQ:   if (nman > 0) and (nman <= numManuais) then
                               leNomeManual (nomeManual [nman]);

                    DIR:   if (nman > 0) and (nman <= numManuais) then
                                sintSoletra (nomeManual [nman]);
                end;
            end
        else
            begin
                if (nman > 0) and (nman <= numManuais) then
                    case upcase(c) of
                        'N':     goto pedeNome;
                         ENTER:  begin
                                     if (nman > 0) and (nman < numManuais) then
                                         nomeMan := nomeManual [nman];
                                     c := #$1b;
                                 end;
                    else
                        if c <> ESC then sintBip;
                    end;
            end;

    until c = #$1b;

    selecManual := nomeMan;
end;

{-------------------------------------------------------------}
{                            ajuda
{-------------------------------------------------------------}

procedure ajuda (falando: boolean);
var c: char;
    posic: string;
begin
    if falando then
        begin
            enviaMci ('pause som');
            enviaMci ('status som position');
            posic := respMCI;
            enviaMci ('close som');
            sintBip;  sintBip;
        end;

    for c := '1' to '8' do
         mensagem ('MAAJUDA' + c, 1, falando);
    while sintFalando do;

    if falando then
        begin
            abreSom (nomeMan);
            enviaMci ('seek som to ' + posic);
        end;
end;

{-------------------------------------------------------------}
{                    programa principal
{-------------------------------------------------------------}

label fim;

begin
    sintInic (0, sintAmbiente ('MANVOX', 'DIRMANVOX'));
    textBackGround (BLUE);
    if paramCount > 0 then
        mensagem ('MAINIC', 2, false)     {'Tocador de arquivos...'}
    else
        mensagem ('MAINIC', 2, true);     {'Tocador de arquivos...'}
    textBackGround (BLACK);

    if paramCount <> 1 then
        nomeMan := selecManual
    else
        nomeMan := paramStr (1);

    if nomeMan = '' then goto fim;

    if not abreSom (nomeMan) then
        begin
            mensagem ('MAARQNAO', 1, true);     {'Arquivo de som não está no disco'}
            mensagem ('MASINTO',  1, true);     {'Sinto muito'}
            delay (1000);
            sintFim;
            doneWinCrt;
        end;

    toca;
    ajuda (false);

    processando := true;
    while processando do
        begin
            c := readkey;
            if c = #$0 then
                begin
                    c := readkey;
                    case c of
                        DIR:  avancaSom;
                        ESQ:  recuaSom;
                        CIMA: toca;
                        BAIX: pausaSom;
                        HOME: inicioSom;
                        TEND: fimSom;
                        F1:   ajuda (true);
                    end
                end
            else
                if c = #$1b then
                    begin
                         fechaSom;
                         processando := false;
                    end;
        end;

fim:
    delay (500);
    while sintFalando do;
    doneWinCrt;
end.