{--------------------------------------------------------}
{
{    Programa de impressão braille
{
{    Autor: Jose' Antonio Borges
{
{    Em 1994/95
{
{--------------------------------------------------------}

{$M 16536,8192}
program Braiwin;
{$R braiwin.res}

uses
    dvcrt, win31, winprocs;

const
    SALTOPAG = #$0c;
    MAIUSCULAS: set of char = ['A'..'Z', #$c0..#$df];   { ANSI apenas }
    MINUSCULAS: set of char = ['a'..'z', #$e0..#$ff];

    VOGAIS     = ['A', 'E', 'I', 'O', 'U', 'a', 'e', 'i', 'o', 'u',
                  {aeiou agudos}
                  'Á', 'É', 'Í', 'Ó', 'Ú', 'á', 'é', 'í', 'ó', 'ú',
                  {aeo circunflexos}
                  'Â','Ê','Ô','â','ê','ô',
                  {ao til}
                  'Ã','Õ','ã','õ',
                  {a grave}
                  'À','à'];

    CONSOANTES = ['B', 'C', 'D', 'F', 'G', 'H', 'J', 'L', 'M',
                  'N', 'P', 'Q', 'R', 'S', 'T', 'V', 'X', 'Z',
                  'b', 'c', 'd', 'f', 'g',{'h',}'j', 'l', 'm',
                  'n', 'p', 'q', 'r', 's', 't', 'v', 'x', 'z',
                  'Ç', 'ç' ]; {cedilha}

    MAIUSCBRL     = #$0f;  {shift in}

    ABREASPASBRL  = '{';
    FECHAASPASBRL = '}';
    PONTOBRL      = '.';
    RETICBRL      = '''''''';
    VIRGDECBRL    = ',';
    PONTODECBRL   = '''';

    PERCENTBRL    = '_}';
    PARAGRAFO     = 'ss';

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

    arqsai: text;
    nomearq, nomesai: string;
    texto, textoCnv, titulo: string;

    soFrente, abre_aspas: boolean;
    autoJunta: boolean;
    centrando, comTitulo: boolean;
    maxcarac, maxlin, npag, nlin, numinic,
    paginic, pagfinal,
    ncopias: integer;
    frenteVerso, paginando: boolean;
    sobraAnterior: string;
    veioDoEdit: boolean;
    pagOrig: integer;
    tituloAtras, numeraOrig, afastaCabecPar: boolean;
    tempoLinha: integer;
    impressaoDireta: boolean;

    tabBraille: array [#0..#255] of byte;
    tabPrinter: array [#0..#255] of byte;

{--------------------------------------------------------}
{                 fala uma mensagem
{--------------------------------------------------------}

procedure mensagem (s: string);
begin
    if s = 'BRCNFERR' then
        writeln ('Arquivo C:\DOSVOX\BRAIVOX.AMB inexistente, programa cancelado')
    else
    if s = 'BRERRLIN' then
        write   ('Erro no arquivo de configuração na linha ')
    else
    if s = 'BRTRUNC' then
        write  ('Linha truncada: ')
    else
    if s = 'BRDEL' then
        write (#08, ' ', #08)
    else
    if s = 'BRDESIS' then
        writeln  ('--- desistiu ---')
    else
    if s = 'BRLPPAG' then
        write ('Quantas linhas por página (0 para não paginar) ? ')
    else
    if s = 'BRCPLIN' then
        write ('Quantos caracteres por linha ? ')
    else
    if s = 'BRNUMINI' then
        write ('Número a imprimir na página inicial (sugiro 1): ')
    else
    if s = 'BRNCOP' then
        write ('Quantas cópias (sugiro 1) ? ')
    else
    if s = 'BRPAGINI' then
        write ('Página inicial (sugiro 1): ')
    else
    if s = 'BRPAGFIN' then
        write ('Página final (sugiro 9999): ')
    else
    if s = 'BRINTRO' then
        begin
            writeln ('Projeto DOSVOX - NCE/UFRJ - 2000');
            writeln ('Programa de impressão Braille - v 1.12')
        end
    else
    if s = 'BRNOMARQ' then
        write ('Digite o nome do arquivo a imprimir: ')
    else
    if s = 'BRDOEDIT' then
        write ('Texto veio do Edit do DOS ? ')
    else
    if s = 'BRARQNAO' then
        writeln ('Arquivo nao foi achado')
    else
    if s = 'BRARQIMP' then
        write ('Digite o nome do arquivo de impressão (sugiro PRN): ')
    else
    if s = 'BRERRCRI' then
        writeln ('Erro ao criar arquivo.  Programa cancelado.')
    else
    if s = 'BRCOMTIT' then
        write ('Deseja titulos e numeração ? ')
    else
    if s = 'BRTIT' then
        writeln ('Informe o título: ')
    else
    if s = 'BRTITFV' then
        writeln ('Título em ambos os lados: ')
    else
    if s = 'BRNUMORG' then
        writeln ('Indica numeração do texto original no cabeçalho ? ')
    else
    if s = 'BRAFASTA' then
        writeln ('Afasta para a direita os cabeçalhos pares ? ')
    else
    if s = 'BRPADRAO' then
        write ('Assumo valores padrão (s/n) ? ')
    else
    if s = 'BRFIMCOP' then
        write ('Fim de impressão da cópia ')
    else
    if s = 'BRFIMTRA' then
        writeln ('Fim de trabalho')
    else
    if s = 'BRFREVER' then
        write ('Frente e verso (s/n) ? ')
    else
    if s = 'BRAUTOJU' then
        write ('Deseja auto-reformatação para Braille (s/n) ? ')
    else
    if s = 'BRLINDIV' then
        writeln ('Linhas grandes foram divididas')
    else
    if s = 'BRERRLEI' then
        writeln ('Erro de leitura do arquivo')

    else
        begin
            writeln;
            writeln ('-------------------------------');
            writeln ('--- mensagem errada: ', s, '---');
            writeln ('-------------------------------');
            writeln;
        end;
end;

{--------------------------------------------------------}
{              assume parametros default
{--------------------------------------------------------}

procedure assumeParamDefaults;
begin
    veioDoEdit := false;
    maxlin := 30;
    maxcarac := 40;
    numinic := 1;
    ncopias := 1;
    paginic := 1;
    pagfinal := 9999;
    titulo := '';
    frenteVerso := true;
    paginando := true;
    autoJunta := true;
    comTitulo := true;
    tituloAtras := false;
    numeraOrig := true;
    afastaCabecPar := true;
    pagOrig := 0;
    tempoLinha := 0;
end;

{--------------------------------------------------------}
{             calcula uma string em maiuscula
{--------------------------------------------------------}

function maiuscAnsi (s: string): string;
var x: string;
    i: integer;
begin
    x := s;
    for i:= 1 to length (s) do
        if x[i] in ['a'..'z'] then
            x[i] := upcase (x[i])
        else
            if x[i] in [#$e0..#$ff] then
                x[i] := chr (ord(x[i]) - $20);
    maiuscAnsi := x;
end;

{--------------------------------------------------------}
{                 pede parametros de impressão
{--------------------------------------------------------}

procedure pedeParametros;
var resp, c2: char;
    m: integer;
begin
    paginando := true;

    titulo := '';

    mensagem ('BRDOEDIT');
    readln (resp);
    veioDoEdit := upcase (resp) = 'S';

    mensagem ('BRAUTOJU');
    readln (resp);
    autoJunta := upcase (resp) = 'S';

    mensagem ('BRFREVER');
    readln (resp);
    frenteVerso := upcase (resp) = 'S';

    mensagem ('BRCOMTIT');
    readln (resp);
    comTitulo := upcase (resp) = 'S';
    if comTitulo then
        begin
            writeln ('---------1---------2---------3---------4---------5');
            mensagem ('BRTIT');
            readln (titulo);

            mensagem ('BRNUMORG');   {Indica numeração do texto original no cabeçalho ?}
            readln (resp);
            numeraOrig := upcase (resp) = 'S';
        end;

    if frenteVerso and comTitulo then
        begin
            mensagem ('BRTITFV');  {'Título em ambos os lados: '}
            readln (resp);
            tituloAtras := upcase (resp) = 'S';

            mensagem ('BRAFASTA'); {Afasta para a direita os cabeçalhos pares ? }
            readln (resp);
            afastaCabecPar := upcase (resp) = 'S';
        end;

    mensagem ('BRLPPAG');
    m := 0;
    readln (m);
    if m <= 0 then
        begin
            paginando := false;
            maxlin := 32766;
        end
    else
        maxlin := m;

    mensagem ('BRCPLIN');
    m := 0;
    readln (m);
    if m > 0 then
        maxcarac := m;

    if paginando then
        begin
            numinic := 1;
            mensagem ('BRNUMINI');
            readln (numinic);
            if numinic <= 0 then
                numinic := 1;
        end;

    ncopias := 1;
    mensagem ('BRNCOP');
    readln (ncopias);
    if ncopias <= 0 then
        ncopias := 1;

    mensagem ('BRPAGINI');
    readln (paginic);
    if paginic <= 0 then
        paginic := 1;

    mensagem ('BRPAGFIN');
    readln (pagfinal);
    if pagfinal <= 0 then
        pagfinal := 9999;
end;

{--------------------------------------------------------}
{                  converte lido hexa
{--------------------------------------------------------}

function cnvhexa (c1, c2: char): byte;
var v1, v2, v: integer;
begin
    c1 := upcase (c1);
    c2 := upcase (c2);

    if c1 >= 'A' then
        v1 := ord (c1) - ord ('A') + 10
    else
        v1 := ord (c1) - ord ('0');

    if c2 >= 'A' then
        v2 := ord (c2) - ord ('A') + 10
    else
        v2 := ord (c2) - ord ('0');

    cnvhexa := (v1 shl 4) or v2;
end;

{--------------------------------------------------------}
{            seleciona o diretorio de ambiente
{--------------------------------------------------------}

function sintAmbiente (nomeSecao, nomeAmbiente: string): string;
var n: integer;
    returnString: string;
begin
    nomeSecao := nomeSecao + #$0;
    nomeAmbiente := nomeAmbiente + #$0;
    n := GetPrivateProfileString(@nomeSecao[1], @nomeAmbiente[1],
         '', @returnString[1], 80, 'DOSVOX.INI');
    returnString[0] := chr(n);
    sintAmbiente := returnString;
end;

{--------------------------------------------------------}
{         carrega configuracao da impressora
{--------------------------------------------------------}

procedure carregaConfigImpr;
var
    arqConfig: text;
    ambBraivox: string;
    linha, i: integer;
    c1, c2, x, p1, p2: char;
    s: string;
    linhasPorMinuto: integer;

label proxima, erro;

    function processaParam: boolean;
    var p, i, erro: integer;
        param, valor: string;
    begin
        processaParam := true;

        p := pos ('=', s);
        param := copy (s, 1, p-1);
        for i := 1 to length (param) do
             param[i] := upcase (param[i]);
        valor := copy (s, p+1, length (s) - p);

        if param = 'COLUNAS' then
            begin
                val (valor, maxcarac, erro);
                if erro <> 0 then processaParam := false;
            end
        else
        if param = 'LINHAS' then
            begin
                val (valor, maxlin, erro);
                if erro <> 0 then processaParam := false;
            end
        else
        if param = 'FRENTEVERSO' then
            frenteVerso := upcase (valor[1]) = 'S'
        else
        if param = 'AUTOFORMATA' then
            autoJunta := upcase (valor[1]) = 'S'
        else
        if param = 'TEXTODOEDIT' then
            veioDoEdit := upcase (valor[1]) = 'S'
        else
        if param = 'PAGINA' then
            paginando := upcase (valor[1]) = 'S'
        else
        if param = 'TITULA' then
            comTitulo := upcase (valor[1]) = 'S'
        else
        if param = 'NUMERAORIG' then
            numeraOrig := upcase (valor[1]) = 'S'
        else
        if param = 'TITULOATRAS' then
            tituloAtras := upcase (valor[1]) = 'S'
        else
        if param = 'AFASTACABECPAR' then
            afastaCabecPar := upcase (valor[1]) = 'S'
        else
        if param = 'LINHASPORMINUTO' then
            begin
                val (valor, linhasPorMinuto, erro);
                if erro <> 0 then processaParam := false;
                if (linhasPorMinuto <> 0) and impressaoDireta then
                    tempoLinha := trunc (60000.0 / linhasPorMinuto)
                else
                    tempoLinha := 0;
            end
        else
            processaParam := false;
    end;

begin
    for i := 0 to 255 do
        tabPrinter [chr(i)] := i;

    ambBraivox := sintAmbiente ('BRAIVOX', 'AMBBRAIVOX');
    assign (arqConfig, ambBraivox);
    {$I-} reset (arqConfig); {$I+}
    if ioresult <> 0 then
        begin
            ambBraivox := 'C:\DOSVOX\BRAIVOX.AMB';
            assign (arqConfig, ambBraivox);
            {$I-} reset (arqConfig); {$I+}
            if ioresult <> 0 then
                begin
                    mensagem ('BRCNFERR');
                    readln;
                    doneWinCrt;
                end;
        end;

    while not eof (arqConfig) do
        begin
            linha := linha + 1;
            {$I-} readln (arqConfig, s); {$I+}

            if (s = '') or (s[1] = '*') then
                goto proxima;

            if s[3] <> '=' then
                begin
                    if not processaParam then goto erro;
                    goto proxima;
                end;

            i := cnvhexa (s[1], s[2]);
            tabPrinter [chr(i)] := cnvHexa (s[4], s[5]);

            if (ioresult <> 0) or (i < 0) or (i > 255) then
                goto erro;
proxima:
        end;

    close (arqConfig);

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

    if false then   { erro de processamento }
        begin
erro:
            close (arqConfig);
            mensagem ('BRERRLIN');
            writeln (linha);
            readln;
            doneWinCrt;
        end;
end;

{--------------------------------------------------------}
{           procedimentos de leitura bufferizada
{--------------------------------------------------------}

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
                     mensagem ('BRERRLEI');    {'Erro de leitura no arquivo'}
                     pegaCaracArq := #$0d;
                     fimDoArq := true;
                     exit;
                 end;
         end;

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

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

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

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

function carregaUmaLinha: 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
                        mensagem ('BRLINDIV');  {'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;

{--------------------------------------------------------}
{          inicializacao e abertura de arquivos
{--------------------------------------------------------}

procedure inicializa;
var resp, c2: char;
    s: string;
    m: integer;
label fim;
begin
    writeln ('--------------------------------------');
    mensagem ('BRINTRO');
    writeln ('--------------------------------------');
    writeln;

    if paramCount > 0 then
        nomeArq := paramStr(1)
    else
        begin
            mensagem ('BRNOMARQ');
            readln (nomearq);
            if nomearq = '' then
                doneWinCrt;
        end;

    assign (arq, nomearq);
    {$i-}  reset (arq, 1);  {$i+}
    if ioresult <> 0 then
        begin
            mensagem ('BRARQNAO');
            goto fim;
        end;

    assumeParamDefaults;
    carregaConfigImpr;

    mensagem ('BRARQIMP');
    readln (nomesai);
    assign (arqsai, nomesai);

    {$i-}  rewrite(arqsai);  {$i+}
    if ioresult <> 0 then
        begin
            mensagem ('BRERRCRI');
            goto fim;
        end;

    s := maiuscAnsi (nomesai);
    impressaoDireta := (s = 'PRN') or (s = 'LPT1') or (s = 'LPT2') or (s = 'LPT3') or
       (s = 'COM1') or  (s = 'COM2');

    mensagem ('BRPADRAO');
    readln (resp);
    if (resp <> '') and (upcase (resp) = 'N') then
        pedeParametros;

    sobraAnterior := '';
    exit;

fim:
    readln;
    doneWinCrt;
end;

{--------------------------------------------------------}
{             converte uma letra para minuscula
{--------------------------------------------------------}

function convMinusc (c: char): char;
begin
    if c in ['A'..'Z'] then
        c := chr (ord(c) + $20)
    else

    if c in [#$c0..#$df] then
        c := chr (ord(c) + $20);

    convMinusc := c;
end;

{--------------------------------------------------------}
{                  da Saida
{--------------------------------------------------------}

procedure escreveSaida (texto: string);
var i, linha: integer;
    bit: byte;
    s: string;
begin
    if npag < paginic then exit;
    if npag > pagfinal then exit;

    for i := 1 to length (texto) do
        texto[i] := chr (tabPrinter [texto[i]]);
    writeln (arqsai, texto);
    if tempoLinha <> 0 then
        delay (tempoLinha);
end;

{--------------------------------------------------------}
{             converte uma linha para Braille
{--------------------------------------------------------}

function convBraille (texto: string): string;
const
    brailleEmbaixo: array ['0'..'9'] of char =
        ('~', ',', ';', ':', '.', '?', '!', ')', '{', '*');
var
    s: string;
    posl: integer;
    c: char;
    parteInic: string;

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

    function trataData: boolean;
    var i, p, numBarras: integer;
        lido: string;
    begin
        trataData := false;

        numBarras := 0;
        p := posl;
        lido := '';
        while (p <= length (texto)) and (texto [p] in ['0'..'9', '/']) do
             begin
                 lido := lido + texto [p];
                 p := p + 1;
                 if texto [p] = '/' then numBarras := numBarras + 1;
             end;
        if (numBarras <> 2) or
            not (lido [length (lido)] in ['0'..'9']) then
                exit;   { número comum ou mal formado }

        posl := posl + length (lido);

        for i := 1 to length (lido) do
            if lido [i] = '/' then lido [i] := '-';
        s := s + lido;

        trataData := true;
    end;

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

    function trataOrdinal: boolean;
    var i, p: integer;
        lido: string;
        sufixo: string [3];
    begin
        trataOrdinal := false;

        p := posl;
        lido := '';
        while (p <= length (texto)) and (texto [p] in ['0'..'9']) do
            begin
                lido := lido + texto [p];
                p := p + 1;
            end;

        if p > length (texto) then exit;    { não é um numeral }

        if texto[p] = 'ª' then
            begin
                sufixo := 'a';
                p := p + 1;
            end
        else
        if texto[p] = '°' then
            begin
                sufixo := 'o';
                p := p + 1;
            end
        else
        if (p+1 <= length (texto)) and
           (   (copy (texto, p, 2) = 'a.') or  (copy (texto, p, 2) = 'o.') ) then
               begin
                   sufixo := texto[p];
                   p := p + 2;
               end
        else
        if (p+2 <= length (texto)) and
           (   (copy (texto, p, 3) = 'as.') or  (copy (texto, p, 3) = 'os.') ) then
               begin
                   sufixo := copy (texto, p, 2);
                   p := p + 3;
               end
        else
            exit;    { não é um numeral }

        for i := 1 to length (lido) do
            s := s + brailleEmbaixo [lido[i]];
        s := s + sufixo;

        posl := p;
        trataOrdinal := true;
    end;

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

    procedure convNumero;
    begin
        s := s + '#';

        if not trataData then
           if not trataOrdinal then
              begin
                while (posl <= length(texto)) and
                      (texto[posl] in ['0'..'9', '.', ',']) do
                     begin
                         case texto[posl] of
                            ',': s := s + VIRGDECBRL;

                            '.': if (posl <> length(texto)) and
                                    (texto[posl+1] in ['0'..'9']) then
                                        s := s + PONTODECBRL
                                 else
                                        s := s + PONTOBRL;
                         else
                             s := s + texto[posl];
                         end;
                         posl := posl + 1;
                    end;
                end;
    end;

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

    procedure trataFracao;
    var i, p: integer;
        lido: string;
    begin   { fração }
        s := s + '#';
        posl := posl + 1;
        while (posl <= length(texto)) and (texto[posl] in ['0'..'9']) do
            begin
                s := s + brailleEmbaixo [texto [posl]];
                posl := posl + 1;
            end;

        if posl > length (texto) then exit;

        if texto [posl] = '/' then
            begin
                posl := posl + 1;
                while (posl <= length(texto)) and (texto[posl] in ['0'..'9']) do
                    begin
                        s := s + texto [posl];
                        posl := posl + 1;
                    end;
            end;
    end;

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

    procedure convPalavra;
    begin
        repeat
            s := s + texto[posl];
            posl := posl + 1;
        until (posl > length(texto)) or
              (not (texto[posl] in MINUSCULAS+['-']));
    end;

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

    procedure convPalavraMaiusc;    { nao trata o caso MMmM }
    begin
        if (posl >= length(texto)) or
                   not (texto [posl+1] in MAIUSCULAS) then
            begin
                c := convMinusc (texto[posl]);
                s := s + MAIUSCBRL + c;
                posl := posl + 1;
            end
        else
            begin
                s := s + MAIUSCBRL + MAIUSCBRL;
                repeat
                    c := convMinusc (texto[posl]);
                    s := s + c;
                    posl := posl + 1;
                until (posl > length(texto)) or
                              not (texto[posl] in MAIUSCULAS);
            end;
    end;

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

    procedure convPonto;
    begin
        if (length (texto) >= posl+2) and
           (texto [posl+1] = '.') and
           (texto [posl+2] = '.') then
            begin
                s := s + RETICBRL;
                posl := posl + 3;
            end
        else
            begin
                s := s + PONTOBRL;
                posl := posl + 1;
            end;
    end;

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

    procedure convAspas;
    begin
        if abre_aspas then
            begin
                s := s + ABREASPASBRL;
                abre_aspas := false;
            end
        else
            begin
                s := s + FECHAASPASBRL;
                abre_aspas := true;
            end;

        posl := posl + 1;
    end;

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

    procedure convCarac;
    begin
        case texto [posl] of
            '%': s := s + PERCENTBRL;
            '§': s := s + PARAGRAFO;
        else
            s := s + texto[posl];
        end;

        posl := posl + 1;
    end;

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

    procedure convMatematicos;
    begin
        posl := posl + 1;
        case texto [posl] of
            '(':  s := s + 'ê';
            ')':  s := s + 'ã';
            '*':  s := s + '{';
            '[':  s := s + 'á';
            ']':  s := s + 'ú';
            '{':  s := s + '~l';
            '}':  s := s + '_,';
        end;
        posl := posl + 1;
    end;

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

begin
    s := '';

    if (texto <> '') then
       if (texto[1] = ' ') and (texto[2] <> ' ') then
           delete (texto, 1, 1);

    posl := 1;
    while posl <= length (texto) do
        begin
            if texto [posl] in MINUSCULAS then
                convPalavra
            else

            if texto[posl] in MAIUSCULAS then
                convPalavraMaiusc
            else

            if (texto[posl] in ['0'..'9']) then
                convNumero
            else

            if (posl < length(texto)) and
               (texto[posl] = '`') and (texto[posl+1] in ['0'..'9']) then
                    trataFracao
            else

            if (posl < length(texto)) and
               (texto[posl] = '`') and (texto[posl+1] in ['(', ')', '*', '[', ']', '{', '}']) then
                    convMatematicos
            else

            if texto[posl] = '.' then
                convPonto
            else

            if texto[posl] = '"' then
                convAspas
            else

                convCarac;
        end;

    convBraille := s;
end;

{--------------------------------------------------------}
{                     escreve o titulo
{--------------------------------------------------------}

procedure escreveTitulo;
var tituloConv: string;
    i, nbrancos, brAntes, brDepois: integer;
    origConv, numPagConv, sai: string;
    npagImpressa: integer;

const brancos: string =
    '                                           ';
begin
    if not paginando then exit;

    npag := npag + 1;
    nlin := 1;

    if (npag < paginic) then exit;

    if npag > paginic then
        write (arqsai, SALTOPAG);

    if npag > pagFinal then exit;
    if not comTitulo then exit;
    if (not tituloAtras) and (not odd(npag)) then exit;

    npagImpressa := npag-paginic+numinic;
    nlin := 2;

    tituloConv := convBraille (titulo);

    origConv := '';
    if numeraOrig and (odd(npagImpressa)) and (pagOrig <> 0) then
        begin
            str (pagOrig, origConv);
            origConv := '  ' + convBraille (origConv);
        end;

    str (npagImpressa, numPagConv);
    numPagConv := convBraille (numPagConv);

    if frenteVerso and (not odd(npagImpressa)) and afastaCabecPar then
        numPagConv := '  ' + numPagConv;

    nbrancos := maxcarac - length (origConv)
                         - length (tituloConv)
                         - length (numPagConv);

    brAntes := nbrancos div 2;
    brDepois := nbrancos - brAntes;
    tituloConv := copy (brancos, 1, brAntes) + tituloConv +
                  copy (brancos, 1, brDepois);

    if odd(npagImpressa) or (not frenteVerso) then
         tituloConv := origConv + tituloConv + numPagConv
    else
         tituloConv := numPagConv + tituloConv;

    for i := length (tituloConv) downto 1 do
        if tituloConv [i] <> ' ' then
            begin
                delete (tituloConv, i+1, 999);
                break;
            end;

    escreveSaida (tituloConv);
end;

{--------------------------------------------------------}
{            divide a linha Braille em duas
{--------------------------------------------------------}

procedure quebraSaida (var texto, parte1: string);
var posic: integer;
    i, aIncluir: integer;
begin
    if texto [maxCarac+1] = ' ' then
        begin
            posic := maxCarac;
            while (posic > 10) and (texto [posic] = ' ') do
                posic := posic - 1;
            parte1 := copy (texto, 1, posic);
            posic := maxCarac + 2;
            while (posic <= length (texto)) and (texto [posic] = ' ') do
                posic := posic + 1;
            texto := copy (texto, posic, length (texto) - posic + 1);
            exit;
        end;

    posic := maxCarac;
    while (posic > 10) and (texto[posic-1] <> ' ') and

        not (     { fimsilaba }
          (texto[posic-2] <> ' ') and
          (texto[posic-1] in VOGAIS + ['S', 's', 'N', 'n', 'R', 'r']) and
          (texto[posic] in CONSOANTES) and
          (texto[posic+1] in VOGAIS)
        )

        do
               posic := posic - 1;

    parte1 := copy (texto, 1, posic-1);
    if texto[posic-1] <> ' ' then
        parte1 := parte1 + '-'
    else
        while parte1 [length (parte1)] = ' ' do
            delete (parte1, length(parte1), 1);

    texto  := copy (texto, posic, length(texto)-posic+1);
end;

{--------------------------------------------------------}
{                   converte uma linha
{--------------------------------------------------------}

procedure converteLinha (texto: string);
var s, parteInic: string;
    descarrega: boolean;

begin
    descarrega := (texto = '') or (not autoJunta);

    if sobraAnterior <> '' then
        s := sobraAnterior + ' ' + convBraille (texto)
    else
        s := convBraille (texto);

    repeat
        if (nlin = 0) or (nlin > maxlin) then
            escreveTitulo;

        if length (s) > maxcarac then
            begin
                quebraSaida (s, parteInic);
                escreveSaida (parteInic);
                sobraAnterior := s;
                nlin := nlin + 1;
            end
        else
            begin
                if descarrega then
                    begin
                        escreveSaida (s);
                        sobraAnterior := '';
                        nlin := nlin + 1;
                    end
                else
                    sobraAnterior := s;

                s := '';
            end;

    until s = '';
end;

{--------------------------------------------------------}
{    remove brancos ao final e so' deixa dois no inicio
{--------------------------------------------------------}

procedure compactaLinha (var texto: string);
begin
    while (texto <> '') and (texto [length (texto)] = ' ') do
        delete (texto, length(texto), 1);

    if autoJunta then
       while (length (texto) > 2) and
          (texto [1] = ' ') and (texto [2] = ' ') and (texto [3] = ' ') do
            delete (texto, 1, 1);
end;

{--------------------------------------------------------}
{              processa controles do texto
{--------------------------------------------------------}

function processaControles (texto: string): boolean;
var erro: integer;
begin
    if (length (texto) = 1) then
        begin
            processaControles := false;
            exit;
        end;

    if (texto = '<p>') or (texto = '<P>') then
        begin
            if autoJunta then
                converteLinha ('');
            escreveTitulo;
        end
    else

    if upcase (texto[2]) = 'T' then
        begin
            titulo := copy (texto, 3, length (texto)-2);
            if titulo [length(titulo)] = '>' then
                delete (titulo, length(titulo), 1);
        end
    else

    if upcase (texto[2]) = 'F' then
        begin
            if texto[3] = '-' then
                begin
                    if autoJunta and (sobraAnterior <> '') then
                        converteLinha ('');
                    autoJunta := false;
                end
            else
                autoJunta := true;
        end
    else

    if texto[2] in ['0'..'9'] then
        begin
            erro := 1;
            if texto [length(texto)] = '>' then
                val (copy (texto, 2, length(texto)-2), pagOrig, erro);
            if erro <> 0 then exit;   {retorna falso}
        end;

    processaControles := true;
end;

{--------------------------------------------------------}
{                   corpo da impressao
{--------------------------------------------------------}

procedure impressao;
label fim, ok, naoImprime;
var i, aIncluir: integer;
label impr;
begin
    nlin := 0;
    npag := 0;
    texto := '';
    abre_aspas := true;

    inicBufArq;
    while not fimDoArq do
        begin
            if npag > pagFinal then goto fim;

            texto := carregaUmaLinha;
            if veioDoEdit then
                begin
                    texto := texto + #$0;
                    oemToAnsi (addr (texto[1]), addr (texto[1]));
                end;

            centrando := autoJunta and
                  (length (texto) > 10) and
                  (copy (texto, 1, 10) = '          ');

            compactaLinha (texto);

            if (texto <> '') and (texto[1] = '<') then
                begin
                    if not processaControles (texto) then
                        goto impr;
                end
            else
                begin
impr:
                    if centrando and (sobraAnterior <> '') then
                         converteLinha ('')
                    else
                    if autoJunta and (sobraAnterior <> '') then
                        if (texto = '') or (texto[1] = ' ') then { paragrafo }
                             converteLinha ('');

                    converteLinha (texto);

                    if centrando then
                        begin
                            aIncluir := (maxCarac - length (sobraAnterior)) div 2;
                            for i := 3 to aIncluir do
                                 sobraAnterior := ' ' + sobraAnterior;
                            converteLinha ('');
                        end;
                end;
        end;

    if (npag <= pagFinal) and (sobraAnterior <> '') then
        converteLinha ('');

    if nlin > 1 then
        begin
            write (arqsai, SALTOPAG);
            npag := npag + 1;
        end;

fim:
    if (not odd(npag)) and (frenteVerso) then
        begin
            writeln (arqsai);
            write (arqsai, SALTOPAG);
        end;
end;

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

var i: integer;
    s: string;
begin
    textColor (BLACK);
    textBackGround (WHITE);
    clrscr;
    inicializa;

    for i := 1 to ncopias do
        begin
            impressao;
            close (arq);

            mensagem ('BRFIMCOP');
            if ncopias <> 1 then
                writeln (i);
            writeln;

            if i < ncopias then reset (arq);
        end;

    close (arqsai);

    mensagem ('BRFIMTRA');
    readln;
    doneWinCrt;
end.
