{--------------------------------------------------------}
{
{    Funcoes de manipulacao do cursor
{
{    Autor: Marcelo Luis Pinheiro
{
{    Orientador Academico: Jose' Antonio Borges
{
{    Em 10/12/93
{
{--------------------------------------------------------}

Unit edCursor;

interface
uses
    DVcrt,  DVWin,
    edvars,   edMensag, edTela, edEmbel;

procedure cmdCursor;

procedure realocaMemLinha (posy, tam1, tam2: integer);

procedure insereLetra (letra: char);
Procedure removeLetra;
Procedure removeProxLetra;

Procedure SetaEsq;
Procedure SetaDir;
Procedure SetaBaixo;
Procedure SetaCima;
Procedure SetaVertBaixo;
Procedure SetaVertCima;

Procedure inicioTexto;
Procedure fimTexto;
procedure coluna1;
procedure ultimaColuna;
Procedure pulaPag;
Procedure voltaPag;
Procedure avancaParag;
Procedure recuaParag;
Procedure posicEmLinha;

Procedure palavraDir (falando: boolean);
Procedure palavraEsq (falando: boolean);

Procedure apagaPalavra;
Procedure apagaFimlinha;
Procedure apagaIniciolinha;

Procedure informaLinha;
Procedure informaColuna;

implementation

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

procedure realocaMemLinha (posy, tam1, tam2: integer);
begin
    if texto[posy] <> NIL then
        freeMem (texto[posy], tam1+1);
    getMem  (texto[posy], tam2+1)
end;

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

Procedure compactaLinha (posy: integer);
var
    t, tamOrig, tamFinal: integer;
    s: string;
begin
    tamOrig := length (texto[posy]^);
    if (tamOrig = 0) or (texto[posy]^[tamOrig] <> ' ') then
        exit;

    s := texto [posy]^;
    t := tamOrig;

    while s[t] = ' ' do
        begin
            t := t - 1;
            s[0] := chr (ord (s[0]) - 1);   { s[0] = length(s) }
        end;

    realocaMemLinha (posy, tamOrig, length(s));
    texto [posy]^ := s;
end;

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

procedure insereLetra (letra: char);
var s: string;
begin
    s := texto[posy]^;
    if posx <= length (s) then
        insert (letra, s,  posx)
    else
        s := s + letra;

    realocaMemLinha (posy, length(s)-1, length(s));
    texto [posy]^ := s;

    posx := posx + 1;

    escreveLinha;

    if (length(texto[posy]^) > margDir) then

        if quebraAuto and (letra <> ' ') and (posx > margDir) then
            ajusteAutomatico
        else
            sintBip;

    if soletrando then
        sintCarac (letra);
end;

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

Procedure removeLetra;
var c: char;
    s: string;
begin
    If posx > 1 Then
        begin
            s := texto[posy]^;
            c := s[posx-1];
            delete (s, posx-1, 1);
            dec(posx);

            realocaMemLinha (posy, length(s)+1, length(s));
            texto[posy]^ := s;

            escreveLinha;
            fala ('EDDEL');
            sintCarac (c);
        end
    else
        sintBip;
end;

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

Procedure removeProxLetra;
var c: char;
begin
    If posx <= length(texto[posy]^) Then
        begin
            posx := posx + 1;
            removeLetra;
        end
    else
        sintBip;
end;

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

Procedure SetaEsq;
Begin
    if posx > 1 then
        begin
            posx := posx - 1;
            gotoxy (posx-deslocEsqTela, 15);
            sintCarac(texto[posy]^[posx]);
        end
    else
        sintBip;
end;

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

Procedure SetaDir;
Begin
    if posx <= length(texto [posy]^) then
        begin
            posx := posx + 1;
            gotoxy (posx-deslocEsqTela, 15);
            sintCarac(texto[posy]^[posx-1]);
        end
    else
        sintBip;
end;

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

Procedure SetaBaixo;
var
    t: integer;
    p: FRASE;
begin
    if posy < maxlinhas then
        begin
            compactaLinha (posy);
            posy := posy + 1;
            sintClek;
        end
    else
        begin
            limpaBufTec;
            fala ('EDFIMTEX');
        end;

    posx := 1;
end;

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

Procedure SetaCima;
begin
    If posy > 1 then
        begin
            compactaLinha (posy);
            posy := posy - 1;
            posx := 1;
            sintClek;
        end
    else
        begin
            limpaBufTec;
            fala ('EDINITEX');
        end;

    posx := 1;
end;

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

Procedure SetaVertBaixo;
var
    tamOrig: integer;
    s: string;

begin
    if posy < maxlinhas then
        begin
            compactaLinha (posy);
            posy := posy + 1;

            s := texto[posy]^;
            tamOrig := length (s);
            while (posx-1) > length(s) do
                s := s + ' ';
            realocaMemLinha (posy, tamOrig, length(s));
            texto[posy]^ := s;
            if posx > length (texto[posy]^) then
                sintCarac (' ')
            else
                sintCarac (texto[posy]^[posx]);
        end
    else
        begin
            limpaBufTec;
            fala ('EDFIMTEX');
        end;
end;

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

Procedure SetaVertCima;
var
    tamOrig: integer;
    s: string;

begin
    If posy > 1 then
        begin
            compactaLinha (posy);
            posy := posy - 1;

            s := texto[posy]^;
            tamOrig := length (s);
            while (posx-1) > length(s) do
                s := s + ' ';
            realocaMemLinha (posy, tamOrig, length(s));
            texto[posy]^ := s;
            if posx > length (texto[posy]^) then
                sintCarac (' ')
            else
                sintCarac (texto[posy]^[posx]);
        end
    else
        begin
            limpaBufTec;
            fala ('EDINITEX');
        end;
end;

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

procedure coluna1;
begin
    posx := 1;
    sintClek;
end;

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

procedure ultimaColuna;
begin
    posx := length( texto [posy]^)+1;
    sintClek;
end;

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

Procedure inicioTexto;
begin
    posy := 1;
    posx := 1;
    fala ('EDINITEX');
    delay (500);
end;

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

Procedure fimTexto;
begin
    posy :=maxlinhas;
    posx := 1;
    fala ('EDFIMTEX');
    delay (500);
end;

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

Procedure pulaPag;
begin
    posx := 1;
    posy:=posy + 15;
    If posy > maxlinhas Then
        begin
            posy:=maxlinhas;
            limpaBufTec;
            fala ('EDFIMTEX');
        end
    else
        begin
            sintClek;  sintClek;
        end;
end;

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

Procedure voltaPag;
var  aux : integer;
begin
    posx := 1;
    aux  := posy - 15;
    If aux < 1 Then
        begin
            posy := 1;
            limpaBufTec;
            fala ('EDINITEX');
        end
     Else
        begin
            posy :=  aux ;
            sintClek;  sintClek;
        end;
end;

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

Procedure avancaParag;
begin
    if texto [posy]^ <> '' then
        while (posy <= maxlinhas) and (texto[posy]^ <> '') do
            begin
                posy := posy + 1;
                sintClek;
            end;

    while (posy <= maxlinhas) and (texto[posy]^ = '') do
        begin
            posy := posy + 1;
            sintClek;
        end;

    posx := 1;
    If posy > maxlinhas Then
        begin
            posy := maxlinhas;
            limpaBufTec;
            fala ('EDFIMTEX');
        end
    else
        begin
            sintClek;  sintClek;
        end;
end;

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

Procedure recuaParag;
var  aux : integer;
begin
    posy := posy - 1;

    while (posy > 0) and (texto[posy]^ = '') do
        begin
            posy := posy - 1;
            sintClek;
        end;

    while (posy > 0) and (texto[posy]^ <> '') do
        begin
            posy := posy - 1;
            sintClek;
        end;

    if posy < 1 then
        begin
            posy := 1;
            limpaBufTec;
            fala ('EDINITEX');
        end
    else
        begin
            posy := posy + 1;
            sintClek;  sintClek;
        end;
end;

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

Procedure palavraDir (falando: boolean);
var 
    linha: string;
    tam: integer;
    c: char;
begin
    tam := length (texto [posy]^);
    linha := texto [posy]^ + ' x';

    c := linha[posx];
    if c <> ' ' then
        repeat
            posx := posx + 1;
            c := linha[posx];
        until not (c in ['a'..'z', 'A'..'Z', #128..#255]);

    if c = ' ' then
        repeat
            posx := posx + 1;
            c := linha[posx];
        until c <> ' ';

    if posx > tam+1 then
        begin
            posx := tam+1;
            if falando then sintBip;
        end
    else
        if falando then sintClek;
end;

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

Procedure palavraEsq (falando: boolean);
var
    linha: string;
    tam: integer;
    c: char;
begin
    tam := length (texto [posy]^);
    linha := ' x' + texto [posy]^;
    posx := posx + 2;

    repeat
        posx := posx - 1;
        c := linha[posx];
    until c <> ' ';

    repeat
        posx := posx - 1;
        c := linha[posx];
    until not (c in ['a'..'z', 'A'..'Z', #128..#255]);

    posx := posx - 1;

    if posx <= 0 then
        begin
            posx := 1;
            if falando then sintBip;
        end
    else
        if falando then sintClek;
end;

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

Procedure posicEmLinha;
var num : Integer;
Begin
    fala ('EDDGNLIN'); { Digite o numero da linha }
    sintReadInt (num);

    if (num > maxLinhas) or (num < 1) then
        fala ('EDLINAO')    { Linha nao existe! }
    else
        begin
            posy := Num;
            posx := 1;
            sintClek;
        end;
end;

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

Procedure apagaPalavra;
var
    x, x1, x2: integer;
    s, s2: string;
begin
    posx := posx + 1;
    palavraEsq (false);
    x1 := posx;
    palavraDir (false);
    x2 := posx;

    if x1 <> x2 then
        begin
            s := texto[posy]^;
            s2 := s;   {para falar depois}

            delete (s, x1, x2-x1);
            realocaMemLinha (posy, length (texto[posy]^), length(s));
            texto[posy]^ := s;
            posx := x1;

            escreveTela;

            sintSom ('EDDEL');
            for x := x1 to x2-1 do
                sintCarac (s2[x]);
        end
    else
        sintBip;
end;

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

Procedure apagaFimlinha;
var tam: integer;
    s: string;
begin
    s := texto [posy]^;
    tam := length (s);

    if posx = 1 then
       s := ''
    else
       s[0] := chr (posx-1);

    realocaMemLinha (posy, tam, length (s));
    texto[posy]^ := s;

    fala ('EDAPAFIM');
end;

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

Procedure apagaIniciolinha;
var tam: integer;
    s: string;
begin
    s := texto [posy]^;
    tam := length (s);

    delete (s, 1, posx-1);
    realocaMemLinha (posy, tam, length (s));
    texto[posy]^ := s;

    posx := 1;
    fala ('EDAPAINI');
end;

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

Procedure informaLinha;
var lin : string[5];
    i : integer;
begin
    fala ('EDLINHA');
    escreveNumero (posy);
    delay (500);
end;

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

Procedure informaColuna;
var col : string;
    i: integer;
begin
    fala ('EDCOLUNA');
    escreveNumero (posx);
    delay (500);
end;

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

procedure memorizaPoscur;
begin
    salvaCurx := posx;
    salvaCury := posy;
end;

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

procedure voltaPoscur;
begin
    posx := salvaCurx;
    posy := salvaCury;
    if posy > maxLinhas then posy := maxlinhas;
    if posx > length (texto[posy]^)+1 then
        posx := 1;

    escreveTela;
end;

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

Procedure cmdCursor;
var
    tecla: char;
label deNovo;
begin

deNovo:
    fala ('EDOPCAO');   { qual opcao ? }
    tecla := leTeclaMaiusc;
    escreveTela;

    case tecla of
        '-': inicioTexto;
        '+': fimTexto;
        'A': avancaParag;
        'R': recuaParag;
        'P': posicEmLinha;
        'I': apagaIniciolinha;
        'F': apagaFimlinha;
        'L': informaLinha;
        'C': informaColuna;
        'M': memorizaPoscur;
        'V': voltaPoscur;

       #$0: begin
                ajuda ('EDAJCU', 12);
                goto deNovo;
            end;
      #$1b: begin
                fala ('EDDESIST');
                exit;
            end
    end;

    escreveTela;
end;

end.
