SRL Archive - Jr. Member General Help and Discussion

EDIT: can't get hue mod to work out. see below

How does ACA calculate the 'best color' from a given list?

https://github.com/CynicRus/ACARemake/blob/master/aca_main.pas#L475

From: Olly
https://github.com/CynicRus/ACARemake/blob/master/aca_main.pas#L475

ty :)

Okay I have everything working except the hue mod. Can anyone help?

ACA:

My simba output:

program cts2Test;
{$i srl-6/srl.simba}

type TColorRec = record
  h, s, l: extended;
  r, g, b, color: integer;
end;

const
   maxHue = 100;
   medHue = 50;

var
  bestColor, bestTol: integer;
  colorList: TIntegerArray;
  hueMod, satMod: extended;
  minC, maxC: TColorRec;

procedure TColorRec.init(c: integer);
begin
  colorToRGB(c, self.r, self.g, self.b);
  colorToHSL(c, self.h, self.s, self.l);
  self.color := c;
end;

procedure checkColorBounds(color: TColorRec);
var
  r, g, b: integer;
  h, s, l: extended;
begin
  with color do
  begin
    if (r < minc.r) then minc.r := r;
    if (r > maxc.r) then maxc.r := r;
    if (g < minc.g) then minc.g := g;
    if (g > maxc.g) then maxc.g := g;
    if (b < minc.b) then minc.b := b;
    if (b > maxc.b) then maxc.b := b;

    if (h < minc.h) then minc.h := h;
    if (h > maxc.h) then maxc.h := h;
    if (s < minc.s) then minc.s := s;
    if (s > maxc.s) then maxc.s := s;
    if (l < minc.l) then minc.l := l;
    if (l > maxc.l) then maxc.l := l;
  end;
end;

function bestHue(minU, maxU: extended): extended;
var
  minD, maxD, h, s, l: extended;
  i: integer;
begin
  result := -1;
  minU := maxHue; minD := maxHue;
  maxU := -1; maxD := -1;
  for i := high(colorList) downto 0 do
  begin
    colorToHSL(colorList[i], h, s, l);
    if h < medHue then
    begin
      if h < minU then
        minU := h;
      if h > maxU then
        maxU := h;
    end
    else
    begin
      if h < minD then
        minD := h;
      if h > maxD then
        maxD := h;
    end;
  end;

  if ((maxU >= 0) <> (maxD >= 0)) then
    if (maxU >= 0) then
      result := (minU + maxU)/2
    else
    begin
      result := (minD + maxD)/2;
      minU := minD;
      maxU := maxD;
    end
  else
  begin
    if ((maxHue - maxD) + minU) < (maxD - maxU) then
      minU := minD
    else
      maxU := maxD;

    result := (minU + maxU)/2;
    if (minU > maxU) then
      result := result - medHue;
  end;

  result := result + maxHue;
  while (result >= maxHue) do
    result := result - maxHue;
end;

procedure bestColor2();
var
  i: integer;
  h, s, l, minH, maxH: extended;
begin
  h := bestHue(minH, maxH);
  s := (minC.s + maxC.s)/2;
  l := (minC.l + maxC.l)/2;
  bestColor := HSLToColor(h, s, l);
  ColorToHSL(bestColor, h, s, l);
  bestTol := ceil(maxE(maxC.l - l, l - minC.l));
  if (bestTol > 0) then
  begin   
    //I think this line has to be the problem
    h := maxE(minE(abs(minH - h), minH + maxHue - h), minE(abs(maxH - h), maxH + maxHue - h))/bestTol;
    //
    s := maxE(maxC.s - s, s - minC.s)/bestTol;
    hueMod := h;
    satMod := s;
  end
  else
  begin
    hueMod := 0;
    satMod := 0;
  end;
end;

procedure calcBestColor();
var
  oColor: TColorRec;
  i: integer;
begin
  minC.init(colorList[0]);
  maxc := minC;
  for i := 0 to high(colorList) do
  begin
    oColor.init(colorList[i]);
    checkColorBounds(oColor);
  end;
  bestColor2();
  writeLn(bestColor);
  writeln(bestTol);
  writeln(hueMod);
  writeln(satMod);
end;

procedure colorTest();
begin
  colorList := [13747840, 12958328, 7892807, 10853220];
  calcBestColor();
end;

begin
  clearDebug();
  colorTest();
end.

From: evilcitrus
Okay I have everything working except the hue mod. Can anyone help?

ACA:

My simba output:

program cts2Test;
{$i srl-6/srl.simba}

type TColorRec = record
  h, s, l: extended;
  r, g, b, color: integer;
end;

const
   maxHue = 100;
   medHue = 50;

var
  bestColor, bestTol: integer;
  colorList: TIntegerArray;
  hueMod, satMod: extended;
  minC, maxC: TColorRec;

procedure TColorRec.init(c: integer);
begin
  colorToRGB(c, self.r, self.g, self.b);
  colorToHSL(c, self.h, self.s, self.l);
  self.color := c;
end;

procedure checkColorBounds(color: TColorRec);
var
  r, g, b: integer;
  h, s, l: extended;
begin
  with color do
  begin
    if (r < minc.r) then minc.r := r;
    if (r > maxc.r) then maxc.r := r;
    if (g < minc.g) then minc.g := g;
    if (g > maxc.g) then maxc.g := g;
    if (b < minc.b) then minc.b := b;
    if (b > maxc.b) then maxc.b := b;

    if (h < minc.h) then minc.h := h;
    if (h > maxc.h) then maxc.h := h;
    if (s < minc.s) then minc.s := s;
    if (s > maxc.s) then maxc.s := s;
    if (l < minc.l) then minc.l := l;
    if (l > maxc.l) then maxc.l := l;
  end;
end;

function bestHue(minU, maxU: extended): extended;
var
  minD, maxD, h, s, l: extended;
  i: integer;
begin
  result := -1;
  minU := maxHue; minD := maxHue;
  maxU := -1; maxD := -1;
  for i := high(colorList) downto 0 do
  begin
    colorToHSL(colorList[i], h, s, l);
    if h < medHue then
    begin
      if h < minU then
        minU := h;
      if h > maxU then
        maxU := h;
    end
    else
    begin
      if h < minD then
        minD := h;
      if h > maxD then
        maxD := h;
    end;
  end;

  if ((maxU >= 0) <> (maxD >= 0)) then
    if (maxU >= 0) then
      result := (minU + maxU)/2
    else
    begin
      result := (minD + maxD)/2;
      minU := minD;
      maxU := maxD;
    end
  else
  begin
    if ((maxHue - maxD) + minU) < (maxD - maxU) then
      minU := minD
    else
      maxU := maxD;

    result := (minU + maxU)/2;
    if (minU > maxU) then
      result := result - medHue;
  end;

  result := result + maxHue;
  while (result >= maxHue) do
    result := result - maxHue;
end;

procedure bestColor2();
var
  i: integer;
  h, s, l, minH, maxH: extended;
begin
  h := bestHue(minH, maxH);
  s := (minC.s + maxC.s)/2;
  l := (minC.l + maxC.l)/2;
  bestColor := HSLToColor(h, s, l);
  ColorToHSL(bestColor, h, s, l);
  bestTol := ceil(maxE(maxC.l - l, l - minC.l));
  if (bestTol > 0) then
  begin   
    //I think this line has to be the problem
    h := maxE(minE(abs(minH - h), minH + maxHue - h), minE(abs(maxH - h), maxH + maxHue - h))/bestTol;
    //
    s := maxE(maxC.s - s, s - minC.s)/bestTol;
    hueMod := h;
    satMod := s;
  end
  else
  begin
    hueMod := 0;
    satMod := 0;
  end;
end;

procedure calcBestColor();
var
  oColor: TColorRec;
  i: integer;
