accurate alpha blend

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
dafhi
Posts: 1641
Joined: Jun 04, 2005 9:51

accurate alpha blend

Post by dafhi »

Code: Select all

' ---------------------------------- '
' accurate alpha blend demo          '
'                          by cRex   '
' ---------------------------------- '

' - Overview -

'Many internal alpha blending functions sacrifice quality for speed.
'Blending artifacts emerge because r,g,b get multiplied by an alpha
'ranging from 0 to 255, and divided by 256. (common case)

'This is easily demonstrated with similar (source, dest) components.
'For example: (src_r = 0, dst_r = 1)

#include "fbgfx.bi"

#Define TRUE -1
#Define FALSE 0

ScreenRes 400, 400, 32,, fb.GFX_ALPHA_PRIMITIVES

Sub ShowBits( ByVal value_ As UInteger, ByVal NoNewline As Integer = FALSE)
   Dim As UInteger strPos, bitPos, AryFG(3), AryBG(3),I,J
   Dim s_ As String * 8   
   AryFG(0) = RGB(200,200,200)
   AryFG(1) = RGB(255,0,0)
   AryFG(2) = RGB(0,255,0)
   AryFG(3) = RGB(0,32,255)
   AryBG(0) = RGB(100,100,100)
   AryBG(1) = RGB(127,0,0)
   AryBG(2) = RGB(0,127,0)
   AryBG(3) = RGB(0,0,86)
   For I = 0 To 3
      Color AryFG(I), AryBG(I)
      For J = 0 To 7
         bitPos = (3 - I) Shl 3 + J
         strPos = 7 - J
         If bit(value_, bitPos) Then s_[strPos] = 49 Else s_[strPos] = 48
      Next
      Print s_;
   Next   
   If Not NoNewline Then Print
End Sub
Sub InfoAlpha(ByVal A As Integer,ByVal Divisor As Integer = 255)
   Color RGB(255,255,255),RGB(0,0,0)
   ? " A = " & Str(A/Divisor)
End Sub

' ===========================================

#Macro Alpha256(ret,back,fore, am, a256)

    ret=((_
   (fore And &Hff00ff) * a256 + _
   (back And &Hff00ff) * am + &H800080) And &Hff00ff00 Or (_
   (fore And &H00ff00) * a256 + _
   (back And &H00ff00) * am + &H008000) And &H00ff0000) Shr 8

#EndMacro

Sub Test(backV As UByte,foreV As UByte,ByVal Accurate As Integer = 0,ByVal steps As uByte = 5)
Dim As UInteger Ptr pixel = ScreenPtr
  Dim As UInteger fore = RGBA(foreV,foreV,foreV,foreV)
  Dim As UInteger back = RGBA(backV,backV,backV,backV)
  If Accurate Then
      Dim As Single   step_acc = 256 / steps
      For s As Single = 0 To 256 Step step_acc
        Dim As Integer A = s
        Dim As Integer vm = 256 - A
        Dim As Integer c
        Alpha256(c,back,fore, vm, A)
        ShowBits c,TRUE
        InfoAlpha A,256
      Next
  Else
      Dim As Single   step_reg = 255 / steps
      For s As single = 0 To 255 Step step_reg
        Dim As Integer A = s
        *pixel = back
        PSet (0,0), RGBA(foreV,foreV,foreV,A)
        ShowBits Point(0,0),TRUE
        InfoAlpha A,255
      Next
  EndIf
End Sub

Dim Shared As Integer N

Sub DualTest(back As UByte,fore As UByte)
   N += 1
   Cls
   Color RGB(255,255,255),RGB(0,0,0)
   ? "Test " & N & " / 2"
   ?:?
   ? "Back: " & back & ", Fore: " & fore
   ?:?
   ? "standard"
   Test back,fore
   ?:?
   Color RGB(255,255,255),RGB(0,0,0)
   ? "accurate"
   Test back,fore,TRUE
   
   Sleep
End Sub

DualTest 1,0
DualTest 255,254
Last edited by dafhi on Aug 29, 2013 13:07, edited 2 times in total.
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

