{--------------------------------------------------------}
{          Telemark - procedimentos de folheamento
{--------------------------------------------------------}

unit tmFolhe;
interface
uses dvcrt, dvwin, tmVars, tmMsg, tmEdita, tmTelef, tmConta;

procedure folheia;

implementation
var
    nlinhasFolheia: integer;
    ytelaFolheia: integer;

{--------------------------------------------------------}
{          escreve um nome na area de folheamento
{--------------------------------------------------------}

procedure escreveNome (qual: integer; aviva: boolean);
const brancos = '                                        ';
var s1, s2, s3: string;
    sel: char;
begin
    if aviva and (qual = posAtual) then
        textColor (yellow)
    else
        textColor (lightGray);

    gotoxy (1, ytelaFolheia-posFolheia+qual);
    if qual > cadastrados then
        clreol
    else
        with pessoas^[qual]^ do
            begin
                s1 := copy (nome+brancos, 1, 40);
                s2 := copy (telefone+brancos, 1, 22);
                s3 := copy (status+brancos, 1, 15);
                sel := ' ';
                if selecionado then sel := '*';

                write (s1 + ' ' + s2 + ' ' + sel + s3);
            end;

    textColor (lightGray);
    gotoxy (1, ytelaFolheia-posFolheia+qual);
end;

{--------------------------------------------------------}
{                  mostra todos os nomes
{--------------------------------------------------------}

procedure mostraTodosNomes;
var i: integer;
begin
    while posFolheia > posAtual do
        posFolheia := posFolheia-10;
    while posFolheia < posAtual-nlinhasFolheia+1 do
        posFolheia := posAtual-nlinhasFolheia+10;
    if posFolheia > cadastrados then                  posFolheia := cadastrados;
    if posFolheia < 1 then                            posFolheia := 1;

    for i := posFolheia to posFolheia+nLinhasFolheia-1 do
        escreveNome (i, true);
end;

{--------------------------------------------------------}
{                remove uma pessoa
{--------------------------------------------------------}

procedure removeEste;
var c: char;
    arq: text;
    i: integer;
    s: string;
begin
    msgBaixo ('TMCNFREM');    {'Confirma remoção ? '}
    c := readkey;
    if upcase (c) = 'S' then
        begin
            s := pessoas^[posAtual]^.nomeArq;
            delete (s, length (s)- 2, 3);
            s := s + 'REM';

            assign (arq, s);
            {$I-}  erase (arq);  {$I+}
            if ioresult <> 0 then;

            assign (arq, pessoas^[posAtual]^.nomeArq);
            {$i-} rename (arq, s);  {$I+}
            if ioresult <> 0 then
                msgBaixo ('TMNAOREM')     {'Não removido'}
            else
                begin
                    dispose (pessoas^[posAtual]);
                    for i := posAtual to cadastrados-1 do
                        pessoas^[i] := pessoas^[i+1];
                    cadastrados := cadastrados - 1;
                    if posAtual > cadastrados then
                        if posAtual > 1 then posAtual := posAtual - 1;
                    msgBaixo ('TMREMOVI');     {'Removido'}
                end;
        end;

    while keypressed do readkey;
end;

{--------------------------------------------------------}
{     transforma cadeia em maiusculos nao acentuados
{--------------------------------------------------------}

function semAcentos (s: string): string;
const
    tabMaiuscPC: array [#$80..#$ff] of char = (

    'C','U','E','A','A','A','A','C','E','E','E','I','I','I','A','A',
    'E','þ','þ','O','O','O','U','U','Y','O','U','þ','þ','þ','þ','þ',
    'A','I','O','U','N','N','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ',
    'þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ',
    'A','A','A','A','A','A','‘','C','E','E','E','E','I','I','I','I',
    'þ','N','O','O','O','O','O','X','þ','U','U','U','U','Y','þ','þ',
    'A','A','A','A','A','A','‘','C','E','E','E','E','I','I','I','I',
    'þ','N','O','O','O','O','O','X','þ','U','U','U','U','Y','þ','þ');

var
    s2: string;
    i: integer;

begin
    move (s, s2, length(s)+1);
    for i := 1 to length (s2) do
        if s2[i] in ['a'..'z'] then
            s2[i] := upcase (s2[i])
        else
        if s2[i] >= #$80 then
            s2[i] := tabMaiuscPC [s2[i]];

    semAcentos := s2;
end;

{--------------------------------------------------------}
{              ordena pelo metodo quick sort
{--------------------------------------------------------}

procedure Sort(l, r: Integer);
var
    i, j: integer;
    x: string[50];
    y: pCadastro;
begin
    i := l;
    j := r;
    x := maiuscAnsi (semAcentos (pessoas^[(l+r) div 2]^.nome));
    repeat
        while maiuscAnsi (semAcentos (pessoas^[i]^.nome)) < x do
            i := i + 1;
        while x < maiuscAnsi (semAcentos (pessoas^[j]^.nome)) do
            j := j - 1;
        if i <= j then
            begin
                y := pessoas^[i];
                pessoas^[i] := pessoas^[j];
                pessoas^[j] := y;
                i := i + 1;
                j := j - 1;
            end;
    until i > j;
    if l < j then Sort(l, j);
    if i < r then Sort(i, r);
end;

procedure ordenaNomes;
begin
    if cadastrados <> 0 then
        sort (1, cadastrados);
end;

{--------------------------------------------------------}
{                 procura próximo nome
{--------------------------------------------------------}

procedure procuraProximo;
var i: integer;
    buscado: string;
begin
    buscado := maiuscAnsi (semAcentos (nomeBusc));
    for i := posAtual+1 to cadastrados do
        begin
             if pos (buscado, maiuscAnsi (semAcentos (pessoas^[i]^.nome))) <> 0 then
                 begin
                     msgBaixo ('TMACHEI');    {'Achei'}
                     posAtual := i;
                     exit;
                 end;
        end;
    msgBaixo ('TMNACHEI');    {'Não achei'}
end;

{--------------------------------------------------------}
{                  procura um nome
{--------------------------------------------------------}

procedure procuraNome;
begin
    gotoxy (1, 24); clreol;
    gotoxy (1, 23); clreol;
    textBackGround (RED);
    mensagem ('TMNOMPRC', 1);    {'Nome a procurar'}
    textBackGround (BLACK);
    sintReadln (nomeBusc);

    procuraProximo;
end;

{--------------------------------------------------------}
{                mostra opcoes de folheamento
{--------------------------------------------------------}

procedure ajudaFolheia;
var i: integer;
    s: string;
begin
    for i := 10 to 25 do
        begin
            gotoxy (1, i);  clreol;
        end;

    gotoxy (1, 11);
    mensagem ('TMAJUFOL', 1);   { As opções de folheamento são'}
    for i := 1 to 9 do
        begin
            str (i, s);
            mensagem ('TMAJUF'+s, 1);
        end;
    readln;

(*
                    N T S       fala nome telefone, status e registro
                    D           discagem automatica
                    ENTER       editar esta pessoa
                    F5          procura um nome
                    control F5  proximo nome
                    F7          remove pessoa
                    + -         seleciona ou não um nome
                    ESC         termina
*)
end;

{--------------------------------------------------------}
{               recria tela de folheamento
{--------------------------------------------------------}

procedure recriaTelaFolheia;
var y: integer;
begin
    limpaTela;

    y := wherey;
    msgBaixo ('TMFOLHE');    {'Folheando...'}
    gotoxy (1, y);

    textColor (CYAN);
    write (TITULO_FOLHEIA);
    textColor (LIGHTGRAY);
    if wherex <> 1 then writeln;

    ytelaFolheia := wherey;
    nlinhasFolheia := 25-ytelaFolheia;
end;

{--------------------------------------------------------}
{                   recria uma entrada
{--------------------------------------------------------}

procedure recriaEste (posAtual: integer);
begin
    with fichaAtual.secao[1]^, folha[1]^, pInfoSecao^ do
        with pessoas^[posAtual]^ do
            begin
                nome := dado[1];
                telefone := dado[2];
                status := dado[3];
            end;
end;

{--------------------------------------------------------}
{                   folheia registros
{--------------------------------------------------------}

procedure folheia;
var i: integer;
    folheando: boolean;
    c, c2: char;
    inibeFala, mostraTudo: boolean;

begin
    ordenaNomes;

    if cadastrados = 0 then
        begin
            mensagem ('TMCADVAZ', 1);    {'Cadastro vazio'}
            exit;
        end;

    recriaTelaFolheia;
    mostraTodosNomes;

    folheando := true;
    inibeFala := false;
    repeat
        mostraTudo := true;

        gotoxy (72, 1);
        writeln (copy (pessoas^[posAtual]^.nomeArq, 1, 8));
        escreveNome (posAtual, true);
        if (not inibeFala) and (not keypressed) then
            sintetiza (pessoas^[posAtual]^.nome);

        c := readkey;
        if c = #$0 then c2 := readkey;
        escreveNome (posAtual, false);

        inibeFala := false;

        if c = #$0 then
            case c2 of
                F1:    ajudaFolheia;
                F5:    procuraNome;
                CTLF5: procuraProximo;
                F7:    removeEste;

                CIMA:   begin
                            msgBaixo ('');
                            if posAtual <= 1 then
                                msgBaixo ('TMULTIMO')   {'Último nome'}
                            else
                                posAtual := posAtual - 1;
                            if posAtual >= posFolheia then
                                 mostraTudo := false;
                        end;

                BAIX:  begin
                            msgBaixo ('');
                            if posAtual >= cadastrados then
                                msgBaixo ('TMULTIMO')   {'Último nome'}
                            else
                                posAtual := posAtual + 1;
                            if posFolheia > posAtual-nlinhasFolheia+1 then
                                 mostraTudo := false;
                        end;

                ESQ:    begin
                            sintetiza (pessoas^[posAtual]^.nome);
                            inibeFala := true;
                        end;

                DIR:    begin
                            sintSoletra (pessoas^[posAtual]^.nome);
                            inibeFala := true;
                        end;

                CTLPGUP:    begin
                                msgBaixo ('');
                                posAtual := 1;
                            end;

                CTLPGDN:    begin
                                msgBaixo ('');
                                posAtual := cadastrados;
                            end;

                PGUP:   begin
                            msgBaixo ('');
                            posAtual := posAtual - nLinhasFolheia;
                            if posAtual <= 1 then
                                begin
                                    msgBaixo ('TMULTIMO');   {'Último nome'}
                                    posAtual := 1;
                                end;
                        end;

                PGDN:  begin
                            msgBaixo ('');
                            posAtual := posAtual + nLinhasFolheia;
                            if posAtual >= cadastrados then
                                begin
                                    posAtual := cadastrados;
                                    msgBaixo ('TMULTIMO');   {'Último nome'}
                                end;
                        end;
            end
        else
            with pessoas^[posAtual]^ do
            begin
                case upcase(c) of
                    'C': begin
                             gotoxy (1, 4);   clreol;
                             gotoxy (1, 5);   clreol;
                             gotoxy (1, 6);   clreol;
                             gotoxy (1, 4);
                             textBackground (RED);
                             contadores;
                             delay (2000);
                             textBackground (BLACK);
                         end;
                    'N': begin
                             sintetiza (nome);
                             inibeFala := true;
                         end;

                    'Q': begin
                             gotoxy (72, 1); clreol;
                             sintWriteInt (cadastrados);
                             delay (2000);
                             gotoxy (72, 1);
                             writeln (copy (pessoas^[posAtual]^.nomeArq, 1, 8));
                         end;

                    'T': begin
                             sintetiza (telefone);
                             inibeFala := true;
                         end;

                    'S': begin
                             sintetiza (status);
                             inibeFala := true;
                         end;

                    'R': begin
                             sintSoletra (copy (nomeArq, 1, 8));
                             inibeFala := true;
                         end;

                    '+': begin
                             msgBaixo ('TMSELEC');   {'Selecionado'}
                             selecionado := true;
                         end;

                    '-': begin
                             msgBaixo ('TMNSELEC');   {'Não selecionado'}
                             selecionado := false;
                         end;

                    'D': if discaTelefone (telefone) then
                             begin
                                 edita (posAtual);
                                 recriaTelaFolheia;
                             end;

                    ENTER: begin
                               edita (posAtual);
                               recriaEste (posAtual);
                               recriaTelaFolheia;
                           end;

                    ESC: begin
                             folheando := false;
                             telaInicial;
                         end;
                end;
            end;

        if c <> ESC then
            if mostraTudo then
                  mostraTodosNomes;

        if cadastrados = 0 then
            begin
                msgBaixo ('TMCADVAZ');    {'Cadastro vazio'}
                folheando := false;
            end;

   until not folheando;
end;

end.