August 22, 2019, 12:09:13 pm

News:

Own IWBasic 2.x ? -----> Get your free upgrade to 3.x now.........


Sorting Colors

Started by billhsln, July 14, 2019, 08:43:07 pm

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

billhsln

I have been trying, for months, to be able to sort colors where shades of each color is in a dark to light order.  I have had no luck with this.  I have used multiple algorithms to sort on, HSV, HSL, CieLAB, Cie2000 and nothing seems to sort in a way that keeps the colors together in any format that is what I have been looking for.  I always seem to end up with all the colors mixed up.  I am looking at 2321 colors, many of which are very close to the same color.  I am going to put up my starting file of colors and the program that converts into the different formats.  I hope that the algorithms are right, but some I converted from C and I don't really understand C.  I use a program called CMSort (freeware), which sorts and leaves me my 3 header lines.  I then have another program to display the colors in the order I sorted it into.  I will zip up all the files you might need.  Hopefully someone can help.

Thanks,
Bill

CMSort.exe - Freeware sorting routine
Colors_Convert.iwb - Console program with different color algorithms.
Colors_View.iwb - Windows program to display the colors, click next to see next page
Colors-Start.txt - Starting file with all the colors, without HSL,HSV,XYZ,CieLAB, etc.
Z.Bat - DOS batch file to run CMSort with the different sort orders in new file

Z.bat will take file Color-f.txt and sort and save as Colors.txt which is input to Colors_View.iwb. You will need to pass a parameter to make it work (from a DOS box).

Tried RGBtoHSV(), which comes up with bad numbers (weird large negatives for H).

When all else fails, get a bigger hammer.

fasecero

This is the winapi color format:

- Hexagesimal Color Format: 0x00bbggrr
- red, green, blue are constrained to the range (0..255)
- hue, saturation, brightness/value are constrained to the range (0..240)

I did some functions to convert between these 3 formats: ColorToHSV, HSVToColor, ColorToRGB, RGBToColor

I can't find what's wrong in your code, is too complex. When I get some time if you can't make it work I'll try to load Colors-Start.txt into a listview (the user can see all the colors at once, or at least scroll fast through them).

Code Select
$INCLUDE "windowssdk.inc"
$INCLUDE "Shlwapi.inc"

OPENCONSOLE
PRINT
PrintColor()

PRINT
PRINT "Press any key to exit"
DO:UNTIL INKEY$ <> ""
CLOSECONSOLE

SUB PrintColor()
INT myColor = 0x00996633 ' COLORREF HEXAGESIMAL FORMAT -> 0x00bbggrr
INT h, s, v

PRINT "My Color: ", myColor
PRINT

ColorToHSV(myColor, h, s, v) ' Output HLS values are constrained to the range (0..240). For Achromatic conversions, Hue is set to 160.
PRINT "Hue : ", h
PRINT "Sat : ", s
PRINT "Val : ", v
PRINT

PRINT "My Color from HSV: ", HSVToColor(h, s, v)
PRINT

INT r, g, b
ColorToRGB(myColor, r, g, b) ' Output RGB values are constrained to the range (0..255)
PRINT "Red   : ", r
PRINT "Green : ", g
PRINT "Blue  : ", b
PRINT

PRINT "My Color from RGB: ", RGBToColor(r, g, b)
ENDSUB

SUB ColorToRGB(UINT value, INT r BYREF, INT g BYREF, INT b BYREF)
  r = value % 256
  g = (value % 65536) / 256
  b = value / 65536
ENDSUB

SUB RGBToColor(INT r, INT g, INT b), UINT
RETURN RGB(r, g, b)
ENDSUB

 SUB ColorToHSV(UINT value, INT h BYREF, INT s BYREF, INT v BYREF)
word hue, sat, _val
 
ColorRGBToHLS(value, &hue, &_val, &sat) ' see https://source.winehq.org/WineAPI/ColorRGBToHLS.html
h = hue
s = sat
v = _val
 ENDSUB

SUB HSVToColor(DOUBLE h, DOUBLE s, DOUBLE v), UINT
RETURN ColorHLSToRGB(h, v, s)
ENDSUB

billhsln

Here is the file that goes into the 'Colors_View.iwb', this will allow you to view the colors.

This includes all the weird calculated results from the 'Colors_Convert.iwb'.

Bill
When all else fails, get a bigger hammer.

fasecero

OK, with that file all your code makes perfect sense. First you made an amazing grid. It is very easy to spot each color, its name and its rgb values.

The problem is inside cmpFunc. You are currently comparing 2 strings with a format like the one below

Quote045,047,040,#282F2D,077.142857,008.045976,017.058824,00.424920,02633517, 002.481706, 002.744120, 002.406351, 018.988529,-002.478642, 004.199197,012.843614,Y28,077,000.148936,000.184314,Yellow-Green  ,Green      ,Eternity

If you want to order those colors according to the brightness you must "extract" the brightness of each of th0se strings inside cmpFunc and compare them with each other. So you need to replace cmpFunc with the code below. Run the program and then select a listbox item to see the change.

Code Select
$INCLUDE "Shlwapi.inc"

SUB cmpFunc(a:POINTER,b:POINTER),INT
INT ra, ga, ba
INT rb, gb, bb

ExtractRGB(*<string>a, ra, ga, ba)
ExtractRGB(*<string>b, rb, gb, bb)

INT colorA = RGB(ra, ga, ba)
INT colorB = RGB(rb, gb, bb)

INT ha, sa, va
INT hb, sb, vb

ColorToHSV(colorA, ha, sa, va)
ColorToHSV(colorB, hb, sb, vb)

RETURN va - vb ' bv - va if you want to reverse the order
ENDSUB

SUB ExtractRGB(string text, INT r BYREF, INT g BYREF, INT b BYREF)
string red, green, blue

