uses crt, graph;

var s: string;
    nomearq: string;
    arq: text;
    tabBraille: array [char] of byte;
    margem, pagInic: integer;
    altLetra: integer;
    bm, brancos: pointer;
    lin, pag: integer;

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

{--------------------------------------------------------}
{          pega defaults da codificacao Braille
{--------------------------------------------------------}

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

label proxima, erro;

begin
    for i := 0 to 255 do
        tabBraille [chr(i)] := 0;
    ambBraille := 'C:\TURBO\BRAILEX.AMB';

    assign (arqConfig, ambBraille);
    {$I-} reset (arqConfig); {$I+}

    if ioresult <> 0 then
        begin
            ambBraille := 'C:\DOSVOX\BRAILEX.AMB';
            assign (arqConfig, ambBraille);
            {$I-} reset (arqConfig); {$I+}
            if ioresult <> 0 then
                begin
                    writeln ('Arquivo brailex.amb nao encontrado');
                    halt;
                end;
        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;

        exit;

erro:
    close (arqConfig);
    writeln ('Erro de configuracao na linha ', (linha-1) * 4);
    halt;
end;

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

procedure inicializa;
var c: char;
    i: integer;
label fim;

begin
    writeln ('Visualizador de impressao braille - v1.0');
    writeln ('Projeto DOSVOX - NCE/UFRJ - IBC');
    writeln;

    write ('Nome do rascunho de impressao braille a ver: ');
    readln (nomearq);
    if nomearq = '' then halt;

    assign (arq, nomearq);
    {$I-}  reset (arq);  {$I+}
    if ioresult <> 0 then
        begin
            writeln ('Arquivo nao encontrado');
            halt;
        end;

    write ('Pagina inicial (sugiro 1): ');
    readln (pagInic);
    write ('Margem desejada inicial (sugiro 40): ');
    readln (margem);

fim:
    getmem (brancos, 32+30*80);
end;

{--------------------------------------------------------}
{                   mostra braille na tela
{--------------------------------------------------------}

procedure mostraTela (s: string);

    procedure ponto (x, y: integer);
    begin
        putpixel (x, y, 1);
        putpixel (x+1, y, 1);
    end;


    procedure scrollUp;
    begin
        getImage (0, 30, 639, 199, bm^);
        putImage (0, 0, bm^, normalput);
        putImage (0, 200-30, brancos^, normalput);
    end;

var i, x, y, cod: integer;
    n1, n2: string;

begin
    scrollUp;
    str (pag:2, n1);
    str (lin:2, n2);

    outTextXY(0, 200-20, n1+' '+n2);
    line (54, 0, 54, 639);
    line ((margem+5)*12-2, 0, (margem+5)*12-2, 639);

    for i := 1 to length (s) do
        outTextXY ((i+4) * 12, 200-20, s[i]);

    for i := 1 to length (s) do
        begin
            cod := tabBraille [s[i]];
            x := (i+4) * 12;
            y := 200-8;

            if (cod and 1)  <> 0 then  ponto (x, y);
            if (cod and 2)  <> 0 then  ponto (x, y+3);
            if (cod and 4)  <> 0 then  ponto (x, y+6);
            if (cod and 8)  <> 0 then  ponto (x+5, y);
            if (cod and 16) <> 0 then  ponto (x+5, y+3);
            if (cod and 32) <> 0 then  ponto (x+5, y+6);
        end;
end;

{--------------------------------------------------------}
{                coloca tela em modo grafico
{--------------------------------------------------------}

procedure modoGrafico;
var
    grDriver : Integer;
    grMode   : Integer;
    ErrCode  : Integer;
begin
    grDriver := CGA;
    grMode := CGAHi;
    InitGraph(grDriver,grMode, 'C:\TURBO');
    ErrCode := GraphResult;
    if ErrCode <> grOk then
        begin
            closeGraph;
            grDriver := CGA;
            grMode := CGAHi;
            InitGraph(grDriver,grMode, 'C:\DOSVOX');
            ErrCode := GraphResult;
            if errCode <> grOk then
                begin
                    writeln ('Modo grafico nao inicializado');
                    close (arq);
                    halt;
                end;
        end;

    getmem (brancos, 32+31*80);
    getmem (bm, 32+word(640*200));
    getImage (0, 0, 639, 29, brancos^);
end;

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

var
    i: integer;
    c: char;

begin
    inicializa;
    carregaConfigMatricial;
    modoGrafico;

    altLetra := 8;
    c := ' ';
    pag := 1;
    lin := 0;

    while (not eof (arq)) and (c <> #$1b) do
        begin
            readln (arq, s);
            while (s <> '') and (s[1] = #$1b) do
                 delete (s, 1, 3);

            lin := lin + 1;
            if s [1] = #$0c then
                begin
                    delete (s, 1, 1);
                    lin := 1;
                    pag := pag + 1;
                    line (0, 199, 639, 199);
                end;

            if pag >= pagInic then
                begin
                    mostraTela (s);
                    c := readkey;
                end;
        end;

    close (arq); 
    textmode (lastmode);
    freemem (brancos, 32+31*80);
    freemem (bm, 32+word(640*200));
end.
