Alpha Capabilities

[mysoft]

so yeah some demo showing alpha capabilities of freebasic...

#include "fbgfx.bi"

type Pixel
  B as ubyte
  G as ubyte
  R as ubyte
  A as ubyte
end type

sub OutlineText( pTarget as any ptr = 0 , iX as long , iY as long , sText as string , iFore as ulong , iBorder as ulong = rgb(0,0,0) )
  for iNY as long = -1 to 1
    for iNX as long = -1 to 1
      draw string pTarget,(iX+iNX,iY+iNY),sText,iBorder
    next iNX
  next iNY
  draw string pTarget,(iX,iY),sText,iFore
end sub
sub DrawMouse( pTarget as any ptr = 0 , iX as long , iY as long , iFill as ulong , iBorder as ulong )
  line pTarget, (iX+ 0,iY+ 0)-(iX+35,iY+32),iBorder
  line pTarget,-(iX+22,iY+37),iBorder : line pTarget,-(iX+28,iY+52),iBorder
  line pTarget,-(iX+22,iY+55),iBorder : line pTarget,-(iX+13,iY+40),iBorder
  line pTarget,-(iX+ 1,iY+49),iBorder : line pTarget,-(iX+ 0,iY+ 0),iBorder
  if iFill <> rgb(255,0,255) then paint pTarget,(iX+18,iY+30),iFill,iBorder  
end sub

#define AlphaEnable() Screencontrol( fb.SET_ALPHA_PRIMITIVES , 1 ) 
#define AlphaDisable() Screencontrol( fb.SET_ALPHA_PRIMITIVES , 0 ) 

'create screen with alha primitives capability
screenres 640,480,32,2,fb.GFX_ALPHA_PRIMITIVES or fb.GFX_HIGH_PRIORITY
width 640\8,480\16 'font size 8x16

'disable alpha primitives until we need it
AlphaDisable()

dim as fb.image ptr pAlpha8 = ImageCreate(320,240,,8)         '8bpp image (alpha part)
dim as fb.image ptr pImage  = ImageCreate(320,240)            'image block
dim as fb.image ptr pBack   = ImageCreate(640,480,rgb(0,0,0)) 'generated background
dim as fb.image ptr pBack2  = ImageCreate(640,480,rgb(0,0,0)) 'generated background
dim as fb.image ptr pCursor = ImageCreate(36,60,rgba(0,0,0,0))'mouse cursor
dim as fb.image ptr pCursor8= ImageCreate(36,60,&hFFFFFF,8)   'mouse cursor (8bpp as alpha)

'generate cursor 
scope  
  var iBorder = rgb(255,255,254) , iFill = rgba(0,0,1,0)
  DrawMouse pCursor ,0,0,iFill,iBorder
  DrawMouse pCursor8,0,0,iFill,iBorder  
end scope

'draw strings all over the screen
for N as long = 0 to 199
  var iC=rgb(192+rnd*63,192+rnd*63,192+rnd*63)
  OutlineText pBack,rnd*640-(6*8),rnd*480,"Hello World!",iC,iC and &hFF7F7F7F
next N
put pBack2,(0,0),pBack,pset

'blur/dither background as effect
for Y as long = -2 to 2 step 2
  for X as long = -2 to 2 step 2
    put pBack,(X,Y),pBack,alpha,128 'dither blur
  next X
next Y

'enable alpha primitives temporally
AlphaEnable()
'generate random 32bpp image
for N as long = 0 to 999
  circle pImage,(rnd*320,rnd*240),rnd*64,rgba(rnd*192,rnd*192,rnd*192,128),,,,f
next N
'and now can disable it again
AlphaDisable()