INT pos1 = INSTR(text, ",")
IF pos1 THEN
INT pos2 = INSTR(text, ",", pos1 + 1)
IF pos2 THEN
INT pos3 = INSTR(text, ",", pos2 + 1)
IF pos3 THEN
red = LEFT$(text, pos1-1)
green = MID$(text, pos1 +1, pos2 - pos1 -1)
blue = MID$(text, pos2 +1, pos3 - pos2 -1)

r = VAL(red)
g = VAL(green)
b = VAL(blue)
ENDIF
ENDIF
ENDIF
ENDSUB

 SUB ColorToHSV(UINT value, INT h BYREF, INT s BYREF, INT v BYREF)
word hue, sat, _val
 
ColorRGBToHLS(value, &hue, &_val, &sat) ' see https://source.winehq.org/WineAPI/ColorRGBToHLS.html
h = hue
s = sat
v = _val
 ENDSUB

billhsln

July 15, 2019, 07:05:33 pm #4 Last Edit: July 15, 2019, 07:09:07 pm by billhsln
Ignore the internal sort, I use the Z.bat to sort by the major different types of algorithms.  There are too many sort styles that I tried and it is easier to use the batch file and keep the headers.  I figured it would be too complicated to use the sort in the program to do all the sorting I needed, so I just did it outside.  Internal does sort by Base color or RGB only.  With the algorithms I have tried I am way past that.  But none of them do a Rainbow type or at least have the major colors together, reds with reds, blues with blue, etc.

Examples:

Z lab
Z luma
Z hsl
Z hsv
Z de (supposed to give me the color difference between black and every color thereafter)
Z ncol (this is pretty much useless)
Z xyz (weird off shoot from LAB)

I know with the logic I am using, I could modify the sort, but right now it is easier with the batch file.  In fact, your sort putting the logic into CmpFunc is much cleaner than what I am doing.

Bill
When all else fails, get a bigger hammer.

fasecero

I see. It seems I followed another path. if I had to choose, I would just create the Colors.txt I need without any sorting in it. Then implement the sort inside cmpFunc, because in there I will be able to add more sorting options if I need to. Inside there you can now compare brightness, saturation, hue and r,g,b values very easy.

billhsln

Sorting by HSL does not give me what I am looking for.  I can add logic for sorting within, but until I can find an algorithm that will sort the colors in an order that at least looks kind of like a Rainbow, then I am stuck.

Bill
When all else fails, get a bigger hammer.

billhsln

Here is the view program with the logic to sort by the different types.  But, it still does not sort the colors in a Rainbow like sort sequence.  I need a better algorithm to do the sort on.

Bill
When all else fails, get a bigger hammer.

fasecero

I do not know if what you want is possible, because you have a great dispersion in hue and brightness at the same time in those colors. One way to get a rainbow like sequence is to sort them by HUE but only with some carefully selected colors following color theory

Basic explanation: https://www.canva.com/colors/color-wheel/
Color palette generator: http://paletton.com

1) Pick a base color
2) Choose a color combination: monochromatic, analogous, triadic, tetradic, free style (your own)
3) Relatively low variance in brightness

Example

fasecero

I've been watching the web and I've found some info.

https://stackoverflow.com/questions/3014402/sorting-a-list-of-colors-in-one-dimension

QuoteI would like to sort a one-dimensional list of colors so that colors that a typical human would perceive as "like" each other are near each other. Obviously this is a difficult or perhaps impossible problem to get "perfectly", since colors are typically described with three dimensions, but that doesn't mean that there aren't some sorting methods that look obviously more natural than others.

- You cannot do this without reducing the 3 color dimensions to a single measurement. There are many (infinite) ways of reducing this information, but it is not mathematically possible to do this in a way that ensures that two data points near each other on the reduced continuum will also be near each other in all three of their component color values. As a result, any formula of this type will potentially end up grouping dissimilar colors.

So the solution lies on search the web for a way to reduce 3 color properties to a single measurement. I tried sortValue = L * 5 + S * 2 + H but no cigar.

Code Select
INT sortValuea = va * 5 + ha * 3 + sa
 INT sortValueb = vb * 5 + hb * 3 + sb
 RETURN sortValuea - sortValueb

billhsln

Exactly, you understand what I am trying to do and having no luck, which is why I asked for more help.  It is very difficult to do a sort based on color. I have searched the web for at least 6 months off and on and using different search engines (just in case they would come up with a different result).  I have not seen the site you found, so will give it a try and see what comes out of it.

Thanks for trying, I know it is difficult, but since I don't have a good sense of color, I was hoping some thing like this would make it easier to pick out color variations.

Thanks again,
Bill
When all else fails, get a bigger hammer.

fasecero

One more: http://www.alanzucconi.com/2015/09/30/colour-sorting/
Hilbert sorting looks promising but can't find some source code about it.

billhsln

Thanks for site, I have seen it.  I also could not figure out how the Hilbert Sort is supposed to work.  Right now I am trying the sorting based on difference between 2 colors.  Just have not figured out how to do the sort.  Basically it should give me the color separation between to HSV colors.  Calculation did not work, when I tried doing it based on one of the colors being straight black RGB(0,0,0).  Does not sort right, so looking to do it another way.

Bill
When all else fails, get a bigger hammer.

fasecero

Good luck. Last one: https://people.csail.mit.edu/jaffer/Color/CSDR
This looks interesting because you are not plotting 3D -> 1D. You are actually plotting 3D to 2D. So the sorting lose less information and get better results. Seems more complicated to implement though.

Quote from: undefinedThe straightforward method of 3-into-2 reduction is to slice the space in parallel layers, each holding the same number of colors.

After the colors are partitioned into pages, the colors are sorted by a second criterion and laid out in a serpentine pattern on the sheet; going down the first column, then up the second column, then down the third column, etc.

These sheets are sliced by the luminance (L of L*C*h), then sorted by hue (h of L*C*h):

fasecero

Well, this was very interesting to play with. Following that page I did a basic 3D -> 2D color sorting and this is what I came up with. Compare each graphics to decide if there is an improvement (or not). This is all subjetive.

