PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

NeuQuant (SSE2)

https://www.purebasic.fr/english/viewtopic.php?t=57939

Page 2 of 2

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 8:03 am
by netmaestro
Can anyone spot what I'm doing wrong here? If the code runs with the current commenting, quality is good but the colors are wrong. Switch the commenting in the inxSearch loop and the colors become right but the quality goes way down. Here's the code, it'll download the sample image one time:

Code: Select all

IncludeFile "NeuQuant.pbi"

Macro GetPixel32BitImage (x, y) 
  PeekL(bitsptr_in + sz_colorbits_in  + ((x) << 2) - ((y) + 1) * wb_in)
EndMacro

Macro SetPixel8BitImage (x, y, col) 
  PokeB(bitsptr_out + (h*wb_out) + (x) - ((y) + 1) * wb_out, col)
EndMacro

Procedure ImageTo8bit(image_number)
  If ImageDepth(image_number)<>32
    this = CreateImage(#PB_Any, ImageWidth(image_number), ImageHeight(image_number), 32)
    StartDrawing(ImageOutput(this))
      DrawImage(ImageID(image_number), 0, 0)
    StopDrawing()
    FreeImage(image_number)
    image_number = this
    hImageIn = ImageID(this)
  Else
    hImageIn = ImageID(image_number)
  EndIf
  
  *palette = AllocateMemory(256*SizeOf(RGBQUAD)) 
  NeuQuant::InitNet()
  NeuQuant::Learn(image_number)
  NeuQuant::UnbiasNet(*palette)
  NeuQuant::InxBuild()
  
  GetObject_(hImageIn,SizeOf(BITMAP),bmp32.BITMAP)
  With bmp32
    w =               \bmWidth 
    h =               \bmHeight 
    bitsptr_in =      \bmBits
    sz_colorbits_in = \bmWidthBytes * bmp32\bmHeight
    wb_in =           \bmWidthBytes
  EndWith
  
  With bmi8.BITMAPINFO 
    \bmiHeader\biSize     = SizeOf(BITMAPINFOHEADER) 
    \bmiHeader\biWidth    = w 
    \bmiHeader\biHeight   = h 
    \bmiHeader\biPlanes   = 1 
    \bmiHeader\biBitCount = 8 
  EndWith
  
  hdcDest = CreateCompatibleDC_(0)
  
  hImageOut = CreateDIBSection_(hdcDest, @bmi8, #DIB_PAL_COLORS, @ppvbits, 0, 0) 
  SelectObject_(hdcDest, hImageOut)
  GdiFlush_()
  SetDIBColorTable_(hdcDest,0,256,*palette)    
  DeleteDC_(hdcDest)
  
  GetObject_(hImageOut, SizeOf(BITMAP), @bmp8.BITMAP)
  With bmp8
    wb_out =      \bmWidthBytes
    bitsptr_out = \bmBits
  EndWith

  StartDrawing(ImageOutput(image_number))
  max_x = w - 1
  max_y = h - 1
  For y = 0 To max_y
    For x = 0 To max_x
      index.a = NeuQuant::InxSearch(NeuQuant::PointOrdDith(x, y)) ; comment this line out if uncommenting the next 2
      ;thiscolor = GetPixel32BitImage(x, y)
      ;index.a = NeuQuant::InxSearch(thiscolor)
      SetPixel8BitImage(x, y, index)
    Next
  Next
  StopDrawing()
  
  FreeMemory(*palette) 
  ProcedureReturn hImageOut 
  
EndProcedure

;////////////////////////////////////////////////////
;                    TEST CODE
;////////////////////////////////////////////////////

file$ = GetTemporaryDirectory()+"girl.jpg"

If FileSize(file$) = -1
  InitNetwork()
  If Not ReceiveHTTPFile("http://www.lloydsplace.com/girl.jpg", file$)
    MessageRequester("oops!","Problem getting image... quitting")
  EndIf
EndIf

UseJPEGImageDecoder() 

image_number = LoadImage(#PB_Any, "girl.jpg") 

w=ImageWidth(image_number)
h=ImageHeight(image_number)

result = ImageTo8bit(image_number) 

; Let's take a look at the results...

OpenWindow(0,0,0,w,h,"") 
ImageGadget(0,0,0,0,0,result)
Repeat:EventID = WaitWindowEvent():Until EventID = #PB_Event_CloseWindow
This code works fine with the luis port of Dekker's algorithm but this implementation is so much faster I'd like to get it working with 8bit output.

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 9:43 am
by wilbert
@netmaestro,
I haven't checked your example but based on what you are saying, I think it might have to do with RGBA vs BGRA .
For Windows internal format, red and blue are switched compared to what Point or PointOrdDith return.

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 9:49 am
by netmaestro
That sounds like exactly like a solution. You don't happen to have an asm version of the conversion kicking around somewhere, do you? It would save me an hour's worth of effort and a possible concussion, but it's something you either have already or could do inside of two minutes. If it wouldn't be too much trouble.

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 9:50 am
by Keya
here's some i prepared earlier! i would love to know how it compares to wilberts hehe (cunningly give him a challenge where there's not much room for improvement to artificially inflate my ego ;))

Code: Select all

Procedure RGBtoBGRinplace(addrPixel) ;and vice versa
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
  !mov rax, [p.v_addrPixel]
  !mov ecx, [rax]         ;/  Input  \
  !bswap ecx              ;33 22 11 FF -> FF 11 22 33
  !ror ecx, 8             ;FF 11 22 33 -> 11 22 33 FF
  !mov [rax], ecx         ;               \  Output /
  CompilerElse
  !mov eax, [p.v_addrPixel]
  !mov ecx, [eax]
  !bswap ecx
  !ror ecx, 8
  !mov [eax], ecx
  CompilerEndIf
EndProcedure
;eg. RGBtoBGRinplace(@rgbPixel.l)
;for a whole image it's easier to use this than the following version which would also require lots of PokeA's!

Procedure RGBAtoBGRA(pixel) ;and vice versa
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    !mov rax, [p.v_pixel]
  CompilerElse
    !mov eax, [p.v_pixel]
  CompilerEndIf
  !bswap eax
  !ror eax, 8
  ProcedureReturn ;eax/rax
EndProcedure
;eg. swappedrgbPixel.l = RGBAtoBGRA(rgbPixel.l)

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 10:04 am
by netmaestro
Thanks to keya, I've implemented the swap.

This results in correct colors, bad quality:

Code: Select all

      color = RGBAtoBGRA(NeuQuant::PointOrdDith(x, y)) ; comment this line out if uncommenting the next 2
      index.a = NeuQuant::InxSearch(color)             ; comment this line out if uncommenting the next 2
      ;thiscolor = RGBAtoBGRA(GetPixel32BitImage(x, y))
      ;index.a = NeuQuant::InxSearch(thiscolor)
      SetPixel8BitImage(x, y, index)
and this results in fine quality, wrong colors:

Code: Select all

      ;color = RGBAtoBGRA(NeuQuant::PointOrdDith(x, y)) ; comment this line out if uncommenting the next 2
      ;index.a = NeuQuant::InxSearch(color)             ; comment this line out if uncommenting the next 2
      thiscolor = RGBAtoBGRA(GetPixel32BitImage(x, y))
      index.a = NeuQuant::InxSearch(thiscolor)
      SetPixel8BitImage(x, y, index)

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 10:05 am
by Keya
make sure you're feeding the pixels to the quantizer in the right order too

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 10:10 am
by wilbert
Any reason you just aren't using Point ?

Code: Select all

index.a = NeuQuant::InxSearch(Point(x, y))

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 10:12 am
by netmaestro
Point(x,y) produces results equal to NeuQuant::PointOrdDith(x, y), nothing to gain there. One applies the dither and the other doesn't. Outcome is the same.

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 10:17 am
by netmaestro
keya wrote:make sure you're feeding the pixels to the quantizer in the right order too
Doublechecked, inxSearch is getting the swapped version in both cases.

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 10:19 am
by wilbert
You probably need a copy of the palette with red and blue swapped to use for SetDIBColorTable_ .

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 10:31 am
by netmaestro
Very good suggestion, but though implementing it did change the results, not for the better. I'll probably have to stick with the luis version, even though it's 3 times slower. I really can't see where I'm making a mistake here. If there was something wrong with my SetPixel8bitImage macro, it wouldn't look like a girl at all. Same with my GetPixel32bitImage macro. Has someone else successfully used this code to affect colors from a truecolor image to an 8bit image? If so, I hope they'll weigh in.

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 10:48 am
by wilbert
Does this work for you ?

Code: Select all

IncludeFile "NeuQuant.pbi"

Procedure RGBAtoBGRA(pixel)
  !mov eax, [p.v_pixel]
  !bswap eax
  !ror eax, 8
  ProcedureReturn
EndProcedure

Procedure ImageTo8bit(image_number)
  Protected Dim palette.l(255)
  
  w = ImageWidth(image_number)
  h = ImageHeight(image_number)
  
  NeuQuant::InitNet()
  NeuQuant::Learn(image_number)
  NeuQuant::UnbiasNet(@palette())
  NeuQuant::InxBuild()
  
  For i = 0 To 255
    palette(i) = RGBAtoBGRA(palette(i))
  Next
 
  With bmi8.BITMAPINFO 
    \bmiHeader\biSize     = SizeOf(BITMAPINFOHEADER) 
    \bmiHeader\biWidth    = w
    \bmiHeader\biHeight   = h
    \bmiHeader\biPlanes   = 1 
    \bmiHeader\biBitCount = 8 
  EndWith
  
  hdcDest = CreateCompatibleDC_(0)
  
  hImageOut = CreateDIBSection_(hdcDest, @bmi8, #DIB_PAL_COLORS, @ppvbits, 0, 0) 
  SelectObject_(hdcDest, hImageOut)
  GdiFlush_()
  SetDIBColorTable_(hdcDest,0,256,@palette())    
  DeleteDC_(hdcDest)
  
  GetObject_(hImageOut, SizeOf(BITMAP), @bmp8.BITMAP)
  With bmp8
    nextline_offset = -\bmWidthBytes - w
    *bitsptr.Ascii = \bmBits + (h - 1) * \bmWidthBytes
  EndWith
  
  StartDrawing(ImageOutput(image_number))
  max_x = w - 1
  max_y = h - 1
  For y = 0 To max_y
    For x = 0 To max_x
      *bitsptr\a = NeuQuant::InxSearch(NeuQuant::PointOrdDith(x, y))
      *bitsptr + 1
    Next
    *bitsptr + nextline_offset  
  Next
  StopDrawing()

  ProcedureReturn hImageOut 
  
EndProcedure

;////////////////////////////////////////////////////
;                    TEST CODE
;////////////////////////////////////////////////////

file$ = GetTemporaryDirectory()+"girl.jpg"

If FileSize(file$) = -1
  InitNetwork()
  If Not ReceiveHTTPFile("http://www.lloydsplace.com/girl.jpg", file$)
    MessageRequester("oops!","Problem getting image... quitting")
  EndIf
EndIf

UseJPEGImageDecoder() 

image_number = LoadImage(#PB_Any, GetTemporaryDirectory()+"girl.jpg") 

w=ImageWidth(image_number)
h=ImageHeight(image_number)

result = ImageTo8bit(image_number) 

; Let's take a look at the results...

OpenWindow(0,0,0,w,h,"") 
ImageGadget(0,0,0,0,0,result)
Repeat:EventID = WaitWindowEvent():Until EventID = #PB_Event_CloseWindow

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 10:52 am
by netmaestro
YES!!!!
Very tired, on the way to bed but I'll see if I can make sense of it anyway. You've never let me down Wilbert and I can't put into words how much I appreciate your help.

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 11:37 am
by netmaestro
Looked through it and mostly understand it. I'm in awe. Very strong coding, thanks again.

Re: NeuQuant (SSE2)

Posted: Tue Jan 31, 2017 12:35 pm
by wilbert
netmaestro wrote:Looked through it and mostly understand it.
Good to hear :)

The important thing to know is that SetDIBColorTable requires BGRA and NeuQuant::InxSearch requires RGBA.
You can of course also use Point instead of PointOrdDith if you don't want to use dithering. Personally I like the combination of NeuQuant and ordered dithering.
It also works well for animated gifs. Dithering based on error diffusion like Sierra or Floyd-Steinberg doesn't look so good for animated gifs I think.
All times are UTC+01:00
Page 2 of 2

Powered by phpBB® Forum Software © phpBB Limited