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

Unit edArq;

interface
uses
    DVcrt, DVWin, strings, winProcs, winTypes,
    edvars, edMensag, edLinha, edTela;

procedure cmdArquivo;
procedure informaNomeArq;
function abreArquivo: boolean;
function abreArqSemCriar: boolean;
procedure salvaArquivo (linha1, linha2: integer; formatoAnsi: boolean);
procedure trocaArquivo;
procedure salvaComo;
procedure gravaETermina;
procedure terminaPrograma;

implementation

var arq: file;
    arqSaida: text;
    linhasDivididas: boolean;
    bufArq: array [0..1023] of char;
    pbufArq, lidosBuf: integer;
    fimDoArq: boolean;

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

procedure terminaPrograma;
begin
    fala ('EDFIMPRC');
    if tamMaxLinha <> 79 then
        trocaTamTela;

    SintFim;
    doneWinCrt;
end;

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

procedure informaNomeArq;
begin
    fala ('EDNOME');
    write (' ', nomearq);
    sintSoletra (nomeArq);
    delay (500);
end;


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

procedure devolveCaracArq (c: char);
begin
   pbufArq := pbufArq - 1;
end;

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

function pegaCaracArq: char;
begin
    if pbufArq >= lidosBuf then
         begin
             {$I-} blockread (arq, bufArq, 1024, lidosBuf);  {$i+}
             pbufArq := 0;

             if ioresult <> 0 then
                 begin
                     fala ('EDERRLEI');
                     pegaCaracArq := #$0d;
                     fimDoArq := true;
                     exit;
                 end;
         end;

    pegaCaracArq := bufArq [pBufArq];
    pbufArq := pbufArq + 1;
    fimDoArq := (pBufArq >= lidosBuf) and eof (arq);
end;

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

procedure inicBuffer;
begin
    pbufArq := 9999;
    lidosBuf := 0;
    devolveCaracArq (pegaCaracArq);
    fimDoArq := eof (arq) and (pBufArq >= lidosBuf);
end;

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

function carregaUmaLinha (var arq: file) : string;
var s: string;
    c: char;
    fimDaLinha: boolean;