Code Select

INT sortByHUE
INT invert

SUB DoQsort(count:INT)
DEF v = &sdata + 0:POINTER
DEF d:INT
count++

' step 1: sort all pages by HUE
sortByHUE = TRUE
qsort(v, count, 255, &cmpFunc)

' step 2: sort each page by BRIGHTNESS
sortByHUE = FALSE
INT number_of_pages = count / (7 * 17) + 1

INT counter = 0
INT j
FOR j = 1 TO number_of_pages
counter += 7 * 17

INT size = 7 * 17
IF counter > count THEN
size = count
ENDIF

v = &sdata[(7 * 17) * (j - 1)] + 0
qsort(v, size, 255, &cmpFunc)
NEXT j

' step 3: invert columns 2, 4, 6 on each page
'/*
INT columns = count / (17) + 1
string temp[17]
counter = -17
invert = 1
INT w
FOR j = 1 TO columns - 1
counter += 17
invert = Revert(invert)

IF invert THEN
FOR w = 1 TO 17
IF counter + 17 - w <= count THEN temp[w - 1] = sdata[counter + 17 - w]
next w

FOR w = 1 TO 17
IF counter + w - 1 <= count THEN sdata[counter + w - 1] = temp[w - 1]
NEXT w
ENDIF
NEXT j
'*/

' continue
IF btn = "RGB"
FOR d = 0 TO maxcntr
r = VAL(MID$(sdata[d],lBase_Color+2))
sdata[d] = idata[r]
NEXT d
ENDIF
RETURN
ENDSUB

SUB Revert(INT value), INT
IF value = 1 THEN RETURN 0
RETURN 1
ENDSUB

SUB cmpFunc(a:POINTER,b:POINTER),INT
INT ra, ga, ba
INT rb, gb, bb

ExtractRGB(*<string>a, ra, ga, ba)
ExtractRGB(*<string>b, rb, gb, bb)

INT colorA = RGB(ra, ga, ba)
INT colorB = RGB(rb, gb, bb)

INT ha, sa, va
INT hb, sb, vb

ColorToHSV(colorA, ha, sa, va)
ColorToHSV(colorB, hb, sb, vb)

INT sortValuea = va
INT sortValueb = vb

IF sortByHUE THEN
sortValuea = ha
sortValueb = hb
ENDIF

RETURN sortValueA - sortValueB
ENDSUB

SUB ExtractRGB(string text, INT r BYREF, INT g BYREF, INT b BYREF)
string red, green, blue

INT pos1 = INSTR(text, ",")
IF pos1 THEN
INT pos2 = INSTR(text, ",", pos1 + 1)
IF pos2 THEN
INT pos3 = INSTR(text, ",", pos2 + 1)
IF pos3 THEN
red = LEFT$(text, pos1-1)
green = MID$(text, pos1 +1, pos2 - pos1 -1)
blue = MID$(text, pos2 +1, pos3 - pos2 -1)

r = VAL(red)
g = VAL(green)
b = VAL(blue)
ENDIF
ENDIF
ENDIF
ENDSUB

 SUB ColorToHSV(UINT value, INT h BYREF, INT s BYREF, INT v BYREF)
word hue, sat, _val
 
ColorRGBToHLS(value, &hue, &_val, &sat) ' see https://source.winehq.org/WineAPI/ColorRGBToHLS.html
h = hue
s = sat
v = _val
 ENDSUB

billhsln

The 2d looks very promising, will plug in your code and take a look.  I might want to eliminate the grey's, which would really make this pretty clean.

Bill
When all else fails, get a bigger hammer.

billhsln

I put in the code and tried it and it just aborts on me.  Will try to figure out what I screwed up that is making this abort.

Also, just an old programmers trick that you might like, replace:

invert = Revert(invert)

with

invert = 1 - invert.

switches between 1 and 0.

Bill
When all else fails, get a bigger hammer.

fasecero

Nice trick I didn't know it. I've always used a function to switch a flag ;)
Here's the full code. I disabled the clipboard and change the messagebox, so make a copy first. Looks fine to me too, but the lack of saturation order is messing up the output to some extent. Any attempt to add saturation to the formula of page (brightness) sorting makes the grid look worse.

Code Select
AUTODEFINE "OFF"

' Compile as Window

$INCLUDE "windowssdk.inc"
$INCLUDE "Shlwapi.inc"

'COLORS_API int fncolors(void);
'COLORS_API int xy2d (int n, int x, int y);

' Splits "Inp$" by  "Deliminator" into "RetArray" returns number of strings placed into "RetArray"
DECLARE Split(Inp$:STRING,Deliminator:CHAR,RetArray:POINTER),INT
DECLARE CDECL cmpFunc(a:POINTER,b:POINTER),INT

CONST filename = "Colors.txt"
CONST index = 2325
CONST Base_Colors = 30   :' Max number of Base Colors
CONST _Base_Color = 201  :' Column where Base Color Starts
CONST cBase_Color = 21   :' Field number for Base Color (0 based)
CONST lBase_Color = 12   :' Length of Base Color in Chars
CONST _Color = 214       :' Column where Color Name Starts
CONST cColor = 22        :' Field number for Color Name (0 based)

/*
CONST filename = "Colors-140.txt"
CONST index = 150
CONST Base_Colors = 30   :' Max number of Base Colors
CONST _Base_Color = 21   :' Column where Base Color Starts
CONST cBase_Color = 4    :' Field number for Base Color (0 based)
CONST lBase_Color = 6    :' Length of Base Color in Chars
CONST _Color = 28        :' Column where Color Name Starts
CONST cColor = 5         :' Field number for Color Name (0 based)
*/

