{--------------------------------------------------------}
{
{     Cria um texto com pedacos substituidos interativamente
{
{     Autor: Jose' Antonio Borges
{
{     Em 20/07/97
{
{--------------------------------------------------------}

program cartex;
uses dvwin, dvcrt, windos;
var
    nomearq, nomesai: string;
    arq, arqsai: text;
    texto: array [1..500] of ^string;
    lin, col: integer;
    maxLin, iniTab: integer;
    lido: string;

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

procedure cancela;
begin
    textBackground (RED);
    sintWriteln ('Programa cancelado');
    textBackground (BLACK);
    delay (2000);
    sintFim;
    doneWinCrt;
end;

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

procedure abreArquivos;
var resp: char;
begin
    writeln;

    sintWrite ('Nome do arquivo de entrada: ');
    sintReadln (nomearq);
    if nomearq = '' then
        cancela;

    assign (arq, nomearq);
    {$I-} reset (arq); {$I+}
    if ioresult <> 0 then
        begin
            sintWriteln ('Arquivo nao existe');
            cancela;
        end;

    sintWrite ('Nome do arquivo de saida: ');
    sintReadln (nomesai);
    assign (arqsai, nomesai);
    {$I-} rewrite (arqsai); {$I+}
    if ioresult <> 0 then
        begin
            sintWriteln ('Arquivo nao pode ser criado');
            cancela;
        end;

    lin := 0;
    col := 0;
    lido := '';
    maxlin := 0;
    iniTab := 9999;
end;

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

procedure carregaTexto;
begin
    maxLin := 0;
    while not eof (arq) do
        begin
            maxLin := maxLin + 1;
            new (texto[maxLin]);
            readln (arq, texto[maxLin]^);
        end;

    close (arq);
end;

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

function upper (s: string): string;
var s2: string;
    i: integer;
begin
    s2 := '';
    for i := 1 to length (s) do
        s2 := s2 + upcase (s[i]);
    upper := s2;
end;

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

function codifData: string;
const
    nomeMes: array [1..12] of string[10] =
       ('Janeiro', 'Fevereiro', 'Mar‡o', 'Abril', 'Maio', 'Junho',
        'Julho', 'Agosto', 'Setembro', 'Outubro', 'Novembro', 'Dezembro');

var
    d, m, a, s: word;
    s1, s2: string;
begin
    getDate (a, m, d, s);
    str (d, s1);
    str (a, s2);
    codifData := s1 + ' de ' + nomeMes[m] + ' de ' + s2;
end;

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

procedure substitui;

    procedure substNome;
    var s, subst: string;
    begin
        delete (lido, 1, 1);
        s := '';
        while (lido <> '') and (lido[1] <> '}') do
            begin
               s := s + lido[1];
               delete (lido, 1, 1);
            end;

        if lido = '' then
            begin
                str (lin, s);
                sintWriteln ('Faltou fechar chave na linha ' + s);
                close (arqSai);
                cancela;
            end;

       delete (lido, 1, 1);

       if upper (s) = 'DATA' then
           subst := codifData
       else
           begin
               textBackground (RED);
               sintWrite (s + ':');
               textBackground (BLACK);
               sintReadln (subst);
           end;

       write (arqSai, subst);
    end;


begin
    while lido <> '' do
        begin
            if lido [1] = '{' then
                substNome
            else
                begin
                    write (arqSai, lido[1]);
                    delete (lido, 1, 1);
                end;
        end;

    writeln (arqSai);
end;

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

var c: char;
begin
    sintinic (2, '');

    clrscr;
    textBackGround (BLUE);
    write ('Projeto DOSVOX - ');
    sintWriteln ('Preparador de cartas padronizadas');
    textBackGround (BLACK);
    writeln;

    abreArquivos;
    carregaTexto;

    lin := 1;

    while lin < maxLin do
       begin
           lido := texto [lin]^;
           if copy (lido, 1, 2) = '{*' then
               begin
                   delete (lido, 1, 2);
                   if lido [length(lido)] = '}' then
                       delete (lido, length(lido), 1);
                   if lido [length(lido)] = '*' then
                       delete (lido, length(lido), 1);

                   textBackGround (MAGENTA);
                   sintWriteln (lido);
                   textBackGround (BLACK);
                   writeln;
               end
           else
           if upper (lido) = '{INITAB}' then
               iniTab := lin
           else
           if upper (lido) = '{FIMTAB}' then
               begin
                   textBackGround (MAGENTA);
                   sintbip; sintbip;
                   sintWrite ('Tem mais ? ');
                   textBackGround (BLACK);
                   c := readkey;
                   writeln (c);
                   sintcarac (c);

                   if upcase(c) <> 'N' then lin := iniTab;
               end
           else
               substitui;

           lin := lin + 1;
       end;

    close (arqsai);

    sintBip;
    sintBip;
    writeln;
    sintWriteln ('Texto gerado');

    delay (2000);
    sintFim;
    doneWinCrt;
end.