{--------------------------------------------------------}
{
{    Tratamento de Blocos de Linhas
{
{    Autor: Marcelo Luis Pinheiro
{
{    Orientador Academico: Jose' Antonio Borges
{
{    Em 10/12/93
{
{--------------------------------------------------------}

Unit edBloco;

interface
uses
    DVcrt, DVWin, DVdde,
    edVars, edMensag, edLinha, edArq, edAcento, edEmbel, edTela;

procedure cmdBloco;
procedure inicBloco;
procedure trataBloco;


implementation

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

Procedure InicBloco;
begin
    inibloco := 1;
    fimbloco := 0;
    novoini  := 0;
end;

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

function blocoInvalido: Boolean;
begin
    blocoInvalido := fimbloco < iniBloco;
end;

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

Procedure copiaBloco;
Var
    tam, k : Integer;
    blocoDepois: boolean;

Begin
    if blocoInvalido or
        ( (posy >= inibloco) and (posy <= fimbloco) ) then
         begin
             fala ('EDBLKINV');   { bloco invalido }
             exit;
         end;

    tam := fimbloco - inibloco + 1;

    blocoDepois := posy < inibloco;
    For k := tam-1 downto 0 do
        if maxavail > 10000 then
            insereLinha (texto [inibloco+k]^, false);

    fimbloco := inibloco + tam - 1;

    if maxavail <= 10000 then
        fala ('EDBLKTRN')
    else
        fala ('EDBLKCPY');
End;

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

Procedure Removebloco;
Var
   i : Integer;

Begin
    If blocoInvalido then
        begin
            fala ('EDBLKINV');
            exit;
        end;

    posy  := inibloco;
    For i := inibloco to fimbloco Do
        removeLinha (false);

    fala ('EDBLKREM');

    inicBloco;
End;

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

Procedure moveBloco;
var
    salva, tam, i : Integer;

begin
    if blocoInvalido or
        ( (posy >= inibloco) and (posy <= fimbloco) ) then
         begin
             fala ('EDBLKINV');   { bloco invalido }
             exit;
         end;

    tam := fimbloco - inibloco + 1;
    salvaCury:= posy;

    For i := tam-1 downto 0 do
        begin
            insereLinha (texto [fimbloco]^, false);
            posy := fimBloco;
            removeLinha (false);
            posy := salvaCury;
        end;

    posy := salvaCury;
    iniBloco := posy;
    fimBloco := iniBloco + tam - 1;

    fala ('EDBLKMOV');
end;

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

Procedure LeBloco;
var
    salvaNome: string;
    linha, nome: string;
    salva: integer;

label fim;

begin
    salvaNome := nomeArq;

    salva := posy;

    if abreArqSemCriar then
        begin
            fimBloco := posy-1;
            iniBloco := salva;
            posy := salva;
            posx := 1;
            fala ('EDBLKCRG');
        end;

    nomeArq := salvaNome;

    if posy <= 0 then
        posy := 1;
end;

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

Procedure GravaBloco;
var
    salvaNome: string;
begin
    If BlocoInvalido  Then
        begin
            fala ('EDBLKINV');   { bloco Invalido }
            exit;
        end;

    salvanome := nomeArq;
    nomearq := '';
    salvaArquivo (iniBloco, fimBloco, true);
    nomeArq := salvaNome;
end;

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

Procedure AdicionaBloco;
Var
    salvaNome: string;
    adic : Text;
    i : Integer;

Label Inicio, fecha, fim;

Begin
    If blocoInvalido then
        begin
            fala ('EDBLKINV');
            exit;
         end;

Inicio :
    fala ('EDDIGNOM');
    salvaNome := Nomearq;
            sintReadln (nomearq);
    nomeArq := compactaLinha (nomearq);
    if nomeArq = '' then
        begin
            fala ('EDDESIST');
            goto fim;
        end;

    assign (adic, nomeArq);
    {$I-} append (adic); {$I+}
    If ioresult <> 0  Then
        begin
            fala('EDARQNAO');
            goto fim;
        end;

    For i := inibloco to fimbloco  Do
        begin
            {$I-} writeln (adic, texto[i]^); {$I+}
            If ioResult <> 0  Then
                begin
                    fala ('EDERRESC');
                    goto fecha;
                end;
        end;

fecha:
    {$I-}  close (adic);  {$I+}
    if ioresult = 0 then
        fala ('EDBLKADC'); {  Bloco adicionado. }

fim:
    nomeArq := salvaNome;
End;

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

Procedure OrdenaBloco;
Var i, j : Integer;
    pt : Frase;
Begin
    If blocoInvalido then
        begin
             fala ('EDBLKINV');
             exit;
        end;

    For i := IniBloco to fimBloco-1 do
        For j:= i+1 To fimBloco do
            if maiuscAnsi (semAcentos (texto[j]^)) <
               maiuscAnsi (semAcentos (texto[i]^))  then
                begin
                    pt       := texto[i];
                    texto[i] := texto[j];
                    texto[j] := pt;
                end;

    fala ('EDBLKORD');
end;

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

procedure blocoParagrafo;
begin
    inibloco := posy;
    fimBloco := posy;

    while (inibloco > 1) and (texto[inibloco-1]^ <> '') do
        inibloco := inibloco - 1;

    while (fimbloco < maxlinhas) and (texto[fimbloco+1]^ <> '') do
        fimbloco := fimbloco + 1;

    fala ('EDBLKPAR');
end;

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

procedure enviaServidor;
var i: integer;
    servidor, topico, item: string [30];
    tamanho: longint;
    p: pchar;
    posic: word;
begin
    servidor := sintAmbiente ('EDIVOX', 'SERVIDOR');
    if servidor = '' then
        servidor := 'MONOLOG';
    topico := sintAmbiente ('EDIVOX', 'TOPICO');
    if topico = '' then
        topico := 'TALK';
    item := sintAmbiente ('EDIVOX', 'ITEM');

    while sintFalando do;

    tamanho := 1;
    for i := iniBloco to fimBloco do
        tamanho := tamanho + length (texto[i]^) + 2;

    if tamanho > longint (65000) then
        begin
            fala ('EDGRANDE');
            exit;
        end;

    getmem (p, tamanho);
    posic := 0;

    for i := iniBloco to fimBloco do
        begin
            move (texto[i]^[1], p[posic], length (texto[i]^));
            posic := posic + length (texto[i]^);
            p[posic] := #$0d;
            p[posic+1] := #$0a;
            posic := posic + 2;
        end;
    p[posic] := #$0;

    if not enviaServidorDDE (servidor, topico, item, p) then
        fala ('EDERRSRV');

    freemem (p, tamanho);
end;

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

procedure justificaParagrafo;
begin
    inibloco := posy;
    fimBloco := posy;

    while (inibloco > 1) and (texto[inibloco-1]^ <> '') do
        inibloco := inibloco - 1;

    while (fimbloco < maxlinhas) and (texto[fimbloco+1]^ <> '') do
        fimbloco := fimbloco + 1;

    acertaMargens (false);
    inicBloco;
    fala ('EDJUSTIF');
end;

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

Procedure TrataBloco;
Var
    c : char;
label deNovo;

Begin

deNovo:

    fala ('EDCMDBLK');     { bloco: }
    c := sintReadKey;

    case upcase(c) of
         'M' : movebloco;
         'C' : copiabloco;
         'A' : AdicionaBloco;
         'O' : OrdenaBloco;
         'R' : removebloco;

         'I' : begin
                   inibloco := posy;
                   fala ('EDINIBLK');    { inicio do bloco }
               end;

         'F' : begin
                   fimbloco := posy;
                   fala ('EDFIMBLK');    { fim do bloco }
               end;

         'D' : begin
                   inicBloco;
                   fala ('EDBLKDSM');   { bloco desmarcado }
               end;

         'L' : leBloco;
         'G' : gravaBloco;
         'E' : embelezaBloco;
         'P' : blocoParagrafo;
         'J' : justificaParagrafo;
         'S' : enviaServidor;

        #$0: begin
                ajuda ('EDAJBL', 15);
                goto deNovo;
             end;

         Else
             begin
                fala ('EDDESIST');
                exit;
            end
    end;
end;

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

procedure cmdBloco;
var
    tecla: char;
label deNovo;
begin

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

    case tecla of

         'M' : movebloco;
         'C' : copiabloco;
         'A' : AdicionaBloco;
         'O' : OrdenaBloco;
         'R' : removebloco;
         'I' : begin
                   inibloco :=posy;
                   fala ('EDINIBLK');    { inicio do bloco }
               end;
         'F' : begin
                   fimbloco := posy;
                   fala ('EDFIMBLK');    { fim do bloco }
               end;
         'D' : begin
                   inicBloco;
                   fala ('EDBLKDSM');   { bloco desmarcado }
               end;
         'L' : leBloco;
         'G' : gravaBloco;
         'E' : embelezaBloco;
         'P' : blocoParagrafo;

         'J' : justificaParagrafo;
         'S' : enviaServidor;

       #$0: begin
                ajuda ('EDAJBL', 14);
                goto deNovo;
            end;
      #$1b:  begin
                fala ('EDDESIST');
                exit;
            end
    else
        sintBip;
    end;

    escreveTela;
end;

end.