DEF win:WINDOW
DEF win2:DIALOG
DEF myfile:FILE
DEF sp[25]:INT
DEF sp$[25]:STRING
DEF changed=0,update=0,fnd=0,irgb[index,3],lb=-1,lbmax=-1,max=0,maxcntr=0:INT
DEF cntr,i,j,l,rows,rr,scntr,msg,mx,my,r,g,b,clip,test:INT
DEF cntrf,cntrl:INT
DEF mc,red,green,blue:UINT
DEF btn[8]="BASE",h[16]:ISTRING
DEF icol[16,index],ihex[16,index]:ISTRING
DEF idata[index],istr[index],sdata[index],lbcol[Base_Colors],lbtext="*All",indata,saveas,header[3],path,temp:STRING
DEF tmp,t:STRING
DEF p1,p2:STRING
DEF del=",":CHAR

t = ","
test = 0

ENUM controls
b_exit = 1000
b_next
b_prev
b_rgb_base
b_static1
b_listbox
b_update
b_chg_color
b_static2
b_static3
b_listbox2
b_exit2
ENDENUM

IF test = 1 THEN OPENCONSOLE

ClearData()

path = GETSTARTPATH

IF (OPENFILE(myfile,path + filename,"R") = 0)
READ(myfile,indata)
header[0] = indata
READ(myfile,indata)
header[1] = indata
READ(myfile,indata)
header[2] = indata
cntr = -1
p1 = ""
p2 = ""
WHILE READ(myfile,indata) = 0
IF MID$(indata,1,12) = p1 AND MID$(indata,34) = p2 THEN GOTO skipit
p1 = MID$(indata,1,12)
p2 = MID$(indata,_COLOR+1)
IF MID$(indata,_COLOR-1,1) <> ","
'MESSAGEBOX 0,STR$(cntr)+" "+indata,"Problem"
END
ENDIF
cntr++
idata[cntr] = indata
rows = Split(indata,del,sp)
FOR rr = 0 TO rows - 1
temp = *<STRING>(sp[rr])
SELECT rr
' Red
CASE 0
r = VAL(temp)
irgb[cntr,0] = r
' Green
CASE 1
g = VAL(temp)
irgb[cntr,1] = g
' Blue
CASE 2
b = VAL(temp)
irgb[cntr,2] = b
' Hex
CASE 3
ihex[0,cntr] = temp
' Base
CASE cBase_Color
'temp = RTRIM$(temp)
icol[0,cntr] = temp
IF lb = -1
lb++
lbcol[lb] = temp
ELSE
fnd = 0
FOR i = 0 TO lb
IF lbcol[i] = temp
fnd = 1
i = lb + 1
ENDIF
NEXT i
IF fnd = 0
lb++
lbcol[lb] = temp
IF lb > Base_Colors
MESSAGEBOX win,"Too many Base Colors","Error"
END
ENDIF
ENDIF
ENDIF
' Color
CASE cColor
IF cntr>0
IF ihex[0,cntr] = ihex[0,cntr-1]
temp = "**" + temp
ENDIF
ENDIF
istr[cntr] = temp
'PRINT istr[cntr],cntr
ENDSELECT
NEXT rr
LABEL skipit
ENDWHILE
CLOSEFILE myfile
maxcntr = cntr
max = cntr
ENDIF

OPENWINDOW win,0,0,1300,804,0x80C80080,0,"Color Bars - RGB -"+STR$(maxcntr+1)+" defs",&handler_win

SETFONT win,"Courier New",10,400
FRONTPEN win,RGB(0,0,0)
BACKPEN win,RGB(255,255,255)

CONTROL win,@BUTTON,"Exit",1200,10,60,25,0x50010001,b_exit
CONTROL win,@BUTTON,"Next",1200,45,60,25,0x50010001,b_next
CONTROL win,@BUTTON,"Prev",1200,80,60,25,0x50010001,b_prev
CONTROL win,@BUTTON,btn,1200,115,60,25,0x50010001,b_rgb_base
CONTROL win,@STATIC,"Limit to",1159,158,60,22,0x50010001,b_static1
CONTROL win,@LISTBOX,"",1160,180,130,280,0x50800142|@CTLISTSTANDARD,b_listbox
CONTROL win,@BUTTON,"Update",1200,480,60,25,0x50010001,b_update
CONTROL win,@BUTTON,"Change\nColor",1200,510,60,45,0x50010001|@CTLBTNMULTI,b_chg_color
CONTROL win,@STATIC,"Save as",1200,590,60,22,0x50010001,b_static2
CONTROL win,@STATIC,"*Undef",1170,610,110,22,0x50010001,b_static3

SETCONTROLCOLOR win,b_exit,RGB(0,0,0),RGB(255,0,0) 'Black, Red
SETCONTROLCOLOR win,b_next,RGB(0,0,0),RGB(102,205,0) 'Black, Green
SETCONTROLCOLOR win,b_prev,RGB(0,0,0),RGB(255,215,0) 'Black, Yellow
SETCONTROLCOLOR win,b_rgb_base,RGB(0,0,0),RGB(092,172,238) 'Black, Blue
SETCONTROLCOLOR win,b_static1,RGB(255,0,0),RGB(0,0,0) 'Red, Black
SETCONTROLCOLOR win,b_listbox,RGB(0,0,0),RGB(0,255,255) 'Black, Cyan
SETCONTROLCOLOR win,b_update,RGB(0,0,0),RGB(211,211,211) 'Black, Gray
SETCONTROLCOLOR win,b_chg_color,RGB(0,0,0),RGB(255,192,203) 'Black, Pink
SETCONTROLCOLOR win,b_static2,RGB(255,0,0),RGB(0,0,0) 'Red, Black
SETCONTROLCOLOR win,b_static3,RGB(0,0,0),RGB(0,0,0) 'Black, Black

SETFONT win,"Arial",12,700,0,b_static3

lbmax = lb
ADDSTRING win,b_listbox,"*All"
FOR i = 0 to lbmax
ADDSTRING win,b_listbox,lbcol[i]
NEXT i
SETSELECTED win,b_listbox,0

