Image posterization and dithering (with optional correction for gamma)

[wilbert]

Edit: Having now had time to try this out, I see why I need the 3 channels, and it seems to be working mostly, and looks terrible .

I couldn't resist trying already with the information you have given so far.
I've chosen to only use the red and green channels of the source image and ignore the blue one.
If the source image doesn't have a lot of blue it gives at least a recognizable image most of the time but I don't know if it is better compared to what you already had.

Edit 2025/02/13: Fixed errors and switched to serpentine version of Sierra Lite

Code: Select all

Procedure DiffusionDitherRGBY(Image)
  ; Sierra Lite (Serpentine), floating point error
  Protected mx, my, x, y, xend, xstep, c, r, g
  Protected.f re, ge, ra_, ga_
  If IsImage(Image) And StartDrawing(ImageOutput(Image))
    mx=OutputWidth()-1                  ; max x
    my=OutputHeight()-1                 ; max y
    Protected Dim ra.f(mx)              ; red error array
    Protected Dim ga.f(mx)              ; green error array
    For y=0 To my
      re=0: ge=0: ra_=0: ga_=0          ; reset errors
      xstep=1-y<<1&2                    ; x step (1 or -1)
      x=mx&-(y&1)                       ; start x
      xend=mx-x+xstep                   ; end x
      While x<>xend
        c=Point(x,y)                    ; source color
        r=c&255                         ; source red
        g=(c>>8)&255                    ; source green
        re=r+0.5*re+0.25*(ra(x)+ra_)    ; re = r + total red error correction
        ge=g+0.5*ge+0.25*(ga(x)+ga_)    ; ge = g + total green error correction
        r=127.5-re: r=(r>>31)&255       ; round r to 0 or 255
        g=127.5-ge: g=(g>>31)&255       ; round g to 0 or 255
        re-r: ra_=ra(x): ra(x)=re       ; update red corrections
        ge-g: ga_=ga(x): ga(x)=ge       ; update green corrections
        Plot(x,y,(~(r|g)<<16)|(g<<8)|r) ; output destination color
        x+xstep
      Wend
    Next
    StopDrawing()
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure BlueNoiseDitherRGBY(Image)
  Protected x, y, mx, my
  Protected c, r, g, rd, gd
  Protected.Ascii *dmy, *dm
  If IsImage(Image) And StartDrawing(ImageOutput(Image))
    ; 16x16 blue noise data from LDR_LLL1_42.png by Christoph Peters (CC0 license)
    Protected Dim dm.q(31)
    dm(00)=$f78c1a26f289e7ae: dm(01)=$5264cc9130a469c1: dm(02)=$0862d5a97b5e1c71: dm(03)=$05a6187a550e49ce
    dm(04)=$b272e4560199bfd8: dm(05)=$96f825bcedd99736: dm(06)=$e99f2f41b6fe3b2b: dm(07)=$8047d13e6dac851d
    dm(08)=$510fc283d2134f66: dm(09)=$e2b55b9d002a60fb: dm(10)=$7994236beb90aac8: dm(11)=$0b8b16f576deca40
    dm(12)=$a8e1cb5c337720f3: dm(13)=$7034c34db08e14bb: dm(14)=$04f44a0da5db4558: dm(15)=$a2e8821ee5315768
    dm(16)=$3a28b38afabd0395: dm(17)=$27cd639a43d3a186: dm(18)=$da986e541b8165d7: dm(19)=$b93d06ff6f0ceec5
    dm(20)=$197ceccf3f2eadf1: dm(21)=$177d53beaf7f225f: dm(22)=$b74607a0c4e67348: dm(23)=$8da7dc2c92374ef9
    dm(24)=$8f32d6612493095a: dm(25)=$35f66715ead0a36c: dm(26)=$c611ab8450fcb4d4: dm(27)=$c0219ec7754202e3
    dm(28)=$59f074df126a9b10: dm(29)=$78874c0a5d88b129: dm(30)=$3c9c4bba38c9442d: dm(31)=$ddef39b8fde01f7e
    mx=OutputWidth()-1         ; max x
    my=OutputHeight()-1        ; max y
    For y=0 To my
      *dmy=@dm()+(y&15)<<4
      For x=0 To mx
        c=Point(x,y)
        r=c&255                             ; source red
        g=(c>>8)&255                        ; source green
        *dm=*dmy+(x&15)
        rd=((*dm\a-*dm\a>>7-r)>>15)&255     ; destination red
        *dm=*dmy+((x+7)&15)
        gd=((*dm\a-*dm\a>>7-g)>>15)&255     ; destination green
        Plot(x,y,(~(rd|gd)<<16)|(gd<<8)|rd) ; output destination color
      Next
    Next
    StopDrawing()
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure


; >>> Test code <<<

UseJPEGImageDecoder()
UsePNGImageDecoder()