Re: accurate alpha blend

Post by Gonzo »

is it possible to just (a+1) / 256.0 ?
remember that channels are 0 to 255.. it looks interesting though

here one of my old functions:

Code: Select all


void __stdcall AlphaBlend32(BYTE *dest, short destModulo, BYTE *src, short srcModulo, short width, short height, short opacity)
{
	short a = 256 * (255 - opacity) / 255;
	short b = 256 * opacity / 255;
	short dstw=destModulo - width*4;
	short srcw=srcModulo - width*4;

	short i;
	while (height--)
	{
		for (i=0; i<width; i++)
		{
			if (src[0] != 255 || src[1] != 0 || src[2] != 255)
			{
				dest[0] = (dest[0]*b + src[0]*a) / 256;
				dest[1] = (dest[1]*b + src[1]*a) / 256;
				dest[2] = (dest[2]*b + src[2]*a) / 256;
			}
			dest += 4;
			src += 4;
		}
		dest += dstw;
		src  += srcw;
	}
}

also, alpha-blending must consider src alpha and dst alpha, which neither of us do (i think)
at least mine doesnt
the src alpha / dst alpha function is more complicated

Code: Select all


	ax = 1.0 - (1.0 - dst_alpha) * (1.0 - src_alpha)
	
	alphavalue = src_alpha / ax
	invalpha    = (1.0 - src_alpha) / ax
	
	dst_r = dst_r * dst_alpha * invalpha + src_r * alphavalue
	dst_g = dst_g * dst_alpha * invalpha + src_g * alphavalue
	dst_b = dst_b * dst_alpha * invalpha + src_b * alphavalue
	dst_a = dst_a * invalpha + ax

i dont really remember.. but its something like that
dafhi
Posts: 1641
Joined: Jun 04, 2005 9:51

Re: accurate alpha blend

Post by dafhi »

Hi Gonzo,

The sub you have provided is good. The short answer to your question is "no" because you are still using a ruler that is the same size (256 - 1) while trying to divide it by a bigger ruler.

Code: Select all

Sub AlphaBlend32(ByRef dest As UInteger, ByVal src As UInteger, ByVal opacity as UByte)
'   short a = 256 * (255 - opacity) / 255;
'   short b = 256 * opacity / 255;
Dim As UShort a = 256 * opacity / 255
Dim As UShort b = 256 - a
Dim As UInteger sb = src And &Hff 
Dim As UInteger sg = (src And &Hff00) Shr 8
Dim As UInteger sr = (src And &Hff0000) Shr 16
Dim As UInteger db = dest And &Hff
Dim As UInteger dg = (dest And &Hff00) Shr 8
Dim As UInteger dr = (dest And &Hff0000) Shr 16
 
   dr = (dr * b + sr * a) / 256
   dg = (dr * b + sr * a) / 256
   db = (dr * b + sr * a) / 256
   
   dest = dr Shl 16 Or dg Shl 8 Or db

End Sub
Dr_D
Posts: 2451
Joined: May 27, 2005 4:59
Contact:

Re: accurate alpha blend

Post by Dr_D »

Here's something I made a year or two ago. I don't know if it's of any use, but I'll just throw it out there. I don't remember exactly where I got the equations now. I modified it a bit to run alone... originally, I made it for this:

http://code.google.com/p/fb-extended-li ... hablit.bas

Code: Select all

#include "fbgfx.bi"

declare sub AlphaBlit( byval dst as FB.IMAGE ptr, byval src as const FB.IMAGE ptr, byref positx as integer, byref posity as integer, byref malpha as integer )

screenres 640,480,32


dim as integer iw = 256, ih = 256


dim as FB.IMAGE ptr back = imagecreate(640,480)
dim as FB.IMAGE ptr image = imagecreate( iw, ih )



for y as integer = 0 to 479
	for x as integer = 0 to 639
		dim as integer c = x xor y
      pset back,(x,y),rgb(c, c, c)
	next
next

