NearestColor module

[wilbert]

I'm hoping you can come up with a fix for this problem.
I've tried looking at the code but it's just too deep for me to follow.

I found it already difficult to follow my own code from a year ago
Anyway, I posted an update in the first post of this thread. Hopefully it's fixed now.

[BasicallyPure]

Yes, it seems to be working now.
Thank you very much.

[SeregaZ]

ha! it is you again help me it will need to write note about you in my "finale title" twice

but i am a little not understand how it use... as i can understand "Palette" - it is a image file? but i have array with 16 colors. can it have some:
NearestColor::SetPaletteFromArray(Arrayname(), colorscount)

and DitheredImage is make repaint with new colors? i have some set transparent color - it will need to do after DitheredImage? by theory 1 color is transparent. so i check Clipboard image for that 1 color and make transparent for pasting.

and "nes57"? it that NES - that i am thinking? ) i know you are our man )) my software for edit console's game too - but SMD, not NES.

[SeregaZ]

probably i am understand. thanks. many code is very crypted with ASM but main idea i am get from that and apply. thanks a lot

[wilbert]

i have array with 16 colors. can it have some:
NearestColor::SetPaletteFromArray(Arrayname(), colorscount)

If the array consists of 16 values of the type Long, you can use CatchPalette.
Something like

NearestColor::CatchPalette(@PaletteArray(0), 16)

[SeregaZ]

yeap i am make like you say. result is very nice.

[SeregaZ]

i know, you know everything! help with this question. (a lot of unanderstandible text)

i have 2 files - pallete - 16 colors, and image - 4bit file, where lays color index from this pallete.

i have brush tool, copy, paste and FillArea how it names...

i have 16 gadgets for change color in pallette. and it is displays new color on image by hot swap.

brush is draw some plot on image by mouse move.

when i have changing color in pallete - no problem, when i am use brash and paint some - no problem. problem is when i use both of them. i am paint some, then change color in a pallete. for example 1 color is blue, 2 is red. when i am change 2 color to blue and start repaint procedure - it merge both color and image becomes full into blue (becouse i am use Point command for get color from image). next step i am change 2 color to green - it will repaint full image into green. not as old borders of this two colors.

so i start to think use some kind of array CoordinatesX(x)\Y(y) and repaint image from this array. so it will solve problem with color pallete changing and will use brush with no problem too. BUT! how to use FillArea? it broke whole idea how to get all coordinates of FillArea command for correct writing it in a array?

[SeregaZ]

probably i am solve this:

Code: Select all

Structure colorarraystr
  Array Y.u(5)
EndStructure
Global Dim ColorCoordX.colorarraystr(5)

ColorCoordX(0)\Y(0) = 1
ColorCoordX(1)\Y(0) = 1
ColorCoordX(2)\Y(0) = 1
ColorCoordX(3)\Y(0) = 1
ColorCoordX(4)\Y(0) = 1
ColorCoordX(5)\Y(0) = 1

ColorCoordX(0)\Y(1) = 1
ColorCoordX(1)\Y(1) = 2
ColorCoordX(2)\Y(1) = 2
ColorCoordX(3)\Y(1) = 2
ColorCoordX(4)\Y(1) = 2
ColorCoordX(5)\Y(1) = 2 ; test overlimit
ColorCoordX(0)\Y(2) = 1
ColorCoordX(1)\Y(2) = 2
ColorCoordX(2)\Y(2) = 1
ColorCoordX(3)\Y(2) = 2
ColorCoordX(4)\Y(2) = 1
ColorCoordX(5)\Y(2) = 1
ColorCoordX(0)\Y(3) = 1
ColorCoordX(1)\Y(3) = 2
ColorCoordX(2)\Y(3) = 1
ColorCoordX(3)\Y(3) = 2
ColorCoordX(4)\Y(3) = 1
ColorCoordX(5)\Y(3) = 1
ColorCoordX(0)\Y(4) = 1
ColorCoordX(1)\Y(4) = 2
ColorCoordX(2)\Y(4) = 2
ColorCoordX(3)\Y(4) = 1
ColorCoordX(4)\Y(4) = 2
ColorCoordX(5)\Y(4) = 1

ColorCoordX(0)\Y(5) = 1
ColorCoordX(1)\Y(5) = 2 ; test overlimit
ColorCoordX(2)\Y(5) = 1
ColorCoordX(3)\Y(5) = 1
ColorCoordX(4)\Y(5) = 1
ColorCoordX(5)\Y(5) = 1