cntr = -1
scntr = cntr
cntrf = 0
FOR i = 10 TO 1000 STEP 160
FOR j = 25 TO 750 STEP 45
cntr++
Legend(i,j,155,20,0,0,0,irgb[cntr,0],irgb[cntr,1],irgb[cntr,2], _
RTRIM$(icol[0,cntr])+":"+istr[cntr],ihex[0,cntr])
NEXT j
NEXT i
cntrl = cntr

DispSE()

SHOWWINDOW(win,@SWHIDE,b_chg_color)
SHOWWINDOW(win,@SWHIDE,b_static2)
SHOWWINDOW(win,@SWHIDE,b_static3)
SHOWWINDOW(win2,@SWHIDE)

CREATEDIALOG win2,0,0,240,360,0x80C80080,win,"Pick a Color",&handler_win2
SETFONT win2,"Arial",10,700
FRONTPEN win2,RGB(0,0,0)
BACKPEN win2,RGB(255,255,255)
CONTROL win2,@BUTTON,"Exit",170,10,60,25,0x50010001,b_exit2
CONTROL win2,@LISTBOX,"",10,10,150,330,0x50800142|@CTLISTSTANDARD,b_listbox2

WAITUNTIL IsWindowClosed(win)
IF test = 1 THEN CLOSECONSOLE
END

SUB handler_win(),int
SELECT @CLASS
CASE @IDCREATE
CENTERWINDOW win

CASE @IDCLOSEWINDOW
CASE& @IDDESTROY
CLOSEWINDOW win

CASE @IDLBUTTONDN
mx = @MOUSEX
my = @MOUSEY
IF mx > 7 AND mx < 1126
IF my > 10 AND my < 764
mc = GETPIXEL(win,mx,my)
DecToRGB(mc)
h = HEX$(mc)
IF LEN(h) < 6 THEN h = STRING$(6-LEN(h),"0") + HEX$(mc)
temp = "RGB("+USING("0###",red)+","+USING("0###",green)+","+USING("0###",blue)+")  0x"+h
'temp += "\n"+STR$(mx)+STR$(my)



INT ha, sa, va

ColorToHSV(mc, ha, sa, va)

temp+= STR$(ha) + " - " + STR$(sa) + " - " + STR$(va) + " - "

IF update = 1
UpdateRec("#" + h)
ELSE
msg = MESSAGEBOX win,temp,"Send to Clipboard",@MB_YESNO|@MB_ICONQUESTION
'IF msg = @IDYES THEN clip = SendToClipBoard(win,temp)
ENDIF
ENDIF
ENDIF

CASE @IDCONTROL
SELECT @CONTROLID
CASE b_listbox
IF @NOTIFYCODE = @LBNSELCHANGE
clearwin()
SHOWWINDOW(win,@SWHIDE,b_chg_color)
SHOWWINDOW(win,@SWHIDE,b_static2)
SHOWWINDOW(win,@SWHIDE,b_static3)
lb = GETSELECTED(win,b_listbox)
lbtext = GETSTRING(win,b_listbox,lb)

i = LEN(temp)
ClearData()
maxcntr = -1
tmp = btn
SELECT tmp
CASE "RGB"
FOR i = 0 TO max
temp = idata[i]
'                                         Base Color
IF lbtext = "*All" OR lbtext = MID$(temp,_Base_Color,LEN(lbtext))
maxcntr++
'                           Base Color
sdata[maxcntr] = MID$(temp,_Base_Color,lBase_Color) + t + STR$(i)
ENDIF
NEXT i
IF lbtext = "*All"
SETCAPTION win,"Color Bars - BASE -"+STR$(maxcntr+1)+" defs"
ELSE
SETCAPTION win,"Color Bars - BASE -"+STR$(maxcntr+1)+" defs for "+lbtext
ENDIF
CASE "BASE"
FOR i = 0 TO max
temp = idata[i]
'                                         Base Color
IF lbtext = "*All" OR lbtext = MID$(temp,_Base_Color,LEN(lbtext))
maxcntr++
sdata[maxcntr] = temp
ENDIF
NEXT i
IF lbtext = "*All"
SETCAPTION win,"Color Bars - RGB -"+STR$(maxcntr+1)+" defs"
ELSE
SETCAPTION win,"Color Bars - RGB -"+STR$(maxcntr+1)+" defs for "+lbtext
ENDIF
ENDSELECT
DoQsort(maxcntr)
SplitRGB()
SETCONTROLTEXT win,b_rgb_base,btn
cntr = -1
cntrf = 0
FOR i = 10 TO 1000 STEP 160
FOR j = 25 TO 750 STEP 45
cntr++
IF cntr > maxcntr
i = 1010
j = 760
cntr = maxcntr
ELSE
IF lbtext = "*All"
Legend(i,j,155,20,0,0,0,irgb[cntr,0],irgb[cntr,1],irgb[cntr,2], _
RTRIM$(icol[0,cntr])+":"+istr[cntr],ihex[0,cntr])
ELSE
Legend(i,j,155,20,0,0,0,irgb[cntr,0],irgb[cntr,1],irgb[cntr,2], _
istr[cntr],ihex[0,cntr])
ENDIF
ENDIF
NEXT j
NEXT i
cntrl = cntr
DispSE()
IF lbtext = "*Undef" AND update = 1
SHOWWINDOW(win,@SWSHOW,b_chg_color)
SHOWWINDOW(win,@SWSHOW,b_static2)
SHOWWINDOW(win,@SWSHOW,b_static3)