for y as integer = 0 to ih - 1
   for x as integer = 0 to iw - 1
   	dim as single d = ( sqr((128-y)^2+(128-x)^2) )
   	if d<=127 then
      	pset image,(x,y),rgba(0, 0, 255, 255-(d*2) )
      else
     		pset image,(x,y),0
   	end if
   next
next


circle image,(128,128),32,rgb(255,255,0),,,,f


do
    
    dim as integer alpha = 128+128*sin(timer)

    screenlock
    put(0,0),back,pset
    alphablit( 0, image, 320-128, 240-128, alpha )
    screensync
    screenunlock
    sleep 3,1
    
loop until multikey(FB.SC_ESCAPE)


sub AlphaBlit( byval dst as FB.IMAGE ptr, byval src as const FB.IMAGE ptr, byref positx as integer, byref posity as integer, byref malpha as integer )
    
    if (src = 0) then exit sub
    
   static as uinteger ptr dstptr, srcptr
   static as integer srcc, dstc
   dim as integer iwidth = src->width
	dim as integer iheight= src->height
   static as integer dw, dh, xput, yput
   static as integer sr, sg, sb, sa, na
   static as integer dr, dg, db, da    

    if dst = 0 then
        dstptr = screenptr
        screeninfo dw,dh
    else
        dstptr = cast( uinteger ptr, dst + 1)
        dw = dst->width
        dh = dst->height
    end if
    
    srcptr = cast( uinteger ptr, src + 1)
    
    
    for y as integer = 0 to iheight-1
        
        yput = y + posity
        if yput>-1 and yput<dh then
            
            for x as integer = 0 to iwidth-1
                xput = x + positx
                
                if xput>-1 and xput<dw then
                    
                    if dst = 0 then
                        dstc = dstptr[ (yput * dw ) + xput ]
                    else
                        dstc = *cast(uinteger ptr, cast(ubyte ptr, dstptr) + yput * dst->pitch + xput * dst->bpp )
                    end if
                    
                    dr = ( ( dstc shr 16 ) and 255 )
                    dg = ( ( dstc shr  8 ) and 255 )
                    db = ( ( dstc        ) and 255 )
                    da = ( ( dstc shr 24 ) and 255 )

                    srcc = *cast(uinteger ptr, cast(ubyte ptr, srcptr) + y * src->pitch + x * src->bpp )
                    sr = ( ( srcc shr 16 ) and 255 )
                    sg = ( ( srcc shr  8 ) and 255 )
                    sb = ( ( srcc        ) and 255 )
                    sa = ( ( srcc shr 24 ) and 255 )
                    
                    na = ((( srcc shr 24 ) and 255 ) + malpha) * malpha shr 8

                    if na < 0 then
                        na = 0
                    elseif na > 255 then 
                        na = 255
                    end if
                    
                    sr = (( na * ( sr - dr) ) shr 8 + dr) and 255
                    sg = (( na * ( sg - dg) ) shr 8 + dg) and 255
                    sb = (( na * ( sb - db) ) shr 8 + db) and 255
                    
                    if srcc <> rgba( 255, 0, 255, 255 ) and sa > 0 then
                        if dst = 0 then
                            dstptr[ (yput * dw ) + xput ] = rgba( sr, sg, sb, sa )
                        else
                            *cast(uinteger ptr, cast(ubyte ptr, dstptr) + yput * dst->pitch + xput * dst->bpp) = rgba( sr, sg, sb, sa )
                        end if
                    else
                        if dst = 0 then
                            dstptr[ (yput * dw ) + xput ] = rgba( dr, dg, db, da )
                        else
                            *cast(uinteger ptr, cast(ubyte ptr, dstptr) + yput * dst->pitch + xput * dst->bpp) = rgba( dr, dg, db, da )
                        end if
                    end if
                    
                end if
            next
            
        end if
    next
    
end sub
dafhi
Posts: 1641
Joined: Jun 04, 2005 9:51

Re: accurate alpha blend

Post by dafhi »

hi Dr_D

