unit test;

const
  SaturationMult = 0.5;

var
  plugin: IInterface;
  lstPatched: TList;

//============================================================================
procedure rgb2hsl(red, green, blue: Byte; var h, s, l: Double);
var
  r, g, b, cmax, cmin, d, dd: double;
begin
  cmin := Min(red, Min(green, blue)) / 255;
  cmax := Max(red, Max(green, blue)) / 255;
  r := red / 255;
  g := green / 255;
  b := blue / 255;
  h := (cmax + cmin) / 2;
  s := (cmax + cmin) / 2;
  l := (cmax + cmin) / 2;
  if cmax = cmin then begin
    h := 0;
    s := 0;
  end
  else begin
    d := cmax - cmin;
    if l > 0.5 then s := d / (2 - cmax - cmin) else s := d / (cmax + cmin);
    if g < b then dd := 6 else dd := 0;
    if cmax = r then
      h := (g - b) / d + dd
    else if cmax = g then
      h := (b - r) / d + 2
    else if cmax = b then
      h := (r - g) / d + 4;
    h := h / 6;
  end;
end;

//============================================================================
function hue2rgb(p, q, t: Double): Double;
begin
  if t < 0 then t := t + 1;
  if t > 1 then t := t - 1;
  if t < 1 / 6 then
    Result := p + (q - p) * 6 * t
  else if t < 1 / 2 then
    Result := q
  else if t < 2 / 3 then
    Result := p + (q - p) * (2/3 - t) * 6
  else
    Result := p;
end;

//============================================================================
procedure hsl2rgb(h, s, l: Double; var red, green, blue: Byte);
var
  r, g, b, p, q: double;
begin
  if s = 0 then begin
    r := l;
    g := l;
    b := l;
  end
  else begin
    if l < 0.5 then q := l * (1 + s) else q := l + s - l * s;
    p := 2 * l - q;
    r := hue2rgb(p, q, h + 1/3);
    g := hue2rgb(p, q, h);
    b := hue2rgb(p, q, h - 1/3);
  end;
  red := Round(r * 255);
  green := Round(g * 255);
  blue := Round(b * 255);
end;

//============================================================================
function CheckForErrors(aElement: IInterface): Boolean;
var
  Error : string;
  i     : Integer;
begin
  Error := Check(aElement);
  Result := Error <> '';
  if Result then Exit;

  for i := ElementCount(aElement) - 1 downto 0 do begin
    Result := CheckForErrors(ElementByIndex(aElement, i));
    if Result then Exit;
  end;
end;

//============================================================================
function CopyRecord(e: IInterface): IInterface;
begin
  if not Assigned(e) then
    Exit;

  if lstPatched.IndexOf(TObject(GetLoadOrderFormID(e))) <> -1 then
    Exit;

  if CheckForErrors(e) then begin
    AddMessage('Skipping ' + Name(e) + ' due to errors');
    Exit;
  end;

  if not Assigned(plugin) then
    plugin := AddNewFile;

  if not Assigned(plugin) then
    raise Exception.Create('Patch file creation cancelled by user');

  AddRequiredElementMasters(e, plugin, False);
  // copy record as override
  Result := wbCopyElementToFile(e, plugin, False, True);

  lstPatched.Add(TObject(GetLoadOrderFormID(Result)));
end;

//============================================================================
procedure PatchColor(e: IInterface);
var
  h, s, l: double;
  r, g, b: byte;
begin
  rgb2hsl(
    GetElementNativeValues(e, 'Red'),
    GetElementNativeValues(e, 'Green'),
    GetElementNativeValues(e, 'Blue'),
    h, s, l
  );
  s := s * SaturationMult;
  hsl2rgb(h, s, l, r, g, b);
  //AddMessage(IntToStr(r)); AddMessage(IntToStr(g)); AddMessage(IntToStr(b)); Exit;
  SetElementNativeValues(e, 'Red', r);
  SetElementNativeValues(e, 'Green', g);
  SetElementNativeValues(e, 'Blue', b);
end;

//============================================================================
procedure PatchIMAD(e: IInterface);
begin
  e := CopyRecord(e);
  if not Assigned(e) then
    Exit;

  PatchColor(ElementByPath(e, 'TNAM\Data #0'));
end;

//============================================================================
procedure PatchIMGS(e: IInterface);
begin
  e := CopyRecord(e);
  if not Assigned(e) then
    Exit;

  if GetElementNativeValues(e, 'DNAM\Cinematic\Tint\Value') <> 0 then
    PatchColor(ElementByPath(e, 'DNAM\Cinematic\Tint\Color'));
end;

//============================================================================
procedure PatchWTHR(e: IInterface);
begin
  if not Assigned(e) then
    Exit;

  PatchIMAD(LinksTo(ElementBySignature(e, #0'IAD')));
  PatchIMAD(LinksTo(ElementBySignature(e, #1'IAD')));
  PatchIMAD(LinksTo(ElementBySignature(e, #2'IAD')));
  PatchIMAD(LinksTo(ElementBySignature(e, #3'IAD')));
  PatchIMAD(LinksTo(ElementBySignature(e, #4'IAD')));
  PatchIMAD(LinksTo(ElementBySignature(e, #5'IAD')));
end;

//============================================================================
procedure PatchWRLD(e: IInterface);
begin
  if not Assigned(e) then
    Exit;

  PatchIMGS(LinksTo(ElementBySignature(e, 'INAM')));
end;

//============================================================================
function Initialize: Integer;
begin
  lstPatched := TList.Create;
end;

//============================================================================
function Process(e: IInterface): integer;
var
  sig: string;
begin
  sig := Signature(e);
  if sig = 'WTHR' then
    PatchWTHR(e)
  else if sig = 'WRLD' then
    PatchWRLD(e);
  //else if sig = 'IMAD' then
  //  PatchIMAD(e);
end;

//============================================================================
function Finalize: Integer;
begin
  if Assigned(plugin) then
    SortMasters(plugin);
  lstPatched.Free;
end;

end.