Procedure ShowImage()
tmp$ = ""
For y = 0 To 5
  For x = 0 To 5
    tmp$ + Str(ColorCoordX(x)\Y(y)) + " "
  Next
  tmp$ + Chr(10)
Next
Debug tmp$
EndProcedure
ShowImage()

Procedure FillAreaArray(x.a, y.a, newcolor.a, oldcolor=-1)
  
  If oldcolor = -1
    oldcolor = ColorCoordX(x)\Y(y)
  EndIf
  
  If ColorCoordX(x)\Y(y) = oldcolor
    ColorCoordX(x)\Y(y) = newcolor
    If y-1 > -1
      If ColorCoordX(x)\Y(y-1) = oldcolor
        FillAreaArray(x, y-1, newcolor, oldcolor)
      EndIf
    EndIf
    If y+1 <= ArraySize(ColorCoordX(x)\Y())
      If ColorCoordX(x)\Y(y+1) = oldcolor
        FillAreaArray(x, y+1, newcolor, oldcolor)
      EndIf
    EndIf
    If x-1 > -1
      If ColorCoordX(x-1)\Y(y) = oldcolor
        FillAreaArray(x-1, y, newcolor, oldcolor)
      EndIf
    EndIf
    If x+1 <= ArraySize(ColorCoordX())
      If ColorCoordX(x+1)\Y(y) = oldcolor
        FillAreaArray(x+1, y, newcolor, oldcolor)
      EndIf
    EndIf
  EndIf  
  
EndProcedure

FillAreaArray(1, 2, 3)

ShowImage()

i think ArraySize will be call to many times. probably it need to be entered as input data for procedure.

[wilbert]

It looks like you have one global 16 color palette for all images.
If this is the case, I would probably do all image processing on images with 16 gray tones (one for each palette index) and only for display use a CustomFilterCallback which replaces each gray tone with the palette color.

[SeregaZ]

anyway i am become back to begining again now i can save both colors, for example 1 and 2 - even they are have same color. but how to make image pasting? it return me to that idea with Point command. i mean make paste, then pass all image with point command and return colors into array for save. it will merge that 1 and 2 colors into 1 - remove borders between of them.

probably i will need to make some restrict options, for avoide same color settings for 2 colors in a palette. but examples can have this same color settings... it broke whole system again it is suks... only i am start to see some light in a dark tonnel, this light is sinking in a shadows

[SeregaZ]

now i cant understand how to make paste with his own palette. when paste to palette of program - no problem. but i think to make some paste with palette of image, not programm. but it have some 512 of allow colors. so first i need to catch nearest of 512, then check for empty slots for 15 colors in palette, then, when i get all 15 colors - make nearest again for full image. only then make paste. and i have all 15 colors is black. where my mistake?

http://dmarket.pusku.com/AC-130.bmp

*old code was deleted

[SeregaZ]

probably this one more correct, than old one... but anyway it is a little wrong. i am get first 15 different colors from image, but maybe it can be some procedure as Gif Animator do? i mean he can set for image how many colors he can have. he merge almost same colors, so image loose not so many, as my case with first 15 colors. only then make some nearest for 15. it will be more correct. any solution? i mean get image, get 512 colors from allow table colors and take from this 512 only 15 for image. not first 15 as i am do, but make some oprimization into 15 of allowing colors.

Code: Select all

