uses screen, memory, crt, dos;

const
VGA=$a000;

procedure setonecolor(c,r,g,b:byte);assembler;
asm
  mov dx,3c8h
  mov al,c
  out dx,al
  inc dx
  mov al,r
  out dx,al
  mov al,g
  out dx,al
  mov al,b
  out dx,al
end;

procedure readonecolor(c:byte;var r,g,b:byte);assembler;
asm
  mov dx,3c7h
  mov al,c
  out dx,al
  add dx,2
  in  al,dx
  les di,r
  mov [es:di],al
  in  al,dx
  les di,g
  mov [es:di],al
  in  al,dx
  les di,b
  mov [es:di],al
end;


var palitra, palitra2:array[0..767] of byte;

Procedure LoadTga(TgaName : String; size, where:word);
Var
  InF   : File of byte; Loop : Word;
  Dummy : Array[1..18] of Byte;
  Pal   : Array[1..768] of Byte;
  n:word;
  tmp,r,g,b:byte;
Begin
  Assign(Inf,TgaName);
  Reset(Inf);
  for n:=0 to 17 do read(inf,tmp);
  for n:=1 to 768 do read(inf,pal[n]);
  for n:=0 to size do read(inf, mem[where:n]);
  Close(Inf);
{  Port[$3C8]:=0;}
  Loop:=1;
  n:=0;
  While Loop<768 Do
    Begin
      r:=Pal[Loop+2] Div 4;
      g:=Pal[Loop+1] Div 4;
      b:=Pal[Loop] Div 4;
      palitra[n]:=r;
      palitra[n+1]:=g;
      palitra[n+2]:=b;

      Port[$3C9]:=r;
      Port[$3C9]:=g;
      Port[$3C9]:=b;
      n:=n+3;
      Inc(Loop,3);
    End;
End;

procedure save_palitra(name:string);
var fw1:file;
i:word;
begin
Assign(fw1, name);
Rewrite(fw1,1);
Reset(fw1, 1);
for i:=0 to 767 do BlockWrite(fw1, palitra2[i], 1);
Close(fw1);
end;

procedure save_texture(name:string);
var fw1:file;
i:word;
begin
Assign(fw1, name);
Rewrite(fw1,1);
Reset(fw1, 1);
for i:=0 to 65535 do BlockWrite(fw1, mem[vaddr:i], 1);
Close(fw1);
end;

procedure TextConv(num:byte; where:word);
var
m,n,y,x:integer;
s,c, t:byte;
offs:word;
begin

for y:=0 to 127 do for x:=0 to 127 do begin
mem[vga:word(y*320+x)]:=mem[vaddr2:y*128+x];
end;


n:=0;
for y:=0 to 127 do for x:=0 to 127 do begin
c:=mem[vga:word(x+y*320)];
s:=c div 64; {выбор цветового профиля (4 градиента по 64 цветов)}


   if (num=0) then begin
      mem[where:word(n*2)]:=            4*c+s;
      mem[where:word(n*2)+128*128*2]:=  4*c+s;
   end;

   if (num=1) then begin
       mem[where:word(n*2+1)]        :=  4*c+s;
       mem[where:word(n*2+1)+128*128*2]:=4*c+s;
   end;

   inc(n);

{mem[vga:word(x+y*320)]:=mem[vga:word(x+(y)*320)]+20;{}
end;
end;


var
fw1,fw2:file;

c, i, x,y,n,m:word;
fr:file;
r,g,b:byte;
size:word;

begin
SetUpVirtual(scr,vaddr);
SetUpVirtual(scr2, vaddr2);
SetUpVirtual(scr3, vaddr3);

asm
mov ax, 13h
int 10h
end;

LoadTga('vorona.tga', 128*128, vaddr2);
TextConv(0, vaddr);
LoadTga('wors.tga', 128*128, vaddr2);
TextConv(1, vaddr);



readkey;
{-----------------------------------------}


for i:=0 to 63 do
  for n:=0 to 2 do begin
     palitra2[(i*3)*4+n]:=palitra[(i*3)+n];
     palitra2[(i*3)*4+n+3]:=palitra[(i*3)+n+64*3];
     palitra2[(i*3)*4+n+6]:=palitra[(i*3)+n+128*3];
     palitra2[(i*3)*4+n+9]:=palitra[(i*3)+n+192*3];
  end;

save_texture('btex2_0.bin');


{--------------------preview---------------------------}

for n:=0 to 255 do setonecolor(n, palitra2[n*3], palitra2[n*3+1], palitra2[n*3+2]);

for y:=190 to 199 do for x:=0 to 255 do mem[vga:x+y*320]:=x;
setonecolor(0,23,23,23);

n:=0;
for y:=0 to 127 do for x:=0 to 127 do begin
mem[vga:x+y*320] := mem[vaddr:word(n*2)];
mem[vga:x+130+y*320] := mem[vaddr:word(n*2)+128*128*2];
inc(n);
end;

readkey;

n:=0;
for y:=0 to 127 do for x:=0 to 127 do begin
mem[vga:x+y*320] := mem[vaddr:word(n*2+1)];
mem[vga:x+130+y*320] := mem[vaddr:word(n*2+1)+128*128*2];
inc(n);
end;


readkey;

asm
mov ax, 3h
int 10h
end;

end.