DOMODAL win2,0
ELSE
SHOWWINDOW(win,@SWHIDE,b_chg_color)
SHOWWINDOW(win,@SWHIDE,b_static2)
SHOWWINDOW(win,@SWHIDE,b_static3)
ENDIF
ENDIF
' Exit
CASE b_exit
IF changed = 1
MESSAGEBOX 0,"Writing new file","Info"
IF (OPENFILE(myfile,path + "ColorsF.txt","W")=0)
FOR i = 0 TO 2
WRITE(myfile,header[i])
NEXT i
FOR i = 0 TO max
WRITE(myfile,idata[i])
NEXT i
CLOSEFILE myfile
tmp = TIME$
tmp = MID$(tmp,1,2) + "-" + MID$(tmp,4,2) + "-" + MID$(tmp,7,2)
tmp = "Colors-" + DATE$("yyyy-MM-dd") + "_-_" + tmp + ".txt"
IF COPYFILE(path + "Colors.txt", path + tmp, 0) = 0
MESSAGEBOX 0, path + "Colors.txt NOT copied","Info"
ENDIF
IF COPYFILE(path + "ColorsF.txt", path + "Colors.txt", 0) = 0
MESSAGEBOX 0, path + "ColorsF.txt NOT copied","Info"
ENDIF
ENDIF
ENDIF
CLOSEWINDOW win
' Next
CASE b_next
clearwin()
scntr = cntr
cntrf = cntr + 1
FOR i = 10 TO 1000 STEP 160
FOR j = 25 TO 750 STEP 45
cntr++
IF cntr > maxcntr
i = 1010
j = 760
cntr = maxcntr
ELSE
IF lbtext = "*All"
Legend(i,j,155,20,0,0,0,irgb[cntr,0],irgb[cntr,1],irgb[cntr,2], _
RTRIM$(icol[0,cntr])+":"+istr[cntr],ihex[0,cntr])
ELSE
Legend(i,j,155,20,0,0,0,irgb[cntr,0],irgb[cntr,1],irgb[cntr,2], _
istr[cntr],ihex[0,cntr])
ENDIF
ENDIF
NEXT j
NEXT i
cntrl = cntr
DispSE()
' Prev
CASE b_prev
clearwin()
cntr = cntr - 119 - 119
IF cntr < 0 THEN cntr = -1
cntrf = cntr + 1
FOR i = 10 TO 1000 STEP 160
FOR j = 25 TO 750 STEP 45
cntr++
IF cntr > maxcntr
i = 1010
j = 760
cntr = maxcntr
ELSE
IF lbtext = "*All"
Legend(i,j,155,20,0,0,0,irgb[cntr,0],irgb[cntr,1],irgb[cntr,2], _
RTRIM$(icol[0,cntr])+":"+istr[cntr],ihex[0,cntr])
ELSE
Legend(i,j,155,20,0,0,0,irgb[cntr,0],irgb[cntr,1],irgb[cntr,2], _
istr[cntr],ihex[0,cntr])
ENDIF
ENDIF
NEXT j
NEXT i
cntrl = cntr
DispSE()
' RGB or Base Color
CASE b_rgb_base
clearwin()
ClearData()
maxcntr = max
IF btn = "BASE"
btn = "RGB"
SetCaption win,"Color Bars - BASE -"+STR$(maxcntr+1)+" defs"
SETCONTROLCOLOR win,b_rgb_base,RGB(0,0,0),RGB(217,217,025) 'Gold
FOR i = 0 TO maxcntr
temp = idata[i]
'                     Base Color
sdata[i] = MID$(temp,_Base_Color,lBase_Color) + t + STR$(i)
'IF i<10 OR i>max-3 THEN PRINTCONSOLE(STR$(i)+" s "+sdata[i])
NEXT i
ELSE
btn = "BASE"
SetCaption win,"Color Bars - RGB -"+STR$(maxcntr+1)+" defs"
SETCONTROLCOLOR win,b_rgb_base,RGB(0,0,0),RGB(092,172,238) 'Blue
FOR i = 0 TO maxcntr
sdata[i] = idata[i]
NEXT i
ENDIF
DoQsort(maxcntr)
SplitRGB()
SETCONTROLTEXT win,b_rgb_base,btn
cntr = -1
cntrf = 0
FOR i = 10 TO 1000 STEP 160
FOR j = 25 TO 750 STEP 45
cntr++
IF lbtext = "*All"
Legend(i,j,155,20,0,0,0,irgb[cntr,0],irgb[cntr,1],irgb[cntr,2], _
RTRIM$(icol[0,cntr])+":"+istr[cntr],ihex[0,cntr])
ELSE
Legend(i,j,155,20,0,0,0,irgb[cntr,0],irgb[cntr,1],irgb[cntr,2], _
istr[cntr],ihex[0,cntr])
ENDIF
NEXT j
NEXT i
cntrl = cntr
DispSE()
' chg Color
CASE b_chg_color
CASE& b_update
update = 1
SHOWWINDOW(win,@SWSHOW,b_chg_color)
SHOWWINDOW(win,@SWSHOW,b_static2)
SHOWWINDOW(win,@SWSHOW,b_static3)

DOMODAL win2,0
ENDSELECT
ENDSELECT
RETURN 0
ENDSUB

SUB handler_win2(),int
SELECT @CLASS
CASE @IDINITDIALOG
CENTERWINDOW win2

SETFONT win2,"Arial",12,700,0,b_exit2
SETFONT win2,"Arial",12,700,0,b_listbox2

SETCONTROLCOLOR win2,b_exit2,RGB(0,0,0),RGB(255,0,0) 'Black, Red

ADDSTRING win2,b_listbox2,"*Undef"
FOR i = 0 to lbmax
ADDSTRING win2,b_listbox2,lbcol[i]
NEXT i
SETSELECTED win2,b_listbox2,0

CASE @IDCLOSEWINDOW
CASE& @IDDESTROY
CLOSEDIALOG win2,@IDOK

CASE @IDCONTROL
SELECT @CONTROLID
CASE b_listbox2
IF @NOTIFYCODE = @LBNSELCHANGE
lb = GETSELECTED(win2,b_listbox2)
saveas = GETSTRING(win2,b_listbox2,lb)
SETCONTROLTEXT win,b_static3,saveas
l = LEN(saveas)
IF l < lBase_Color THEN saveas = saveas + STRING$(lBase_Color-l," ")
CLOSEDIALOG win2,@IDOK
ENDIF
' Exit
CASE b_exit2
CLOSEDIALOG win2,@IDOK
ENDSELECT
ENDSELECT
RETURN 0
ENDSUB

