
UNIT Colors;

interface

uses Global;

  procedure InitColors;

  procedure GetPalette( var RGB; from : byte; count : word);
  procedure SetPalette( var RGB; from : byte; count : word);
  procedure DimPalette( var RGB; col : byte );


{ ... }
  procedure FadeToColor(   var FromPalette : PAL;
                               r, g, b : byte;
                               Steps : byte );
  procedure FadeFromColor( var ToPalette : PAL;
                               r, g, b : byte;
                              Steps : byte );
  procedure WaitVR;
{ ... }


implementation

procedure GetPalette( var RGB; from : byte; count : word); external;
procedure SetPalette( var RGB; from : byte; count : word); external;
procedure DimPalette( var RGB; col : byte ); external;
{$L pal.obj}


procedure RGBPalette; external;
{$L colors.oop}

procedure InitColors;
begin
  Move( @RGBPalette^, RGB, sizeof(RGB) );
end;


{ ... }
{ // WaitVR : wait for vertical retrace to start // }

procedure WaitVR; assembler;    { must preserve cx, and ds:si }
asm
  mov dx, $3da
@1:
  in al, dx
  test al, 8   { wait till out of VR }
  jnz @1
@2:
  in al, dx
  test al, 8   { wait till in VR }
  jz @2
end;

{ // CrossFade : fade from one palette to another // }

procedure CrossFade( var FromPalette, ToPalette : PAL;
                         Steps : byte );
var  Palette : PAL;
     k : word;
begin
  Palette := FromPalette;
  if Steps < 0 then Steps := 0;
  if Steps > 64 then Steps := 64;
  for k := Steps downto 1 do begin
     asm
       les di, ToPalette
       lea si, Palette
       mov bx, K
       mov cx, 3*256
    @1:
       mov al, [es:di]
       mov bh, [ss:si]
       sub al, bh
       cbw
       idiv bl
       add bh, al
       test bh, $c0
       jnz @2
       mov [ss:si], bh
     @2:
       inc di
       inc si
       loop @1
     end;
     WaitVR;
     SetPalette( Palette, 0, 256 );
  end;
end;

{ // FadeToColor : fade palette to a single color // }

procedure FadeToColor( var FromPalette : PAL;
                           r, g, b : byte;
                           Steps : byte );
var  Palette : PAL;
     C : CRGB;
     i : byte;
begin
   C[0] := r;   C[1] := g;   C[2] := b;
   for i := 0 to 255 do Palette[i] := C;
   CrossFade( FromPalette, Palette, Steps );
end;

{ // FadeFromColor : fade from a single color to palette // }

procedure FadeFromColor(var ToPalette : PAL;
                            r, g, b : byte;
                            Steps : byte );
var Palette : PAL;
     C : CRGB;
     i : byte;
begin
   C[0] := r;   C[1] := g;   C[2] := b;
   for i := 0 to 255 do Palette[i] := C;
   CrossFade( Palette, ToPalette, Steps );
end;

{ ... }


END.

