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

{$M 16536,8192}
program manual;

uses dvcrt, dvWin, strings, mmsystem;

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

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

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

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;

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;

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

procedure inicio;
begin
    enviaMci ('pause som');
    enviaMci ('seek som to 0');
end;

procedure fim;
begin
    enviaMci ('pause som');
    enviaMci ('seek som to end');
end;

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

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

procedure ajuda;
begin
    writeln;
    writeln ('Controles:');
    writeln ('  cima:     toca');
    writeln ('  baixo:    para');
    writeln ('  direita:  avança');
    writeln ('  esquerda: recua');
    writeln ('  home:     posiciona no inicio');
    writeln ('  end:      posiciona no fim');
    writeln ('  esc:      termina o programa');
end;

begin
    sintInic (0, '');
    if paramCount <> 1 then
        begin
            sintWrite ('Manual de que programa');
            writeln (' ? ');
            sintReadln (nomeMan);
        end
    else
        nomeMan := paramStr (1);

    if not abreSom (nomeMan) then
        begin
            sintWriteln ('Manual não está no disco');
            sintWriteln ('Sinto muito');
            delay (1000);
            sintFim;
            doneWinCrt;
        end;

    toca;
    ajuda;

    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: pausa;
                        HOME: inicio;
                        TEND: fim;
                        F1:   ajuda;
                    end
                end
            else
                if c = #$1b then
                    begin
                         fechaSom;
                         processando := false;
                    end;
        end;

    doneWinCrt;
end.