;{
Global Dim FullPalette.l(513)
Dim col.a(8)
col(1) = 0
col(2) = 36
col(3) = 72
col(4) = 109
col(5) = 145
col(6) = 181
col(7) = 219
col(8) = 255
x = 0
y = 0
If CreateImage(0, 256, 32)
  If StartDrawing(ImageOutput(0))
    For i = 1 To 8
      For l = 1 To 8
        For k = 1 To 8
          Box(x,y,4,4, RGB(col(k),col(l),col(i)))
          num + 1
          FullPalette(num) = RGB(col(k),col(l),col(i))          
          x + 4
        Next
        x - 32
        y + 4
      Next
      x + 32
      y - 32
    Next      
    StopDrawing()
  EndIf
EndIf ;}

  ;{
  Global Dim Palette.l(1)
  Global Dim IndexG.l(255)

  EnableASM

  CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
    Macro rdx : edx : EndMacro
  CompilerEndIf

  Macro M_FindNearest(i, st)
    !nearestcolor.findnearest#i#_loop: 
    !mov ecx, [p.v_c#i#]
    !test ecx, ecx
    !jz nearestcolor.findnearest#i#_cont2
    !movzx eax, byte [p.v_Color + 1]
    !movzx ecx, ch
    !sub eax, ecx
    !imul eax, eax
    !shl eax, 11
    !cmp eax, [p.v_bestd]
    !jnc nearestcolor.findnearest#i#_cont1
    !mov [p.v_d], eax
    !movzx eax, byte [p.v_Color]
    !movzx ecx, byte [p.v_c#i#]
    !lea edx, [eax + ecx]   ; edx = rsum
    !sub eax, ecx
    !imul eax, eax          ; eax = r*r
    !lea ecx, [edx + 0x400] ; ecx = $400 + rsum
    !imul eax, ecx          ; eax = ($400+rsum)*r*r
    !add [p.v_d], eax
    !movzx eax, byte [p.v_Color + 2]
    !movzx ecx, byte [p.v_c#i# + 2]
    !sub eax, ecx
    !imul eax, eax          ; eax = b*b
    !neg edx
    !add edx, 0x5fe         ; edx = $5fe - rsum
    !imul eax, edx          ; eax = ($5fe-rsum)*b*b
    !add eax, [p.v_d]
    !cmp eax, [p.v_bestd]
    !jnc nearestcolor.findnearest#i#_cont0
    !mov [p.v_bestd], eax
    !mov eax, [p.v_c#i#]
    !mov [p.v_c], eax
    !nearestcolor.findnearest#i#_cont0:
    mov rdx, *p#i
    add rdx, st
    mov *p#i, rdx
    mov eax, [rdx]
    !mov [p.v_c#i#], eax
    CompilerIf i = 1
      !jmp nearestcolor.findnearest0_loop
    CompilerElse
      !jmp nearestcolor.findnearest1_loop
    CompilerEndIf
    !nearestcolor.findnearest#i#_cont1:
    !mov dword [p.v_c#i#], 0
    !nearestcolor.findnearest#i#_cont2:
    CompilerIf i = 1
      !cmp dword [p.v_c0], 0
      !jnz nearestcolor.findnearest0_loop
    CompilerEndIf
  EndMacro

  Procedure.l FindNearest(Color.l)
    ; Find the nearest color
    Protected.l c, c0, c1, d, bestd = $12000000
    Protected.Long *p0, *p1
    !movzx eax, byte [p.v_Color + 1]
    !mov [p.v_d], eax
    *p1 = @Palette(IndexG(d)) : *p0 = *p1 - 4
    c0 = *p0\l : c1 = *p1\l
    M_FindNearest(0, -4)
    M_FindNearest(1, 4)
    ProcedureReturn c
  EndProcedure
  
  Procedure CatchPalette(*MemoryAddress.Long, NumColors.i)
    ; Catch a palette from memory
    Protected.i i, j = 1, t
    ReDim Palette(NumColors + 1)
    Palette(0) = 0 : Palette(NumColors + 1) = 0
    For i = 1 To NumColors
      Palette(i) = $ff000000 | *MemoryAddress\l
      Debug Hex(Palette(i))
      *MemoryAddress + 4
    Next
    SortStructuredArray(Palette(), 0, 0, #PB_Unicode, 1, NumColors)
    For i = 0 To 255
      IndexG(i) = j
      While ((Palette(j) >> 8) & $ff) = i And j < NumColors
        j + 1
      Wend
      IndexG(i) = (IndexG(i) + j) >> 1
    Next
  EndProcedure
  DisableASM
  ;}
  
; fill 1 to palette. 1 like marker, says this slot is empty.
Dim ColorArr(16)
For i = 1 To 15
  ColorArr(i) = 1
Next    
color.i

If LoadImage(1, "AC-130.bmp")
  SetClipboardImage(1)
EndIf

If GetClipboardImage(1, 32)
  
  CatchPalette(@FullPalette(), 513) ; accessible colors
  
  If OpenWindow(0, 100, 200, 500, 360, "PureBasic Window", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
    
    ImageGadget(10, 10, 10, 96, 56, ImageID(1))
    
    ; get first 15 colors. (0 color is purple for transparent)  
    If StartDrawing(ImageOutput(1))
      y = 0
      While y < 56
        x = 0
        While x < 96
          bingo = 0  
          color = Point(x, y)
          
          color = FindNearest(color)

          For i = 1 To 15
            If ColorArr(i) = color
              ; already have this color in a palette
              bingo = 1
              Break
            EndIf
          Next
          If bingo = 0
            For i = 1 To 15
              If ColorArr(i) = 1
                ; this slot is empty
                ColorArr(i) = color
                bingo = 1
                Debug "catch some color " + Str(color)
                Break
              EndIf
            Next
            If bingo = 0
              Debug "all passible colors is catch, ignore others"
              Break
            EndIf
          EndIf
          x + 1
        Wend
        y + 1
      Wend        
      StopDrawing()
    EndIf    
    
    ; create some palette images and gadgets for show
    For i = 0 To 15
      CreateImage(100 + i,          20,  20, 32, ColorArr(i))
      ImageGadget(12  + i, 20 + i * 21, 150, 20, 20, ImageID(100+i))
    Next
    
    CopyImage(1, 2)
    
    ; now catch from 16 colors
    CatchPalette(@ColorArr(), 16)
    ; repaint with 16 colors
    If StartDrawing(ImageOutput(2)) 
      y = 0
      While y < 56
        x = 0
        While x < 96
          Plot(x, y, FindNearest(Point(x, y)))
          x + 1
        Wend
        y + 1
      Wend        
      StopDrawing()
    EndIf    
    
    ImageGadget(11, 10, 70, 96, 56, ImageID(2))

    Repeat
      Event = WaitWindowEvent()

      If Event = #PB_Event_CloseWindow  ; If the user has pressed on the close button
        Quit = 1
      EndIf

    Until Quit = 1
  
  EndIf

EndIf

End  

[wilbert]

The module only tries to find the best match from an existing palette but it sound like your problem is more how to pick the right palette colors.
There exist a lot of color quantization algorithms; some of them can be found on this forum as well.
Maybe this explains things a bit more
http://bisqwit.iki.fi/jutut/colorquant/index16.html

[wilbert]

As an answer to the question you posted in the NeuQuant topic, I'm not saying that is the solution to your problem.
NeuQuant is mainly good for a 256 color palette and the module I wrote is hardcoded for such a palette. In your case you want a 16 color palette.
You will have to figure out what is the best method for you to get from your 512 colors to 16.
BasicallyPure has explored some methods http://www.purebasic.fr/english/viewtop ... 27&t=59428 and on Rosetta Code there's also some PureBasic code https://rosettacode.org/wiki/Color_quan ... #PureBasic .
The most simple approach is simply counting which 16 colors of your 512 ones occur the most and discard the rest but that might not give the result you want.
In general, it's hard to get a good result with only 16 colors. Dithering might help.

[SeregaZ]

wilbert, i am lost where i get Transparent module... i have a question about it. for example i have image, where purple is sets as transparent. then i am painting this image in canvas. with 3 layers or how it names.
1. box 160x160 of purple
2. gridlines
3. DrawAlphaImage with this image

then i need to make some plot with color (box 5x5 actualy). when i am over on not transparent part of image - all work fine. but if i am on transparent part - this box is not painting. this coordinates have transparent marker, so it will no show this color. how to set not transparent back in that coordinates?

Code: Select all

If StartDrawing(ImageOutput(#GFXEditorMAINEditImage))
                          ; for this box need to set untransparent marker. how to make it?
                          Box(CurIconx8X*5, CurIconx8Y*5, 5, 5, ColorArr(palitranum)\colornum[IcEdColor-1])
                          StopDrawing()
                          
                          If StartDrawing(CanvasOutput(#GFXEditorMAINEditGad))
                            Box(0, 0, 160, 160, ColorArr(palitranum)\colornum[0])
                            GFXGridLines()
                            DrawAlphaImage(ImageID(#GFXEditorMAINEditImage), 0, 0)
                            StopDrawing()
                          EndIf
                      
                        EndIf 

i think
Box(CurIconx8X*5, CurIconx8Y*5, 5, 5, ColorArr(palitranum)\colornum[IcEdColor-1]|$FF000000)
can help, but probably is not...

or i can make full repaint image with free old one and remake transparent again. it will take a lot of repaint - but i want to make more fine code with minimum repaint operations.

after DrawAlphaImage - canvas is remember that transparent mask and when i am move image on canvas - it shows image only that place, where no transparent. all another place of image is not show image.