Thanks for sharing your core blend function. Your original uses (255 * delta) Shr 8 which of course is not accurate, but meant for speed.

Code: Select all

#Include "fbgfx.bi"

#Define TRUE -1
#Define FALSE 0

ScreenRes 400, 400, 32,, fb.GFX_ALPHA_PRIMITIVES

Const MagicNumber = 256 * 255 + 128

Sub ShowBits( ByVal value_ As UInteger, ByVal NoNewline As Integer = FALSE)
   Dim As UInteger strPos, bitPos, AryFG(3), AryBG(3),I,J 'unsigned 32 bit
   Dim s_ As String * 8   
   AryFG(0) = RGB(200,200,200)
   AryFG(1) = RGB(255,0,0)
   AryFG(2) = RGB(0,255,0)
   AryFG(3) = RGB(0,32,255)
   AryBG(0) = RGB(100,100,100)
   AryBG(1) = RGB(127,0,0)
   AryBG(2) = RGB(0,127,0)
   AryBG(3) = RGB(0,0,86)
   For I = 0 To 3
      Color AryFG(I), AryBG(I)
      For J = 0 To 7
         bitPos = (3 - I) Shl 3 + J 'first position = 0
         strPos = 7 - J           'first position = 0
         If bit(value_, bitPos) Then s_[strPos] = 49 Else s_[strPos] = 48
      Next
      Print s_;
   Next   
   If Not NoNewline Then Print
End Sub
Sub AlphaBlit( ByRef dst as Uinteger, byval src as UInteger, ByVal malpha As UByte)
Static as integer sr, sg, sb, sa, na
static as integer dr, dg, db, da    

dr = ( dst shr 16 ) And 255
dg = ( dst shr  8 ) And 255
db = ( dst        ) And 255
da = ( dst shr 24 )

sr = ( src shr 16 ) And 255
sg = ( src shr  8 ) And 255
sb = ( src        ) And 255
sa = ( src shr 24 )

na = malpha

sr = na * ( sr - dr) / 255 + dr
sg = na * ( sg - dg) / 255 + dg
sb = na * ( sb - db) / 255 + db
sa = na * ( sa - da) / 255 + da

dst = sa Shl 24 or sr Shl 16 Or sg Shl 8 Or sb

End Sub

Dim Shared As UInteger mDest

Sub InfoAlpha(ByVal A As Integer,ByVal Divisor As Integer = 255)
   Color RGB(255,255,255),RGB(0,0,0)
   ? " A = " & Str(A/Divisor)
End Sub

Sub Test(DstV As UByte,SrcV As UByte,ByVal Accurate As Integer = 0)
Dim As UInteger Ptr pixel = ScreenPtr
Dim As UInteger lSrc
   If Accurate Then
      For A As Integer = 0 To 255 Step 51
      	lSrc = RGBA(SrcV,SrcV,SrcV,SrcV)
         mDest = RGBA(DstV,DstV,DstV,DstV)
         AlphaBlit mDest,lSrc,A
         ShowBits mDest,TRUE
         InfoAlpha A,255
      Next
   Else
      For A As Integer = 0 To 255 Step 51
         *pixel = RGB(DstV,DstV,DstV)
         PSet (0,0), RGBA(SrcV,SrcV,SrcV,A)
         ShowBits Point(0,0),TRUE
         InfoAlpha A,255
      Next
   EndIf
   ?
End Sub

Dim Shared As Integer N

Sub CompareFuncs(DstV As UByte,SrcV As UByte)
   N += 1
   Cls
   Color RGB(255,255,255),RGB(0,0,0)
   ? " Result " & N & " of 2"
   ?
   ? "Back: " & DstV & ", Fore: " & SrcV
   ?
   ? "Accurate" 
   Test DstV,SrcV,TRUE
   ?
   Color RGB(255,255,255),RGB(0,0,0)
   ? "Standard"
   Test DstV,SrcV
   
   Sleep
End Sub

CompareFuncs 254,255
CompareFuncs 0,1
Post Reply