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 TextGen3(where:word);
var
m,n, xu,yu, y,x, xx,yy,s:integer;
offs:word;
begin
xx:=0;
yy:=0;
s:=25;

for y:=0 to 199 do for x:=0 to 256 do begin
mem[vga:word(y*320+x)]:=1;
end;


for m:=0 to 6 do begin
for n:=0 to 5 do begin
    for y:=0 to s do for x:=0 to s do
    begin
         xu:=abs(x+x-s) div 2+1;
         yu:=abs(y+y-s);

         offs:=word(x+(y+yy)*320+xx);
         if (xu<s div 2) and (xu+yu<s) then
         if ((m+1) and 1) + (n mod 3) <> 2 then
         mem[vga:offs]:=17;

    end;
xx:=xx+s+1;

end;
yy:=yy+ (s div 1) - (s div 4) +2;
xx:=(s div 2) *((m+1) and 1) ;

end;

n:=0;
for y:=0 to 127 do for x:=0 to 127 do begin
mem[where:word(n*2)]:=            4*(mem[vga:word(x+(y+12)*320)+s div 2]);{}
mem[where:word(n*2)+128*128*2]:=  4*(mem[vga:word(x+(y+12)*320)+s div 2]);{}

mem[where:word(n*2+1)]        :=  4*(mem[vga:word(x+(y+12)*320)+s div 2])+2;{}
mem[where:word(n*2+1)+128*128*2]:=4*(mem[vga:word(x+(y+12)*320)+s div 2])+3;{}
inc(n);

mem[vga:word(x+(y+12)*320)+s div 2]:=mem[vga:word(x+(y+12)*320)+s div 2]+2;{}
end;
end;


var
fw1,fw2:file;

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

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

z:=0;

asm
mov ax, 13h
int 10h
end;

{LoadTga('c:\bp\demo\bump\bump_t2.tga', 65535, vaddr);}

TextGen3(vaddr);
for m:=0 to 63 do begin
n:=m div 2;
SetOneColor((63-m)*4,  n+3, n +8,  n +15);{}
SetOneColor((63-m)*4+1,n+1, n +2,  n);{}
SetOneColor((63-m)*4+2,n+14, n +14,  n+14 );{}
SetOneColor((63-m)*4+3,n+5, n +10, n +12);{}
end;

for m:=0 to 255 do begin
readonecolor(m,r,g,b);
palitra[m*3]:=r;
palitra[m*3+1]:=g;
palitra[m*3+2]:=b;
end;
  Assign(fw1, 'textgen3.pal');
  Rewrite(fw1,1);
  Reset(fw1, 1);
  for i:=0 to 767 do begin
    BlockWrite(fw1, z, 1);
    BlockWrite(fw1, palitra[i], 1);
  end;
  Close(fw1);

readkey;


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

  Assign(fw1, 'textgen3.bin');
  Rewrite(fw1,1);
  Reset(fw1, 1);
  for i:=0 to 65535 do BlockWrite(fw1, mem[vaddr:i], 1);
  Close(fw1);

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;



repeat
{Clear(64000, vaddr);}





WaitVR;{}
{FlipScreen(vaddr,vga);{}
until port[$60]=1;

asm
mov ax, 3h
int 10h
end;
readkey;
repeat until keypressed;

end.