If OpenWindow(0, 0, 0, 990, 580, "RGBY Dither", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)
  ImageGadget(0, 10, 10, 480, 480, 0, #PB_Image_Border)
  ImageGadget(1, 500, 10, 480, 480, 0, #PB_Image_Border)
  ButtonGadget(2, 20, 520, 120, 30, "Load image")
  ComboBoxGadget(3, 500, 520, 160, 30)
  AddGadgetItem(3, -1, "Error diffusion")
  AddGadgetItem(3, -1, "Blue noise")
  SetGadgetState(3, 0)
  Repeat
    Event = WaitWindowEvent()
    If Event = #PB_Event_Gadget
      Select EventGadget()
        Case 2; load image
          File.s = OpenFileRequester("Choose image file", GetCurrentDirectory(), "", 0)
          If File And LoadImage(0, File)
            scale.d = DesktopScaledX(480)/ImageWidth(0)
            scaleY.d = DesktopScaledY(480)/ImageHeight(0)
            If scaleY<scale: scale=scaleY: EndIf
            If scale<1
              ResizeImage(0, ImageWidth(0)*scale, ImageHeight(0)*scale)   
            EndIf
            SetGadgetState(0, ImageID(0))
          EndIf
      EndSelect
      If IsImage(0)
        ; update result image
        CopyImage(0,1)
        If GetGadgetState(3)
          BlueNoiseDitherRGBY(1)
        Else
          DiffusionDitherRGBY(1)
        EndIf
        SetGadgetState(1, ImageID(1))
      EndIf
    EndIf
  Until Event = #PB_Event_CloseWindow
EndIf

[matalog]

Yours is great, thanks for sharing.

The computer that has these colours is the Acorn Atom, and when it is in this colour mode, it can only display 128x192 although it is displayed over the area of the 256x192 (which it can also do, but monochrome).

I resized the sources to 128x192 for this comparison and then resized all of them back to 256x192 to display, yours is at the top.

I also found that I had to almost disregard the blue channel, within the square root in the colour difference formula I had red*150, green*100 and blue*1, so they was not much contribution from the blue.



Increasing the blue input does allow magenta to be diffused more accurately, but it causes failures in the diffusion resulting in 'shadows' forming that are not in the source image.

[wilbert]

The computer that has these colours is the Acorn Atom, and when it is in this colour mode, it can only display 128x192 although it is displayed over the area of the 256x192

Great. I didn't know of the Atom.
The first home computer I used was in 1985. A few years after the Atom.

Increasing the blue input does allow magenta to be diffused more accurately, but it causes failures in the diffusion resulting in 'shadows' forming that are not in the source image.

If you order the RGBY palette from darker to lighter colors you have blue - red - green - yellow.
The problem with the blue is that there is no darker palette color. If the source color of one pixel has blue 0 and another one blue 255, you would expect the output of the second color to be brighter as the first one but this is not possible withe the RGBY palette.

For my RGBY diffusion dither I used the Sierra Lite algorithm.
I tried to implement it also in a serpentine way but found it too difficult to get that working.
If you are interested in dithering algorithms, you should try Ditherista
https://github.com/robertkist/ditherista

[wilbert]

I realized that I totally messed up my RGBY diffusion dithering code above.
That's probably why it also didn't work to convert it to a serpentine version.
I corrected and updated the code.
https://www.purebasic.fr/english/viewto ... 47#p635147
Hopefully the output will look better now.

[matalog]

It looks better.

Because you don't check the blue very much, it misses out on magenta.
[]

[wilbert]

Because you don't check the blue very much, it misses out on magenta.

My code doesn't check the blue at all.
It's a choice you have to make.
Your red/magenta source image gets brighter at the right.
Your dithered image gets darker at the right.
Personally I don't like that side effect for real world photos but if you have no problem with that it's totally fine of course.

Here's an adaptation of my function that also looks at the blue channel

Code: Select all

Procedure DiffusionDitherRGBY(Image)
  ; Sierra Lite (Serpentine), floating point error
  Protected mx, my, x, y, xend, xstep, c, r, g, b
  Protected.f re, ge, be, ra_, ga_
  If IsImage(Image) And StartDrawing(ImageOutput(Image))
    mx=OutputWidth()-1                  ; max x
    my=OutputHeight()-1                 ; max y
    Protected Dim ra.f(mx)              ; red error array
    Protected Dim ga.f(mx)              ; green error array
    For y=0 To my
      re=0: ge=0: ra_=0: ga_=0          ; reset errors
      xstep=1-y<<1&2                    ; x step (1 or -1)
      x=mx&-(y&1)                       ; start x
      xend=mx-x+xstep                   ; end x
      While x<>xend
        c=Point(x,y)                    ; source color
        r=c&255                         ; source red
        g=(c>>8)&255                    ; source green
        b=(c>>16)&255                   ; source blue
        r-b>>3: r&(~r>>31)              ; mix blue into red
        g-b>>3: g&(~g>>31)              ; mix blue into green
        re=r+0.5*re+0.25*(ra(x)+ra_)    ; re = r + total red error correction
        ge=g+0.5*ge+0.25*(ga(x)+ga_)    ; ge = g + total green error correction
        r=127.5-re: r=(r>>31)&255       ; round r to 0 or 255
        g=127.5-ge: g=(g>>31)&255       ; round g to 0 or 255
        re-r: ra_=ra(x): ra(x)=re       ; update red corrections
        ge-g: ga_=ga(x): ga(x)=ge       ; update green corrections
        Plot(x,y,(~(r|g)<<16)|(g<<8)|r) ; output destination color
        x+xstep
      Wend
    Next
    StopDrawing()
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure