{--------------------------------------------------------}
{
{    Programa de conversão do códigos para o Braivox
{
{    Autor: Jose' Antonio Borges
{
{    Em 18/3/99
{
{--------------------------------------------------------}

{$M 16536,8192}
program transcod;
uses winDos, dvCrt, dvWin, winProcs, strings;

var nomeArq, nomeSai, nomeArqCod: string;
    arq, arqsai, arqcod: text;
    tamTab: integer;
    txorig, txnovo: array [1..1000] of ^string;

{--------------------------------------------------------}
{                finaliza programa
{--------------------------------------------------------}

procedure finaliza;
begin
    while sintFalando do;
    sintFim;
    doneWinCrt;
end;

{--------------------------------------------------------}
{             inicializa e abre arquivos
{--------------------------------------------------------}

procedure inicializa;
begin
    clrscr;
    sintInic (2, sintAmbiente ('TRANSCOD', 'DIRTRANSCOD'));
    writeln ('Conversor de códigos para o Braivox - v1.0');
    sintSom ('CVINIC');
    writeln;

    writeln ('Qual o arquivo a converter ? ');
    sintSom ('CVNOMARQ');

    sintReadln (nomeArq);
    if nomeArq = '' then doneWinCrt;

    assign (arq, nomeArq);
    {$I-}  reset (arq);  {$I+}
    if ioresult <> 0 then
        begin
            writeln ('Arquivo não existe, programa terminado');
            sintSom ('CVARQNAO');
            finaliza;
        end;
    close (arq);

    writeln ('Qual o arquivo de saída ? ');
    sintSom ('CVNOMSAI');

    sintReadln (nomeSai);
    if nomeSai = '' then doneWinCrt;
    assign (arqSai, nomeSai);
end;

{--------------------------------------------------------}
{                 carrega a codificacao
{--------------------------------------------------------}

procedure carregaCodigo;
var
    linha, p: integer;
    original, novoTexto, s: string;
begin
    writeln ('Qual o arquivo de codificação ? Assumo \dosvox\codmat.amb');
    sintSom ('CVARQCOD');
    sintReadln (nomeArqCod);

    if nomeArqCod = '' then
         if sintAmbiente ('TRADUTOR', 'MINIVOX') = 'SIM' then
             nomeArqCod := sintAmbiente ('DOSVOX', 'PGMDOSVOX') + '\codmat.amb'
         else
             nomeArqCod := '\dosvox\codmat.amb';

    assign (arqCod, nomeArqCod);
    {$I-}  reset (arqCod);  {$I+}
    if ioresult <> 0 then
        begin
            writeln ('Arquivo de codificação não existe, programa terminado');
            sintSom ('CVCODNAO');
            finaliza;
        end;

    linha := 0;
    tamTab := 0;
    while not eof (arqCod) do
        begin
            readln (arqCod, s);
            linha := linha + 1;
            if (s = '') or (s[1] = ';') then
                { nada faz }
            else
            if s[1] <> '`' then
                begin
                    write ('Codigo inválido na linha ');
                    sintSom ('CVCODINV');
                    sintWriteInt (linha);
                    writeln;
                end
            else
                begin
                    original := '';
                    novoTexto := '';
                    tamTab := tamTab + 1;
                    p := 1;
                    while (p <= length (s)) and (s[p] <> ' ') do
                        begin
                            original := original + s[p];
                            p := p + 1;
                        end;
                    while (p <= length (s)) and (s[p] = ' ') do
                        p := p + 1;
                    while (p <= length (s)) and (s[p] <> ' ') do
                        begin
                            novoTexto := novoTexto + s[p];
                            p := p + 1;
                        end;

                    getMem (txorig [tamTab], length(original) + 1);
                    txorig [tamTab]^ := original;
                    getMem (txnovo [tamTab], length(novoTexto) + 1);
                    txnovo [tamTab]^ := novoTexto;
                end;
        end;

    close (arqCod);
end;

{--------------------------------------------------------}
{                 busca texto novo
{--------------------------------------------------------}

procedure buscaTroca (const texto: string; posInicial: integer;
                      var avancar: integer; var troca: string);
var i, tam: integer;
begin
    troca := '';
    for i := 1 to tamTab do
        begin
            tam := length (txOrig [i]^);
            if copy (texto, posInicial, tam) = txOrig [i]^ then
                begin
                    troca := txNovo [i]^;
                    avancar := tam;
                    exit;
                end;
        end;

    avancar := 1;
    troca := texto [posInicial];
end;

{--------------------------------------------------------}
{        transcreve o texto fazendo alteracoes
{--------------------------------------------------------}

procedure transcreve;
var s, saida, troca: string;
    p, avancar: integer;
label errodisco;
begin
    reset (arq);
    rewrite (arqSai);

    while not eof (arq) do
        begin
            {$I-} readln (arq, s);  {$I+}
            if ioresult <> 0 then goto errodisco;

            p := 1;
            saida := '';
            while p <= length (s) do
                begin
                    if s[p] <> '`' then
                        begin
                            saida := saida + s[p];
                            p := p + 1;
                        end
                    else
                        begin
                            buscaTroca (s, p, avancar, troca);
                            p := p + avancar;
                            saida := saida + troca;
                        end;
                end;

            {$I-} writeln (arqSai, saida);   {$I+}
            if ioresult <> 0 then goto errodisco;
        end;


    if false then
        begin
erroDisco:
            writeln ('Problemas no disco');
            sintSom ('CVERRDSK');
        end;

    {$I-}  close (arq);  {$I+}
    if ioresult <> 0 then;
    {$I-}  close (arqSai); {$I+}
    if ioresult <> 0 then;
end;

{--------------------------------------------------------}
{             programa principal
{--------------------------------------------------------}

begin
    inicializa;
    carregaCodigo;
    transcreve;

    writeln ('Conversão terminada');
    sintSom ('CVFIM');
    finaliza;
end.
