PROGRAM dib;
USES graph;
TYPE
    tlinea=ARRAY[1..16] OF byte;
    tplano=ARRAY[1..4] OF word;
VAR
   f:file;
   i,j,k:word;
   b:tplano;
   linea:tlinea;
   paleta:ARRAY[1..16] OF word;
   p:pointer;
   tamano:word;

{$F+}
function TestDetect : Integer;
begin
  TestDetect:=0; { Modo en el que se desea poner la tarjeta de video }
end;
{$F-}

PROCEDURE graficos;
Var
  Driver, Mode, TestDriver,
  ErrCode  : Integer;

begin
  TestDriver :=InstallUserDriver('SVGA256',@TestDetect);
  if GraphResult <> grOk then
  begin
    WriteLn('Error installing TestDriver');
    Halt(1);
  end;
  Driver := Detect;
  InitGraph(Driver, Mode, '');
  ErrCode := GraphResult;
  if ErrCode <> grOk then
  begin
    WriteLn('Error during Init: ', ErrCode);
    Halt(1)
  end
end;

PROCEDURE texto;
BEGIN
     closegraph
END;

PROCEDURE convierte (b1,b2,b3,b4:word;VAR linea);ASSEMBLER;
ASM
            les  di,linea
            mov  cx,8
            xor  ax,ax
            rep  stosw

            mov  ax,b1
            mov  bx,b2
            mov  cx,b3
            mov  dx,b4
            xchg ah,al
            xchg bh,bl
            xchg ch,cl
            xchg dh,dl
            xor  si,si
            les  di,linea

 @bucle:    shl  ax,1
            jnc  @men8
            mov  si,8
 @men8:     shl  bx,1
            jnc  @men4
            add  si,4
 @men4:     shl  cx,1
            jnc  @men2
            add  si,2
 @men2:     shl  dx,1
            jnc  @men1
            inc  si
 @men1:     push ax
            mov  ax,si
            stosb
            pop  ax
            mov  si,ax
            or   si,bx
            or   si,cx
            or   si,dx
            jnz  @bucle
END;



PROCEDURE setpal;
VAR
   i:byte;
   r,g,b:byte;
BEGIN
     FOR i:=1 TO 16 DO
     BEGIN
          r:=8*(lo(paleta[i]) AND $0f);
          g:=8*(hi(paleta[i]) shr 4);
          b:=8*(hi(paleta[i]) and $0f);
          ASM
             xor bh,bh
             mov bl,i
             mov dh,r
             mov ch,g
             mov cl,b
             mov ax,1010h
             int 10h
          END
     END
END;



BEGIN
     assign(f,'DMAP3.CHR');
     reset(f,1);
     blockread(f,paleta,sizeof(paleta));
     blockread(f,tamano,2);
     graficos;
     tamano:=imagesize(0,0,15,12);
     getmem(p,tamano);
     {setpal;}
     FOR k:=1 TO 75 DO
     BEGIN
          FOR i:=0 TO 12 DO
          BEGIN
               blockread(f,b,sizeof(b));
               convierte(b[1],b[2],b[3],b[4],linea);
               FOR j:=0 TO 15 DO
                   PutPixel (j,i,linea[j+1]);
              
          END;
          getimage(0,0,15,12,p^);
          readln
     END;
     close(f);
     freemem(p,tamano)
END.

