unit TTColor;

{ TT color interpolation for antialiased output,
  Copr. 1996 Matthias Koeppe
}

interface

type
  PColor = ^TColor;
  TColor = record
    R, G, B: Integer;
  end;

procedure MakeColor(R, G, B: Integer; var Color: TColor);
procedure ColorByIndex(Index: Integer; var Color: TColor);

function Interpolation(A, B: TColor): pointer;

const
  MaxEpsilon: Integer = 25;

implementation

uses Gr, Objects, Bitmap;

procedure MakeColor(R, G, B: Integer; var Color: TColor);
begin
  Color.R := R;
  Color.G := G;
  Color.B := B
end;

procedure ColorByIndex(Index: Integer; var Color: TColor);
begin
  with DevicePalette[Index] do
    MakeColor(rgbtBlue, rgbtGreen, rgbtRed, Color);
end;

function DotProduct(X, Y: TColor): LongInt;
begin
  DotProduct := LongMul(X.R, Y.R) + LongMul(X.G, Y.G) + LongMul(X.B, Y.B)
end;

procedure CrossProduct(X, Y: TColor; var Res: TColor);
begin
  Res.R := X.G * Y.B - X.B * Y.G;
  Res.G := X.B * Y.R - X.R * Y.B;
  Res.B := X.R * Y.G - X.G * Y.R;
end;

procedure Minus(X, Y: TColor; var Res: TColor);
begin
  Res.R := X.R - Y.R;
  Res.G := X.G - Y.G;
  Res.B := X.B - Y.B;
end;

function Magnitude(X: TColor): Real;
begin
  Magnitude := Sqrt(1.0 * LongMul(X.R, X.R) + LongMul(X.G, X.G) + LongMul(X.B, X.B))
end;

function Parameter(X, P, Y: TColor): Real;
var
  D, PX: TColor;
begin
  Minus(Y, X, D);
  Minus(P, X, PX);
  Parameter := DotProduct(PX, D) / DotProduct(D, D)
end;

function Epsilon(X, P, Y: TColor): Real;
var
  PX, YX, CP: TColor;
begin
  Minus(P, X, PX);
  Minus(Y, X, YX);
  CrossProduct(PX, YX, CP);
  Epsilon := Magnitude(CP) / Magnitude(YX)
end;

{ 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

type
  PColorEntry = ^TColorEntry;
  TColorEntry = record
    Index: Integer;
    Parameter: Real;
  end;

  PColorCollection = ^TColorCollection;
  TColorCollection = object(TSortedCollection)
    function Compare(Key1, Key2: pointer): Integer; virtual;
    procedure FreeItem(Item: pointer); virtual;
    function GetDistribution: pointer;
  end;

function TColorCollection.Compare;
begin
  If PColorEntry(Key1)^.Parameter < PColorEntry(Key2)^.Parameter
  then Compare := -1 else
  if PColorEntry(Key1)^.Parameter > PColorEntry(Key2)^.Parameter
  then Compare := +1 else Compare := 0
end;

procedure TColorCollection.FreeItem;
begin
  Dispose(PColorEntry(Item))
end;

function TColorCollection.GetDistribution;
var
  p: PChar;
  Cur, i: Integer;
  Next: Real;

	function param(i: Integer): Real;
	begin
	  param := PColorEntry(At(i))^.Parameter
	end;

begin
  GetMem(p, 256);
  GetDistribution := p;
  i := 0;
  For Cur := 0 to Count - 1 do
  begin
    If Cur = Count - 1
    then Next := 256
    else Next := (param(Cur) + param(Cur + 1)) * 128;
    while i < Next do
    begin
      p[0] := Chr(PColorEntry(At(Cur))^.Index);
      Inc(p);
      Inc(i);
    end
  end;
end;

{ 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

function Interpolation(A, B: TColor): pointer;
var
  Coll: PColorCollection;
  i: Integer;
  x: Real;
  E: PColorEntry;
  P: TColor;
begin
  Coll := New(PColorCollection, Init(32, 32));
  For i := 0 to GetMaxColor do
  begin
    ColorByIndex(i, P);
    If Epsilon(A, P, B) < MaxEpsilon
    then begin
      x := Parameter(A, P, B);
      If (x >= 0) and (x <= 1)
      then begin
	New(E);
	E^.Index := i;
	E^.Parameter := x;
	Coll^.Insert(E)
      end
    end;
  end;
  Interpolation := Coll^.GetDistribution;
  Dispose(Coll, Done)
end;

end.

