{--------------------------------------------------------}
{
{    Calculadora Vocal - versao 2.0
{
{    Autor: Jose' Antonio Borges
{
{    Em 5/5/96
{
{--------------------------------------------------------}

{$M 16536,8192}
program Calcuvox;
uses
    DVcrt, DVWin, DVHora, DVleNum;

const
    versao = '2.0';

var
    valorLido, resultado: real;
    jaLido: boolean;
    ultLido: char;
    ultOp: char;
    progAcabou: boolean;
    nDecimais: integer;
    memoria: array [0..9] of real;

    posFita, nrFita: integer;
    opFita:    array [1..200] of char;
    valorFita: array [1..200] of real;

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

procedure ajudaCalc (falando: boolean);
var i: char;
begin
    gotoxy (45, 3);
    writeln ('Operações válidas:');
    gotoxy (45, 5);
    writeln ('   As 4 básicas: + - * /');
    gotoxy (45, 6);
    writeln ('\           raiz quadrada');
    gotoxy (45, 7);
    writeln ('= ou ENTER  termina cálculo');
    gotoxy (45, 8);
    writeln ('D ou HOME   número de decimais');
    gotoxy (45, 9);
    writeln ('C ou DEL    limpa conta');
    gotoxy (45,10);
    writeln ('BS          apaga digito');
    gotoxy (45,11);
    writeln ('PAGE-UP x   põe na memória  (0 a 9)');
    gotoxy (45,12);
    writeln ('PAGE-DN x   traz da memória (0 a 9)');

    if falando then
        begin
            for i := '1' to '9' do
                begin
                    if not keypressed then
                        sintSom ('CAAJUD'+i);
                end;

            while keypressed do i := readkey;
        end;
end;

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

procedure mostraMemorias;
var i: integer;
begin
    gotoxy (55, 13);
    write ('Memórias: ');

    for i := 0 to 9 do
        begin
            gotoxy (65, i+13);
            write (i, ': ',  memoria[i]:0:nDecimais);
            clreol;
        end;
end;

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

procedure desenhaCalculadora;
var i: integer;
begin
    textBackground (black);
    clrscr;
    for i := 1 to 17 do    { desenha fita }
        writeln ('    !                                 !');

    textBackground (BROWN);
    textColor (lightgray);
    writeln (' +---------------------------------------+ ');
    writeln (' !                                       ! ');
    writeln ('++---------------------------------------++');
    writeln ('!    7    8    9       +    =    M+   BS  !');
    writeln ('!    4    5    6       -    \    M-   ESC !');
    writeln ('!    1    2    3       *    %    MR   R   !');
    writeln ('!    .    0    ,       /         MC   C   !');
    write   ('+-----------------------------------------+');
    textBackground (black);

    gotoxy (20, 19);
    write ('                 0');

    gotoxy (45, 1);
    textBackGround (blue);
    write ('Calculadora Vocal - ', versao);
    textBackGround (black);

    mostraMemorias;

    ajudaCalc (false);
end;

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

procedure inicializa;
var i: integer;

begin
    sintInic (0, sintAmbiente ('CALCUVOX', 'DIRCALCUVOX'));

    valorLido := 0;
    resultado := 0;
    ultOp := ' ';
    nDecimais := 2;
    posFita := 0;

    for i := 0 to 9 do
        memoria [i] := 0.0;

    desenhaCalculadora;
    sintSom ('CAINIC');   { Calculadora Vocal }
end;

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

procedure mostraErroArq;
begin
    gotoxy (45, 24);
    write ('Erro no arquivo de memória');
    sintSom ('CAERRARQ');
    gotoxy (45, 24);
    write ('                          ');
end;

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

procedure leMemorias;
var i: integer;
    arq: text;
label fim;
begin
    assign (arq, sintAmbiente('CALCUVOX', 'ARQMEMORIAS'));
    {$I-} reset (arq); {$i-}
    if ioresult <> 0 then
        begin
           sintBip;
           exit;
        end;

    for i := 0 to 9 do
        if not eof (arq) then
            begin
                {$I-} readln (arq, memoria[i]); {$I+}
                if ioresult <> 0 then
                    begin
                        mostraErroArq;
                        goto fim;
                    end;
            end;
fim:
    close (arq);

    mostraMemorias;
    sintSom ('CAMEMCRG');
end;

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

procedure gravaMemorias;
var i: integer;
    arq: text;
label fim;

begin
    assign (arq, sintAmbiente('CALCUVOX', 'ARQMEMORIAS'));
    {$I-} rewrite (arq); {$I+}
    if ioresult <> 0 then
        begin
            mostraErroArq;
            goto fim;
        end;

    for i := 0 to 9 do
        begin
            {$I-} writeln (arq, memoria[i]:0:nDecimais); {$I+}
            if ioresult <> 0 then
                begin
                    mostraErroArq;
                    goto fim;
                end;
        end;
fim:
    {$I-}  close (arq);  {$I+}
    if ioresult <> 0 then;
    sintSom ('CAMEMGRV');
end;

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

procedure termina;
begin
    gotoxy (1, 25);
    textBackground (BLACK);
    sintSom ('CAFIM');
    sintFim;
    doneWinCRT;
end;

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

procedure desleTecla (c: char);
begin
    jaLido := true;
    ultLido := c;
end;

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

procedure leTeclado (var c: char);
begin
    if jaLido then
        begin
            jaLido := false;
            c  := ultLido;
        end
    else
        c := readkey;
end;

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

procedure entraNumero;
var c: char;
    erro: integer;
    brancos, mostrador: string;
    teclouPonto: boolean;
    removido: char;

begin
    valorLido := 0.0;
    mostrador := '';
    brancos := '                    ';
    teclouPonto := false;
    gotoxy (20, 19);

    mostrador := '';
    repeat
        leTeclado (c);
        if c = ',' then c := '.';

        if teclouPonto and (c = '.') then
            sintBip
        else
            if (c = #$08) then
                begin
                    if (length (mostrador) > 0) then
                        begin
                            removido := mostrador [length(mostrador)];
                            if removido = '.' then
                                teclouPonto := false;
                            sintSom ('_DEL');
                            sintCarac (removido);
                            mostrador := copy (mostrador, 1, length(mostrador)-1);
                        end;
                end
            else
                if c in ['0'..'9', '.'] then
                    begin
                        if length (mostrador) >= 18 then
                            sintBip
                        else
                            begin
                                mostrador := mostrador + c;
                                sintCarac (c);
                            end;
                    end;

        if c = '.' then
            teclouPonto := true;

        gotoxy (20, 19);
        write (copy (brancos, 1, 18-length(mostrador)), mostrador);

    until not (c in ['0'..'9', '.', #$08]);

    if mostrador = '' then
        begin
           mostrador := '0';
           sintCarac ('0');
        end;

    val (mostrador, valorlido, erro);

    desleTecla (c);
end;

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

procedure falaNumeroReal (numero: real);
var
    s: string;
    l: longint;
    i: integer;
    podeFalar: boolean;
begin
    if numero < 0 then
        begin
            sintSom ('CAMENOS');
            numero := -numero;
        end;

    l := trunc (numero);
    falaNumeroConv (numeroParaString (l), MASCULINO);
    if numero - trunc (numero) <> 0 then
        begin
            str (numero:18:ndecimais, s);
            podeFalar := false;
            for i := 1 to length (s) do
                begin
                    if s[i] = '.' then
                        begin
                            sintSoletra (',');  {virgula}
                            podeFalar := true;
                        end
                    else
                        if podeFalar then
                             falaNumeroConv (numeroParaString (ord(s[i]) and $f), MASCULINO);
                end;
        end;
end;

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

procedure mostraResult;
begin
    window (20, 1, 38, 17);
    gotoxy (1, 1);
    delline;
    delline;
    window (1, 1, 80, 25);

    gotoxy (20, 16);
    write (resultado:17:nDecimais, '  ');

    posFita := posFita + 1;
    valorFita [posFita] := resultado;
    opFita [posFita] := '#';
    posFita := posFita + 1;
    valorFita [posFita] := 0;   { marca de fim de conta }
    opFita [posFita] := ' ';

    gotoxy (20, 19);
    write (resultado:18:ndecimais);
    gotoxy (38,19);
end;

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

procedure operacaoInvalida;
begin
    sintSom ('CAOPINV');
    valorLido := 0;
    resultado := 0;
    ultOp := ' ';

    window (20, 1, 38, 17);
    gotoxy (1, 1);
    delline;
    window (1, 1, 80, 25);

    gotoxy (20, 17);
    write ('           # erro #');
    gotoxy (20, 19);
    write (0.0:18:ndecimais);
end;

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

procedure operaEPrepara (operacao: char);

var x1, x2: string;

begin
    window (20, 1, 38, 17);
    gotoxy (1, 1);
    delline;
    window (1, 1, 80, 25);

    gotoxy (20, 17);
    write (valorLido:17:nDecimais, ' ', operacao);

    posFita := posFita + 1;
    valorFita [posFita] := valorLido;
    opFita [posFita] := operacao;

    case operacao of
        '+' :    sintSom ('CAMAIS');
        '-' :    sintSom ('CAMENOS');
        '*' :    sintSom ('CAVEZES');
        '%' :    sintSom ('CAPERCEN');
        '/' :    sintSom ('CADIVID');
        '=' :    sintSom ('CAIGUAL');
        '\' :    sintSom ('CARAIZ');
    end;

    case ultOp of
        ' ' :    resultado := valorLido;
        '+' :    resultado := resultado + valorLido;
        '-' :    resultado := resultado - valorLido;

        '*' :    begin
                     str (abs(resultado):0:0, x1);
                     str (abs(valorLido):0:0, x2);
                     if (length (x1) + length (x2)) > 11 then
                         operacaoInvalida
                     else
                         resultado := resultado * valorLido;
                 end;

        '/' :    if valorLido = 0 then
                      operacaoInvalida
                 else
                      resultado := resultado / valorLido;

        '%' :    resultado := resultado / 100;

        '=': ;   { ignora }
    end;

    { operacao imediata }

    if operacao = '\' then  {raiz}
        begin
            if resultado < 0 then
                operacaoInvalida
            else
                resultado := sqrt (resultado);
        end;

    ultOp := operacao;
end;

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

procedure pegaDecimais;
var tecla: char;
begin
    sintSom ('CANUMDEC');
    leTeclado (tecla);
    if tecla = #$0 then
        begin
            leTeclado (tecla);  {ignora proxima}
            sintBip;
            exit;
        end;

    if not (tecla in ['0'..'8']) then
        sintBip
    else
        begin
            sintCarac (tecla);
            nDecimais := ord(tecla) - ord ('0');
            sintclek;
            sintclek;
        end;

    mostraMemorias;
end;

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

procedure limpaConta;
begin
    window (20, 1, 38, 17);
    gotoxy (1, 1);
    delline;
    window (1, 1, 80, 25);

    resultado := 0;
    gotoxy (20, 17);
    write ('Conta Cancelada');
    sintSom ('CACANC');

    gotoxy (20, 19);
    write (0.0:18:ndecimais);
end;

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

procedure poeNaMemoria (valor: real);
var c: char;
begin
    gotoxy (45, 24);
    write ('Em que memória guardo [0..9]: ');
    sintSom ('CAQUALMG');
    leTeclado (c);
    if c = #$0 then
        begin
            leTeclado (c);  {ignora proxima}
            sintBip;
            exit;
        end;


    if c in ['0'..'9'] then
        begin
            sintCarac (c);
            memoria [ord(c) - ord('0')] := valorLido;
        end
    else
        sintBip;
    
    mostraMemorias;

    gotoxy (45, 24);
    write ('                               ');
end;

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

function trazDaMemoria: real;
var c: char;
    valor: real;
begin
    trazDaMemoria := 0;

    gotoxy (45, 24);
    write ('Qual memoria [0..9]: ');
    sintSom ('CAQUALME');
    leTeclado (c);
    if c = #$0 then
        begin
            leTeclado (c);  {ignora proxima}
            sintBip;
            exit;
        end;


    if c in ['0'..'9'] then
        begin
            sintCarac (c);
            valor := memoria [ord(c) - ord('0')];
        end
    else
        begin
            valor := 0;
            sintBip;
        end;

    falaNumeroReal (valor);
    gotoxy (20, 19);
    write (valor:18:nDecimais);

    gotoxy (45, 24);
    write ('                      ');
    trazDaMemoria := valor;
end;

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

procedure zeraMemorias;
var i: integer;
begin
    for i := 0 to 9 do
        memoria [i] := 0.0;

    mostraMemorias;
    sintSom ('CAMEMZER');
end;

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

procedure leFita;
var c: char;

begin
    leTeclado (c);
    case c of
        CIMA:  if nrfita <= 1 then
                   sintBip
               else
                   begin
                       nrfita := nrfita - 1;
                       if opFita [nrfita] <> ' ' then
                           falaNumeroReal (valorFita [nrfita]);

                       if opFita [nrfita] = '#' then
                           sintSom ('CARESULT')
                       else
                           sintSoletra (opFita [nrfita]);
                   end;

        BAIX:  if nrfita >= posFita then
                   sintBip
               else
                   begin
                       nrfita := nrfita + 1;
                       if opFita [nrfita] <> ' ' then
                           falaNumeroReal (valorFita [nrfita]);

                       if opFita [nrfita] = '#' then
                           sintSom ('CARESULT')
                       else
                           sintSoletra (opFita [nrfita]);
                   end;

        PGUP:  begin
                   while (nrfita > 0) and (opFita[nrfita] = ' ') do
                       begin
                           nrfita := nrfita - 1;
                           sintClek;
                       end;

                   while (nrfita > 0) and (opFita[nrfita] <> ' ') do
                       begin
                           nrfita := nrfita - 1;
                           sintClek;
                       end;

                   if nrfita <= 0 then
                       begin
                           sintBip;
                           nrfita := 0;
                       end;
               end;

        PGDN:  begin
                   if opFita [nrfita] <> ' ' then
                       while (nrfita <= posFita) and
                             (opFita[nrfita] <> ' ') do
                           begin
                               nrfita := nrfita + 1;
                               sintClek;
                           end;

                   while (nrfita <= posFita) and
                         (opFita[nrfita] = ' ') do
                       begin
                           nrfita := nrfita + 1;
                           sintClek;
                       end;

                   if nrfita > posFita then
                       begin
                           sintBip;
                           nrfita := posFita + 1;
                       end;
               end;

        HOME:  begin
                   nrfita := 0;
                   sintClek;
               end;

        TEND:  begin
                   nrfita := posFita+1;
                   sintClek;
               end;
    end;
end;

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

procedure reveContaEMemorias;
var c: char;

begin
    gotoxy (45, 23);
    write ('Use as setas ou o numero da');
    gotoxy (45, 24);
    write ('memória a rever, ESC termina');
    sintSom ('CAREVE');

    nrFita := posFita;

    repeat
        leTeclado (c);
        case c of
            '0'..'9':  begin
                           sintSom ('CAMEMO');
                           sintCarac (c);
                           falaNumeroReal (memoria [ord(c) - ord ('0')]);
                       end;

            #0: leFita;
        end;

    until c = #$1b;

    gotoxy (45, 23);
    write ('                            ');
    gotoxy (45, 24);
    write ('                            ');

    sintSom ('CAFIMREV');
end;

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

procedure entraComando;
var tecla, c2: char;
begin
    gotoxy (38,19);
    leTeclado (tecla);

    case upcase (tecla) of
       '.', ',', '0'..'9':
                 begin
                     desleTecla (tecla);
                     entraNumero;
                 end;

       'C': limpaConta;
       'D': pegaDecimais;
       '+': operaEPrepara ('+');
       '-': operaEPrepara ('-');
       '*': operaEPrepara ('*');
       '/': operaEPrepara ('/');
       '%': operaEPrepara ('%');
       '\': operaEPrepara ('\');

       'P': poeNaMemoria (resultado);
       'M': valorLido := trazDaMemoria;
       'R': reveContaEMemorias;
       'C': limpaConta;
       'Z': zeraMemorias;

       '=', ENTER:
                  begin
                      operaEPrepara ('=');
                      if abs(resultado) > 99999999 then
                          operacaoInvalida
                      else
                          begin
                              mostraResult;
                              repeat
                                  falaNumeroReal (resultado);
                                  leTeclado (tecla);
                              until (tecla <> '=') and (tecla <> ENTER);

                              ultOp := ' ';

                              if not (upcase(tecla) in
                                     ['+', '-', '*', '/', '\', #0,
                                      '0'..'9', #$1b, 'P']) then
                                    resultado := 0;

                              valorLido := resultado;
                              desleTecla (tecla);
                          end;
                  end;
      #$0:  begin
                 leTeclado (c2);
                 case c2 of
                     F1:    ajudaCalc (true);
                     F2:    gravaMemorias;
                     F3:    leMemorias;
                     CIMA:  reveContaEMemorias;
                     DEL:   limpaConta;
                     PGUP:  poeNaMemoria (resultado);
                     PGDN:  valorLido := trazDaMemoria;
                 else
                     sintSom ('CATECINV');
                 end;
            end;

      #$1b: progAcabou := true;
    else
        sintSom ('CATECINV');
    end;
end;

begin
{$R+}
    inicializa;

    progAcabou := false;
    repeat
        entraComando;
    Until progAcabou;

    termina;
end.