SUB clearwin()
RECT win,1,1,1290,799,rgb(255,255,255),rgb(255,255,255)
RETURN
ENDSUB

SUB Legend(x:int,y:int,width:int,height:int,br:int,bg:int,bb:int,fr:int,fg:int,fb:int,msg:string,hex:STRING)
'----------------------------------------------------------------------------------------
' HOW TO USE:
'   x, y   = position
'   width  = width in pixels
'   height = height in pixels
'   br, bg, bb = border color
'   fr, fg, fb = fill color
'   msg    = legend name
'----------------------------------------------------------------------------------------
IF msg = "---" THEN RETURN
RECT win,x,y,width,height,RGB(br,bg,bb),RGB(fr,fg,fb)
MOVE win,x,y-18
IF INSTR(msg,"**")
FRONTPEN win,RGB(255,0,0)
BACKPEN win,RGB(0,255,255)
ELSE
FRONTPEN win,0
BACKPEN win,RGB(255,255,255)
ENDIF
PRINT win,msg
FRONTPEN win,0
BACKPEN win,RGB(255,255,255)
MOVE win,x+2,y+2
PRINT win,USING("0###",fr)+" "+USING("0###",fg)+" "+USING("0###",fb) :'+"-"+USING("###",cntr)
'PRINT win,hex
RETURN
ENDSUB

INT sortByHUE
INT invert

SUB DoQsort(count:INT)
DEF v = &sdata + 0:POINTER
DEF d:INT
count++

' step 1: sort all pages by HUE
sortByHUE = TRUE
qsort(v, count, 255, &cmpFunc)

' step 2: sort each page by BRIGHTNESS
sortByHUE = FALSE
INT number_of_pages = count / (7 * 17) + 1

INT counter = 0
INT j
FOR j = 1 TO number_of_pages
counter += 7 * 17

INT size = 7 * 17
IF counter > count THEN
size = count
ENDIF

v = &sdata[(7 * 17) * (j - 1)] + 0
qsort(v, size, 255, &cmpFunc)
NEXT j

' step 3: invert columns 2, 4, 6 on each page
'/*
INT columns = count / (17) + 1
string temp[17]
counter = -17
invert = 1
INT w
FOR j = 1 TO columns - 1
counter += 17
invert = Revert(invert)

IF invert THEN
FOR w = 1 TO 17
IF counter + 17 - w <= count THEN temp[w - 1] = sdata[counter + 17 - w]
next w

FOR w = 1 TO 17
IF counter + w - 1 <= count THEN sdata[counter + w - 1] = temp[w - 1]
NEXT w
ENDIF
NEXT j
'*/

' continue
IF btn = "RGB"
FOR d = 0 TO maxcntr
r = VAL(MID$(sdata[d],lBase_Color+2))
sdata[d] = idata[r]
NEXT d
ENDIF
RETURN
ENDSUB

SUB Revert(INT value), INT
IF value = 1 THEN RETURN 0
RETURN 1
ENDSUB

SUB cmpFunc(a:POINTER,b:POINTER),INT
INT ra, ga, ba
INT rb, gb, bb

ExtractRGB(*<string>a, ra, ga, ba)
ExtractRGB(*<string>b, rb, gb, bb)

INT colorA = RGB(ra, ga, ba)
INT colorB = RGB(rb, gb, bb)

INT ha, sa, va
INT hb, sb, vb

ColorToHSV(colorA, ha, sa, va)
ColorToHSV(colorB, hb, sb, vb)

INT sortValuea = va
INT sortValueb = vb

IF sortByHUE THEN
sortValuea = ha
sortValueb = hb
ENDIF

RETURN sortValueA - sortValueB
ENDSUB

SUB ExtractRGB(string text, INT r BYREF, INT g BYREF, INT b BYREF)
string red, green, blue

INT pos1 = INSTR(text, ",")
IF pos1 THEN
INT pos2 = INSTR(text, ",", pos1 + 1)
IF pos2 THEN
INT pos3 = INSTR(text, ",", pos2 + 1)
IF pos3 THEN
red = LEFT$(text, pos1-1)
green = MID$(text, pos1 +1, pos2 - pos1 -1)
blue = MID$(text, pos2 +1, pos3 - pos2 -1)

r = VAL(red)
g = VAL(green)
b = VAL(blue)
ENDIF
ENDIF
ENDIF
ENDSUB

 SUB ColorToHSV(UINT value, INT h BYREF, INT s BYREF, INT v BYREF)
word hue, sat, _val
 
ColorRGBToHLS(value, &hue, &_val, &sat) ' see https://source.winehq.org/WineAPI/ColorRGBToHLS.html
h = hue
s = sat
v = _val
 ENDSUB

SUB ClearData()
FOR i = 0 TO index - 1
irgb[i,0] = 0
irgb[i,1] = 0
irgb[i,2] = 0
ihex[0,i] = ""
sdata[i] = ""
istr[i] = ""
icol[0,i] = ""
NEXT i
RETURN
ENDSUB

SUB SplitRGB()
DEF c,m:INT
FOR m = 0 TO maxcntr
indata = sdata[m]
r = INSTR(indata,",")
'IF m<4 THEN messagebox 0,indata+STR$(r),"Info"
IF r > 0
c = -1
DO
c++
sp$[c] = MID$(indata,1,r-1)
indata = MID$(indata,r+1)
r = INSTR(indata,",")
'IF m<4 THEN messagebox 0,indata+STR$(r),"Info2"
UNTIL r = 0
c++
sp$[c] = indata
ENDIF
'IF m<4 THEN MESSAGEBOX 0,STR$(c),"C"
' Red
irgb[m,0] = VAL(sp$[0])
' Green
irgb[m,1] = VAL(sp$[1])
' Blue
irgb[m,2] = VAL(sp$[2])
' HEX
ihex[0,m] = sp$[3]
' Base
icol[0,m] = RTRIM$(sp$[cBase_Color])
' Color
istr[m] = sp$[cColor]
NEXT m
cntr = -1
RETURN
ENDSUB

