old/PAS/!SPbSTU/Graph/BG2-GEN.PAS

{$G+}
Uses Graph;
const
 table :array [0..15] of byte  = (0,1,2,Yellow,Blue,5,6,7,8,9,10,Yellow,LightBlue,13,14,15);
{ table : array [0..15] of byte  = (0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15);}

type
 ReadBuf = array [0..13999] of byte;

var
 inp,outp : file;
 R,G,B,A  : ^ReadBuf;
 Size     : Word;
 k,i,j,pos: word;
 x,y      : word;
 val,nR,nG,nB,nA   : byte;
{ gD,gM    : Integer;}

Procedure Mega;
begin
  pos := 0;
  for i := 1 to y shr 1 do
  begin
    for j := 1 to x shr 3 do
     begin
      nR := 0;nG := 0;nB := 0;nA := 0;
      for k := 1 to 4 do
       begin
        BlockRead(INP,val,1);
        nR:=nR shl 1;nG:=nG shl 1;nB:=nB shl 1;nA:=nA shl 1;
        nA := nA or ((table[(val shr 4) and $F] and 8) shr 3);
        nR := nR or ((table[(val shr 4) and $F] and 4) shr 2);
        nG := nG or ((table[(val shr 4) and $F] and 2) shr 1);
        nB := nB or (table[(val shr 4) and $F] and 1);
        nR:=nR shl 1;nG:=nG shl 1;nB:=nB shl 1;nA:=nA shl 1;
        nA := nA or ((table[val and $F] and 8) shr 3);
        nR := nR or ((table[val and $F] and 4) shr 2);
        nG := nG or ((table[val and $F] and 2) shr 1);
        nB := nB or (table[val and $F] and 1);
       end;
      R^[pos]:=nR; G^[pos]:=nG; B^[pos]:=nB; A^[pos]:=nA;
      inc(pos);
     end;
     Seek(INP,FilePos(INP)-640);
  end;
end;

Procedure Mega2;
begin
  BlockWrite(OUTP,B^,Size shr 2);
  BlockWrite(OUTP,G^,Size shr 2);
  BlockWrite(OUTP,R^,Size shr 2);
  BlockWrite(OUTP,A^,Size shr 2);
end;
begin
{ gD:=VGA;
 gM:=VGAMed;

 InitGraph(gD,gM,'');}

 Assign(outp,'BG2.dat');
 ReWrite(outp,1);

 Assign(inp,'BG.bmp');
 Reset(inp,1);

 New(R);New(G);New(B);New(A);

  Seek(INP,$12);
  BlockRead(inp,x,4);
  BlockRead(inp,y,4);
  Seek(Inp,FileSize(INP)-(640 div 2));

  i:=2;
  BlockWrite(OUTP,i,1);
  Size := SizeOf(readBuf)*4;
  BlockWrite(OUTP,Size,2);

  i:=0;
  BlockWrite(OUTP,i,2);
  BlockWrite(OUTP,i,2);
  i:=640;
  BlockWrite(OUTP,i,2);
  i:=y shr 1;
  BlockWrite(OUTP,i,2);

  Mega;
  WriteLn('Done(1)');
  Mega2;

  BlockWrite(OUTP,Size,2);
  i:=0;
  BlockWrite(OUTP,i,2);
  i:=y shr 1;
  BlockWrite(OUTP,i,2);
  i:=640;
  BlockWrite(OUTP,i,2);
  i:=y shr 1;
  BlockWrite(OUTP,i,2);

  Mega;
  WriteLn('Done(2)');
  Mega2;


 Close(INP);
 Close(OUTP);

 Dispose(R);Dispose(G);Dispose(B);Dispose(A);
end.
Procedure GetImage(ypos,ysize:word;toP : pointer);assembler;
var
 Beg:pointer;
 size : word;
asm
 push ds

 mov bx, 0A000h

 mov ax, ypos  {Calculate ypos}
 push ax
 shl ax, 4     {1}
 pop cx
 shl cx, 6     {2}
 add ax, cx    {1 and 2 -> mul 640/8}

 push ax
 shr ax, 4
 add bx, ax
 pop ax
 and ax, 0Fh

 mov word ptr Beg, ax
 mov word ptr Beg+2, bx

 les di, toP
 mov ax, 0005h
 mov dx, 03CEH
 out dx, ax
 mov dx, 03C4h

 mov bx, ysize
 push bx
 shl bx, 5
 pop ax
 shl ax, 3
 add bx, ax
 mov size, bx

 mov bx, 0102h
@1:
 mov ax, bx
 add bx, 0100h
 out dx, ax
 push ds
 lds si, Beg
 mov cx, size
 repe movsw
 pop ds

 cmp bx, 502h
jne @1

 mov dx, 3C4H
 mov ax, 0F02h
 out dx, ax
 pop ds
end;