dim as long iAlpha,iPage
setmouse ,,0
WindowTitle("Alpha Examples")
do
  dim as integer MX,MY
  var iShow = (GetMouse(MX,MY)=0)
  
  iAlpha = iAlpha+3 'back and forth -255 to 255
  if iAlpha > 255 then iAlpha -= 511 'back to -255
  
  iPage xor= 1 '1 <-> 0
  screenset iPage,iPage xor 1
  put (0,0),pBack,pset
  
  'generate 8bpp image with a radius fading alpha
  for N as integer = 383 to 0 step -1
    var iCircleAlpha = (iAlpha\2+cint(N/1.5)) and &hF0
    circle pAlpha8,(160,120),N,iCircleAlpha,,,,f
  next N  
  
  'put the 8bpp image as alpha into the 32bpp image
  'BUG: FBGFX? if i dont enable Alpha here... it permanently disable primitive alpha...
  AlphaEnable() : put pImage,(0,0),pAlpha8,alpha : AlphaDisable()
  'draw on the screen on the left top with alpha    
  if iShow then AlphaEnable() : put pImage,(MX,MY),pCursor8,alpha : AlphaDisable()    
    
  put(0,0),pImage,alpha
  OutlineText ,4,2,"Alpha from 8bpp image",rgb(255,255,255)
  
  'draw on the screen on the right top WITHOUT alpha
  if iShow then put pImage,(MX-320,MY),pCursor8,alpha
  put(320,0),pImage,pset
  OutlineText ,324,2,"regular put",rgb(255,255,255)
  
  'draw on the screen on the left bottom with fixed alpha
  if iShow then AlphaEnable():put pImage,(MX,MY-240),pCursor8,alpha:AlphaDisable()
  put(0,240),pImage,alpha,abs(iAlpha)
  OutlineText ,4,242,"fixed alpha " & abs(iAlpha),rgb(255,255,255)
  
  'changing alpha of each pixel to random
  var pPix = cast(Pixel ptr,pImage+1) 'point to the alpha of the first pixel    
  for Y as long = 0 to 239
    for X as long = 0 to 319
      pPix[X].A = rnd*255 'sets random alpha
    next X
    cast(ubyte ptr,pPix) += pImage->Pitch 'advance to next row
  next Y
  
  'blur alpha (right side)
  var iPixPit = (pImage->Pitch)\sizeof(pixel), iL=1+cint(abs(iAlpha)*(158/255))  
  pPix = cast(Pixel ptr,pImage+1)
  for Y as long = 1 to 239
    cast(ubyte ptr,pPix) += pImage->Pitch
    for X as long = iL to iL+158
      pPix[X].A = (pPix[X].A + pPix[X-1].A + pPix[X-iPixPit].A + pPix[X-iPixPit+1].A)\4
    next X
  next Y
  
  'draw on the screen with (right bottom) modified random alpha
  if iShow then AlphaEnable():put pImage,(MX-320,MY-240),pCursor8,alpha:AlphaDisable()
  put(320,240),pImage,alpha
  OutlineText ,324,242,"random blurred alpha",rgb(255,255,255)
  line(320+iL,240)-step(158,239),rgb(128,128,128),b
  
  line(320,0)-(320,479),rgb(255,255,255)
  line(0,240)-(639,240),rgb(255,255,255)
  
  'just the borders with alpha... (trans could be used here i guess)
  if iShow then Put(MX,MY),pCursor,alpha  
  
  sleep 15,1  
  
loop until len(inkey)

'only cursor as alpha :)
WindowTitle("Only Alpha Cursor")

'255 alpha area (to erase cursor)
line pAlpha8,(0,0)-(35,59),-1,bf 

AlphaEnable()
do
  
  dim as integer MX,MY
  var iShow = (GetMouse(MX,MY)=0)
  
  iPage xor= 1 '1 <-> 0
  screenset iPage,iPage xor 1  
  
  'partially show unblurred background
  put (  0,  0),pBack2,alpha,16  
  
  'draw mouse on alpha and then the alpha on the screen
  if iShow then put pBack,(MX,MY),pCursor8,alpha
  put (0,0),pBack,alpha
  if iShow then 
    DrawMouse ,MX,MY,rgb(255,0,255),rgba(255,255,255,16)    
    put pBack,(MX,MY),pAlpha8,(0,0)-(35,59),alpha
  end if
  
  sleep 15,1
  
loop until len(inkey)

[ron77]

hi mysoft thanks for posting this example

here is how it looks like: