SRL Archive - Test corner

NEW VERSION! HSL, RGB and XYZ Support!

I am sorry, but the RGB must be used as an Extended, because procedure pointers think like "Variant <> Extended", but it's not hard, red for example would be (255.0, 0.0, 0.0) :)


As far as I know, this works, I tested it with 0, 65536 which are both black, and 255 - red, and with the correct tolerances, as supposed to, when I writelned the length of the array it returns, it said 2.

0 and 65536 were one, and 255 one.

You who have been struggling with finding willows - your problems are over.

You can do a GetColors to a ATPA gotten with TPAToATPA(ex), and then put it through this with a quite small tol since the grass color in a block doesn't vary so much, if it returns 1 or so, it's grass ;)

Program New;

Type
  ColorSpace =(RGB, XYZ, HSL);
  
  

Procedure ConvertHSL(Color: Integer; Var H, S, L: Extended);

Begin
  ColorToHSL(Color, H, S, L);
End;


Procedure ConvertRGB(Color: Integer; Var R, G, B: Extended);

Var
   Re, Gr, Bl: Integer;
Begin
  ColorToRGB(Color, Re, Gr, Bl);
  R := Re;
  G := Gr;
  B := Bl;
End;


Procedure ConvertXYZ(Color: Integer; Var X, Y, Z: Extended);

Begin
  ColorToXYZ(Color, X, Y, Z);
End;


Function RevertHSL(H, S, L: Extended): Integer;

Begin
  Result := HSLToColor(H, S, L);
End;


Function RevertRGB(R, G, B: Extended): Integer;

Begin
  Result := RGBToColor(Round(R), Round(G), Round(B));
End;


Function RevertXYZ(X, Y, Z: Extended): Integer;

Begin
  Result := XYZToColor(X, Y, Z);
End;


Function SortColors(Colors: TIntegerArray; HRX, SGY, LBZ: Extended; CS: ColorSpace): T2DIntArray;

Var
   aHSL: Array of Array [0..2] Of Extended;
   fRes: Array Of Array of Array [0..2] Of Extended;
   a, b, c, l, i: LongInt;
   conversionProc: Procedure(Color: Integer; Var C1, C2, C3: Extended);
   reversionFunc: Function(C1, C2, C3: Extended): Integer;
Begin
  Case CS Of
    RGB: Begin conversionProc := @ConvertRGB; reversionFunc := @RevertRGB; End;
    HSL: Begin conversionProc := @ConvertHSL; reversionFunc := @RevertHSL; End;
    XYZ: Begin conversionProc := @ConvertXYZ; reversionFunc := @RevertXYZ; End;
  End
  SetLength(fRes, 0);
  SetLength(aHSL, Length(Colors));
  L := High(Colors);
  C := 0;
  For I := 0 To L Do
    conversionProc(Colors[i], aHSL[i][0], aHSL[i][1], aHSL[i][2]);
  For a := 0 To L Do
  begin
    For b := 0 To c -1 Do
      If (Abs(aHSL[a][0] - fRes[b][0][0]) <= HRX) And (Abs(aHSL[a][1] - fRes[b][0][1]) <= SGY)
      And (Abs(aHSL[a][2] - fRes[b][0][2]) <= LBZ) Then
        Break;
    If b < c Then
    begin
      SetLength(fRes[b], Length(fRes[b]) + 1);
      i := High(fRes[b]);
      conversionProc(Colors[a], fRes[b][i][0], fRes[b][i][1], fRes[b][i][2]);
    End Else
    Begin
      SetLength(fRes, c + 1);
      SetLength(fRes[c], 1);
      conversionProc(Colors[a], fRes[c][0][0], fRes[c][0][1], fRes[c][0][2]);
      Inc(c);
    End;
  End;
  L := High(fRes);
  SetLength(Result, L + 1);
  For I := 0 To L Do
  Begin
    b := High(fRes[i]);
    SetLength(Result[i], b + 1);
    For a := 0 To b Do
      Result[i][a] := reversionFunc(fRes[i][a][0], fRes[i][a][1], fRes[i][a][2]);
  End;
End;

Begin
  Writeln(IntToStr(Length(SortColors([0, 65536, 255], 67.0, 100.0, 1.0, HSL))));
End.

The algorithm is based on Wizzie's TPAToATPAEx, so he can get half of the cookie :)


Glad to make an useful function for a while…


Now, go spread terror and mass destruction over the world… (with the function)


EDIT: You're free to use as long as you credit properly.

Well Done n3ss3s!!!
You never cease to amaze me!

And what does it do?

It sorts colors within certain H, S and L tolerances to their own arrays - read…

You can do a GetColors to a ATPA gotten with TPAToATPA(ex), and then put it through this with a quite small tol since the grass color in a block doesn't vary so much, if it returns 1 or so, it's grass

From: n3ss3s
It sorts colors within certain H, S and L tolerances to their own arrays - read…

Excuse me but I still don't get it.. xD

From: mastaraymond
Excuse me but I still don't get it.. xD

Same

Nice, maybe add XYZ and RGB support too?

Only smart 150 IQ + People understand xD. Get Benland in here to say something smart :P

It puts all colours with certain H, S, L values into arrays, and then it finds the closest colours…I think?

Simply put, it does the same thing as tpatoatpa but instead of checking for the distance it checks for the difference in h,s,l. You might also want to use the splittpa algorithm, it might be better depending on what you do, with tpatoatpa you define the maximum size of the array by giving xy(or in your case h,s,l), with split tpa you could find that all colors are in range, so instead of only checked against the first, starting point, it gets checked against all points in the array.

Yes, it should be done a bit different IMO.

This is what Raymond (and I) came up with…

Function HSLColorsTolerance(Col1, Col2: Integer; HMod, SMod: Extended): Integer;

Var
   H1, S1, L1, H2, S2, L2: Extended;
   Temp : Extended;
Begin
  ColorToHSL(Col1, H1, S1, L1);
  ColorToHSL(Col2, H2, S2, L2);
  Temp := Abs(H2 - H1) / HMod;
  If (Abs(S2 - S1)/SMod) > Temp then
    Temp :=  Abs(S2 - S1) / SMod;
  If Abs(L2 - L1) > Temp then
    Temp :=  Abs(L2 - L1);
  Result := Ceil(Temp);
End;

RGB Tolerance is more simple:

Function RGBColorsTolerance(Col1, Col2: Integer): Integer;

Var
   R1, G1, B1, R2, G2, B2: Integer;
   
Begin
  ColorToRGB(Col1, R1, G1, B1);
  ColorToRGB(Col2, R2, G2, B2);
  Result := Round(Sqrt(Sqr(R1 - R2) + Sqr(G1 - G2) + Sqr(B1 - B2)));
End;

That way you can get the read color 'distance' (tolerance), might also be an option for your function. ;)

Lol, you don't believe that even yourself, do you - if I now had some function that would change the world, and it would be easy to use it in your essence miner and looks leet - no, you would not add it there would you?

I don't want the leetest part of my function to be someone other's function :p


The SplitTPA(SplitColors?) idea sounds nice, BUT, the whole point of it is that you define the H, S and L tolerances, you have to set a tolerance for them somewhere, there isn't such a thing as gathering the colors that are connected to eachother to same arrays, and using TPAToATPA type IMO is better for my purpose, (expecting you talk about the old SplitTPA(TPA: TPointArray), because the nowadays SplitTPA is the same as defining the tols so…)

Anyways, thanks Killerdou and Wizzy :)


Santa, no.


I'll think of the RGB and XYZ support :)

Umm about XYZ, do you want me to use it like HSL, or the weird " X - Z " etc shit?

Well Done n3ss3s!!!
You never cease to amaze me!

Don't spam.

where do you guys learn all this stuff about how is the best way to compare colors and what is the best way to filter through them

From: HyperSecret
where do you guys learn all this stuff about how is the best way to compare colors and what is the best way to filter through them

They just experiment or think of it themselves :)


Anyways, as I told you on msn, good job :)

From: HyperSecret
where do you guys learn all this stuff about how is the best way to compare colors and what is the best way to filter through them

Wikipedia!

Megadig!

Wizzup, I made some use of your function -

Function RGBColorsTolerance(Col1, Col2: Integer): Integer;

Var
   R1, G1, B1, R2, G2, B2: Integer;
Begin
  ColorToRGB(Col1, R1, G1, B1);
  ColorToRGB(Col2, R2, G2, B2);
  Result := Round(Sqrt(Sqr(R1 - R2) + Sqr(G1 - G2) + Sqr(B1 - B2)));
End;


Function GetClosest(Colors: TIntegerArray; ToColor: Integer): Integer;

Var
   Lead, Dist, C: Integer;
Begin
  Lead := 0;
  Dist := RGBColorsTolerance(ToColor, Colors[0]);
  For C := 1 To High(Dist) Do
    If RGBColorsTolerance(ToColor, Colors[c]) < Dist Then
    Begin
      Dist := RGBColorsTolerance(ToColor, Colors[c]);
      Lead := C;
    End;
  Result := Colors[c];
End;

Useful for example autocoloring falador roadcolor, there aren't too many gray colors and if are, the closest one is the right one :)


For Falador -

Function GetRoadColor: Integer;

Var
   TPA: TPointArray;
Begin
  FindColorsPie(TPA, 5927541, 0, 0, 360, 20, 70, MMX1, MMY1, MMX2, MMY2, MMCX, MMCY);
  Result := GetClosest(GetColors(TPA), 5927541);
End;

There's no gravedigging in script threads right?

maybe not…?
if the thread is your own, then maybe its only a bump…?

So tempted to call that spam…

Why would you call that spam?

I just say that I think its not gravedig if its your own thread :(

so basicaly you put the color you want and it tells you how many different colors if you get waht im saying?

so basicaly you put the color you want and it tells you how many different colors if you get waht im saying?

Yeah that's what the first function does, it puts all the colors into integer arrays of "one color" which is defined by the three tols…

thought so cherz for clearing it up so is this were i put the color i want to see the diffs at….

[php]
Begin
Writeln(IntToStr(Length(SortColors([0, 65536, 255], 67.0, 100.0, 1.0, HSL))));
End.[/php]</span>

Edit: Nevermind…that was obvious.

apparently and btw you like 2 months late..