Alpha Particles (Project pack example) This is a repost (i think) of the alpha particle demo from the PLayBASIC learning edition project packs.
Released: 1st,Aug,2006
[pbcode]
; PROJECT : AlphaParticles
; AUTHOR : Kevin Picone (c) Underware Design 2005
; CREATED : 1/08/2006
; EDITED : 4/6/2010
OpenScreen 640,480,32,1
Randomize 42
MakeBitmapFont 1,$ffffff
setfps 60
sw=GetScreenWidth()
sh=GetScreenHeight()
Clipx2=sw-1
Clipy2=sh-1
; CReate an FX copy of the display
FXScreen=NewFXImage(sw,sh)
; create BlitIMage's blend surface.
BlendFXScreen=NewFXImage(sw,sh)
SetBlitImageBuffer BlendFXscreen
RenderToImage BlendFXScreen
ShadeBox 0,0,sw,sh,RndRGB(),RndRGB(),RndRGB(),RndRGB()
Path$=""
// #if PbCompileMode=0
Path$="..\..\gfx\"
//#Endif
RenderToScreen
; Projection constants
Constant ProjectionX#=400
Constant ProjectionY#=400
; View Z depth
Zdepth#=600
; Size of Alpha Texture
Size=24
MaxImages=64
Dim ParticleIMage(MaxImages)
Col=$ffffff
For lp=0 To MaxImages
ParticleIMage(lp)=NewImage(Size,Size)
RenderToImage ParticleIMage(lp)
PrepareFXImage ParticleIMage(lp)
RenderPhongImage ParticleIMage(lp),Size/2,Size/2,col,255,260/(size/2)
Col=RndRGB()
Next
RenderToScreen
ParticleSize=GetImageWidth(ParticleIMage(0))
NumberOfParticles=350
ACSet =1
Constant Particle_Xpos=AC(1)
Constant Particle_Ypos=AC(1)
Constant Particle_Zpos=AC(1)
Constant Particle_Sprite=AC(1)
Constant Particle_StructSize=AC(1)
Dim VertexList#(NumberOfParticles,Particle_StructSize)
Dim RotatedVertexList#(NumberOfParticles,Particle_StructSize)
ParticleSizeX#=30*ProjectionX#
ParticleSizeY#=30*ProjectionY#
Size=500
DRawmode=16
For lp=0 To NumberOfParticles
anglex#=Rnd(360)
angley#=Rnd(360)
anglez#=Rnd(360)
speed#=RndRange(50,size)
x#,y#,z#=CalcMovement(Anglex#,angley#,anglez#,Speed#)
VertexList#(lp,Particle_Xpos)=x#
VertexList#(lp,Particle_Ypos)=Y#
VertexList#(lp,Particle_Zpos)=Z#
ThisSprite=NewSprite(0,0,ParticleIMage(Rnd(MaxImages)))
SpriteDrawMode ThisSprite,2+DRawmode
; SpriteTransparent ThisSprite,Off
VertexList#(lp,Particle_Sprite)=ThisSprite
Next
Max=1000
VertSize =12
SrcBank=NewBank((NumberOfParticles+1)*VertSize)
DEstBank=NewBank((NumberOfParticles+1)*VertSize)
SrcAddress =GetBankPtr(SrcBank)
DestAddress =GetBankPtr(SrcBank)
For lp=0 To NumberOfParticles
PokeFloat SrcAddress,VertexList#(lp,Particle_Xpos)
PokeFloat SrcAddress+4,VertexList#(lp,Particle_Ypos)
PokeFloat SrcAddress+8,VertexList#(lp,Particle_Zpos)
SrcAddress=SrcAddress+12
Next
RenderMode=0
RenderToImage fxscreen
CreateCamera 1
CameraCls 1,Off
boxX2=100
boxY2=100
MaxEffectTime=5000
RenderToScreen
Type tVertex
x#,y#,z#
EndType
Dim VertexPointer As tVertex Pointer
Do
Inc frames
If EffectChangeTime<Timer()
EffectChangeTime=Timer()+MaxEffectTime
Inc RenderMode
If rendermode>3 Then rendermode=0
EndIf
RenderToImage fxscreen
; Rotate vertex list (with XYZ rotation order)
RotationTime2=Timer()
SrcAddress =GetBankPtr(SrcBank)
DestAddress =GetBankPtr(destBank)
RotateVertexListXYZ SrcAddress,12,DestAddress,12,0.0,0.0,Zdepth#,Tilt#,turn#,roll#,NumberOFParticles
RotationTime2=Timer()-RotationTime2
; =========================================
; Render particles
; =========================================
If RenderMode=0
renderTime=Timer()
BackDrop()
CaptureToScene
ClsScene
InkMode 1+64
; Addcolour=RndRGB() And $f0f0f
addcolour=$112233
lp=NumberOFParticles
address= DestAddress+(lp*12)
Do
z#=PeekFloat(Address+8)
If z#>10 And z#<5000
CaptureDepth z#
CircleC scx+(PeekFloat(Address)*projectionX#)/z#,scy+(PeekFloat(Address+4)*projectionY#)/z#,ParticleSizeX#/z#,1,AddColour
EndIf
Address=Address-12
DecLoop lp
renderTime=Timer()-rendertime
circletime#=circletime#+rendertime
DrawCamera 1
EndIf
; =========================================
; USe Sprites to render the effect
; =========================================
If RenderMode>0
RenderTime=Timer()
address= DestAddress
scx=GetScreenWidth()/2
scy=GetScreenHeight()/2
lp=NumberOFParticles
Do
z#=PeekFloat(Address+8)
If z#>10 And z#<5000
ThisSprite=VertexList#(lp,Particle_Sprite)
PositionSpriteXYZ ThisSprite,scx+(PeekFloat(Address)*projectionX#)/z#,scy+(PeekFloat(Address+4)*projectionY#)/z#,z#
ScaleSprite ThisSprite,ParticleSizeX#/z#/ParticleSize
Else
PositionSpriteX VertexList#(lp,Particle_Sprite),-2000
EndIf
address=address+12
DecLoop lp
DrawOrderedSprites
renderTime=Timer()-renderTime
If EnterKey()=True
DrawMode=DRawmode*2
Me=GetFirstSprite()
Repeat
SpriteDrawMode me,2+drawmode
SpriteAlphaLevel me, 0.25
SpriteAlphaSubColour me,RndRGB()
SpriteAlphaAddColour me,RndRGB()
SpriteFlashColour me,RndRGB()
me=GetNextSprite(me)
Until me=0
If DrawMode=>$4000 Then drawmode=2
FlushKeys
EndIf
EndIf
InkMode 1
RenderToScreen
BlitTime=Timer()
ypos=0
If RenderMode=0 Then BlitImageALphaSub(FXScreen,xpos,ypos,RGB(23,34,20))
If RenderMode=1 Then BlitImageClr(FXScreen,xpos,ypos,RGB(140,30,40))
; If RenderMode=1 Then BlitImageALphaSub(FXScreen,xpos,ypos,RGB(8,8,8))
If RenderMode=2 Then BlitImageAlpha50(FxScreen,Xpos,ypos,RGB(23,34,22),BlendFxScreen)
If rendermode=3 Then BlitImageAlphaSubImage(FXscreen,Xpos,Ypos,BlendFXscreen)
BlitTime=Timer()-BlitTime
Rem animate the tilt, turn And roll values
tilt# = tilt#+1.21
turn# = turn#+2.42
roll# = roll#+0.83
; ShowSubDivides = EnterKey()
If UpKey() And zdepth#>400 Then Zdepth#=Zdepth#-20
If DownKey() Then Zdepth#=Zdepth#+20
If SpaceKey() And KeyPRessed=False
Inc RenderMode
If rendermode>3 Then rendermode=0
KeyPressed=True
EffectChangeTime=Timer()+MaxEffectTime
EndIf
If ScanCode()=0 Then KeyPressed=False
; If keystate(19) and KeyPRessed=false
; rotationmode=1-rotationmode
; KeyPressed=true
; endif
If RenderMode=0 Then ModeName$="Alpha Circles"
If RenderMode=1 Then ModeName$="Alpha Sprite Addition"
If RenderMode=2 Then ModeName$="Alpha Sub, Alpha 50% Merge + ALpha ADD Sprites"
If RenderMode=3 Then ModeName$="Alpha Sub, Alpha Subtract + ALpha ADD Sprites"
SetCursor 0,0
Print "Effect Mode: "+Modename$
Print FPS()
Print GetGfxMMX()
If FunctionKeys(1) And KeyPressed=False
GfxMMX 1-GetGfxMMX()
KeyPressed=True
EndIf
Sync
Loop
Function BlitImageAlpha50(ThisImage,X#,y#,ClrRGB,BlendImage)
oldsurface=GetSurface()
RenderToImage Thisimage
; cls clrrgb
w=GetImageWidth(Thisimage)
h=GetImageHeight(Thisimage)
InkMode 1+128
Ink ClrRgb
Box 0,0,w,h,True
InkMode 1
RenderToImage oldsurface
; Use BLIT IMAGE for 32bit buffer with the
BlitMode=32
SetBlitImageBuffer BlendIMage
BlitImage ThisIMage,x#,y#,transparentflag,Blitmode,ClrRGB,true,0
EndFunction
Function BlitImageClr(ThisImage,X#,y#,ClrRGB)
Select GetScreenDepth()
Case 16,32
BlitMode=1
BlitImage ThisIMage,x#,y#,transparentflag,Blitmode,ClrRGB,0,0
Case 24
oldsurface=GetSurface()
DrawImage ThisIMage,x#,y#,transparentflag
RenderToImage ThisImage
Cls ClrRgb
RenderToImage Oldsurface
EndSelect
EndFunction
Function BlitImageALphaAdd(ThisImage,X#,y#,AddRGB)
Select GetScreenDepth()
Case 16,32
BlitMode=64
BlitImage ThisImage,x#,y#,transparentflag,Blitmode,AddRGB,0,0
Default
; Create an Equivalent Alpha effect using a box alpha masked over the src image
OldSurface=GetSurface()
w=GetImageWidth(Thisimage)
h=GetImageHeight(Thisimage)
oldinkmode=GetInkMode()
RenderToImage thisimage
InkMode 1+64
BoxC 0,0,w,h,1,AddRgb
InkMode oldinkmode
RenderToImage OldSurface
DrawImage Thisimage,X#,y#,0
EndSelect
EndFunction
Function BlitImageALphaSub(ThisImage,X#,y#,SubRGB)
Select GetScreenDepth()
; BlitImage only supports 16 + 32bit in PBV1.13
Case 16,32
BlitMode=128
BlitImage ThisImage,x#,y#,transparentflag,Blitmode,SubRGB,0,0
Default
; Create an Equivalent Alpha effect using a box alpha masked over the src image
OldSurface=GetSurface()
w=GetImageWidth(Thisimage)
h=GetImageHeight(Thisimage)
oldinkmode=GetInkMode()
RenderToImage thisimage
InkMode 1+128
BoxC 0,0,w,h,1,SubRgb
InkMode oldinkmode
RenderToImage OldSurface
DrawImage Thisimage,X#,y#,0
EndSelect
EndFunction
Function BlitImageAlphaSubImage(SrcImage,X#,y#,BlendImage)
Select GetScreenDepth()
; Set up Alpha Sub of BlendImage from the SRc image
; ONly available in 16 32bit modes
Case 16,32
BlitMode=128
SetBlitImageBuffer BlendIMage
BlitImage SrcImage,x#,y#,transparentflag,Blitmode,SubRGB,True,0
OldSurface=GetSurface()
oldinkmode=GetInkMode()
RenderToImage Srcimage
InkMode 1+128
BoxC 0,0,GetImageWidth(Srcimage),GetImageHeight(Srcimage),1,$101010
InkMode oldinkmode
RenderToImage OldSurface
EndSelect
EndFunction
Function CalcMovement(Anglex#,angley#,anglez#,Speed#)
` invert angles
anglex#=360-anglex#
angley#=WrapAngle(90,-angley#)
anglez#=360-anglez#
` precalc cos+sin for rotation
cx#=Cos(anglex#)
sx#=Sin(anglex#)
cy#=Cos(angley#)
sy#=Sin(angley#)
Zpos#=Speed#
z#=(cx#*Zpos#)
y#=(sx#*zpos#)
` Around Y axis
x2#=(cY#*Z#)-(sy#*X#)
z#=((cy#*X#)+(sy#*Z#))
EndFunction x2#,y#,z#
Function BackDrop()
Static baseangle#
c1=RGBFade($ff0000,SinNewValue(50,baseangle#,50))
c2=RGBFade($ffff00,CosNewValue(50,baseangle#,50))
c3=RGBFade($ff00f0,SinNewValue(50,baseangle#*2,50))
c4=RGBFade($1234,CosNewValue(50,baseangle#*2,50))
ShadeBox 0,0,GetScreenWidth(),GetScreenHeight(),c1,c2,c3,c4
baseangle#=Mod(baseangle#+1,360)
EndFunction
[/pbcode]