begin
    fimDaLinha := false;
    s := '';

    repeat
        c := pegaCaracArq;

        if (c = #$0d) or (c = #$0a) then
            fimDaLinha := true
        else
            if c = #9 then
                s := s + '        '
            else
                if c in [#0..#31] then
                    s := s + '#'
                else
                    s := s + c;

        if length (s) > 160 then
            begin
                if not linhasDivididas then
                    begin
                        fala ('EDLINGRA') ;
                              { linhas grandes foram divididas }
                        linhasDivididas := true;
                    end;

                if length (s) >= 180 then
                    fimDaLinha := true;

                if c = ' ' then
                    begin
                        fimDaLinha := true;
                        while (c = ' ') and (not fimDoArq) do
                           c := pegaCaracArq;
                        if (c <> #$0d) and (c <> #$0a) then
                            devolveCaracArq (c);
                    end;
            end;

    until fimDaLinha or fimDoArq;

    if (not fimDoArq) and (c = #$0d) then
        begin
            c := pegaCaracArq;
            if c <> #$0a then
                devolveCaracArq (c);
        end;

    carregaUmaLinha := s;
end;

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

procedure fazCargaDoArquivo;
var
    s: string;
Begin
    linhasDivididas := false;

    While not fimDoArq do
        begin
            s := carregaUmaLinha (arq);

            if (maxavail > 10000) and (posy < MAXLINHASTEXTO) then
                begin
                    insereLinha (s, false);
                    posy := posy + 1;
                end
            else
                begin
                    fala ('EDARTRUN');
                    exit;
                end;
        end;

    close (arq);
end;

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

function abreArquivo: boolean;
var
    i: integer;
    tituloJan: array [0..100] of char;
begin
    abreArquivo := true;

    for i := 8 to 25 do
        begin
             gotoxy (1, i);
             clreol;
        end;

    if nomeArq = '' then
        begin
            fala ('EDDIGNOM');
            sintReadln (nomeArq);
            nomearq := compactaLinha (nomearq);
            if nomeArq = '' then
                begin
                    abreArquivo := false;
                    exit;
                end;
        end;

    assign (arq, nomeArq);
    {$i-} reset (arq, 1); {$i+}
    if ioresult <> 0 then
        begin
             maxLinhas := 1;
             getmem (texto [1], 1);
             texto[1]^ := '';
             fala ('EDARQNOV');
        end
    else
        begin
            maxLinhas := 0;
            posy := 1;
            inicBuffer;
            fazCargaDoArquivo;
            if maxlinhas = 0 then
                begin
                    maxLinhas := 1;
                    getmem (texto [1], 1);
                    texto[1]^ := '';
                end;
            fala ('EDARQCRG');
        end;

    posx := 1;
    posy := 1;

    strPCopy (tituloJan, 'EDIVOX ' + nomeArq);
    setWindowText (crtWindow, tituloJan);
end;

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

function abreArqSemCriar: boolean;
var
    i: integer;
begin
    abreArqSemCriar := false;

    fala ('EDDIGNOM');
    sintReadln (nomearq);
    nomeArq := compactaLinha (nomearq);
    if nomeArq = '' then
        begin
            fala ('EDDESIST');
            exit;
        end;

    assign (arq, nomeArq);
    {$i-} reset (arq, 1); {$i+}
    if ioresult <> 0 then
        begin
            fala ('EDARQNAO');
            exit;
        end;

    inicBuffer;
    fazCargaDoArquivo;
    abreArqSemCriar := true;
end;

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

procedure salvaArquivo (linha1, linha2: integer; formatoAnsi: boolean);
var
    i: integer;
    ansi: boolean;
    resp : char;

label inicio, fechaArq;
begin

inicio:
    limpaBufTec;

    If (nomeArq = '') then
         begin
             fala ('EDNOMGRV');  { Nome do arquivo a gravar: }
             sintReadln (nomearq);
             nomeArq := compactaLinha (nomearq);
             if nomearq = '' then
                 begin
                     fala ('EDDESIST');
                     exit;
                 end;

             assign (arqSaida, nomeArq);
             {$i-} reset (arqSaida); {$i+}
             If ioresult = 0 then
             begin
                 close (arqSaida);
                 fala ('EDREESCR');
                 resp := sintReadKey;
                 if upcase (resp) <> 'S' then
                      begin
                          fala ('EDESCCAN');
                          exit;
                      end;
         end;
    end;

    assign (arqSaida, nomeArq);
    {$i-} rewrite (arqSaida); {$I+}
    if ioresult <> 0 then
        begin
            fala ('EDERRESC');
            nomeArq := '';
            goto inicio;
        end;

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

    For i := linha1 to linha2 Do
        begin
            if formatoAnsi then
                {$i-} writeln (arqSaida, texto[i]^) {$I+}
            else
                {$i-} writeln (arqSaida,{ ansiParaPC }texto[i]^); {$I+}

            if ioresult <> 0 then
                begin
                    fala ('EDERRESC');
                    goto fechaArq;
                end;
        end;

fechaArq:
    {$I-} close (arqSaida); {$I+}
    if ioresult <> 0 then
        begin
            fala ('EDERRESC');
            exit;
        end;

    fala ('EDARQGRV');
end;

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

Procedure limpaMemoria;
var i: word;
begin
    For i := 1 to maxlinhas Do
        If texto [i] <> nil then
            freemem (texto [i], length (texto[i]^)+1);
end;

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

procedure trocaArquivo;
var
    resp : char;
begin
    repeat
        fala ('EDQUERSV');
        resp := sintReadKey;
        if resp = #27 then
           begin
                fala ('EDDESIST');
                exit;
            end;
        resp := upcase (resp);
    until resp in ['S', 'N'];

    if resp = 'S' then
        salvaArquivo (1, maxLinhas, true);

    limpaMemoria;

    nomearq := '';
    if not abrearquivo then
        terminaPrograma;
end;

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

procedure salvaComo;
var nomeNovo: string;
    c : char;
begin
    fala ('EDDIGNOM');
            sintReadln (nomenovo);
    nomeNovo := compactaLinha (nomenovo);

    if nomeNovo = '' then
        begin
            fala ('EDDESIST');
            exit;
        end;

    fala ('EDFORTXT');
    c := sintReadKey;
    if c = #$1b then
        begin
            fala ('EDDESIST');
            exit;
        end;

    nomeArq := nomeNovo;
    salvaArquivo (1, maxlinhas, upcase(c) <> 'N');
end;

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

procedure gravaETermina;
begin
    salvaArquivo (1, maxLinhas, true);
    terminaPrograma;
end;

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

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

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

    case tecla of

        'I': informaNomeArq;
        'S': salvaArquivo (1, maxlinhas, true);
        'N': trocaArquivo;
        'C': salvaComo;
        'F': gravaETermina;
        'A': terminaPrograma;
        'X': salvaArquivo (1, maxlinhas, false);


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

    escreveTela;
end;

end.
