{----------------------------------------------------}
{
{   Programa conversor de codigos Internacionais
{   para o codigo da impressora Braillo da
{   Sociedade de Assistencia aos Cegos de Fortaleza
{
{   Autor: Jose' Antonio Borges
{
{   Em 12/05/97
{
{----------------------------------------------------}


program pbraillo;
uses crt;
const
    tabconv: array [0..$ff] of byte =
    (
        $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0a,$0b,$0c,$0d,$0e,$0f,
        $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1a,$1b,$1c,$1d,$1e,$1f,
        $20,$8a,$24,$23,$85,$8d,$87,$27,$a0,$a3,$2a,$a2,$7e,$2d,$3e,$2f,
        $29,$2c,$3b,$3a,$2e,$2b,$21,$22,$28,$25,$97,$3c,$88,$82,$41,$5e,
        $26,$61,$42,$43,$44,$45,$46,$47,$48,$49,$4a,$4b,$4c,$4d,$4e,$4f,
        $50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5a,$4f,$81,$8b,$40,$5f,
        $26,$61,$62,$63,$64,$65,$66,$67,$68,$69,$6a,$6b,$6c,$6d,$6e,$6f,
        $70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7a,$4f,$81,$8b,$40,$82,
        $80,$81,$82,$83,$84,$85,$86,$87,$88,$89,$8a,$8b,$8c,$8d,$8e,$8f,
        $90,$91,$92,$93,$94,$95,$96,$97,$98,$99,$9a,$9b,$9c,$9d,$9e,$9f,
        $a0,$a1,$a2,$a3,$a4,$a5,$a6,$a7,$a8,$a9,$aa,$ab,$ac,$ad,$ae,$af,
        $b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,$b8,$b9,$ba,$bb,$bc,$bd,$be,$bf,
        $c0,$c1,$c2,$c3,$c4,$c5,$c6,$c7,$c8,$c9,$ca,$cb,$cc,$cd,$ce,$cf,
        $d0,$d1,$d2,$d3,$54,$d5,$d6,$d7,$d8,$d9,$da,$db,$dc,$dd,$de,$df,
        $e0,$e1,$e2,$e3,$e4,$e5,$e6,$e7,$e8,$e9,$ea,$eb,$ec,$ed,$ee,$ef,
        $f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff
    );

var arqent, arqsai: text;
    espaco: string;
    c: char;

procedure abreArquivos;
var i, e, erro: integer;
begin
    if paramcount <> 3 then
        begin
            sound (440); delay (200);
            sound (880); delay (200);
            nosound;

            writeln;
            writeln ('Use:  pbraillo arqEntrada arqSaida espaco');
            writeln ('Para jogar direto na impressora:');
            writeln ('       pbraillo a:saida prn 3');
            halt;
        end;

    assign (arqent, paramstr(1));
    {$I-}  reset (arqent);  {$I+}
    if ioresult <> 0 then
        begin
            sound (440); delay (200);
            sound (880); delay (200);
            sound (440); delay (200);
            nosound;

            writeln ('Arquivo ', paramstr(1), ' nao existe');
            halt;
        end;

    assign (arqsai, paramstr(2));
    {$I-}  rewrite (arqsai);  {$I+}
    if ioresult <> 0 then
        begin
            sound (440); delay (100);
            sound (880); delay (200);
            sound (440); delay (100);
            sound (880); delay (200);
            sound (440); delay (100);
            nosound;

            writeln ('Arquivo ', paramstr(2),
                              ' nao pode ser gerado ou aberto');
            halt;
        end;

    espaco := '';
    val (paramstr(3), e, erro);
    for i := 1 to e do
         espaco := espaco + ' ';
end;

procedure fechaArquivos;
begin
    close (arqEnt);
    close (arqSai);

    sound (440); delay (1000);
    sound (220); delay (1000);
    sound (110); delay (1000);
    nosound;

    writeln ('Fim de processamento');
end;

procedure processa;
label denovo;
var c, tecla: char;
    i: integer;
    primLetra: boolean;

begin
    primLetra := true;
    while not eof (arqent) do
        begin
            read (arqent, c);
            case c of
                    #$0c, #$0a:  primLetra := true;
                    #$0d:        primLetra := false;
            else
                    if primLetra then
                        begin
                            write (arqsai, espaco);
                            primLetra := false;
                        end;
            end;

            c := chr(tabconv [ord(c)]);

deNovo:
            {$I-}  write (arqsai, c);  {$I+}
            if ioresult <> 0 then
                begin
                    sound (440); delay (100);
                    sound (880); delay (100);
                    sound (480); delay (100);
                    sound (880); delay (100);
                    nosound;

                    writeln ('Erro no arquivo de impressao:');
                    writeln ('Aperte ESC para cancelar, Enter para tentar de novo');
                    repeat
                        tecla := readkey;
                    until (tecla = #$1b) or (tecla = #$0d);
                    if tecla = #$0d then
                        goto denovo
                    else
                        halt;
                end;
    end;
end;

begin
    abreArquivos;
    processa;
    fechaArquivos;
end.
