{--------------------------------------------------------}
{                  Módulo de impressao
{--------------------------------------------------------}

unit brImprime;
interface
uses winDos, dvCrt, dvWin, winProcs, strings, brVars, brMsg, brLeBuf;

procedure impressao;

implementation

var
    txtIngles, sepSilabas: boolean;

{--------------------------------------------------------}
{             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;

    if imprMatricial then
        begin
            write (arqsai, #$1b, 'A', #$8);  { impressao comprimida }
            for linha := 0 to 2 do
                begin
                    s := '';
                    for i := 1 to length (texto) do
                        begin
                            bit := 1 shl linha;
                            if (tabBraille [texto[i]] and bit) <> 0 then
                                s := s + '.'
                            else
                                s := s + ' ';

                            bit := 8 shl linha;
                            if (tabBraille [texto[i]] and bit) <> 0 then
                                s := s + '.'
                            else
                                s := s + ' ';
                        end;

                    s := s + '                                        ';
                    s := s + '                                        ';

                    for i := (maxcarac * 2) downto 1 do
                        write (arqsai, s[i]);
                    write (arqsai, #$0d);
                    for i := (maxcarac * 2) downto 1 do
                        write (arqsai, s[i]);
                    writeln (arqsai);
                end;

            write (arqsai, #$1b, 'A', #$12);  { impressao normal }
            writeln (arqsai);
        end
    else
        begin
            for i := 1 to length (texto) do
                texto[i] := chr (tabPrinter [texto[i]]);
            {$i-} writeln (arqsai, texto);  {$I+}
            if ioresult <> 0 then
                begin
                    mensagem ('BRERRESC', 1);  {'Erro de escrita no dispositivo de impressão'}
                    mensagem ('BRESCCAN', 1);  {'ENTER continua, ESC cancela'}
                    if readkey = ESC then
                        begin
                            close (arq);
                            close (arqSai);
                            sintFim;
                            doneWinCrt;
                        end;
                end;

            if tempoLinha <> 0 then
                delay (tempoLinha);
        end;
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;

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

    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 (p <= length (texto)) and (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 trataHora: boolean;
    var p: integer;
        lido: string;
    begin
        trataHora := 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)) and (texto[p] <> ':') then exit;

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

        s := s + lido;
        posl := posl + length (lido);
        trataHora := 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] = '°') or (texto[p] = 'º') then
            {cuidado: na linha anterior não aparece diferente o segundo ozinho !}
            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 trataHora 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;
    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]);
                if txtIngles then
                    s := s + MAIUSCINGLES + c
                else
                    s := s + MAIUSCBRL + c;
                posl := posl + 1;
            end
        else
            begin
                if txtIngles then
                    s := s + MAIUSCINGLES + MAIUSCINGLES
                else
                    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
            '_': if txtIngles then
                     s := s + GRIFOINGLES
                 else
                     s := s + GRIFOBRL;
            '%': 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
    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 (tipoCabec = 1) 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;
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 }
          sepSilabas and
          (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;

    if posic = 10 then posic := maxCarac;

    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
            if paginando then escreveTitulo;

        if (nlin = 1) and (npag > 1) and (s = '') and tiraBrancasInicioPag then
            begin
                sobraAnterior := '';
                exit;
            end;

        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;

{--------------------------------------------------------}
{             troca os TABS por dois brancos
{--------------------------------------------------------}

procedure tiraTabs (var texto: string);
const TAB = #$09;
var i: integer;
begin
    for i := length(texto) downto 1 do
        begin
            if texto[i] = TAB then
                begin
                    insert (' ', texto, i);
                    texto [i+1] := ' ';
                end;
        end;
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
    processaControles := false;
    if (length (texto) = 1) then
        begin
            processaControles := false;
            exit;
        end;

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

            if paginando then escreveTitulo
                         else write (arqSai, SALTOPAG);
        end
    else

    if upcase (texto[2]) = 'T' then
        begin
            if copy (texto, 3, 2) = '->' then
                comTitulo := false
            else
            if copy (texto, 3, 2) = '+>' then
                comTitulo := true
            else
            if (length (texto) >= 5) and
               (copy (texto, 3, 1) = '+') and
               (texto [4] in ['0'..'9']) and
               (texto [length(texto)] = '>') then
                   begin
                       comTitulo := true;
                       val (copy (texto, 4, length(texto)-4), npag, erro);
                       npag := npag - 1;
                   end
            else
                begin
                    titulo := copy (texto, 3, length (texto)-2);
                    if titulo [length(titulo)] = '>' then
                        delete (titulo, length(titulo), 1);
                end;
        end
    else

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

    if upcase (texto[2]) = 'S' then
        begin
            if copy (texto, 3, 2) = '->' then sepSilabas := false
            else
            if copy (texto, 3, 2) = '+>' then sepSilabas := true;
        end
    else

    if upcase (texto[2]) = 'I' then
        begin
            if copy (texto, 3, 2) = '->' then txtIngles := false
            else
            if copy (texto, 3, 2) = '+>' then txtIngles := 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 := '';
    sobraAnterior := '';
    abre_aspas := true;
    txtIngles := textoIngles;
    sepSilabas := separaSilabas;

    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;

end.