SUB DecToRGB(decimal:UINT)
'----------------------------------------------------------------------------------------
' Returns RGB Triplet from integer
' Original idea: TexasPete
' Please note  : Red,Green and Blue Must be Global and declared outside of this function
'----------------------------------------------------------------------------------------
DEF GetRed,GetGreen,GetBlue:UINT
' GetRed
blue = (decimal/(256*256))
green = ((decimal-blue*256*256)/256)
GetRed = (decimal-blue*256*256-green*256)
' GetGreen
blue = (decimal/(256*256))
GetGreen = (decimal-blue*256*256)/256
' GetBlue
GetBlue = (decimal/(256*256))
red = GetRed
green = GetGreen
blue = GetBlue
RETURN
ENDSUB

SUB UpdateRec(text:STRING)
DEF ii,ll:INT
FOR ii = 0 TO max
ll = INSTR(idata[ii],text)
IF ll
msg = MESSAGEBOX 0,STR$(ll)+" "+text+" - "+MID$(idata[ii],_Base_Color,lBase_Color)+"\n"+saveas+"\n\n"+MID$(idata[ii],_Color),"Update",@MB_YESNO|@MB_ICONQUESTION
IF msg = @IDYES
'                  up to Base Color                               Color
temp = MID$(idata[ii],1,_Base_Color-1) + saveas + MID$(idata[ii],_Color-14)
idata[ii] = temp
changed = 1
ENDIF
ENDIF
NEXT ii
RETURN
ENDSUB

SUB DispSE()
RECT win,1180,655,100,25,rgb(255,0,0),rgb(255,0,0)
MOVE win,1190,660
PRINT win,"Start ", USING("####",cntrf)

RECT win,1180,705,100,25,rgb(255,0,0),rgb(255,0,0)
MOVE win,1190,710
PRINT win,"  End ", USING("####",cntrl)
RETURN
ENDSUB

/*
'---- print text to console window -----------
SUB PrintConsole(text:STRING)
  STATIC UINT stdout
UINT charwritten

IF stdout=0
OPENCONSOLE
stdout=GetStdHandle(-11)
SetWindowPos(FindWindow(0,__FILE__),HWND_TOPMOST,0, 0, 0, 0,SWP_NOMOVE | SWP_NOSIZE)
test=1
ENDIF
WriteConsole(stdout,text+"\n",len(text)+2,&charwritten,0)
RETURN
ENDSUB
*/

' Split created by Ficko
_asm
Split: push ebp
mov ebp, esp
push esi
push edi
push ebx
mov edi, [ebp+8]
mov esi, [ebp+16]
xor ecx, ecx
xor ebx, ebx
movzx eax, byte [ebp+12]
C01:mov [esi], edi
inc ebx
C00:cmp byte [edi], 0
        jz Exit
inc ecx
scasb
jnz C00
lea esi, [esi+4]
mov [edi-1], ah
jmp C01
Exit: mov dword [esi+4], 0          ;Can be omited since we have return value.
xchg eax, ebx
pop ebx
pop edi
pop esi
leave
ret 0x0C
_endasm


billhsln

That works, after a few minor changes, due to some stuff I changed.  Looks very good.  At least, it is definitely in the right direction.

Thanks,
Bill
When all else fails, get a bigger hammer.

billhsln

Just an interesting side note.  I wrote the data out after the sort and it seems like 6 records are missing.  Not sure why and it puts some blank records, but only at the end.

Put the following code into the end of DoSort routine:

Code Select
IF (OPENFILE(myfile,path + "Colors-Sorted.txt","W") = 0)
FOR d = 0 TO index-1
WRITE(myfile,sdata[d])
NEXT d
ENDIF
CLOSEFILE myfile

Writes out a file that I looked at.  Will see if I can figure it out.

Bill
When all else fails, get a bigger hammer.

billhsln

Found the problem, changed 1 line:

Code Select
INT size = 7 * 17
 IF counter > count THEN
    size = counter - count
 ENDIF

It now writes all the records without blank spaces.

Bill
When all else fails, get a bigger hammer.

fasecero

I'm still playing with this :). No luck trying to find a Hilbert sorting example (I gave up) but I found a library to measure the "distance" between two colors based on human color perception. Its C++ source code so I made a small dll around it.

Cie76 & DeltaE (distance of colors according to human perception)
https://support.hunterlab.com/hc/en-us/articles/203023559-Brief-Explanation-of-delta-E-or-delta-E-
https://en.wikipedia.org/wiki/CIELAB_color_space

Source code (dll code)
https://github.com/ThunderStruct/Color-Utilities

So now there's a fourth way to compare colors: hue, saturation, brightness, and deltaE.

But there's a catch, because you have to choose a REFERENCE color to measure the distances. I've chosen black, the more distant the color is to black the more sooner it will appear on the list. You can try different colors until you get a good looking one.

billhsln

The 'Ciede2000' subroutine in the Colors_Convert.iwb is Cie2000 algorithm to come back with the delta E. I used black as the base and it did not work out as good as your previous color sorting.  Maybe if I put it into the actual sort, it will look better.  I am thinking because just using the base as black and going from there did not look right.  Maybe sorting will do a better job.  See column de_2000 in converted file.

Bill
When all else fails, get a bigger hammer.

fasecero

I guess somehow I must've missed that subroutine. Of all the combinations I tried, HUE + brightness and deltaE + HUE are the ones I liked the most. At least you have lots of options to choose from :)

billhsln

I obviously don't understand how the QSort works. tried doing the difference using Cie2000 and it aborts in the Qsort routine.  Putting the code here that I tried.  All you have to do is click on '*All' in the listbox to do this sort, assuming I have it right.

Bill
When all else fails, get a bigger hammer.