unit imprvox;
interface
uses dvwin, dvCrt, winprocs;

procedure imprimeArquivo (nomeArq, nomeSaida: string);

implementation

{--------------------------------------------------------}
{                   traduz texto
{--------------------------------------------------------}

function traduzImpr (c: char): string;
begin
    case c of
        '‡'  : traduzImpr := 'c'+ #8 + ',';
        '€'  : traduzImpr := 'C'+ #8 + ',';
        #130 : traduzImpr := 'e'+ #8 + '''';
        #144 : traduzImpr := 'E'+ #8 + '''';
        #160 : traduzImpr := 'a'+ #8 + '''';
        #143 : traduzImpr := 'A'+ #8 + '''';
        #132 : traduzImpr := 'a'+ #8 + '~';
        #131 : traduzImpr := 'a'+ #8 + '^';
        #133 : traduzImpr := 'a'+ #8 + '`';
        #136 : traduzImpr := 'e'+ #8 + '^';
        #147 : traduzImpr := 'o'+ #8 + '^';
        #162 : traduzImpr := 'o'+ #8 + #39;
        #148 : traduzImpr := 'o'+ #8 + '~';
        #153 : traduzImpr := 'O'+ #8 + '~';
        #161 : traduzImpr := 'i'+ #8 + '''';
        #163 : traduzImpr := 'u'+ #8 + '''';
    Else
        traduzImpr := c;
    end;
end;

{--------------------------------------------------------}
{                   impressao comum
{--------------------------------------------------------}

procedure imprimeArquivo (nomeArq, nomeSaida: string);
var
    nomeAmb: string;
    arq, arqSaida: text;
    novoNome, s: string;
    c, c2: char;
    i, nl, nlf, nlpag: integer;
    texto: string;
    impressaoDireta: boolean;
    achouTabPadrao: boolean;

label fim, deNovo;

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

begin
    nomeAmb := 'c:\dosvox\printer.amb';

    assign (arq, nomeArq);
    {$i-}  reset (arq);  {$i+}
    if ioresult <> 0 then exit;

    assign (arqSaida, nomeSaida);
    {$i-}  rewrite (arqSaida);  {$i+}
    if ioresult <> 0 then exit;

    write (arqSaida, #$1b, 'A', chr (9));
    while not eof (arq) do
        begin
            {$I-} readln (arq, texto); {$I+}
            texto [length(texto)] := #$0;
            ansiToOem (@texto[1], @texto[1]);
            for i := 1 to length (texto) do
                begin
                    s := traduzImpr (texto[i]);
                    write (arqSaida, s);
                end;
            writeln (arqSaida);
        end;

    write (arqSaida, #$1b, 'A', chr (12));
fim:
    close (arq);
    close (arqSaida);
end;

end.
