{-------------------------------------------------------------}
{
{    Telnet Falado
{
{    Modulo de interpretacao ANSI
{
{    Autor: Jose' Antonio Borges
{
{    Em 24/04/98
{
{-------------------------------------------------------------}

unit tnAnsi;

interface

uses dvcrt, dvWin, strings, winsock, tnVars, tnfala;

procedure ansiWrite (c: char);
procedure inicAnsi;
procedure restauraCorAnsi;
procedure escBufVideo;

{-------------------------------------------------------------}
{                    controles da escrita ANSI
{-------------------------------------------------------------}

const
    MAXSTKANSI = 5;

var
    estado_ansi: (LETRACOMUM, PEGANDOCOLCHETE, PEGANDONUMERO, IGNORA1, IGNORANF);
    svansix, svansiy: integer;
    y1scroll, y2scroll: integer;
    atrib: byte;
    corFg, corBg, corc, corb: byte;
    pst: integer;
    stkAnsi: array[0..MAXSTKANSI-1] of integer;
    numAnsi: string[5];

    bufVideo: string [80];

implementation

{-------------------------------------------------------------}
{                  descarrega buffer de video
{-------------------------------------------------------------}

procedure escBufVideo;
begin
    if length (BufVideo) = 0 then exit;
    write (bufVideo);
    bufVideo := '';
end;

{-------------------------------------------------------------}
{                  insere no buffer de video
{-------------------------------------------------------------}

procedure insBufVideo (c: char);
begin
     if (c = #$0d) or (c = #$0a) or (c = #$0c) then
         begin
             escBufVideo;
             if c = #$0c then clrscr
                         else write (c);
         end
     else
         begin
             bufVideo := bufVideo + c;
             if length (bufVideo) = 80 then
                 escBufVideo;
         end;
end;

{-------------------------------------------------------------}
{                     fala normal reduzida
{-------------------------------------------------------------}

procedure trataFalaNormal (c: char);
begin
    if teclaGuard <> '' then
        begin
             if (c <> #$0d) then
                 begin
                     sintCarac (teclaGuard [1]);
                     delete (teclaGuard, 1, 1);
                 end
             else
                 teclaGuard := '';
        end;

    if (c = #$0a) and (not sintFalando) then
        begin
            sintClek;
            ultycur := -1;
        end;
end;

{--------------------------------------------------------}
{             escreve emulando codigos ANSI
{--------------------------------------------------------}

procedure ansiWrite (c: char);

const
    alta    = 1;
    italico = 2;
    sublin  = 4;
    pisca   = 8;
    reverso = 16;
    invis   = 32;

    procedure checkstack (i: integer);
    begin
        while pst < i do
            begin
                stkAnsi [pst] := 0;
                pst := pst + 1;
            end;
    end;

var
    i, x, y, valor, erro: integer;
    salva: byte;

    procedure interpreta (c: char);
    var n: integer;
    begin
        case c of
            'J': begin
                     ultycur := -1;
                     corc := LIGHTGRAY;
                     corb := BLACK;
                     textColor (corc);
                     textBackground (corb);

                     x := wherex;  y := wherey;
                     checkStack (1);
                     i := stkAnsi [pst-1];
                     if i = 2 then
                         clrscr
                     else
                         begin
                             clreol;
                             for n := y+1 to numLinhasTerm do
                                 begin
                                     gotoxy (1, n);
                                     clreol;
                                 end;
                         end;

                     gotoxy (x, y);
                     clreol;
                 end;

            'K': begin
                     checkStack (1);
                     i := stkAnsi [pst-1];
                     if i = 1 then
                         begin
                             x := wherex;
                             y := wherey;
                             gotoxy (1, y);
                             for n := 1 to x-1 do
                                 write (' ');
                             gotoxy (x, y);
                         end
                     else
                         clreol;
                 end;

            'H': begin
                     checkStack (2);
                     y := stkAnsi [pst-2];
                     x := stkAnsi [pst-1];
                     if y = 0 then y := 1;
                     if y > numLinhasTerm then y := numLinhasTerm;
                     if x = 0 then x := 1;
                     gotoxy (x, y);
                 end;

            'A': begin
                      checkStack (1);
                      y := stkAnsi [pst-1];
                      if y = 0 then y := 1;
                      gotoxy (wherex, wherey-y);
                      ultycur := -1;
                 end;

            'B': begin
                      checkStack (1);
                      y := stkAnsi [pst-1];
                      if y = 0 then y := 1;
                      gotoxy (wherex, wherey+y);
                      ultycur := -1;
                end;

            'C': begin
                      checkStack (1);
                      x := stkAnsi [pst-1];
                      if x = 0 then x := 1;
                      gotoxy (wherex+x, wherey);
                 end;

            'D': begin
                      checkStack (1);
                      x := stkAnsi [pst-1];
                      if x = 0 then x := 1;
                      gotoxy (wherex-x, wherey);
                 end;


            'r': begin
                     checkStack (2);
                     y1scroll := stkAnsi [pst-2];
                     y2scroll := stkAnsi [pst-1];
                 end;

            's': begin
                     svansix := wherex;
                     svansiy := wherey;
                 end;

            'u': begin
                     gotoxy (svansix, svansiy);
                     ultycur := -1;
                 end;

            'm': begin
                     checkStack (1);
                     for n := 0 to pst-1 do
                         begin
                             case stkAnsi [n] of
                                 0: atrib := 0;
                                 1: atrib := atrib or alta;
                                 2: atrib := atrib and (not alta);
                                 3: atrib := atrib or italico;
                                 4: atrib := atrib or sublin;
                                 5, 6: atrib := atrib or pisca;
                                 7: atrib := atrib or reverso;
                                 8: atrib := atrib or invis;

                                 30: corFg := black;
                                 31: corFg := red;
                                 32: corFg := green;
                                 33: corFg := yellow;
                                 34: corFg := blue;
                                 35: corFg := magenta;
                                 36: corFg := cyan;
                                 37: corFg := lightGray;

                                 40: corBg := black;
                                 41: corBg := red;
                                 42: corBg := green;
                                 43: corBg := yellow;
                                 44: corBg := blue;
                                 45: corBg := magenta;
                                 46: corBg := cyan;
                                 47: corBg := lightGray;
                             end;

                             pst := pst - 1;

                             if atrib = invis then
                                 begin
                                     textColor (corBg);
                                     textBackground (corBg);
                                 end
                             else
                                 begin
                                     corc := corFg;
                                     corb := corBg;
                                     if (atrib and sublin) <> 0 then
                                        corc := blue;

                                     if (atrib and italico) <> 0 then
                                        corc := cyan;

                                     if (atrib and reverso) <> 0 then
                                         begin
                                             escBufVideo;
{                                             if (getScreenAttrib (wherex, wherey) and $F0) = 0 then
                                                 ultycur := -1;}
                                             salva := corc;
                                             corc := corb;
                                             corb := salva;
                                         end;

                                     if (atrib and alta) <> 0 then
                                         corc := corc or 8;

                                     if (atrib and pisca) <> 0 then
                                         corb := corb or 8;

                                     textColor (corc);
                                     textBackground (corb);
                                 end;
                         end;
                 end;
        end;
    end;

var lin: integer;

begin
    case estado_ansi of
        LETRACOMUM:
            if c = #$1b then
               begin
                   escBufVideo;
                   estado_ansi := PEGANDOCOLCHETE;
                   if modoFala <> falaMudo then
                       acumulaPalavra (' ');
               end
            else
                begin
                    if c = #$0a then ultycur := -1;
                    if (c = #$0a) and
                          ((y1scroll <> 1) or (y2scroll <> numLinhasTerm)) then
                        begin
                            x := wherex;
                            y := wherey;
                            window (1, y1scroll, 80, y2scroll);
                            gotoxy (1, y-y1scroll+1);
                            write (c);
                            window (1, 1, 80, numLinhasTerm);
                            gotoxy (x, y);

                            teclaGuard := '';
                        end
                    else
                    if c <> #15 then
                        begin
                            lin := wherey;
                            insBufVideo (c);
                            case modoFala of
                                falaMudo:    ;
                                falaNormal:  trataFalaNormal (c);
                                falaCalado:  if c = ENTER then sintClek;
                                falaTudo:    acumulaPalavra (c);
                                falaLynx:    if ((corb <> BLACK) and (lin <= 21)) or
                                                 (c = ENTER) then
                                                      acumulaPalavra (c);
                            end;
                        end;
                    estado_ansi := LETRACOMUM;
                end;

        PEGANDOCOLCHETE:
           if c = 'D' then
                begin
                    estado_ansi := LETRACOMUM;
                    writeln;
                end
           else
           if c = '8' then
                begin
                    estado_ansi := LETRACOMUM;
                    gotoxy (svansix, svansiy)
                end
           else
           if c = '7' then
               begin
                   estado_ansi := LETRACOMUM;
                   svansix := wherex;
                   svansiy := wherey;
               end
           else
           if (c = 'M') then
               begin
                   ultyCur := -1;
                   x := wherex;
                   y := wherey;
                   estado_ansi := LETRACOMUM;
                   window (1, y1scroll, 80, y2scroll);
                   gotoxy (1, y-y1scroll+1);
                   insline;
                   window (1, 1, 80, numLinhasTerm);
                   gotoxy (x, y);
               end
           else
           if (c = '>') then
               estado_ansi := LETRACOMUM
           else
           if (c = '(') or (c = ')') then
               estado_ansi := IGNORA1
           else
           if c = '[' then
                begin
                    estado_ansi := PEGANDONUMERO;
                    pst := 0;
                    numAnsi := '';
                end
            else
                begin
                    write (c);
                    estado_ansi := LETRACOMUM;
                end;

        PEGANDONUMERO:
           begin
               if c in ['0'..'9'] then
                   begin
                       numAnsi := numAnsi + c;
                       exit;
                   end;

               if numAnsi = '' then
                   begin
                      stkAnsi [pst] := 0;
                      if pst < MAXSTKANSI then
                          pst := pst + 1;
                   end
               else
                   begin
                       val (numAnsi, valor, erro);
                       stkAnsi [pst] := valor;
                       if pst < MAXSTKANSI then
                           pst := pst + 1;
                       numAnsi := '';
                   end;

               if c = '=' then
                   estado_ansi := IGNORANF
               else
               if (c <> ';') and (c <> '?') then
                   begin
                       interpreta (c);
                       estado_ansi := LETRACOMUM;
                   end;
           end;

       IGNORANF: if not (c in ['0'..'9']) then
                     estado_ansi := LETRACOMUM;

       IGNORA1:
               estado_ansi := LETRACOMUM;

   end;
end;

{--------------------------------------------------------}
{       restaura atributos apos destruicao externa
{--------------------------------------------------------}

procedure restauraCorAnsi;
begin
    textColor (corc);
    textBackground (corb);
end;

{--------------------------------------------------------}
{               inicializacao de variaveis
{--------------------------------------------------------}

procedure inicAnsi;
begin
   estado_ansi := LETRACOMUM;
   svansix := 1;
   svansiy := 1;
   y1scroll := 1;
   y2scroll := numLinhasTerm;
   atrib := 0;

   corFg := LIGHTGRAY;
   corBg := BLACK;
   corc := LIGHTGRAY;
   corb := BLACK;

   BufVideo := '';
end;

end.
