{$N+,A+,G+,F+,D-,E-,L-,R-,S-,Q-,Y-,I-}
unit crosfade;

interface

procedure DitherFade(q, col, gradient, where:word);
procedure DitherFadeInit(where:word);
function DitherFade2(q, col, gradient, where:word):byte;

implementation
const
pattern64: array[0..8*8-1] of byte =
( 0,48,12,60, 3,51,15,63,
  32,16,44,28,35,19,47,31,
  8,56, 4,52,11,59, 7,55,
  40,24,36,20,43,27,39,23,
  2,50,14,62, 1,49,13,61,
  34,18,46,30,33,17,45,29,
  10,58, 6,54, 9,57, 5,53,
  42,26,38,22,41,25,37,21);


procedure DitherFadeInit(where:word);
var n:word;
begin
for n:=0 to 63 do memw[where:n shl 1 +65535-128]:=word(pattern64[n]);
end;

procedure DitherFade(q, col, gradient, where:word);
var n:integer;
begin
n:=-255+q;
asm
push ds
push bp
mov es, where

xor si, si
mov ax, n
mov dh, byte ptr col

mov ds, gradient
mov bp, ax
mov dl, 200/4
@y:
   db $0f,$b6,$fa {movzx di, dl}
   shl di, 2
   and di, 7
   shl di, 4

   xor ax, ax
   mov cx, 320
   @x:
   {c:=mem[TunTexSeg:y*320+x];}
   mov al, ds:[si]
      test al, al{if c>0 then begin}
      jz @skip
         xor ah, ah
         add ax, bp{c:=c+n;}
         {if pattern64[(x and 7)+(y and 7)*8] >= c then mem[vaddr:y*320+x]:=63;}

         mov bx, cx
         and bx, 7
         add bx, bx
         cmp es:[di+bx+65535-128], ax
         jl @skip0
            mov byte ptr es:[si],     dh
         @skip0:
         cmp es:[di+bx+65535-128  +8*2], ax
         jl @skip1
            mov byte ptr es:[si+320], dh
         @skip1:
         cmp es:[di+bx+65535-128  +16*2], ax
         jl @skip2
            mov byte ptr es:[si+640], dh
         @skip2:
         cmp es:[di+bx+65535-128  +24*2], ax
         jl @skip
            mov byte ptr es:[si+960], dh
      @skip:
      inc si
   dec cx
   jnz @x
   add si, 320*3
dec dl
jnz @y
pop bp
pop ds
end;
end;

function DitherFade2(q, col, gradient, where:word):byte;
var xx,yy,y:word;
n:integer;
begin
n:=-255+q;
yy:=0;
for y:=0 to 9 do begin
asm
mov es, where
mov ax, gradient
db $8e,$e0 {mov fs, ax}
xor di, di
mov word ptr xx, 0
mov dh, byte ptr col

mov cx, 16
@x:  {for x:=0 to 15 do begin}
push cx
push di

{c:=mem[gradient:x+y shl 4];}
mov bx, y
shl bx, 4
xor ah, ah
db $64; mov al, [di+bx]
add ax, n {c:=c+n;}
cmp ax, 64
jg @nodraw

{screen offset_:=xx+yy;}
mov si, xx
add si, yy

cmp ax, 0
jl @just_fill

mov dl, 20/4
@y_:
   db $0f,$b6,$fa {movzx di, dl}
   shl di, 2
   and di, 7
   shl di, 4

   mov cx, 20
   @x_:
         {if pattern64[(x and 7)+(y and 7)*8] >= c then mem[vaddr:y*320+x]:=63;}
         mov bx, cx
         and bx, 7
         add bx, bx
         cmp es:[di+bx+65535-128],        ax
         jl @skip0
             mov byte ptr es:[si],     dh
         @skip0:
         cmp es:[di+bx+65535-128  +8*2],  ax
         jl @skip1
             mov byte ptr es:[si+320], dh
         @skip1:
         cmp es:[di+bx+65535-128  +16*2], ax
         jl @skip2
             mov byte ptr es:[si+640], dh
         @skip2:
         cmp es:[di+bx+65535-128  +24*2], ax
         jl @skip
             mov byte ptr es:[si+960], dh
         @skip:
   inc si
   dec cx
   jnz @x_
   add si, 320*4-20
dec dl
jnz @y_
jmp @nodraw

@just_fill:
mov di, si
mov al, dh
mov ah, al
db $66; shl ax, 16
mov al, dh
mov ah, dh
mov dl, 20
@y_fill:
   mov cx, 20/4
   db $66; rep stosw
   add di, 320-20
dec dl
jnz @y_fill

@nodraw:
pop di
pop cx
add xx, 20
inc di
dec cx
jnz @x
end;
 yy:=yy+(320*20);
 end;

if n>=64 then DitherFade2:=0 {экран пустой}
else if n<=-256 then DitherFade2:=1 {экран заполнен}
else DitherFade2:=2; {в процессе}
end;


end.