{$MODESWITCH ALLOWINLINE}
unit dcolors;

interface

uses
  dtypes,
  dstrnum,
  dmath,
  dvector4f;

type
  TColor = TUint32;

function Grey(L: TUint8; A: TUint8 = 255): TColor; overload;
function RGBA(R, G, B: TUint8; A: TUint8 = 255): TColor; inline; overload;
function ARGB(R, G, B: TUint8; A: TUint8 = 255): TColor; inline;
function HSLA(H, S, L: Single; A: TUint8 = 255): TColor;

function RGBA(const Color: TVec4f): TColor; overload;

function RGBA2Vec4f(Color: TColor): TVec4f;
function RGBALerp(A, B: TColor; F: TFloat): TColor;

function GetRed(Color: TColor): Byte; inline;
function GetGreen(Color: TColor): Byte; inline;
function GetBlue(Color: TColor): Byte; inline;
function GetAlpha(Color: TColor): Byte; inline;

function ColorAdd(A, B: TColor): TColor;
function ColorMul(A: TColor; Scale: TVec4f): TColor;

function ByteBlend(const Color, Background: Byte; Factor: Byte): Byte; inline;
function ColorBlend(const Color, Background: TUint32; Factor: Byte): TUint32; inline;

function StrToColor(const S: TString): TColor;
function ColorToStr(Color: TUint32): TString;

procedure BGRAToRGBA(Color: Pointer); inline;

function SetAlpha(Color: UInt32; Alpha: UInt8): UInt32;

implementation

type
  TArray4 = array[0..3] of TUint8;

function Grey(L: TUint8; A: TUint8 = 255): TColor;
begin
  TArray4(Result)[0] := L;
  TArray4(Result)[1] := L;
  TArray4(Result)[2] := L;
  TArray4(Result)[3] := A;
end;

function RGBA(R, G, B: TUint8; A: TUint8 = 255): TColor;
begin
  TArray4(Result)[0] := R;
  TArray4(Result)[1] := G;
  TArray4(Result)[2] := B;
  TArray4(Result)[3] := A;
end;

function ARGB(R, G, B: TUint8; A: TUint8 = 255): TColor;
begin
  TArray4(Result)[0] := A;
  TArray4(Result)[1] := R;
  TArray4(Result)[2] := G;
  TArray4(Result)[3] := B;
end;

function Hue2Comp(P, Q, T: Single): Single; inline;
begin
  if T < 0 then begin
    T := T + 1;
  end else if T > 1 then begin
    T := T - 1;
  end;
  if T < 1/6 then begin
    Result := P + (Q - P) * 6 * T;
  end else if T < 1/2 then begin
    Result := Q;
  end else if T < 2/3 then begin
    Result := P + (Q - P) * 6 * (2/3 - T);
  end else
    Result := P;
end;

function HSLA(H, S, L: Single; A: TUint8 = 255): TColor;
var
  P, Q: Single;
begin
  if S = 0 then begin
    L := 255 * L;
    Result := RGBA(Trunc(L), Trunc(L), Trunc(L), A)
  end else begin
    if L < 0.5 then
      Q := L * (1 + S)
    else
      Q := L + S - L * S;
    P := 2 * L - Q;
	Result := RGBA(Trunc(255 * Hue2Comp(P, Q, H + 1/3)),
	               Trunc(255 * Hue2Comp(P, Q, H)),
				   Trunc(255 * Hue2Comp(P, Q, H - 1/3)),
				   A);
  end;
end;

function RGBA(const Color: TVec4f): TColor;
begin
  Result := RGBA(Round(Color.X * 255), Round(Color.Y * 255),
                 Round(Color.Z * 255), Round(Color.W * 255));
end;

function RGBA2Vec4f(Color: TColor): TVec4f;
begin
  Result.X := TArray4(Color)[0]/255;
  Result.Y := TArray4(Color)[1]/255;
  Result.Z := TArray4(Color)[2]/255;
  Result.W := TArray4(Color)[3]/255;
end;

function RGBALerp(A, B: TColor; F: TFloat): TColor;
var
  V, W: TVec4f;
