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

interface

procedure Draw_screen(f, offset_di, offset_dx, vaddr,vaddr2,vaddr3, output:word);
procedure Fblur2_(where:word);
PROCEDURE DrawLineH(X1,X2,Y1:integer; color:Byte;where:word);
PROCEDURE DrawLineH_add(X1,X2,Y1:integer; color, max:Byte;where:word);
PROCEDURE FillCircle3(centerX,centerY,radius:Integer; C:Byte;where:word);
PROCEDURE FillCircle_Add(centerX,centerY,radius:Integer; C, max:Byte;where:word);
procedure CircleRGB(x,y, d:integer; r,g,b:byte; buf_red, buf_green, buf_blue:word);
procedure CircleRGB_add(x,y, d:integer; r,g,b, max:byte;buf_red, buf_green, buf_blue:word);


implementation

const
MinScreenY = 1;
MaxScreenY = 197;

Procedure Fblur2_(where:word);assembler;
asm
push ds
     mov ds, where
     mov es, where
     mov bx, -1  {; smear's effect factor}
     mov si, 64000
     mov cx, 320*199/4
     @blur:
        db $66; mov ax, ds:[si]
        add al, ds:[si+bx  -4]
        add al, ds:[si-320 -4]
        add al, ds:[si+320 -4]
        shr al, 2
        db $66; mov ds:[si-321], ax
        sub si, 4
     dec cx
     jnz @blur
pop ds
end;


{convert RGB(18bit) to indexed 8-bit color with dithering}
procedure Draw_screen(f, offset_di, offset_dx, vaddr,vaddr2,vaddr3, output:word);
begin
if (f=0) or (f=2) then
asm
mov di, offset_di
mov dx, offset_dx

push ds
push bp
mov ax, vaddr2
db $8E,$E0 {mov fs, ax}
mov ax, vaddr3
db $8e,$e8; {mov gs,ax}
mov es, output
mov ds, vaddr

mov bp, dx
@y:{for y:=0 to 199 do for x:=0 to 319 do begin}

mov si, bp  {bayer y}
and si, 3
shl si, 3
add si, 64000-2 +3
db $66; mov dx, ds:[si]
mov dh, dl
db $66; rol dx, 16
mov dh, dl
db $66; rol dx, 16

mov si, 319
@x:

mov ah, ds:[di]
db $64; mov al, [di]
db $65; mov bl, [di]
add ax, dx
add bl, dl

{col:=byte( (r*8 div 64)*32 + (g*8 div 64)*4 + (b*4 div 64) );}
shl ah, 2
shr al, 1
shr bl, 4
and ax, 0e0fch
add al, ah
add al, bl
mov es:[di], al {mem[vga:n]:=col;}{inc(n);}

{--------------------------------------------}
db $66; rol dx, 16 {@s2: mov bh, ds:[si+1111h]}

mov ah, ds:[di+2]
db $64; mov al, [di+2]
db $65; mov bl, [di+2]
add ax, dx
add bl, dh

{col:=byte( (r*8 div 64)*32 + (g*8 div 64)*4 + (b*4 div 64) );}
shl ah, 2
shr al, 1
shr bl, 4
and ax, 0e0fch
add al, ah
add al, bl
mov es:[di+2], al {mem[vga:n]:=col;}{inc(n);}
add di, 4

db $66; rol dx, 16

sub si, 4
jns @x

add di, 320
sub bp, 2
jns @y
pop bp
pop ds
end;

if (f=1) or (f=3) then
asm
push ds
push bp
mov di, offset_di
mov dx, offset_dx

mov ax, vaddr2
db $8E,$E0 {mov fs, ax}
mov ax, vaddr3
db $8e,$e8; {mov gs,ax}
mov ds, vaddr
push 0a000h
pop es

mov bp, dx
@y:{for y:=0 to 199 do for x:=0 to 319 do begin}
mov si, bp  {bayer y}
and si, 3
shl si, 3
add si, 64000-2 +2
db $66; mov dx, ds:[si]
mov dh, dl
db $66; rol dx, 16
mov dh, dl
db $66; rol dx, 16

mov si, 318
@x:

mov ah, ds:[di]
db $64; mov al, [di]
db $65; mov bl, [di]
add ax, dx
add bl, dl

{col:=byte( (r*8 div 64)*32 + (g*8 div 64)*4 + (b*4 div 64) );}
shl ah, 2
shr al, 1
shr bl, 4
and ax, 0e0fch
add al, ah
add al, bl
mov es:[di], al {mem[vga:n]:=col;}{inc(n);}

{--------------------------------------------}
db $66; rol dx, 16 {@s2: mov bh, ds:[si+1111h]}

mov ah, ds:[di+2]
db $64; mov al, [di+2]
db $65; mov bl, [di+2]
add ax, dx
add bl, dh

{col:=byte( (r*8 div 64)*32 + (g*8 div 64)*4 + (b*4 div 64) );}
shl ah, 2
shr al, 1
shr bl, 4
and ax, 0e0fch
add al, ah
add al, bl
mov es:[di+2], al {mem[vga:n]:=col;}{inc(n);}
add di, 4

db $66; rol dx, 16

sub si, 4
jns @x

add di, 320
sub bp, 2
jns @y
pop bp
pop ds
end;
end;


PROCEDURE DrawLineH(X1,X2,Y1:integer; color:Byte;where:word);
BEGIN
if (y1<MinScreenY) or (y1>MaxScreenY) then exit;
if (x1<0) and (x2<0) then exit;
if (x1>319) and (x2>319) then exit;
if x1<0 then x1:=0;
if x1>319 then x1:=319;
if x2<0 then x2:=0;
if x2>319 then x2:=319;
     ASM
        mov  es, where
        mov  ax, y1
        mov  di, ax
        xchg ah, al     {y*256}
        shl  di, 6      {y*64}
        add  di, ax

        mov  cl, color  {set eax to color}
        mov  ch, cl
        mov  ax, cx
        db $66; shl ax, 16
        mov  ax, cx

        mov  bx, x1
        mov  dx, x2
{        cmp  bx, dx
        jl @skip_sort
        xchg bx, dx
        @skip_sort:
}
        add  di, bx     {start offset}

        inc  dx
        sub  dx, bx   {length}
        jz @exit; js @exit {}

                 test dx, 65520
                 jz @length_less_sixteen
                 mov  bx, dx
                 shr  bx, 4
                 @l16:
                    db $66; mov es:[di], ax
                    db $66; mov es:[di+4], ax
                    db $66; mov es:[di+8], ax
                    db $66; mov es:[di+12], ax
                    add di, 16
                    dec bx
                 jnz @l16

             @length_less_sixteen:
                 mov bx, dx
                 and bx, 15
                 shr bx, 2
                 jz @length_less_four
                 @l4:
                    db $66; mov es:[di], ax
                    add di, 4
                    dec bx
                 jnz @l4

             @length_less_four:
                 test dx, 2
                 jz @length_less_two
                    mov es:[di], ax
                    add di, 2
             @length_less_two:
                 test dx, 1
                 jz @exit
                    mov es:[di], al

             @exit:
  END;
END;



PROCEDURE DrawLineH_add(X1,X2,Y1:integer; color, max:Byte;where:word);
BEGIN
if (y1<MinScreenY) or (y1>MaxScreenY) then exit;
if (x1<0) and (x2<0) then exit;
if (x1>319) and (x2>319) then exit;
if x1<0 then x1:=0;
if x1>319 then x1:=319;
if x2<0 then x2:=0;
if x2>319 then x2:=319;
     ASM
        mov  es, where
        mov  ax, y1
        mov  di, ax
        xchg ah, al     {y*256}
        shl  di, 6      {y*64}
        add  di, ax

        mov  bx, x1
        mov  dx, x2
{        cmp  bx, dx
        jl @skip_sort
        xchg bx, dx
        @skip_sort:
}
        add  di, bx     {start offset}

        inc  dx
        sub  dx, bx   {length}
        jz @exit; js @exit {}

        mov bl, color
        mov bh, max

        test dx, 65532
        jz @length_less_four
        mov  cx, dx
        shr  cx, 2
        @ld:
          db $66; mov ax, es:[di]
          add al, bl; cmp al, bh; jbe @skip_clamp1; mov al, bh; @skip_clamp1:
          add ah, bl; cmp ah, bh; jbe @skip_clamp2; mov ah, bh; @skip_clamp2:
          db $66; ror ax, 16
          add al, bl; cmp al, bh; jbe @skip_clamp3; mov al, bh; @skip_clamp3:
          add ah, bl; cmp ah, bh; jbe @skip_clamp4; mov ah, bh; @skip_clamp4:
          db $66; ror ax, 16
          db $66; mov es:[di], ax
          add di, 4
          dec cx
        jnz @ld

     @length_less_four:
        test dx, 2
        jz @length_less_two
          mov ax, es:[di]
          add al, bl; cmp al, bh; jbe @skip_clamp5; mov al, bh; @skip_clamp5:
          add ah, bl; cmp ah, bh; jbe @skip_clamp6; mov ah, bh; @skip_clamp6:
          mov es:[di], ax
          add di, 2

     @length_less_two:
          test dx, 1
          jz @exit
          mov al, es:[di]
          add al, bl; cmp al, bh; jbe @skip_clamp7; mov al, bh; @skip_clamp7:
          mov es:[di], al

     @exit:
  END;
END;



PROCEDURE FillCircle3(centerX,centerY,radius:Integer; C:Byte;where:word);
VAR
   X,Y,m:Integer;
BEGIN
      x := 0;
      y := radius;
      m := 5 - 4 * radius;

      while (x <= y) do
      begin
        drawlineh(centerX - y, centerX + y, centerY - x, c, where);
        if x>0 then drawlineh(centerX - y, centerX + y, centerY + x, c, where);

        if (m > 0) then
        begin
          if x<>y then begin
          drawlineh(centerX - x, centerX + x, centerY - y, c, where);
          drawlineh(centerX - x, centerX + x, centerY + y, c, where);
          end;
          dec(y);
          m := m - y shl 3;
        end;

        inc(x);
        m:= m + (x shl 3 + 4);
      end;
end;

PROCEDURE FillCircle_Add(centerX,centerY,radius:Integer; C, max:Byte;where:word);
VAR
   X,Y,m:Integer;
BEGIN
      x := 0;
      y := radius;
      m := 5 - 4 * radius;

      while (x <= y) do
      begin
        drawlineh_add(centerX - y, centerX + y, centerY - x, c, max, where);
        if x>0 then drawlineh_add(centerX - y, centerX + y, centerY + x, c, max, where);

        if (m > 0) then
        begin
          if x<>y then begin
          drawlineh_add(centerX - x, centerX + x, centerY - y, c, max, where);
          drawlineh_add(centerX - x, centerX + x, centerY + y, c, max, where);
          end;
          dec(y);
          m := m - y shl 3;
        end;

        inc(x);
        m:= m + (x shl 3 + 4);
      end;
end;

procedure CircleRGB(x,y, d:integer; r,g,b:byte; buf_red, buf_green, buf_blue:word);
begin
   if r>0 then FillCircle3(x,y,d, r, buf_red);
   if g>0 then FillCircle3(x,y,d, g, buf_green);
   if b>0 then FillCircle3(x,y,d, b, buf_blue);
end;

procedure CircleRGB_add(x,y, d:integer; r,g,b, max:byte;buf_red, buf_green, buf_blue:word);
begin
   if r>0 then FillCircle_Add(x,y,d, r, max, buf_red);
   if g>0 then FillCircle_Add(x,y,d, g, max, buf_green);
   if b>0 then FillCircle_Add(x,y,d, b, max, buf_blue);
end;




end.