{--------------------------------------------------------}
{
{    Rotinas de Impressao Braille
{
{    Autor: Antonio Borges
{
{    Em 18/02/97
{
{--------------------------------------------------------}

uses crt, dos;

const
    latch1 = $80;
    latch2 = $40;

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

    tabMeiaTrava: array [0..42] of integer;

    esperaAperta, esperaSolta: integer;
    esperaMeiaTrava1, esperaMeiaTrava2, esperaMeiaTrava3: integer;
    esperaLF, esperaFimLf, esperaAposLF: integer;
    esperaCRLF, esperaHome: integer;

var
    corrDelay: integer;
    arq: text;
    npag: integer;
    terminou: boolean;
    maxLinPag, pularInic: integer;
    repulando: boolean;

{--------------------------------------------------------}
{                      delays
{--------------------------------------------------------}

procedure delay (x: integer);
var i: integer;
begin
    crt.delay (x * corrDelay);
end;

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

procedure calibraDelay;
var 
    hora1, hora2: longint;
    h1, m1, s1, c1: word;
    h2, m2, s2, c2: word;
begin
    repeat
       gettime (h1,m1,s1,c1);
       hora1 := (((h1*60)+m1)*60+s1)*100+c1;
       crt.delay (1000);
       gettime (h2,m2,s2,c2);
       hora2 := (((h2*60)+m2)*60+s2)*100+c2;
    until hora2 > hora1;  { evita meia noite !}

    corrDelay := 103 div (hora2-hora1);
    if corrDelay < 1 then corrDelay := 1;
end;

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

procedure xdelay (i: integer);
var j: integer;
begin
    for j := 1 to i do ;
end;

{--------------------------------------------------------}
{               acionamento basico
{--------------------------------------------------------}

procedure strobe;
begin
    xdelay (1);   port [$37a] := 0;
    xdelay (1);   port [$37a] := 1;
    xdelay (1);   port [$37a] := 0;
end;

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

procedure escLatch1 (b: byte);
begin
     b := b xor $3f;
     port [$378] := b + latch1;  strobe;
end;

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

procedure escLatch2 (b: byte);
begin
     b := b xor $3f;
     port [$378] := b + latch2;  strobe;
end;

{--------------------------------------------------------}
{                 rotinas de funcao
{--------------------------------------------------------}

procedure inicMaquina;
begin
     escLatch1(0);
     escLatch2(0);

     calibraDelay;
end;

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

procedure repete;     { so' util para testes }
begin
    esclatch2 ($2);   delay (esperaLF);
    esclatch2 (0);    delay (esperaAposLF);
end;

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

procedure lineFeed;  { ok }
begin
    esclatch2 ($8);   delay (esperaLF);
    esclatch2 (0);    delay (esperaAposLF);
end;

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

procedure home;
begin
    esclatch2 ($1);   delay (esperaAperta);
    esclatch2 (0);    delay (esperaHome);
    if repulando then
        lineFeed;
end;

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

procedure crlf;
begin
    esclatch2 ($4);   delay (esperaCRLF);
    esclatch2 (0);    delay (esperaSolta);
    delay (esperaAposLF);
    if repulando then lineFeed;
end;

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

procedure meiaTrava (quanto: integer);  { ok }
begin
    delay (esperaAperta);
    delay (esperaSolta);

    esclatch2 ($4);   delay (quanto);
    esclatch2 (0);    delay (esperaMeiaTrava1);
    esclatch2 ($4);   delay (esperaMeiaTrava2);
    esclatch2 (0);    delay (esperaMeiaTrava3);
    if repulando then lineFeed;
end;

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

procedure lineBack;  { ok }
begin
    esclatch2 ($10);  delay (esperaLF);
    esclatch2 (0);    delay (esperaAposLF);
end;

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

procedure space;     { ok }
begin
    esclatch2 ($20);  delay (esperaAperta);
    esclatch2 (0);    delay (esperaSolta);
end;

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

procedure caracBraille (b: byte);   { ok }
begin
    if b = 0 then
        space
    else
        begin
            esclatch1 (b);  delay (esperaAperta);
            esclatch1 (0);  delay (esperaSolta);
        end;
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;

{--------------------------------------------------------}
{            le tabela Caractere para Braille
{--------------------------------------------------------}

procedure carregaConfigBraille;
var
    arqConfig: text;
    s: string;
    linha, l, i, valor: integer;
    bit: byte;

label proxima, erro;

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

    assign (arqConfig, 'brailex.amb');
    {$I-} reset (arqConfig); {$I+}

    if ioresult <> 0 then
        begin
            assign (arqConfig, 'c:\dosvox\brailex.amb');
            {$I-} reset (arqConfig); {$I+}
        end;
    if ioresult <> 0 then
        begin
            assign (arqConfig, 'c:\turbo\brailex.amb');
            {$I-} reset (arqConfig); {$I+}
        end;

    if ioresult <> 0 then
        begin
            writeln ('Arquivo brailex.amb nao foi encontrado');
            halt;
        end;

    linha := 0;
    while not eof (arqConfig) do
        begin
            {$I-} readln (arqConfig, s); {$I+}
            linha := linha + 1;
            if (s = '') or (s[1] = '*') then goto proxima;

            l := cnvhexa (s[1], s[2]);
            delete (s, 1, 2);
            while (s <> '') and ((s[1] = '=') or (s[1] = ' ')) do
                delete (s, 1, 1);

            if length (s) <> 6 then goto erro;

            valor := 0;
            for i := 1 to 6 do
                begin
                    if s[i] = '0' then bit := 0
                    else
                    if s[i] = '1' then bit := 1
                    else
                        goto erro;

                    valor := valor + (bit shl (i-1));
                end;

            tabBraille [chr(l)] := valor;
proxima:
        end;

        close (arqConfig);
        exit;

erro:
    close (arqConfig);
    write ('Erro em Brailex.amb na linha ');
    writeln ((linha-1) * 4);
    writeln ('Programa cancelado');
    halt;
end;

{--------------------------------------------------------}
{            carrega parametros de tempo da maquina
{--------------------------------------------------------}

procedure carregaConfigMaquina;
const
    defaultMeiaTrava: array [0..42] of integer = (
         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
         200, 200, 200, 200, 200, 200, 250, 250, 250, 250,
         250, 250, 250, 300, 300, 300, 300, 300, 300, 340,
         340, 340, 380, 380, 380, 380, 450, 450, 450, 450, 450, 450);
var
    arqConfig: text;
    s, comando: string;
    linha, posIgual, l, i, valor, erro: integer;

label proxima, errou;

begin

    for i := 0 to 42 do
        tabMeiaTrava [i] := defaultMeiaTrava [i];

    esperaAposLF     := 500;
    esperaAperta     := 150;
    esperaSolta      := 500;
    esperaMeiaTrava1 := 500;
    esperaMeiaTrava2 := 1200;
    esperaMeiaTrava3 := 1000;
    esperaLF         := 500;
    esperaFimLf      := 1000;
    esperaCRLF       := 2500;
    esperaHome       := 500;

    assign (arqConfig, 'braitemp.amb');
    {$I-} reset (arqConfig); {$I+}

    if ioresult <> 0 then
        begin
            assign (arqConfig, 'c:\dosvox\braitemp.amb');
            {$I-} reset (arqConfig); {$I+}
        end;
    if ioresult <> 0 then
        begin
            assign (arqConfig, 'c:\turbo\braitemp.amb');
            {$I-} reset (arqConfig); {$I+}
        end;

    if ioresult <> 0 then
        begin
            writeln ('Arquivo braitemp.amb nao foi encontrado, assumidos defaults');
            exit;
        end;


    linha := 0;
    while not eof (arqConfig) do
        begin
            readln (arqconfig, s);
            linha := linha + 1;
            for i := length (s) downto 1 do
                if s[i] = ' ' then delete (s, i, 1);
            posIgual := 0;
            for i := length (s) downto 1 do
                begin
                    if s[i] = '=' then
                        posIgual := i
                    else
                        s[i] := upcase (s[i]);
                end;

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

            comando := copy (s, 1, posIgual-1);
            val (copy (s, posIgual+1, length(s) - posIgual), valor, erro);
            if erro <> 0 then goto errou;

            if comando = 'ESPERAAPOSLF'     then esperaAposLF     := valor
            else
            if comando = 'ESPERAAPERTA'     then esperaAperta     := valor
            else
            if comando = 'ESPERASOLTA'      then esperaSolta      := valor
            else
            if comando = 'ESPERAMEIATRAVA1' then esperaMeiaTrava1 := valor
            else
            if comando = 'ESPERAMEIATRAVA2' then esperaMeiaTrava2 := valor
            else
            if comando = 'ESPERAMEIATRAVA3' then esperaMeiaTrava3 := valor
            else
            if comando = 'ESPERALF'         then esperaLF         := valor
            else
            if comando = 'ESPERAFIMLF'      then esperaFimLf      := valor
            else
            if comando = 'ESPERACRLF'       then esperaCRLF       := valor
            else
            if comando = 'ESPERAHOME'       then esperaHome       := valor
            else
            if comando = 'TABMEIATRAVA' then
                begin
                    for i := 0 to valor do
                        begin
                            {$I-}  readln (arqConfig, valor);  {$I+}
                            linha := linha + 1;
                            if ioresult <> 0 then goto errou;
                            tabMeiaTrava [i] := valor;
                        end;
                end
            else
                goto errou;

proxima:
        end;

    close (arqConfig);
    exit;

errou:
    close (arqConfig);
    write ('Erro em Braitemp.amb na linha ');
    writeln (linha);
    writeln ('Programa cancelado');
    halt;
end;

{--------------------------------------------------------}
{                inicializacao
{--------------------------------------------------------}

procedure inicializa;
begin
    clrscr;
    writeln ('---------------------------------------------------');
    writeln ('Programa de controle da Impressora Braille Mecanica');
    writeln ('Versao 2.0 de 18/03/98');
    writeln ('Projeto DOSVOX - NCE/UFRJ - 1997');
    writeln ('Convenio: Nucleo de Computacao Eletronica');
    writeln ('          Instituto Benjamin Constant');
    writeln ('---------------------------------------------------');
    writeln;

    carregaConfigBraille;
    carregaConfigMaquina;
    inicMaquina;
end;

{--------------------------------------------------------}
{                abre o arquivo a imprimir
{--------------------------------------------------------}

procedure abreArquivo;
var
    nomearq: string;
    c: char;
begin
    write ('Digite o nome do arquivo a imprimir: ');
    readln (nomearq);
    if nomearq = '' then halt;

    assign (arq, nomearq);
    {$i-}  reset (arq);  {$i+}
    if ioresult <> 0 then
        begin
            writeln ('Arquivo n„o foi achado');
            halt;
        end;

    close (arq);
    npag := 0;

    pularInic := 0;
    write ('Quantas linhas deixo de margem superior (sugiro 0): ');
    readln (pularInic);

    write ('Numero de linhas a imprimir na pagina (sugiro 30): ');
    readln (maxLinPag);

    write ('O auto-pulador de linhas esta'' instalado (s/n) ? ');
    readln (c);
    repulando := upcase (c) = 'N';

end;

{--------------------------------------------------------}
{                  imprime o arquivo
{--------------------------------------------------------}

procedure jogaNaImpressora;
var lido: char;
    i: integer;
    s: string;
    nlinImpr, primLinhaPag: integer;
    quanto: integer;

label ok, fim;

begin
    inicMaquina;
    nlinImpr := 0;

    write ('Quer comecar a impressao em que linha da pagina (sugiro 1): ');
    readln (primLinhaPag);
    writeln;
    writeln (#7, 'Coloque o cliche na maquina, botao start, e tecle ENTER');
    writeln ('Aperte ESC se quiser cancelar');
    lido := readkey;

    if lido = #$1b then
        begin
            writeln (#7, 'Desistiu...');
            if nlinImpr < 3 then lineFeed;
            crlf;
            goto fim;
        end;

    crlf;     { destrava a maquina }
    lineBack;

    for i := 1 to pularInic do
        lineFeed;

    repeat
        if eof (arq) then
            begin
                writeln (#7, #7, #7, #7, #7, 'Terminou arquivo !!!');
                goto fim;
            end;

        readln (arq, s);

        if s[1] = #$0c then
            goto fim;

        nlinImpr := nlinImpr + 1;
        if nlinImpr > maxLinPag then
            begin
                writeln (#7, #7, #7, 'Pagina muito longa, foi truncada');
                goto fim;
            end;

        for i := length (s) downto 1 do
            begin
                if s[i] <> ' ' then goto ok;
                delete (s, length(s), 1);
            end;
ok:
        if length (s) > 40 then
            begin
                s := copy (s, 1, 40);
                writeln (#7, #7, 'Linha truncada: nlinImpr...');
                writeln (s);
            end;

        if nlinImpr < primLinhaPag then
            s := '';

        while length (s) < 5 do s := s + ' ';  { mascara erro da impressora }

        for i := 1 to length (s) do
            begin
                caracBraille (tabBraille [s[i]]);
                if keypressed then
                    begin
                        lido := readkey;
                        if lido = #$1b then
                            begin
                                writeln (#7, #7, #7, 'Desistiu...');
                                crlf;
                                goto fim;
                            end;
                    end;
            end;

        if s = '' then
            lineFeed
        else
            begin
                quanto := tabMeiaTrava [length (s)];
                meiaTrava (quanto);
            end;

    until false;

fim:
    lineBack;
    home;
end;

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

procedure pulaPag (npul: integer);
var n: longint;
    c: char;
begin
    for n := 1 to npul do
        repeat
            if not eof (arq) then
                read (arq, c)
            else
                c := #$0c;
        until c = #$0c;
end;


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

procedure imprime;
begin
    npag := npag + 1;
    writeln;
    writeln ('Se voce teclar 0 (zero) eu termino...');
    write ('Informe o numero da pagina, sugiro ', npag, ': ');
    readln (npag);
    if npag = 0 then
        begin
            terminou := true;
            exit;
        end;

    reset (arq);
    pulaPag (npag-1);
    if not eof (arq) then
         jogaNaImpressora;
    close (arq);
end;

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

begin
    inicializa;
    abreArquivo;

    terminou := false;
    repeat
        imprime;
    until terminou;

    inicMaquina;
end.
