{--------------------------------------------------------}
{
{    DOSVOX - interface do DOS para sintetizador de voz
{
{    Autor: Jose' Antonio Borges
{
{    Em 14/4/94
{
{--------------------------------------------------------}

{$M 16536,8192}
program agenvox;

uses windos, dvCrt, dvWin, dvHora,

     agDados,
     agMensag,
     agEstDad,
     agArq;

{--------------------------------------------------------}
{               mutreta para descobrir o dia
{--------------------------------------------------------}

function descobreDia (dia, mes, ano: word): word;
var
    salvaAno, salvaMes, salvaDia, salvaSem, diaSemana: word;
begin
    getDate (salvaAno, salvaMes, salvaDia, salvaSem);
    setDate (ano, mes, dia);
    getDate (ano, mes, dia, diaSemana);
    setDate (salvaAno, salvaMes, salvaDia);

    descobreDia := diaSemana;
end;

{--------------------------------------------------------}
{                      mostra o dia
{--------------------------------------------------------}

procedure mostraUmDia (dia, mes, ano: integer);
var x, y: integer;
begin
    x := wherex;
    y := wherey;
    gotoxy (1, 12);   clreol;
    write (diaPorExtenso(dia, mes, ano));

    falaDiaQualquer (dia, mes, ano);

    gotoxy (x, y);
end;

{--------------------------------------------------------}
{                     inicializacao
{--------------------------------------------------------}

procedure inicializa;
var
    segundo, cent: word;
begin
    clrscr;
    SintInic (0, sintAmbiente('AGENVOX', 'DIRAGENVOX'));

    limpaTela;

    gotoxy (1, 9);
    mensagem ('AGINIC');
    getDate (ano, mes, dia, diaSemana);
    getTime (hora, minuto, segundo, cent);

    inicEstrDados;
    leAgenda;
end;

{--------------------------------------------------------}
{                   seleciona um dia
{--------------------------------------------------------}

procedure selecDia;
const
    NUMEROS: set of char = ['0'..'9'];
var
    linha, s: string;
    ok: boolean;
    posCarac, i, erro: integer;

label errou, fim, okdia, okmes;

begin
    ok := false;
    limpaBaixo;

    repeat
        gotoxy (1, 13);
        clreol;
        textBackground (blue);
        mensagem ('AGINFDIA');
        textBackground (black);
        clreol;

        sintReadln (linha);
        linha := linha + '@';

        if not (linha[1] in NUMEROS) then goto errou;

        posCarac := 1;
        for i := 2 to length(linha) do
            if not (linha[i] in NUMEROS) then
                begin
                    dia := 9999;
                    s := copy (linha, 1, i-posCarac);
                    val (s, dia, erro);
                    posCarac := i+1;
                    if erro <> 0      then goto errou;
                    if linha[i] = '@' then goto fim;
                    goto okdia;
                end;
okdia:
        if not (linha[posCarac] in NUMEROS) then goto errou;
        for i := posCarac+1 to length(linha) do
            if not (linha[i] in NUMEROS) then
                begin
                    s := copy (linha, posCarac, i-posCarac);
                    val (s, mes, erro);
                    posCarac := i+1;
                    if erro <> 0      then goto errou;
                    if linha[i] = '@' then goto fim;
                    goto okmes;
                end;
okmes:
        if not (linha[posCarac] in NUMEROS) then goto errou;
        for i := posCarac+1 to length(linha) do
            if not (linha[i] in NUMEROS) then
                begin
                    s := copy (linha, posCarac, i-posCarac);
                    val (s, ano, erro);
                    posCarac := i+1;
                    if erro <> 0      then goto errou;
                    if linha[i] <> '@' then goto errou;
                    goto fim;
                end;
fim:
        ok := true;

        if ano <= 99 then
            if ano >= 83 then
                ano := ano + 1900
            else
                ano := ano + 2000;

        if (ano < 1900) or (ano >= 2100)
            or (mes < 1) or (mes > 12) then ok := false
        else
        if (dia < 1) or (dia > 31) then ok := false
        else
        if (mes in [4, 6, 9, 11]) and (dia > 30) then ok := false
        else
        if (mes = 2) and (dia > 29) then ok := false
        else
        if (mes = 2) and (dia = 29) and ((ano mod 4) <> 0) then ok := false;

errou:
        if not ok then
            mensagem ('AGERRDIA');
    until ok;

    mostraUmDia (dia, mes, ano);
end;

{--------------------------------------------------------}
{                   seleciona uma hora
{--------------------------------------------------------}

procedure selecHora;
const
    NUMEROS: set of char = ['0'..'9'];
var
    linha, s: string;
    ok: boolean;
    posCarac, i, erro: integer;

label errou, fim, okHora, okMin;

begin
    ok := false;
    limpaBaixo;

    repeat
        gotoxy (1, 13);
        clreol;
        mensagem ('AGINFHOR');

        sintReadln (linha);

        minuto := 0;
        linha := linha + '@';

        if not (linha[1] in NUMEROS) then goto errou;

        posCarac := 1;
        for i := 2 to length(linha) do
            if not (linha[i] in NUMEROS) then
                begin
                    hora := 9999;
                    s := copy (linha, 1, i-posCarac);
                    val (s, hora, erro);
                    posCarac := i+1;
                    if erro <> 0      then goto errou;
                    if linha[i] = '@' then goto fim;
                    goto okhora;
                end;
okhora:
        if not (linha[posCarac] in NUMEROS) then goto errou;
        for i := posCarac+1 to length(linha) do
            if not (linha[i] in NUMEROS) then
                begin
                    s := copy (linha, posCarac, i-posCarac);
                    val (s, minuto, erro);
                    posCarac := i+1;
                    if erro <> 0      then goto errou;
                    if linha[i] <> '@' then goto errou;
                end;

fim:
        ok := true;

        if ano <= 99 then
            if ano >= 83 then
                ano := ano + 1900
            else
                ano := ano + 2000;

        if (ano < 1900) or (ano >= 2100)
            or (mes < 1) or (mes > 12) then ok := false
        else
        if (dia < 1) or (dia > 31) then ok := false
        else
        if (mes in [4, 6, 9, 11]) and (dia > 30) then ok := false
        else
        if (mes = 2) and (dia > 29) then ok := false
        else
        if (mes = 2) and (dia = 29) and ((ano mod 4) <> 0) then ok := false;

errou:
        if not ok then
            mensagem ('AGERRHOR');
    until ok;
end;

{--------------------------------------------------------}
{                   mostra um compromisso
{--------------------------------------------------------}

procedure mostraComprom;
var
    poslista: PLISTA;
    s, fon: string;
    i: integer;
begin
    falaHoraQualquer (hora, minuto);

    gotoxy (1, 15);
    write (hora:2, ':');
    str (minuto:2, s);
    if s[1] = ' ' then s[1] := '0';
    write (s, ' - ');

    if buscaEstrDados (dia, mes, ano, hora, minuto, poslista) then
        begin
            with poslista^ do
                begin
                    if poslista^.marcaComprom <> ' ' then
                        for i := 1 to 5 do sintBip;

                    s := copy (textoComprom, 1, 72);
                    sintWrite (s);
                end;
        end
    else
        mensagem ('AGLIVRE');
end;

{--------------------------------------------------------}
{                   insere um compromisso
{--------------------------------------------------------}

procedure insereComprom;
var texto: string;
    poslista: PLISTA;
    cod: char;
    c, c2: char;

begin
    selecHora;

    if buscaEstrDados (dia, mes, ano, hora, minuto, poslista) then
        begin
            gotoxy (1, 14);
            mensagem ('AGDUPLI');
	    exit;
        end;

    gotoxy (1, 15);
    textBackground (blue);
    mensagem ('AGDIGITE');
    textBackground (black);

    texto := '';
    cod := sintEdita (texto, 1, 16, 80, true);
    if (cod = ESC) or (texto = '') then
        begin
            gotoxy (1,16);  clreol;
            writeln; clreol;
            mensagem ('AGIGNORA');
            exit;
        end;

    if insereEstrDados (dia, mes, ano, hora, minuto, texto, poslista) then
        begin
            gotoxy (1, 19);
            mensagem ('AGINSER');
        end;
end;

{--------------------------------------------------------}
{                   remove um compromisso
{--------------------------------------------------------}

procedure removeComprom;
var poslista: PLISTA;
    s, fon: string;
    c, c2: char;
begin
    limpaBaixo;
    mensagem ('AGOPREM');

    selecDia;
    selecHora;

    if buscaEstrDados (dia, mes, ano, hora, minuto, poslista) then
        begin

            with poslista^ do
                begin
                    gotoxy (1, 16);
                    mensagem ('AGCONFRM');
                    s := copy (textoComprom, 1, 72);
                    sintWriteln (s);
                end;

            sintLeTecla (c, c2);

            if upcase (c) = 'S' then
                begin
		    if not removeEstrDados (dia, mes, ano, hora, minuto) then
			 ;
		    mensagem ('AGREMOV');

                end
        end
    else
        begin
	    writeln;
	    mensagem ('AGLIVRE');
        end;
end;

{--------------------------------------------------------}
{                 folheia os compromissos
{--------------------------------------------------------}

procedure folheiaComprom (var poslista: PLISTA);
var campo: string;
    cod, c, c2: char;
    s, codorig, coddia: string;
    i: integer;
begin
    gotoxy (1, 13);
    mensagem ('AGPODEDI');

    repeat
        with poslista^ do
            begin
                dia := diaComprom;
                mes := mesComprom;
                ano := anoComprom;
                hora   := horaComprom;
                minuto := minComprom;
                campo  := textoComprom;
            end;

        codorig := copy (codifica (dia, mes, ano, hora, minuto), 1, 8);

        limpaBaixo;
        gotoxy (1, 15);
        write (hora:2, ':');
        str (minuto:2, s);
        if s[1] = ' ' then s[1] := '0';
        write (s, ' - ');
        falaHoraQualquer (hora, minuto);

        if poslista^.marcaComprom <> ' ' then
            for i := 1 to 5 do sintBip;

        cod := sintEdita (campo, 9, 15, 70, true);
        if (cod <> ESC) and (campo <> poslista^.textoComprom) then
            begin
                writeln;
                mensagem ('AGQUERAL');
                sintLeTecla (c, c2);
                writeln (c);
                if (c = ESC) or (upcase(c) = 'N') then
                    mensagem ('AGNAOALT')
                else
                    begin
                        poslista^.textoComprom := campo;
                        mensagem ('AGALT');
                    end;
            end;

        case cod of

            BAIX,
            PGDN: begin
                      if (poslista=NIL) or
                         (poslista^.prox^.prox = NIL) then
                          begin
                              write ($0d);
                              mensagem ('AGNAOACH');
                          end
                      else
                          poslista := poslista^.prox;
                  end;

            CIMA,
            PGUP: begin
                      if poslista^.ant = NIL then
                          begin
                              write ($0d);
                              mensagem ('AGNAOACH');
                          end
                      else
                          poslista := poslista^.ant;
                  end;

        end;

        with poslista^ do
            begin
                 coddia := copy (codifica (diaComprom, mesComprom, anoComprom,
                             horaComprom, minComprom), 1, 8);
                 if codorig <> coddia then
                     begin
                         dia := diaComprom;
                         mes := mesComprom;
                         ano := anoComprom;
                         falaDiaQualquer (dia, mes, ano);
                     end;
            end;

    until cod = ESC;
end;

{--------------------------------------------------------}
{                   procura um compromisso
{--------------------------------------------------------}

procedure procuraComprom;
var poslista: PLISTA;
    ultdia, ultmes, ultano: integer;
    texto: string;
    c: char;

begin
    limpaBaixo;
    gotoxy (1, 13);
    mensagem ('AGINFPRO');

    texto := '';
    c := sintEdita (texto, 1, 14, 80, true);
    if (c = #$1b) or (texto = '') then
        begin
            writeln;
            mensagem ('AGPROCAN');
            exit;
        end;

    { a partir da ultima busca... }

    if not (buscaEstrDados (dia, mes, ano, 0, 0, poslista)) then ;

    if (poslista^.prox = NIL) then
            begin
               writeln; clreol;
               mensagem ('AGNAOACH');
               exit;
            end;

    if buscaTextoEstrDados (texto, poslista) then
        begin
            writeln; clreol;
            mensagem ('AGACHEI');
            writeln;

            with poslista^ do
                falaDiaQualquer (diaComprom, mesComprom, anoComprom);
            folheiaComprom (poslista)
        end
    else
        begin
            gotoxy (1, 18);
            mensagem ('AGNAOACH');
            exit;
        end;
end;


{--------------------------------------------------------}
{                 edita os compromissos
{--------------------------------------------------------}

procedure editaComprom;
var poslista: PLISTA;
begin
    if not buscaEstrDados (dia, mes, ano, hora, minuto, poslista) then
        begin
            poslista := poslista^.ant;
            if (poslista = NIL) then
                begin
                    mensagem ('AGVAZIA');
                    exit;
                end;
        end;

    folheiaComprom (poslista);
end;

{--------------------------------------------------------}
{                insere uma marca especial
{--------------------------------------------------------}

procedure marcaEspecial;
var poslista: PLISTA;
    s: string;
    fon: string;
begin
    selecHora;

    if buscaEstrDados (dia, mes, ano, hora, minuto, poslista) then
        begin
            with poslista^ do
                begin
                    if marcaComprom = ' ' then
                        marcaComprom := '*'
                    else
                        marcaComprom := ' ';

                    s := copy (textoComprom, 1, 72);
                    sintWriteln (s);

                    gotoxy (1, 16);
                    if poslista^.marcaComprom <> ' ' then
                        mensagem ('AGREGMAR')
                    else
                        mensagem ('AGREGDSM');
                end;

        end
    else
        begin
	    writeln;
	    mensagem ('AGLIVRE');
        end;
end;

{--------------------------------------------------------}
{            mostra varios compromissos na tela
{--------------------------------------------------------}

procedure mostraDia;
var poslista, p1, p2: PLISTA;

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

    procedure falaCompromisso (p: PLISTA);
    var fon: string;
    begin
        hora   := p^.horaComprom;
        minuto := p^.minComprom;
        falaHoraQualquer (hora, minuto);
        sintetiza (p^.textoComprom);
    end;

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

    procedure mostraOsCompromissos;
    var p, ptela: PLISTA;
        c, c2: char;
        h, m: string;
        l: integer;
    begin
        limpaBaixo;
        mensagem ('AGSETAS');

        p := NIL;
        ptela := p1;

        repeat
            l := 13;
            while ptela <> p2 do
                begin
                    str (ptela^.horaComprom, h);
                    str (ptela^.minComprom, m);
                    if length (h) = 1 then h := '0' + h;
                    if length (m) = 1 then m := '0' + m;

                    if l < 25 then
                        begin
                            gotoxy (1, l);
                            write (h, ':', m, ' - ');
                            write (ptela^.textoComprom);
                            clreol;
                        end;

                    ptela := ptela^.prox;
                    l := l + 1;
                end;

            for l := l to 25 do
                begin
                    gotoxy (1, l);
                    clreol;
                end;

            gotoxy (1, 13);
            sintLeTecla (c, c2);

            gotoxy (1, 12);  clreol;
            gotoxy (1, 13);

            if c = ESC then exit;

            if (p = NIL) then
               begin
                   p  := p1;
                   c := #0;
                   c2 := DIR;
               end;

            if c = ESC then exit;
            if c <> #0 then
                 sintBip
            else
                 case c2 of
                     F1:   begin
                               gotoxy (1, 12);
                               mensagem ('AGSETAS');
                           end;

                     ESQ, DIR: falaCompromisso (p);

                     BAIX,
                     PGDN: if p^.prox = p2 then
                               begin
                                   gotoxy (1, 12);
                                   mensagem ('AGNAOACH');
                               end
                           else
                               begin
                                   p := p^.prox;
                                   falaCompromisso (p);
                               end;

                     CIMA,
                     PGUP: if p = p1 then
                               begin
                                   gotoxy (1, 12);
                                   mensagem ('AGNAOACH');
                               end
                           else
                               begin
                                   p := p^.ant;
                                   falaCompromisso (p);
                               end;
                 end;

            ptela := p;

        until false;
    end;

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

begin
    writeln;
    if buscaEstrDados (dia, mes, ano, 0, -1, p1) then;
    if (dia = p1^.diaComprom) and
       (mes = p1^.mesComprom) and
       (ano = p1^.anoComprom) then

        begin
            if buscaEstrDados (dia+1, mes, ano, 0, -1, p2) then;

            mostraOsCompromissos;
        end
    else
        mensagem ('AGVAZIA');
end;

{--------------------------------------------------------}
{                    trata controles
{--------------------------------------------------------}

procedure trataControles (c2: char);
begin
    case c2 of
        F1:  ajuda;

        F2:  gravaAgenda;

        F3:  begin
                gravaAgenda;
                leAgenda;
             end;
    end;
end;

{--------------------------------------------------------}
{                    executa um comando
{--------------------------------------------------------}

procedure executaComando;
var c, c2: char;
begin
    while keypressed do
        c := readkey;

    gotoxy (1, 11);
    clreol;
    textBackground (blue);
    mensagem ('AGOPCAO');
    textBackground (black);
    clreol;

    sintLeTecla (c, c2);

    limpaBaixo;
    gotoxy (1, 13);
    case upcase(c) of
        #0 : trataControles (c2);
        'D': begin
                 selecDia;
                 mostraDia;
             end;

        'H': begin
                 selecHora;
                 mostraComprom;
             end;

        'E': editaComprom;
        'P': procuraComprom;
        'I': insereComprom;
        'R': removeComprom;
        '*': marcaEspecial;

        'S': gravaAgenda;
  #$1b, 'F': fim := true;
    else
        ajuda;
    end;
end;

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

begin
    inicializa;

    falaDiaQualquer (dia, mes, ano);
    delay (1000);
    mostraDia;

    fim:= false;
    repeat
        executaComando;
    until fim;

    gravaAgenda;
    finaliza;
end.