begin
  V := RGBA2Vec4f(A);
  W := RGBA2Vec4f(B);
  Result := RGBA(Add4f(Mul4f(V, 1 - F), Mul4f(W, F)));
end;

function GetRed(Color: TColor): Byte;
begin
  Result := TArray4(Color)[0];
end;

function GetGreen(Color: TColor): Byte;
begin
  Result := TArray4(Color)[1];
end;

function GetBlue(Color: TColor): Byte;
begin
  Result := TArray4(Color)[2];
end;

function GetAlpha(Color: TColor): Byte;
begin
  Result := TArray4(Color)[3];
end;

function ColorAdd(A, B: TColor): TColor;
begin
  TArray4(Result)[0] := Min(255, (TArray4(A)[0] + TArray4(B)[0]));
  TArray4(Result)[1] := Min(255, (TArray4(A)[1] + TArray4(B)[1]));
  TArray4(Result)[2] := Min(255, (TArray4(A)[2] + TArray4(B)[2]));
  TArray4(Result)[3] := Min(255, (TArray4(A)[3] + TArray4(B)[3]));
end;

function ColorMul(A: TColor; Scale: TVec4f): TColor;
begin
  TArray4(Result)[0] := Min(255, Trunc(Scale.X * (TArray4(A)[0])));
  TArray4(Result)[1] := Min(255, Trunc(Scale.Y * (TArray4(A)[1])));
  TArray4(Result)[2] := Min(255, Trunc(Scale.Z * (TArray4(A)[2])));
  TArray4(Result)[3] := Min(255, Trunc(Scale.W * (TArray4(A)[3])));
end;

function ByteBlend(const Color, Background: Byte; Factor: Byte): Byte;
begin
  Result := (Factor * Color + (255 - Factor) * Background) div 255;
end;

function ColorBlend(const Color, Background: TUint32; Factor: Byte): TUint32;
begin
  TArray4(Result)[0] := ByteBlend(TArray4(Color)[0], TArray4(Background)[0], Factor);
  TArray4(Result)[1] := ByteBlend(TArray4(Color)[1], TArray4(Background)[1], Factor);
  TArray4(Result)[2] := ByteBlend(TArray4(Color)[2], TArray4(Background)[2], Factor);
  TArray4(Result)[3] := ByteBlend(TArray4(Color)[3], TArray4(Background)[3], Factor);
end;

function StrToColor(const S: TString): TColor;
  function GetByte(Index: LongInt): Byte; inline;
  begin
    if Index <= Length(S) then
      Result := Ord(S[Index])
    else
      Result := Ord('F');
    if (Ord('a') <= Result) and (Result <= Ord('f')) then begin
      Result := Result - Ord('a') + 10;
    end else if (Ord('A') <= Result) and (Result <= Ord('F')) then begin
      Result := Result - Ord('A') + 10;
    end else if (Ord('0') <= Result) and (Result <= Ord('9')) then
      Result := Result - Ord('0');
  end;
begin
  TArray4(Result)[0] := GetByte(1) shl 4 + GetByte(2);
  TArray4(Result)[1] := GetByte(3) shl 4 + GetByte(4);
  TArray4(Result)[2] := GetByte(5) shl 4 + GetByte(6);
  TArray4(Result)[3] := GetByte(7) shl 4 + GetByte(8);
end;

function ColorToStr(Color: TUint32): TString;
begin
  Result := IntToHex(TArray4(Color)[0], 2) + IntToHex(TArray4(Color)[1], 2) +
            IntToHex(TArray4(Color)[2], 2) + IntToHex(TArray4(Color)[3], 2);
end;

procedure BGRAToRGBA(Color: Pointer);
var
  Temp: Byte;
begin
  Temp := TArray4(Color^)[0];
  TArray4(Color^)[0] := TArray4(Color^)[2];
  TArray4(Color^)[2] := Temp;
end;

function SetAlpha(Color: UInt32; Alpha: UInt8): UInt32;
begin
  Result := Color;
  TArray4(Result)[3] := Alpha;
end;

end.
