Meta (phong) Blobs

[kevin]

 Meta (phong) Blobs

  This demo creates a palette mapped 5 point illumination on a FX image back buffer, then filters it to the screen.



  Built with PlayBASIC V1.64j12

PlayBASIC Code: [Select]

   Global ScreenWidth=200
   Global ScreenHeight=200
   

   PhongMapWidth=(ScreenWidth)*4
   PhongMapHeight=(ScreenHeight)*4
   Dim PhongMap(PhongMapWidth,PhongMapHeight)


   // Phong table
   t=timer()
   centerX=PhongMapWidth/2
   centerY=PhongMapHeight/2
   For y = 0 To PhongMapHeight-1
      For x = 0 To PhongMapWidth-1
         PhongMap(x, y) =  ScreenWidth*6/ GetDistance2D(CenterX,CenterY,x,y) 
      Next 
   Next 
   PhongMap(CenterX,CenterY) = 255



   // Blob buffers
   MakeArray ScreenAccess()

   Dim Screen1(ScreenWidth,ScreenHeight)
   Dim Screen2(ScreenWidth,ScreenHeight)
   Dim Screen3(ScreenWidth,ScreenHeight)
   Dim Screen4(ScreenWidth,ScreenHeight)
   Dim Screen5(ScreenWidth,ScreenHeight)

   Type tObjects
         x#,y#,z#
         RotatedX#,RotatedY#,RotatedZ#
         ScreenX#,ScreenY#
   EndType

   Dim Objects(10) as tobjects
   


    Dim Palette(12550)
   // construct palette

   Col =$3050a0
   Col2 =$ff4000
   CreatePalette(Col,COl2)



   Screen=NewFximage(ScreenWidth,ScreenHeight)
 
 
 ObjectDistance#=1500
 
 Do

   t=timer()

   Index=1
   For H=getArray(Screen1()) to GetArray(Screen5())

      // check if this object exists ?? if it doesn't create it
      IF Objects(Index)=0

            Objects(Index)= New tobjects
            Objects(Index).x=Rndrange(-ScreenWidth,ScreenWidth)*2
            Objects(Index).y=RndRange(-ScreenHeight,ScreenHeight)
            Objects(Index).z=RndRange(-ScreenWidth,ScreenWidth)

      EndIF
      
      Xpos#=Objects(Index).ScreenX
      Ypos#=Objects(Index).ScreenY

      SetArray ScreenAccess(),h
      CopyPhongToArray(Xpos#,Ypos#,ScreenAccess())

      inc index 
    next
    

   Distance#=ObjectDistance#+(Cos(Turn#+Tilt#*4-Roll#)*ObjectDistance#/2)
   
    

   RotateVerts(Tilt#,turn#,roll#,Distance#)

   rendertoimage Screen
   lockbuffer
      NullPixel=point(0,0)
      For ylp = 0 To ScreenHeight-1
         For xlp = 0 To ScreenWidth-1
            i=Screen1(Xlp,ylp)+Screen2(Xlp,ylp)+Screen3(Xlp,ylp)+Screen4(Xlp,ylp)+Screen5(Xlp,ylp)
            FastDot Xlp,ylp,Palette(i)
         next
      next    
   unlockbuffer

   rendertoscreen
   TextureQuad Screen,0,0,0,0,GetScreenWidth(),0,ScreenWidth,0,GetScreenWidth(),GetScreenHeight(),ScreenWidth,ScreenHeight,0,GetScreenHeight(),0,Screenheight,8
   
   text 0,0,Timer()-t    
 
       Tilt#=WrapAngle(Tilt#,0.51)
      Turn#=WrapAngle(Turn#,1.51)
      Roll#=WrapAngle(Roll#,2.41)
   
   if Spacekey()
      CreatePalette(rndRgb(),COl2)
   endif

 
    Sync
 loop
 
 
 
Function CopyPhongToArray(Xpos,Ypos,ThisArray())

   DestWidth   =GetArrayElements(ThisArray(),1)
   DestHeight   =GetArrayElements(ThisArray(),2)

   Xpos   =ClipRange(Xpos,-DestWidth,DestWidth*2)
   Ypos   =ClipRange(Ypos,-DestHeight,DestHeight*2)

   
   DestModulo=(DestWidth+1)*4   
   DestAddress=GetArrayPtr(ThisArray())+PBArraystruct_size 


   SrcWidth   =GetArrayElements(PhongMap(),1)
   SrcHeight=GetArrayElements(PhongMap(),2)

   SrcModulo=(SrcWidth+1)*4   
   SrcAddress=GetArrayPtr(PhongMap())+PBArraystruct_size 

   // center of phong map   
   CenterX=SrcWidth/2
   CenterY=SrcHeight/2
   
   // Center Src Address
   SrcAddress=SrcAddress+(CenterX*4)
   SrcAddress=SrcAddress+(CenterY*SrcModulo)

   // calc displacement in source buffer
   SrcAddress=SrcAddress+(-Xpos*4)
   SrcAddress=SrcAddress+(-Ypos*SrcModulo)


Login required to view complete source code

 -  



Related To:

     - Meta Balls - Light Blobs (optimized 2016)

     - PlayBASIC Programming Language Home Page

[kevin]

PBFX 1.75 version

Code Select Expand


Global ScreenWidth =200
Global ScreenHeight =200

PhongMapWidth =(ScreenWidth)*4
PhongMapHeight =(ScreenHeight)*4
Dim PhongMap(PhongMapWidth,PhongMapHeight)

// Phong table
t=timer()
centerX=PhongMapWidth/2
centerY=PhongMapHeight/2
For y = 0 To PhongMapHeight-1
For x = 0 To PhongMapWidth-1
      PhongMap(x, y) =  ScreenWidth*6/ GetDistance2D(CenterX,CenterY,x,y)
   Next
Next
PhongMap(CenterX,CenterY) = 255


// Blob buffers
MakeArray ScreenAccess()

Dim Screen1(ScreenWidth,ScreenHeight)
Dim Screen2(ScreenWidth,ScreenHeight)
Dim Screen3(ScreenWidth,ScreenHeight)
Dim Screen4(ScreenWidth,ScreenHeight)
Dim Screen5(ScreenWidth,ScreenHeight)

Type tObjects
x#,y#,z#
RotatedX#,RotatedY#,RotatedZ#
ScreenX#,ScreenY#
EndType

Dim Objects(10) as tobjects



Dim Palette(22550)
// construct palette

Col =$3050a0
Col2 =$ff4000
CreatePalette(Col,COl2)



Screen=New3Dimage(ScreenWidth,ScreenHeight)


ObjectDistance#=1500

Do

t=timer()

Index=1
For H=getArray(Screen1()) to GetArray(Screen5())

// check if this object exists ?? if it doesn't create it
IF Objects(Index)=0

Objects(Index)= New tobjects
Objects(Index).x=Rndrange(-ScreenWidth,ScreenWidth)*2
Objects(Index).y=RndRange(-ScreenHeight,ScreenHeight)
Objects(Index).z=RndRange(-ScreenWidth,ScreenWidth)

EndIF

Xpos#=Objects(Index).ScreenX
Ypos#=Objects(Index).ScreenY

SetArray ScreenAccess(),h
    CopyPhongToArray(Xpos#,Ypos#,ScreenAccess())

inc index
next


Distance#=ObjectDistance#+(Cos(Turn#+Tilt#*4-Roll#)*ObjectDistance#/2)



RotateVerts(Tilt#,turn#,roll#,Distance#)

rendertoimage Screen
lockbuffer
NullPixel=point(0,0)
For ylp = 0 To ScreenHeight-1
For xlp = 0 To ScreenWidth-1
i=Screen1(Xlp,ylp)+Screen2(Xlp,ylp)+Screen3(Xlp,ylp)+Screen4(Xlp,ylp)+Screen5(Xlp,ylp)
FastDot Xlp,ylp,Palette(i)
next
next
unlockbuffer

rendertoscreen
TextureQuad Screen,0,0,0,0,GetScreenWidth(),0,ScreenWidth,0,GetScreenWidth(),GetScreenHeight(),ScreenWidth,ScreenHeight,0,GetScreenHeight(),0,Screenheight,8

text 0,0,Timer()-t

Tilt#=WrapAngle(Tilt#,0.51)
Turn#=WrapAngle(Turn#,1.51)
Roll#=WrapAngle(Roll#,2.41)

if Spacekey()
CreatePalette(rndRgb(),rndRgb())
endif


Sync
loop



Function CopyPhongToArray(Xpos,Ypos,ThisArray())

DestWidth =GetArrayElements(ThisArray(),1)
DestHeight =GetArrayElements(ThisArray(),2)

Xpos =ClipRange(Xpos,-DestWidth,DestWidth*2)
Ypos =ClipRange(Ypos,-DestHeight,DestHeight*2)


DestModulo=(DestWidth+1)*4
DestAddress=GetArrayPtr(ThisArray())+PBArraystruct_size


SrcWidth =GetArrayElements(PhongMap(),1)
SrcHeight=GetArrayElements(PhongMap(),2)

SrcModulo=(SrcWidth+1)*4
SrcAddress=GetArrayPtr(PhongMap())+PBArraystruct_size

// center of phong map
CenterX=SrcWidth/2
CenterY=SrcHeight/2

// Center Src Address
SrcAddress=SrcAddress+(CenterX*4)
SrcAddress=SrcAddress+(CenterY*SrcModulo)

// calc displacement in source buffer
SrcAddress=SrcAddress+(-Xpos*4)
SrcAddress=SrcAddress+(-Ypos*SrcModulo)

// copy the rows
For ylp=0 to DestHeight-1
CopyMemory SrcAddress,DestAddress,DestModulo
inc SrcAddress,SrcModulo
inc DestAddress,DestModulo
next

EndFunction






Function RotateVerts(Tilt#,turn#,roll#,ObjectDistance#)

NumbOfVerts=GetArrayElements(Objects(),1)

ProjectionX#=400
ProjectionY#=400

cx=ScreenWidth/2
cy=ScreenHeight/2


Rem prepare the rotation matrix
A#=Cos(tilt#):B#=Sin(tilt#)
C#=Cos(turn#):D#=Sin(turn#)
E#=Cos(roll#):F#=Sin(roll#)
AD#=A#*D#
BD#=B#*D#

; Calc Rotation Matrix 
m11#=C#*E#
m21#=-1*C#*F#
m31#=D#
m12#=BD#*E#+A#*F#
m22#=-1*BD#*F#+A#*E#
m32#=-1*B#*C#
m13#=-1*AD#*E#+B#*F#
m23#=AD#*F#+B#*E#
m33#=A#*C#

Rem rotate all the points using the matrix
For p=1 To NumbOfVerts

pointx#=Objects(p).x
pointy#=Objects(p).y
pointz#=Objects(p).z

    Objects(p).RotatedX = (m11# * pointx#) + (m12# * pointy#) + (m13# * pointz#)
    Objects(p).RotatedY = (m21# * pointx#) + (m22# * pointy#) + (m23# * pointz#)
    Objects(p).RotatedZ = (m31# * pointx#) + (m32# * pointy#) + (m33# * pointz#)
   
    Rem Now Do the perspective calculation
    z# =  Objects(p).RotatedZ + ObjectDistance#
        Objects(p).ScreenX = cx+ ((Objects(p).RotatedX*ProjectionX# ) / z#)
    Objects(p).ScreenY = cy+ ((Objects(p).RotatedY*ProjectionY# )/ z#)
Next p


EndFunction


Function CreatePalette(Col,COl2)
ShadeBox 0, 0, 128, 1, 0, Col,0,Col
ShadeBox 128, 0, 256, 1, Col,  Col2,Col,$ffffff
for i=0 to 255
palette(i)=$0000
next
For i = 10 To 255
   palette(i) = Point(i, 0)
Next i
For i = 256 To GetArrayElements(Palette(),1)
   palette(i) = Palette(255)
Next i
EndFunction