uses screen, memory, crt, dos;

const
VGA=$a000;
 REZ160 = 160;
 REZ320 = 0;

var
  TunTex           : Pointer;
TunTexSeg         : Word;
  COL_ADD_160:byte;
  DITHER_MASK_160:byte;
  BUFFER_160:word;

procedure copyblock10(x,y:integer; col, resolution:byte; from, where:word);
begin
if resolution=REZ320 then
asm
   push ds
   mov  es, where
   mov  si, x
   mov  cx, y
   xchg ch, cl {calc start offset  (y*320+x1)}
   add  si, cx
   shr  cx, 2
   add  si, cx
   mov  di, si

   mov  ds, from

   mov  dx, 20
   @y:
        {db $66; mov ax, ds:[si]
        db $66; mov es:[si], ax
        db $66; mov ax, ds:[si+4]
        db $66; mov es:[si+4], ax
        db $66; mov ax, ds:[si+8]
        db $66; mov es:[si+8], ax
        db $66; mov ax, ds:[si+12]
        db $66; mov es:[si+12], ax
        db $66; mov ax, ds:[si+16]
        db $66; mov es:[si+16], ax}
        mov cx, 5; db $66; rep movsw;

   add si, 320-20
   add di, 320-20
   dec dx
   jnz @y
   pop ds
end
else
asm
   push ds
   push bp
   mov  es, where
   mov  di, x
   mov  si, di

  {-------------self-modding----------------}
           {fix for last column}
{   mov al, 66h {prefix for opcode}
{   cmp di, 300; jl @write {if x>=300 then}
{     mov al, 90h {nope}
{   @write:
{   mov cs:[offset @fix], al
   {jmp @clear_prefetch; @clear_prefetch:}
  {-----------------------------------------}

   mov  dx, y
   xchg dh, dl {calc start offset  (y*320+x1)}
   add  di, dx
   shr  dx, 2
   add  di, dx

   mov dx, y
   shr dx, 1
   {imul dx, dx, 160}
   mov ax, dx
   shl ax, 7 {*128}
   shl dx, 5 {*32}
   add dx, ax
   shr si, 1
   add si, dx

   mov cl, DITHER_MASK_160
   mov ch, cl
   mov dx, cx
   db $66; shl cx, 16
   mov cx, dx

   mov al, col
   mov ah, al
   mov dx, ax
   db $66; shl ax, 16
   mov ax, dx

   mov ds, from
   db $66; mov bp, cx {8080h; dw $8080}
   mov cx, 20
   @y:
        {select dither pattern}
        mov  bl, ch
        and  bl, 3; jnz @sk0
              db $66; mov bx, 0A02h; dw $0800 {0,8,2,10} jmp @go
        @sk0: cmp bl, 1; jne @sk1
              db $66; mov bx, 060Eh; dw $040C {12,4,14,6}jmp @go
        @sk1: cmp bl, 2; jne @sk2
              db $66; mov bx, 0901h; dw $0B03 {3,11,1,9} jmp @go
        @sk2: db $66; mov bx, 050Dh; dw $070F {15,7,13,5}
        @go:

     db $66; mov dx, ds:[si]
     db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
     db $66; mov es:[di], dx
     db $66; mov dx, ds:[si+2]
     db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
     db $66; mov es:[di+4], dx
     db $66; mov dx, ds:[si+4]
     db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
     db $66; mov es:[di+8], dx
     db $66; mov dx, ds:[si+6]
     db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
     db $66; mov es:[di+12], dx
     @fix: db $66; mov dx, ds:[si+8]
     db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
     db $66; mov es:[di+16], dx
     add di, 320
     inc ch
     jp @add_si
     dec cl; jnz @y; jmp @exit
     @add_si: add si, 160; dec cl; jnz @y
   @exit:
   pop bp
   pop ds
end;
end;

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;pal_on:byte);
Var
  InF   : File; Loop : Word;
  Dummy : Array[1..18] of Byte;
  Pal   : Array[1..768] of Byte;

Begin
  Assign(Inf,TgaName);
  Reset(Inf,1);
  BlockRead(Inf,Dummy,18);
  BlockRead(Inf,Pal,768);
  BlockRead(Inf,TunTex^,64000);
  Close(Inf);
  Port[$3C8]:=0;
  Loop:=1;
  if pal_on=1 then
  While Loop<768 Do
    Begin
      Port[$3C9]:=Pal[Loop+2] Div 4;
      Port[$3C9]:=Pal[Loop+1] Div 4;
      Port[$3C9]:=Pal[Loop] Div 4;
      Inc(Loop,3);
    End;
End;


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


var
fw1,fw2:file;

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

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

BUFFER_160:=vaddr2;

asm
mov ax, 13h
int 10h
end;

GetMem(TunTex,65535); TunTexSeg:=Seg(TunTex^);
LoadTga('c:\bp\demoded\scenes\plasma\tools\palette.tga',1);{}

for y:=0 to 199 do for x:=0 to 255 do mem[vga:x+y*320]:=x;


COL_ADD_160:=9;
DITHER_MASK_160:=254;

for y:=0 to 31 do for x:=0 to 31 do mem[buffer_160:x+y*160]:=(y xor x) and 15 +1;

for y:=0 to 4 do for x:=0 to 4 do
copyblock10(x*20,y*20, COL_ADD_160, REZ160, BUFFER_160, vga);

readkey;

for n:=254 downto 1 do begin
r:=round(cos(n/21)*31+32);
g:=round(cos(n/25+1)*31+32);
b:=round(cos(n/28+2)*31+32);

SetOneColor(n,r,g,b);
end;

COL_ADD_160:={76} 200;
DITHER_MASK_160:=128;

for y:=0 to 4 do for x:=0 to 4 do
copyblock10(x*20,y*20, COL_ADD_160, REZ160, BUFFER_160, vga);


readkey;
asm
mov ax, 3h
int 10h
end;

end.