unit weblevox;
interface

uses winProcs, winDos, winTypes, shellApi,
     dvcrt, strings, dvWin, winsock, dvexec,
     webVars, webMsg, webTraz;

procedure leituraInterativa (nomeArq: string;
         var proxLink: string; var linhaLink: integer);

implementation

type
    TLinha = string[80];
    PLinha = ^TLinha;
    VetLinhas = array [1..5000] of PLinha;
    PVetLinhas = ^VetLinhas;

var
    arq: text;
    nlinhas: integer;
    linha: PVetLinhas;
    lin, col: integer;
    linkAtual: integer;
    atualiza: boolean;

{-------------------------------------------------------------}
{                     interacao da leitura
{-------------------------------------------------------------}

procedure leituraInterativa (nomeArq: string;
         var proxLink: string; var linhaLink: integer);

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

    function procTermino: boolean;
    var c, c2: char;
    begin
        writeln;
        mensagem ('FIMLEI', 0);
        sintLeTecla (c, c2);
        writeln;
        case upcase (c) of
            'A':  begin
                      proxLink := '';
                      procTermino := true;
                      exit;
                  end;
            'V':  begin
                       proxLink := pilhaPag [topoPilhaPag];
                       linhaLink := pilhaLin [topoPilhaPag];
                       topoPilhaPag := topoPilhaPag -1;
                  end;
        else
            procTermino := false;
        end;
    end;

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

    procedure leRestoLinha;
    var s, copia: string;
    begin
        copia := linha^[lin]^;
        repeat
            s := '';
            while (col <= length (copia)) and (copia [col] <> ' ') do
                s := s + copia[col];
            col := col + 1;
            if (s [1] <> '<') and (s[1] <> '>') then
                sintetiza (s)
            else
                if s[1] <> '>' then
                    sintBip;
            gotoxy (15, col);
        until col < length (copia);
    end;

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

    procedure atualizaTela;
    var y, l: integer;
    begin
        for y := 1 to 25 do
            begin
                l := lin-15+y;
                gotoxy (1, y);
                if (l >= 1) and (l <= nlinhas) then
                    write (linha^[l]^);
                clreol;
            end;
    end;

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

    function proximoLink: boolean;
    var achou: boolean;
        s: string;
        c: char;
        erro: integer;
    begin
        achou := false;
        while not achou do
            begin
                if col < length (linha^[lin]^) then
                     col := col + 1
                else
                    begin
                         lin := lin + 1;
                         col := 1;
                         if lin > nLinhas then
                             begin
                                 proximoLink := false;
                                 sintBip; sintBip; sintBip;
                                 exit;
                             end;
                     end;

                if linha^[lin]^[col] = '<' then
                    achou := true;
            end;

        s := '';
        repeat
            col := col + 1;
            c := linha^[lin]^[col];
            if c in ['0'..'9'] then
                s := s + c;
        until not (c in ['0'..'9']);
        val (s, linkAtual, erro);
        proximoLink := true;
    end;

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

    function linkAnterior: boolean;
    var achou: boolean;
        s: string;
        c: char;
        erro: integer;
    begin
        achou := false;
        while not achou do
            begin
                if col > 1 then
                     col := col - 1
                else
                    begin
                         lin := lin - 1;
                         if lin < 1 then
                             begin
                                 lin := 1;
                                 col := 1;
                                 linkAnterior := false;
                                 sintBip; sintBip; sintBip;
                                 exit;
                             end
                         else
                             col := length (linha^[lin]^);
                     end;

                if linha^[lin]^[col] = '<' then
                    achou := true;
            end;

        s := '';
        repeat
            col := col + 1;
            c := linha^[lin]^[col];
            if c in ['0'..'9'] then
                s := s + c;
        until not (c in ['0'..'9']);
        val (s, linkAtual, erro);
        linkAnterior := true;
    end;

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

    procedure moveParaEsquerda;
    begin
       col := col - 1;
       if col > 0 then
           begin
               sintCarac (linha^[lin]^[col]);
               atualiza := false;
           end

       else
           begin
               lin := lin - 1;
               if lin > 0 then
                   begin
                       col := length (linha^[lin]^);
                       sintClek;
                   end
               else
                   begin
                       sintBip; sintBip; sintBip;
                       col := 1;
                       lin := 1;
                   end;
           end;
    end;

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

    procedure moveParaDireita;
    begin
       col := col + 1;
       if col <= length (linha^[lin]^) then
           begin
               sintCarac (linha^[lin]^[col]);
               atualiza := false;
           end
       else
           begin
               lin := lin + 1;
               if lin <= nLinhas then
                   begin
                       col := length (linha^[lin]^);
                       sintClek;
                   end
               else
                   begin
                       sintBip; sintBip; sintBip;
                       col := 1;
                       lin := nLinhas+1;
                   end;
           end;
    end;

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

    procedure moveParaBaixo;
    begin
        col := 1;
        lin := lin + 1;
        if lin > nLinhas then
            begin
                sintBip; sintBip; sintBip;
                lin := nLinhas + 1;
            end
        else
            leRestoLinha;
    end;

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

    procedure moveParaCima;
    begin
        col := 1;
        lin := lin - 1;
        if lin < 1 then
            begin
                sintBip;
                lin := 1;
            end
        else
            leRestoLinha;
     end;

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

    function vaiParaLink: boolean;
    begin
        if linkAnterior then
            begin
                proxLink := hRefs [linkAtual];
                linhaLink := 1;
                vaiParaLink := true;
            end
        else
            vaiParaLink := false;
    end;

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

    procedure alocaETrazArquivo;
    begin
        assign (arq, nomeArq);
        {$I-} reset (arq);  {$I+}

        new (linha);
        nLinhas := 0;
        while not eof (arq) do
            begin
                nLinhas := nLinhas + 1;
                new (linha^[nLinhas]);
                readln (arq, linha^[nLinhas]^);
            end;
        close (arq);

        new (linha^[nLinhas+1]);
        linha^[nLinhas+1]^ := '';
    end;

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

    procedure desalocaMem;
    var i: integer;
    begin
        for i := 1 to nLinhas+1 do
            dispose (linha^[nLinhas]);
        dispose (linha);
    end;

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

label retorna;
var c: char;
begin
    alocaETrazArquivo;

    lin := 1;
    col := 1;
    atualizaTela;

    while true do
        begin
            atualiza := true;

	    c := readkey;
            case upcase (c) of

                ESC:  if procTermino  then exit;

                ' ':  while (lin <= nlinhas) and (not keypressed) do
                          begin
                              leRestoLinha;
                              lin := lin + 1;
                              atualizaTela;
                          end;

                 TAB: begin
                          if not proximoLink then
                              begin
                                  sintBip; sintBip; sintBip;
                                  col := 1;
                                  lin := nLinhas+1;
                              end;

                          atualizaTela;
                      end;

                 ENTER:  if vaiParaLink then
                               goto retorna;

                 #$0:
                    begin
                         c := readkey;
                         case c of
                             ESQ:   moveParaEsquerda;
                             DIR:   moveParaDireita;
                             CIMA:  moveParaCima;
                             BAIX:  moveParaBaixo;

                             HOME:
                                  begin
                                       col := 1;
                                       sintClek;
                                  end;

                             TEND:
                                  begin
                                      if (lin >= 1) and (lin <= nLinhas) then
                                          col := length (linha^[lin]^)
                                      else
                                          col := 1;
                                      sintClek;
                                  end;
                         end;
                    end;
            end;

        end;

retorna:
    desalocaMem;
end;

end.