begin
  minC.init(colorList[0]);
  maxc := minC;
  for i := 0 to high(colorList) do
  begin
    oColor.init(colorList[i]);
    checkColorBounds(oColor);
  end;
  bestColor2();
  writeLn(bestColor);
  writeln(bestTol);
  writeln(hueMod);
  writeln(satMod);
end;

procedure colorTest();
begin
  colorList := [13747840, 12958328, 7892807, 10853220];
  calcBestColor();
end;

begin
  clearDebug();
  colorTest();
end.

Well,

const
  MaxHue = 100;
  MedHue = 50;
function BestColour_CTS2_Hue(out MinU, MaxU: Extended): Extended;
var
  {MinU, MaxU, }MinD, MaxD: Extended;
  i: Integer;
begin
  Result := -1;
  if (Storage.Count < 1) then
    Exit;

  MinU := MaxHue; MinD := MaxHue;
  MaxU := -1;     MaxD := -1;

  for i := Storage.Items[CurrIndex].ColorList.Count-1 downto 0 do
    if (Storage.Items[CurrIndex].ColorList[i].aColor.h < MedHue) then
    begin
      if (Storage.Items[CurrIndex].ColorList[i].aColor.h < MinU) then
        MinU := Storage.Items[CurrIndex].ColorList[i].aColor.h;
      if (Storage.Items[CurrIndex].ColorList[i].aColor.h > MaxU) then
        MaxU := Storage.Items[CurrIndex].ColorList[i].aColor.h;
    end
    else
    begin
      if (Storage.Items[CurrIndex].ColorList[i].aColor.h < MinD) then
        MinD := Storage.Items[CurrIndex].ColorList[i].aColor.h;
      if (Storage.Items[CurrIndex].ColorList[i].aColor.h > MaxD) then
        MaxD := Storage.Items[CurrIndex].ColorList[i].aColor.h;
    end;

  if ((MaxU >= 0) <> (MaxD >= 0)) then
    if (MaxU >= 0) then
      Result := (MinU + MaxU) / 2
    else
    begin
      Result := (MinD + MaxD) / 2;
      MinU := MinD;
      MaxU := MaxD;
    end
  else
  begin
    if ((MaxHue - MaxD) + MinU) < (MaxD - MaxU) then
      MinU := MinD
    else
      MaxU := MaxD;

    Result := (MinU + MaxU) / 2;
    if (MinU > MaxU) then
      Result := Result - MedHue;
  end;

  Result := Result + MaxHue;
  while (Result >= MaxHue) do
    Result := Result - MaxHue;
end;

procedure BestColour_CTS2;
var
  h, s, l,
  minH, maxH: Extended;
begin
  h := BestColour_CTS2_Hue(minH, maxH);
  //h := (minC.h + maxC.h) / 2;
  s := (minC.s + maxC.s) / 2;
  l := (minC.l + maxC.l) / 2;

  BestColor := HSLToColor(h, s, l);
  ColorToHSL(BestColor, h, s, l);

  BestTolerance := Ceil(Max(maxC.l - l, l - minC.l));
  if (BestTolerance > 0) then
  begin
    h := Max(Min(Abs(minH - h), minH + MaxHue - h), Min(Abs(maxH - h), maxH + MaxHue - h)) / BestTolerance;
    //h := MaxE(maxC.h - h, h - minC.h) / BestTolerance;
    s := Max(maxC.s - s, s - minC.s) / BestTolerance;
    HueMod := h;
    SatMod := s;
  end
  else
  begin
    HueMod := 0;
    SatMod := 0;
  end;
end;

also, you should check the values in the variables.

From: CynicRus
Well,

function BestColour_CTS2_Hue(out MinU, MaxU: Extended): Extended; //I was missing the OUT!

Even though you just posted what I had already read through a dozen times, THANK YOU! I somehow missed that one little OUT. This was the missing piece of the script that I've been wanting to write.