[bb] Lotus Particle System R2 - Part 1 by N [ 1+ years ago ]

[BlitzBot]

Title : Lotus Particle System R2 - Part 1
Author : N
Posted : 1+ years ago

Description : This is part 1 of the source code (since it's too large to go into one entry, as Rob pointed out).  For part 2: <a href="codearcs62a3.html?code=1657" >Lotus Particle System R2 - Part 2</a>

In the interest of furthering the potential usefulness of Lotus R2 (I will try to document some of it later, just don't expect it overnight), I'm releasing it into the public domain.

Hopefully this will help those people who are particularly hateful of licenses (can't blame'em considering I loathe anything longer than 100 lines).

Anywho, feel free to use and abuse.  I'll add a comment when I begin documenting the source.  (No guarantee that it will work with the DIMs arranged in the order they're in, however I don't think there will be a problem with them).

Media for Lotus R2 is laid out like so:

Code Select Expand

particles.png
_________________
| 0 | 1 | 2 | 3 |
|___|___|___|___|
| 4 | 5 | 6 | 7 |
|___|___|___|___|
Where numbers indicate the indices of particle cells (textures).  These cells are individual particles or animation frames (depending on which Load function you use).

The Graph functionality allows you to have keyframe'd values (color and size were all that were finished last I checked) instead of linearly interpolating between two values.

The public domain license does not apply to the existing archive of Lotus R2.  That is to say, all media, samples, the editor, etc. are still under the license they were originally released under. [/i]

Code :

Code (blitzbasic) Select Expand

Dim gSine#(0)
Dim gCosine#(0)
Dim gGraphArray#( 0, 1 )
Dim gAlphaPartArray#( 0, 0 )
Dim gLotusUpdateTimes%( 5 )

Function Min#(A#,B#)
If A < B Then Return B
Return A
End Function

Function Max#(A#,B#)
If A > B Then Return B
Return A
End Function

Function lSort( L, R )

If R <= L Then Return False

Local A, B, SwapA#, SwapB#, Middle#
A = L
B = R

Middle# = gAlphaPartArray( (L+R)/2, 0 )

Repeat

While gAlphaPartArray( A, 0 ) < Middle
A = A + 1
If A > R Then Exit
Wend

While  Middle < gAlphaPartArray( B, 0 )
B = B - 1
If B < 0 Then Exit
Wend

If A > B Then Exit

SwapA = gAlphaPartArray( A, 0 )
SwapB = gAlphaPartArray( A, 1 )
gAlphaPartArray( A, 0 ) = gAlphaPartArray( B, 0 )
gAlphaPartArray( A, 1 ) = gAlphaPartArray( B, 1 )
gAlphaPartArray( B, 0 ) = SwapA
gAlphaPartArray( B, 1 ) = SwapB

A = A + 1
B = B - 1

If B < 0 Then Exit

Forever

If L < B Then lSort( L, B )
If A < R Then lSort( A, R )
End Function

Function InsertionSort( Size% )
Local i, j, index

For i = 1 To Size - 1
index = gGraphArray( i, 0 )
j = i
While j > 0 And gGraphArray( j-1, 0 ) > index
gGraphArray( j, 0 ) = gGraphArray( j - 1, 0 )
j = j - 1
Wend
gGraphArray( j, 0 ) = index
Next
End Function


;; Line Helper functions, written by Jeremy Alessi (they are public domain)
Function ReturnedY#(x#, X1#, Y1#, X2#, Y2#)
Return (  Slope( X1#, Y1#, X2#, Y2# ) * x# + YIntercept( X1#, Y1#, X2#, Y2# ) )
End Function

Function Slope#(X1#, Y1#, X2#, Y2#)
m# = ( ( Y2# - Y1# ) / ( X2# - X1# ) )

If m#=0
Return .01 ;avoid infinity
EndIf

Return m#
End Function

Function YIntercept(X1#, Y1#, X2#, Y2#)
Return (Y1# - Slope#( X1#, Y1#, X2#, Y2# ) * X1#)
End Function

Type LotusParticle
Field Texture.LotusTexture
Field Frame%
Field FrameStart%
Field FrameLength%
Field Animated%

Field Parent.LotusEmitter
Field Child.LotusEmitter
Field Trail.LotusEmitter

Field LastPositionX#
Field LastPositionY#
Field LastPositionZ#

Field PositionX#
Field PositionY#
Field PositionZ#

Field TranslationX#
Field TranslationY#
Field TranslationZ#

Field VelocityX#
Field VelocityY#
Field VelocityZ#

Field OVelocityX#
Field OVelocityY#
Field OVelocityZ#

Field AccelerationX#
Field AccelerationY#
Field AccelerationZ#

Field VelocityDecay#

Field AngleX#
Field AngleY#
Field AngleZ#

Field AngleVelocityX#
Field AngleVelocityY#
Field AngleVelocityZ#

Field AngleAccelerationX#
Field AngleAccelerationY#
Field AngleAccelerationZ#

Field DeflectorSpeedX#
Field DeflectorSpeedY#
Field DeflectorSpeedZ#

Field RedFrom%
Field GreenFrom%
Field BlueFrom%
Field AlphaFrom#

Field RedTo%
Field GreenTo%
Field BlueTo%
Field AlphaTo#

Field ColorGraph.LotusGraph

Field SizeFromX#
Field SizeFromY#
Field SizeFromZ#

Field SizeToX#
Field SizeToY#
Field SizeToZ#

Field SizeGraph.LotusGraph

Field WaveRadiusX#
Field WaveRadiusY#
Field WaveRadiusZ#

Field WaveSpeedX#
Field WaveSpeedY#
Field WaveSpeedZ#

Field BlendMode%

Field Vertex%

Field RollMode%

Field LifeSpan#
Field LifeBegan#
Field Life#
Field ParticleMesh%
Field Previous.LotusParticle

Field GravityEnabled%
Field Gravity#
Field Weight#

Field Range#

Field ViewMode%
Field LifeMode%

Field ChildMode%
Field Frozen%
Field Hidden%
Field Draw%
Field Cull%
Field Sorting%

Field Bounce%
Field BounceDecay#
Field BounceMax%
Field Bounces%

Field MinY#

Field BounceSound%
Field BounceSoundChannel%
Field BounceSoundRange#

Field SplineMesh%

Field DeflectorsAffect%
End Type

Type LotusEmitter
Field Name$

Field Entity%
Field Texture.LotusTexture
Field Frame%
Field FrameStart%
Field FrameLength%
Field Animated%

Field Parent.LotusEmitter
Field Child.LotusEmitter
Field Trail.LotusEmitter

Field TranslationJitterUp%
Field TranslationJitterDown%

Field PositionX#
Field PositionY#
Field PositionZ#

Field AngleX#
Field AngleY#
Field AngleZ#

Field TranslationJitterX#
Field TranslationJitterY#
Field TranslationJitterZ#

Field VelocityJitterUp
Field VelocityJitterDown

Field VelocityJitterX#
Field VelocityJitterY#
Field VelocityJitterZ#

Field VelocityDecay#

Field TranslationX#
Field TranslationY#
Field TranslationZ#

Field VelocityX#
Field VelocityY#
Field VelocityZ#

Field AccelerationX#
Field AccelerationY#
Field AccelerationZ#

Field AngleVelocityX#
Field AngleVelocityY#
Field AngleVelocityZ#

Field AngleAccelerationX#
Field AngleAccelerationY#
Field AngleAccelerationZ#

Field RandomRotationX#
Field RandomRotationY#
Field RandomRotationZ#

Field CircleRadiusX#
Field CircleSpeedX#
Field CircleRadiusY#

Field CircleSpeedY#
Field CircleRadiusZ#
Field CircleSpeedZ#

Field RedFrom%
Field GreenFrom%
Field BlueFrom%
Field AlphaFrom#

Field RedTo%
Field GreenTo%
Field BlueTo%
Field AlphaTo#

Field ColorJitterRed%
Field ColorJitterGreen%
Field ColorJitterBlue%
Field ColorJitterAlpha#
Field ColorJitterUniform%
Field ColorJitterUp%
Field ColorJitterDown%

Field ColorGraph.LotusGraph

Field SizeJitterX#
Field SizeJitterY#
Field SizeJitterZ#
Field SizeJitterUniform%
Field SizeJitterUp%
Field SizeJitterDown%

Field SizeFromX#
Field SizeFromY#
Field SizeFromZ#

Field SizeToX#
Field SizeToY#
Field SizeToZ#

Field SizeGraph.LotusGraph

Field CylinderX#
Field CylinderY#
Field CylinderZ#

Field CubeX#
Field CubeY#
Field CubeZ#

Field WaveRadiusX#
Field WaveRadiusY#
Field WaveRadiusZ#

Field WaveSpeedX#
Field WaveSpeedY#
Field WaveSpeedZ#

Field BlendMode%

Field LifeSpan%
Field LifeSpanJitter%
Field LifeSpanJitterUp%
Field LifeSpanJitterDown%

Field Active%
Field ActiveSpan%
Field FreeOnEndActive%

Field GravityEnabled%
Field Gravity#
Field GravityJitter#
Field GravityJitterUp%
Field GravityJitterDown%
Field Weight#

Field RollMode%

Field Emit%
Field EmissionRate%

Field InnerRadius#
Field Radius#
Field YRadius#

Field ParticleMesh%
Field Latest.LotusParticle
Field ViewMode%
Field LifeMode%
Field WaitA# ;; Auto-emission wait
Field WaitB# ;; Child-emission wait
Field WaitC# ;; Trail-emission wait
Field WaitSpan%
Field ChildMode%
Field Range#

Field Frozen%
Field Hidden%
Field Cull%
Field Sorting%
Field DWaitSpan%
Field WaitSpanJitter%

Field Bounce%
Field BounceDecay#
Field BounceMax%

Field MinY#

Field EmitSound%
Field BounceSound%
Field LoopEmitSound%
Field EmitSoundChannel%
Field EmitSoundRange#
Field BounceSoundRange#

Field SplineMesh%

Field DeflectorsAffect%
End Type

Type LotusDeflector
Field PositionX#
Field PositionY#
Field PositionZ#
Field Entity%
Field Radius#
Field Strength#
Field Active%
End Type

Type LotusTexture
Field Bitmap%
Field Flags%
Field Path$
Field Add%
Field Multiply%
Field Alpha%
Field UStep#
Field VStep#
Field Rows%
Field Columns%
End Type

Type LotusGraph
Field Bank%
Field Keys%
Field Width#
End Type

Dim LoadedEmitters%(255) ;; The emitters loaded by LoadASCIIEmitters
Global gLoadedEmittersCount% ;; The amount of emitters loaded through LoadASCIIEmitters

Dim LoadedDeflectors%(255) ;; The deflectors loaded by LoadASCIIEmitters
Global gLoadedDeflectorsCount% ;; The amount of deflectors loaded through LoadASCIIEmitters

Dim LoadedTextures%(255) ;; The textures loaded by LoadASCIIEmitters
Global gLoadedTexturesCount% ;; The amount of textures loaded through LoadASCIIEmitters

Global gLotusParticlePivot% ;; Pivot used to determine various properties and the position and rotation of particles
Global gLotusTPivot% ;; Extra pivot used for view mode calculations
Global gLotusParticleMesh% ;; The container-mesh for all Lotus particles
Global gLotusCamera% ;; The camera particles will face (when told to)

Global gLotusNullTexture.LotusTexture ;; The 'Null Texture' object- used in the case that no texture is available
Global gLotusEmitterTexture% ;; The texture assigned to emitter cones.
Global gNullTexture% ;; The handle of the 'Null Texture'

Global gLotusParticleCount% ;; The amount of particles in existence
Global gLotusAlphaParticleCount% ;; The amount of alpha-blended particles to be sorted
Global gLotusParticlesDrawn% ;; The amount of particles drawn during the last call to UpdateLotusParticles

Const cP_QUAD% = 0 ;; SetEmitterParticleMesh enumerator; sets a particle's mesh to a quad (two triangles)
Const cP_TRIANGLE% = 1 ;; SetEmitterParticleMesh enumerator; sets a particle's mesh to a triangle
Const cP_TRAIL% = 2 ;; SetEmitterParticleMesh enumerator; sets a particle's mesh to the trail style (all particles are 'connected' by quads)
Const cP_TRAILVERTICAL% = 3 ;; SetEmitterParticleMesh enumerator; sets a particle's mesh to the vertical trail style (all particles are 'connected' by quads)
Const cP_DENT% = 4 ;; SetEmitterParticleMesh enumerator; sets a particle's mesh to a quad with a dent in the center (four triangles)

Const updTimeSort% = 0 ;; Indices for update times
Const updTimeEmit% = 1
Const updTimePart% = 2
Const updTimeDrawAlpha% = 3
Const updTimeTexture% = 4
Const updTimeAll% = 5

Global gWidth% ;; The screen buffer width and height
Global gHeight%

Const cUSE_EMITTERCONES = 0 ;; Whether or not to use emitter cones (little graphical thingy); recommended to leave off

Global gFacingX#,gFacingY#,gFacingZ# ;; Facing vector

Type LotusVector
Field X#
Field Y#
Field Z#
End Type

Global gTempLotusVector.LotusVector ;can be used for temporary LotusVector operations.
Global gNullLotusVector.LotusVector ;zero-LotusVector.

Type LotusStringPiece
Field Text$
End Type

Function DivideString(Text$,Sep$)
Text$ = Trim(Text$)
Local Pieces = 0
OT$ = Text$
Text$ = ""
For E = 1 To Len(OT)
C = Asc(Mid(OT,E,1))
S = Instr(Sep,Chr(C))

If (Not StringOpen) And C = 39 Then Exit

If C = 34 Then StringOpen = Not StringOpen

If (S > 0 Or C = 32) And (Not StringOpen) Then
Text = Text + Chr(4)
Else
Text = Text + Chr(C)
EndIf
Next

While Text$ <> ""
If Asc(Left(Text$,1)) = 34 Then
Text$ = Right(Text$,Len(Text$)-1)
Closest = Instr(Text$,Chr(34))
Else
Closest = Instr(Text$,Chr(4))
EndIf

If Closest Then
NText$ = Trim(Left(Text$,Closest-1))
Text$ = Trim(Right(Text$,Len(Text$)-Closest))
Else
NText$ = Text$
Text$ = ""
EndIf

P.LotusStringPiece = New LotusStringPiece
PText$ = Replace(NText$,""+Chr(34),Chr(34))
Pieces = Pieces + 1
Wend

Return Pieces
End Function

;creates a LotusVector and returns it
Function LotusVec.LotusVector(X#=0,Y#=0,Z#=0)
V.LotusVector = New LotusVector
VX = X
VY = Y
V = Z
Return V
End Function

;adds LotusVector B to LotusVector A
Function LotusVec_Add(A.LotusVector, B.LotusVector)
If Not A <> Null Or B <> Null Then Return False
AX = AX + BX
AY = AY + BY
A = A + B
Return True
End Function

;subtracts LotusVector B from LotusVector A
Function LotusVec_Subtract(A.LotusVector, B.LotusVector)
If Not A <> Null Or B <> Null Then Return False
AX = AX - BX
AY = AY - BY
A = A - B
Return True
End Function

;returns the difference of LotusVector A and LotusVector B
Function LotusVec_Difference.LotusVector(A.LotusVector, B.LotusVector)
If Not A <> Null Or B <> Null Then Return Null
Return LotusVec(AX-BX,AY-BY,A-B)
End Function

;returns the sum of LotusVector A and LotusVector B
Function LotusVec_Sum.LotusVector(A.LotusVector, B.LotusVector)
If Not A <> Null Or B <> Null Then Return Null
Return LotusVec(AX+BX,AY+BY,A+B)
End Function

;multiplies LotusVector A by LotusVector B
Function LotusVec_Multiply(A.LotusVector, B.LotusVector)
If Not A <> Null Or B <> Null Then Return False
AX = AX * BX
AY = AY * BY
A = A * B
Return True
End Function

;divides LotusVector A by LotusVector B
Function LotusVec_Divide(A.LotusVector, B.LotusVector)
If Not A <> Null Or B <> Null Then Return False
AX = AX / BX
AY = AY / BY
A = A / B
Return True
End Function

;scales LotusVector A by Scalar B
Function LotusVec_Scale(A.LotusVector, B#)
If Not A <> Null Then Return False
AX = AX * B
AY = AY * B
A = A * B
Return True
End Function

;divides LotusVector A by Scalar B
Function LotusVec_SDivide(A.LotusVector,B#)
If Not A <> Null Or B = 0 Then Return False
AX = AX / B
AY = AY / B
A = A / B
Return True
End Function

;makes LotusVector A the cross product of LotusVectors A and B
Function LotusVec_CrossProduct(A.LotusVector, B.LotusVector)
If Not A <> Null Or B <> Null Then Return False
X# = AY*B - A*BY
Y# = A*BX - AX*B
Z# = AX*BY - AY*BX
AX = X
AY = Y
A = Z
Return True
End Function

;returns the dot product of LotusVectors A and B
Function LotusVec_DotProduct#(A.LotusVector, B.LotusVector)
If Not A <> Null Or B <> Null Then Return False
Return AX * BX + AY * BY + A * B;
End Function

;copies the contents of LotusVector A to a new LotusVector and returns it
Function LotusVec_Copy.LotusVector(A.LotusVector)
If Not A <> Null Then Return Null
B.LotusVector = New LotusVector
BX = AX
BY = AY
B = A
Return B
End Function

;copies the contents of LotusVector B to LotusVector A
Function LotusVec_CopyTo(A.LotusVector,B.LotusVector)
If Not A <> Null Or B <> Null Then Return False
AX = BX
AY = BY
A = B
End Function

;normalizes LotusVector A
Function LotusVec_Normalize(A.LotusVector)
If Not A <> Null Then Return False
M# = LotusVec_Magnitude(A)
AX = AX / M
AY = AY / M
A = A / M
Return True
End Function

;returns the magnitude of LotusVector A
Function LotusVec_Magnitude#(A.LotusVector)
If Not A <> Null Then Return False
Return Sqr(AX*AX+AY*AY+A*A)
End Function

;returns the distance between LotusVector A and LotusVector B
Function LotusVec_Distance#(A.LotusVector,B.LotusVector)
If Not A <> Null Or B <> Null Then Return False
DX# = AX - BX
DY# = AY - BY
DZ# = A - B
Return Sqr(DX*DX+DY*DY+DZ*DZ)
End Function

;inverts LotusVector A
Function LotusVec_Invert(A.LotusVector)
If Not A <> Null Then Return False
AX = -AX
AY = -AY
A = -A
Return True
End Function

;returns an inverted LotusVector A
Function LotusVec_Inverse.LotusVector(A.LotusVector)
If Not A <> Null Then Return Null
B.LotusVector = LotusVec_Copy(A)
LotusVec_Invert B
Return B
End Function

;returns the position of an entity in a LotusVector.  G = Global
Function LotusVec_Entity_Position.LotusVector(Entity,G = False)
If Entity = 0 Then Return Null
V.LotusVector = New LotusVector
VX = EntityX(Entity,G)
VY = EntityY(Entity,G)
V = EntityZ(Entity,G)
Return V
End Function

;returns the angle of an entity in a LotusVector.  G = Global
Function LotusVec_Entity_Angle.LotusVector(Entity,G = False)
If Entity = 0 Then Return Null
V.LotusVector = New LotusVector
VX = EntityPitch(Entity,G)
VY = EntityYaw(Entity,G)
V = EntityRoll(Entity,G)
Return V
End Function

;positions an entity at LotusVector A
Function LotusVec_PositionEntity(Entity,A.LotusVector,Glb=False)
If Entity = 0 Or A = Null Then Return False
PositionEntity Entity,AX,AY,A,Glb
End Function

;rotates an entity to LotusVector A
Function LotusVec_RotateEntity(Entity,A.LotusVector,Glb=False)
If Entity = 0 Or A = Null Then Return False
RotateEntity Entity,AX,AY,A,Glb
End Function

;turns an entity by LotusVector A
Function LotusVec_TurnEntity(Entity,A.LotusVector)
If Entity = 0 Or A = Null Then Return False
TurnEntity Entity,AX,AY,A
End Function

;aligns an entity to LotusVector A
Function LotusVec_AlignToLotusVector(Entity,A.LotusVector,Axes=3,Trans#=1)
If Entity = 0 Or A = Null Then Return False
AlignToVector Entity,AX,AY,A,Axes,Trans
End Function

;moves an entity by LotusVector A
Function LotusVec_MoveEntity(Entity,A.LotusVector)
If Entity = 0 Or A = Null Then Return False
MoveEntity Entity,AX,AY,A
End Function

;translates an entity by LotusVector A
Function LotusVec_TranslateEntity(Entity,A.LotusVector)
If Entity = 0 Or A = Null Then Return False
TranslateEntity Entity,AX,AY,A
End Function

;returns the normals of a vertex
Function LotusVec_VertexNormal.LotusVector(Surface,Index)
If Surface = 0 Or Index < 0 Or Index > CountVertices(Surface)-1 Then Return Null
Return LotusVec(VertexNX(Surface,Index),VertexNY(Surface,Index),VertexNZ(Surface,Index))
End Function

;returns the local position of a vertex
Function LotusVec_VertexPosition.LotusVector(Surface,Index)
If Surface = 0 Or Index < 0 Or Index > CountVertices(Surface)-1 Then Return Null
Return LotusVec(VertexX(Surface,Index),VertexY(Surface,Index),VertexZ(Surface,Index))
End Function

;sets the position of a vertex to LotusVector A
Function LotusVec_VertexCoords(Surface,Index,A.LotusVector)
If Surface = 0 Or Index < 0 Or Index > CountVertices(Surface)-1 Or A = Null Then Return False
VertexCoords Surface,Index,AX,AY,A
End Function

;returns the normal of a triangle
Function LotusVec_TriangleNormal.LotusVector(Surface,Index)
If Surface = 0 Or Index < 0 Or Index > CountTriangles(Surface)-1 Then Return Null
Local VNormals.LotusVector[2]
For N = 0 To 2
VNormals[N] = LotusVec_VertexNormal(Surface,TriangleVertex(Surface,Index,N))
Next
LotusVec_Subtract VNormals[0],VNormals[1]
LotusVec_Subtract VNormals[1],VNormals[2]
LotusVec_CrossProduct(VNormals[0],VNormals[1])
Delete VNormals[1]
Delete VNormals[2]
Return VNormals[0]
End Function

;returns the local position of a triangle
Function LotusVec_TrianglePosition.LotusVector(Surface,Index)
If Surface = 0 Or Index < 0 Or Index > CountTriangles(Surface)-1 Then Return Null
Local VNormals.LotusVector[2]
For N = 0 To 2
VNormals[N] = LotusVec_VertexPosition(Surface,TriangleVertex(Surface,Index,N))
Next
LotusVec_Add(VNormals[0],VNormals[1])
LotusVec_Add(VNormals[0],VNormals[2])
LotusVec_SDivide(VNormals[0],3)
Delete VNormals[1]
Delete VNormals[2]
Return VNormals[0]
End Function

;transforms LotusVector A from one coordinate system to another
Function LotusVec_TFormPoint(A.LotusVector,EntityA,EntityB)
If Not A <> Null Then Return False
TFormPoint AX,AY,A,EntityA,EntityB
End Function

;returns the TFormed vector
Function LotusVec_TFormedA.LotusVector()
Return LotusVec(TFormedX(),TFormedY(),TFormedZ())
End Function

;puts the values of the TFormed vector into LotusVector A
Function LotusVec_TFormedB(A.LotusVector)
If A = Null Then Return False
AX = TFormedX()
AY = TFormedY()
A = TFormedZ()
End Function

Global ParticleTiles=0
Global BulletHoleEmitter=0
Global BulletSparkEmitter=0
Global BulletSmokeEmitter=0

Function FXP_SetupTilesets()
If ParticleTiles = 0 Then
Tiles = LoadLotusTileset("media/particles.png",59,2,4,1,0,1)
ParticleTiles = Tiles
Else
Tiles = ParticleTiles
EndIf

Return Tiles
End Function

Function CreateBulletSpark(X#,Y#,Z#,NX#,NY#,NZ#)
Tiles = FXP_SetupTilesets()

If BulletSparkEmitter = 0 Then
e = CreateEmitter()
ApplyTexture e,Tiles,3

SetEmitterVelocity e,0,.2,0
SetEmitterSizeJitter e,1,0,0,0,1,1
SetEmitterLifespan e,8
SetEmitterSorting e,1
SetEmitterBlend e,3
SetEmitterColorFrom e,246,167,76,.6
SetEmitterColorTo e,235,155,0,0
SetEmitterSizeTo e,1,.5
SetEmitterSizeFrom e,.5,.25
SetEmitterRandomRotation e,25,25,0
SetEmitterRollMode e,1
SetEmitterEmissionRate e,32
BulletSparkEmitter = e
Else
e = BulletSparkEmitter
EndIf

If BulletSmokeEmitter = 0 Then
s = CreateEmitter()
SetEmitterLifespan s,120
SetEmitterVelocity s,0,.005,0
SetEmitterVelocityDecay s,1
SetEmitterEmissionRate s,4
SetEmitterColorFrom s,88,86,84,.7
SetEmitterColorTo s,77,76,75,0
SetEmitterColorJitter s,15,15,15,0,1
ApplyTexture s,Tiles,4
SetEmitterSizeFrom s,0,0
SetEmitterRandomRotation s,0,0,180
SetEmitterSizeTo s,1,2
SetEmitterSizeJitter s,.4,.4,.4,1,1,0
SetEmitterTranslation s,0,.01,0
SetEmitterTranslationJitter s,0,.025,0,1,0
BulletSmokeEmitter = s
Else
s = BulletSmokeEmitter
EndIf

If BulletHoleEmitter = 0 Then
b = CreateEmitter()
SetEmitterLifespan b,3000
SetEmitterViewmode b,2
SetEmitterColorFrom b,0,0,0,8
SetEmitterColorTo b,0,0,0,0
SetEmitterSize b,1,1,1
SetEmitterRandomRotation b,0,0,180
SetEmitterSizeJitter b,.4,.4,.4,1,1,1
ApplyTexture b,Tiles,1
Else
b = BulletHoleEmitter
EndIf

PositionEntity e,X,Y,Z
PositionEntity s,X,Y,Z
AlignToVector e,NX,NY,NZ,2,1
AlignToVector s,NX,NY,NZ,3,1
MoveEntity s,0,0,.7
MoveEntity e,0,0,.2
PositionEntity b,X,Y,Z
AlignToVector b,NX,NY,NZ,3,1
MoveEntity b,0,0,.025

CreateParticle(s)
CreateParticle(e)
CreateParticle(b)
End Function

Function CreateTorch()
Tiles = FXP_SetupTilesets()

E = CreateEmitter()
ApplyTexture E,Tiles,0
SetEmitterTranslation E,0,.045,0
SetEmitterLifespan E,600,400
SetEmitterBlend E,3
SetEmitterSizeFrom E,.45,.45
SetEmitterColor E,209,151,78,1
SetEmitterColorTo E,150,80,0,0
SetEmitterColorJitter E,42,42,42,0,1
SetEmitterSizeTo E,1.25,1.25
SetEmitterRandomRotation E,0,0,50
SetEmitterViewMode E,1
SetEmitterSizeJitter E,.25,.25,.25,1,1,0

N = CreateEmitter()
ApplyTexture N,Tiles,7
SetEmitterParent N,E
SetEmitterChildMode E,2
SetEmitterTranslation N,0,.045,0
SetEmitterVelocity N,0,0,.0025
SetEmitterRandomRotation N,20,360,180
SetEmitterLifeSpan N,3500
SetEmitterColorFrom N,120,120,120,.7
SetEmitterColorTo N,100,100,100,0
SetEmitterBlend N,1
SetEmitterWaitSpan E,2
SetEmitterWaitSpan N,5
SetEmitterSizeJitter N,.5,.5,.5,1,1,0
SetEmitterLifeMode N,2
SetEmitterSizeFrom N,.05,.05
SetEmitterSizeTo N,1.5,1.5
SetEmitterEmissionRate E,1
SetEmitterLifeMode E,2

SetEmitterCulling N,0

Return E
End Function

;#Region LotusXML.bb
;#Region DESCRIPTION
; XML load / parse / save functions
; Written by Blitztastic, butchered by Noel Cower
;#End Region

;#Region CLASSES
Type XMLnodelist
Field node.XMLnode
Field nextnode.XMLnodelist
Field prevnode.XMLnodelist
End Type

; for internal use, do not use in code outside of this file
Type XMLworklist
Field node.XMLnode
End Type


Type XMLnode
Field tag$,value$,path$
Field firstattr.XMLattr
Field lastattr.XMLattr
Field attrcount,fileid
Field endtag$

; linkage functionality
Field firstchild.XMLnode
Field lastchild.XMLnode
Field childcount
Field nextnode.XMLnode
Field prevnode.XMLnode
Field parent.XMLnode
End Type

Type XMLattr
Field name$,value$
Field sibattr.XMLattr
Field parent.XMLnode
End Type

Global XMLFILEID
;#End Region

;#Region PROCEDURES
Function ReadXML.XMLnode(filename$)
infile = ReadFile(filename$)
XMLFILEID=MilliSecs()
x.XMLnode = XMLReadNode(infile,Null)
CloseFile infile
Return x
End Function

Function WriteXML(filename$,node.XMLnode,writeroot=False)
outfile = WriteFile(filename$)
WriteLine outfile,"<?xml version="+Chr$(34)+"1.0"+Chr$(34)+" ?>"
XMLwriteNode(outfile,node)
CloseFile outfile
End Function

Function XMLOpenNode.XMLnode(parent.XMLnode,tag$="")
x.XMLnode = New XMLnode
x ag$=tag$
xfileid = XMLFILEID; global indicator to group type entries (allows multiple XML files to be used)
XMLaddNode(parent,x)
Return x
End Function

Function XMLCloseNode.XMLnode(node.XMLnode)
Return nodeparent
End Function

; adds node to end of list (need separate function for insert, or mod this on)
Function XMLAddNode(parent.XMLnode,node.XMLnode)
If parent <> Null
If parentchildcount = 0 Then
parentfirstchild = node
Else
parentlastchild
extnode = node
End If
nodeprevnode = parentlastchild
parentlastchild = node
parentchildcount = parentchildcount +1
nodepath$ = parentpath$+parent ag$
End If
nodeparent = parent
nodepath$=nodepath$+"/"
End Function

Function XMLDeleteNode(node.XMLnode)
n.XMLnode = nodefirstchild
; delete any children recursively
While n <> Null
nn.XMLnode= n
extnode
XMLdeletenode(n)
n = nn
Wend

; delete attributes for this node
a.XMLattr = nodefirstattr
While a <> Null
na.XMLattr = asibattr
Delete a
a = na
Wend

; dec parents child count
If nodeparent <> Null
nodeparentchildcount = nodeparentchildcount -1

; heal linkages
If nodeprevnode <> Null Then nodeprevnode
extnode = node
extnode
If node
extnode <> Null Then node
extnodeprevnode = nodeprevnode
If nodeparentfirstchild = node Then nodeparentfirstchild = node
extnode
If nodeparentlastchild = node Then nodeparentlastchild = nodeprevnode
End If
; delete this node
Delete node

End Function

; node functions
Function XMLfindNode.XMLnode(node.XMLnode,path$)

ret.XMLnode = Null
p=Instr(path$,"/")
If p > 0 Then
tag$=Left$(path$,p-1)
a.XMLnode = node
While ret=Null And a<>Null
If Lower(tag$)=Lower(a ag$) Then
If p=Len(path$) Then
ret = a
Else
If afirstchild <> Null Then
ret = XMLfindnode(afirstchild,Mid$(path$,p+1))
End If
End If
End If
a = a
extnode
Wend
End If
Return ret
End Function

Function XMLDeleteList(nl.XMLnodelist)
While nl <> Null
na.XMLnodelist = nl
extnode
Delete nl
nl = na
Wend
End Function


Function XMLSelectNodes.XMLnodelist(node.XMLnode,path$,recurse=True)
root.XMLnodelist=Null
XMLselectnodesi(node,path$,recurse)
prev.XMLnodelist=Null
c = 0
For wl.XMLworklist = Each XMLworklist
c = c + 1
nl.XMLnodelist = New XMLnodelist
nl
ode = wl
ode
If prev = Null Then
root = nl
prev = nl
Else
prev
extnode = nl
nlprevnode = prev
End If
prev = nl
Delete wl
Next
;gak debuglog "XML: "+c+" nodes selected"
Return root
End Function

; internal selection function, do not use outside this file
Function XMLSelectNodesI(node.XMLnode,path$,recurse=True)
wl.XMLworklist=Null
If node = Null Then
End If
ret.XMLnode = Null
p=Instr(path$,"/")
If p > 0 Then
tag$=Left$(path$,p-1)
a.XMLnode = node
While a<>Null
If Lower(path$)=Lower(Right$(apath$+a ag$+"/",Len(path$))) Then
wl = New XMLworklist
wl
ode = a
End If
If afirstchild <> Null And (recurse) Then
XMLSelectNodesI(afirstchild,path$)
End If
a = a
extnode
Wend
End If

End Function

Function XMLNextNode.XMLnode(node.XMLnode)
Return node
extnode
End Function

Function XMLPrevNode.XMLnode(node.XMLnode)
Return nodeprevnode
End Function

Function XMLAddAttr(node.XMLnode,name$,value$)
;gak debuglog "XML:adding attribute "+name$+"="+value$+" ("+Len(value$)+")"
a.XMLattr = New XMLattr
a
ame$ = name$
avalue$ = value$
If nodeattrcount = 0 Then
nodefirstattr = a
Else
nodelastattrsibattr = a
End If
nodelastattr=a
nodeattrcount = nodeattrcount + 1
aparent = node
If Upper(avalue)="TRUE" avalue=1
If Upper(aValue)="FALSE" avalue=0
If Upper(aValue)="GRAPHICSWIDTH" avalue=GraphicsWidth()
If Upper(aValue)="GRAPHICSHEIGHT" avalue=GraphicsHeight()
End Function

Function XMLReadNode.XMLnode(infile,parent.XMLnode,pushed=False)
mode = 0
root.XMLnode = Null
cnode.XMLnode = Null
x.XMLnode = Null
ispushed = False
done = False
While (Not done) And (Not Eof(infile))
c = ReadByte(infile)
If c<32 Then c=32
ch$=Chr$(c)
; ;gak debuglog "{"+ch$+"} "+c+" mode="+mode
Select mode
 Case 0 ; looking for the start of a tag, ignore everything else
If ch$ = "<" Then
mode = 1; start collecting the tag
End If
 Case 1 ; check first byte of tag, ? special tag
If ch$ = "?" Or ch$ = "!" Then
mode = 0; class special nodes as garbage & consume
Else
If ch$ = "/" Then
mode = 2 ; move to collecting end tag
xendtag$=ch$
;gak debuglog "** found end tag"
Else
cnode=x
x.XMLnode = XMLOpennode(cnode)
If cnode=Null Then root=x
x ag$=ch$
mode = 3 ; move to collecting start tag
End If
End If
 Case 2 ; collect the tag name (close tag)
If ch$=">" Then
mode = 0 ; end of the close tag so jump out of loop
;done = True
x = XMLclosenode(x)
Else
xendtag$ = xendtag$ + ch$
End If
 Case 3 ; collect the tag name
If ch$=" " Then
;gak debuglog "TAG:"+x ag$
mode = 4 ; tag name collected, move to collecting attributes
Else
If ch$="/" Then
;gak debuglog "TAG:"+x ag$
xendtag$=x ag$
mode = 2; start/end tag combined, move to close
Else
If ch$=">" Then
;gak debuglog "TAG:"+x ag$
mode = 20; tag closed, move to collecting value
Else
x ag$ = x ag$ + ch$
End If
End If
End If
 Case 4 ; start to collect attributes
If Lower(ch$)>="a" And Lower(ch$)<="z" Then
aname$=ch$;
mode = 5; move to collect attribute name
Else
If ch$=">" Then
xvalue$=""
mode = 20; tag closed, move to collecting value
Else
If ch$="/" Then
mode = 2 ; move to collecting end tag
xendtag$=ch$
;gak debuglog "** found end tag"
End If
End If
End If
 Case 5 ; collect attribute name
If ch$="=" Then
 ;gak debuglog "ATT:"+aname$
 aval$=""
 mode = 6; move to collect attribute value
Else
 aname$=aname$+ch$
End If
 Case 6 ; collect attribute value
If c=34 Then
mode = 7; move to collect string value
Else
If c <= 32 Then
;gak debuglog "ATV:"+aname$+"="+aval$
XMLAddAttr(x,aname$,aval$)
mode = 4; start collecting a new attribute
Else
  aval$=aval$+ch$
End If
End If
 Case 7 ; collect string value
If c=34 Then
;gak debuglog "ATV:"+aname$+"="+aval$
XMLADDattr(x,aname$,aval$)
mode = 4; go and collect next attribute
Else
aval$=aval$+ch$
End If
 Case 20 ; COLLECT THE VALUE PORTION
If ch$="<" Then
;gak debuglog "VAL:"+x ag$+"="+xvalue$
mode=1; go to tag checking
Else
xvalue$=xvalue$+ch$
End If
End Select

If Eof(infile) Then done=True

Wend

Return root

End Function

; write out an XML node (and children)
Function XMLWriteNode(outfile,node.XMLnode,tab$="")
; ;gak debuglog "Writing...."+node ag$+".."
s$="<"+node ag$
a.XMLattr = nodefirstattr
While a<>Null
s$ = s$+" "+Lower(a
ame$)+"="+Chr$(34)+avalue$+Chr$(34)
a = asibattr
Wend

If nodevalue$="" And nodechildcount = 0 Then
s$=s$+"/>"
et$=""
Else
s$=s$+">"+nodevalue$
et$="</"+node ag$+">"
End If

WriteLine outfile,XMLcleanStr$(tab$+s$)
n.XMLnode = nodefirstchild
While n <> Null
XMLwriteNode(outfile,n,tab$+"  ")
n = n
extnode
Wend

If et$<> "" Then WriteLine outfile,XMLCleanStr$(tab$+et$)

End Function

; remove non-visible chars from the output stream
Function XMLCleanStr$(s$)
a$=""
For i = 1 To Len(s$)
If Asc(Mid$(s$,i,1))>=32 Then a$ = a$ +Mid$(s$,i,1)
Next
Return a$

End Function

; attribute functions
; return an attribute of a given name
Function XMLFindAttr.XMLattr(node.XMLnode,name$)
ret.XMLattr = Null
If node <> Null Then
a.XMLattr = nodefirstattr
done = False
While ret=Null And a<>Null
If Lower(name$)=Lower(a
ame$) Then
ret = a
End If
a = asibattr
Wend
End If
Return ret
End Function

; return an attribute value as a string
Function XMLAttrValueStr$(node.XMLnode,name$,dflt$="")
ret$=dflt$
a.XMLattr = XMLfindattr(node,name$)
If a <> Null Then ret$=avalue$
Return ret$
End Function

; return an attribute value as an integer
Function XMLAttrValueInt(node.XMLnode,name$,dflt=0)
ret=dflt
a.XMLattr = XMLfindattr(node,name$)
If a <> Null Then ret=avalue
Return ret
End Function

; return an attribute value as a float
Function XMLAttrValueFloat#(node.XMLnode,name$,dflt#=0)
ret#=dflt#
a.XMLattr = XMLfindattr(node,name$)
If a <> Null Then ret#=avalue
Return ret
End Function

Function XMLHasChildren(node.XMLnode)
Return nodefirstchild <> Null
End Function

Function XMLHasAttributes(node.XMLnode)
Return nodefirstattr <> Null
End Function

Function XMLGetChild.XMLNode(node.XMLNode,index=0)
child.XMLNode = nodeFirstChild
For i = 0 To index-1
child.XMLNode = child
extnode
Next
Return child
End Function

Function XMLGetFirstAttribute.XMLAttr(node.XMLNode)
Return nodefirstattr
End Function

Function XMLGetNextAttribute.XMLAttr(attr.XMLAttr)
Return attrsibattr
End Function

Function XMLHasAttribute(n.XMLNode,attr$)
If XMLHasAttributes(n) = 0 Then Return 0

a.XMLAttr = XMLGetFirstAttribute(n)
While (a <> Null)
If Lower(a
ame) = Lower(attr) Return 1
a = XMLGetNextAttribute(a)
Wend
Return 0
End Function

Function XMLGetParent.XMLNode(node.XMLNode)
Return nodeparent
End Function

Function PrintXMLNode(i.XMLNode,start$="")
If i = Null Then Return
Write start+"<"+i ag
a.XMLAttr = XMLGetFirstAttribute(i)
While a <> Null
Write " "+a
ame+"="+Chr(34)+avalue+Chr(34)
a = XMLGetNextAttribute(a)
Wend
Write ">"
Print ""

f.XMLNode = XMLGetChild(i,0)
While f.XMLNode <> Null
PrintXMLNode(f,start+"    ")
f = XMLNextNode(f)
Wend
Print start+"</"+i ag+">"
End Function
;#End Region
;#End Region

;; DE/INITIALIZATION
Function InitLotus()
Dim gSine#(359)
Dim gCosine#(359)

For A = 0 To 359
gSine#(A) = Sin(A)
gCosine#(A) = Cos(A)
Next

gLotusParticlePivot = CreatePivot()
gLotusTPivot = CreatePivot()
gLotusParticleMesh = CreateMesh()
EntityFX gLotusParticleMesh,1+2+8+16+32

gLotusNullTexture.LotusTexture = New LotusTexture
gNullTexture = Handle(gLotusNullTexture)
gLotusNullTextureRows = 1
gLotusNullTextureColumns = 1
gLotusNullTextureUStep = 1
gLotusNullTextureVStep = 1

Brush = CreateBrush()
BrushFX Brush,1+2+16+32

BrushBlend Brush,1
gLotusNullTextureAlpha = CreateSurface(gLotusParticleMesh)
PaintSurface gLotusNullTextureAlpha,Brush

FreeBrush Brush

gNullLotusVector = New LotusVector
gTempLotusVector = New LotusVector

If cUSE_EMITTERCONES Then
gLotusEmitterTexture = CreateTexture(64,64,1+16+32)
Buffer = GraphicsBuffer()
T = gLotusEmitterTexture
SetBuffer TextureBuffer(T)
R = ColorRed()
G = ColorGreen()
B = ColorBlue()
Color 255,255,255
Rect 0,0,64,64,True
Color 255,120,40
Rect 0,60,64,4
Color R,G,B
SetBuffer Buffer
EndIf

gLotusParticleCount = 0

gWidth = GraphicsWidth()
gHeight = GraphicsHeight()
End Function

Function KillLotus()
Dim gSine#(0)
Dim gCosine#(0)
FreeEntity gLotusParticlePivot
FreeEntity gLotusTPivot
FreeEntity gLotusParticleMesh
If cUSE_EMITTERCONES Then FreeTexture gLotusEmitterTexture
gLotusParticlePivot = 0
gLotusParticleMesh = 0
gLotusEmitterTexture = 0

For T.LotusTexture = Each LotusTexture
FreeTexture TBitmap
Next

For E.LotusEmitter = Each LotusEmitter
FreeEntity EEntity
Next

For G.LotusGraph = Each LotusGraph
FreeBank GBank
Next

For D.LotusDeflector = Each LotusDeflector
FreeEntity DEntity
Next

Delete Each LotusParticle
Delete Each LotusEmitter
Delete Each LotusGraph
Delete Each LotusDeflector
Delete Each LotusVector
Delete Each LotusTexture
Delete Each LotusStringPiece
gLotusParticleCount = 0
End Function


;; TEXTURE
Function LoadLotusTexture(Path$,Flags%=59,Alpha=0,Multiply=0,Add=0)
For T.LotusTexture = Each LotusTexture
If Lower(TPath) = Lower(Path) Then Return Handle(T)
Next
Bitmap = LoadTexture(Path$,Flags)
If Bitmap = 0 Then Return False
T.LotusTexture = New LotusTexture
TBitmap = Bitmap
TFlags = Flags
TRows = 1
TColumns = 1
TUStep = 1
TVStep = 1
TPath = Path
SetTextureBlendModes Handle(T),Alpha,Multiply,Add
Return Handle(T)
End Function

Function LoadLotusAnimTexture(Path$,Flags%=59,Rows%=1,Columns%=1,Alpha=0,Multiply=0,Add=0)
For T.LotusTexture = Each LotusTexture
If Lower(TPath) = Lower(Path) Then Return Handle(T)
Next
Texture = LoadLotusTexture(Path$,Flags,Alpha,Multiply,Add)
T.LotusTexture = Object.LotusTexture(Texture)
If T = Null Or T = gLotusNullTexture Then Return False
Rows = Min(Rows,1):Columns = Min(Columns,1)
TRows = Rows
TColumns = Columns
FrameWidth# = TextureWidth(TBitmap)/Columns
FrameHeight# = TextureHeight(TBitmap)/Rows
TUStep = FrameWidth/TextureWidth(TBitmap)
TVStep = FrameHeight/TextureHeight(TBitmap)
Return Texture
End Function

Function LoadLotusTileSet(Path$,Flags%=59,Rows%=3,Columns%=3,Alpha=0,Multiply=0,Add=0)
For T.LotusTexture = Each LotusTexture
If Lower(TPath) = Lower(Path) Then Return Handle(T)
Next
Texture = LoadLotusTexture(Path$,Flags,Alpha,Multiply,Add)
T.LotusTexture = Object.LotusTexture(Texture)
If T = Null Or T = gLotusNullTexture Then Return False
Rows = Min(Rows,1):Columns = Min(Columns,1)
TRows = Rows
TColumns = Columns
FrameWidth# = TextureWidth(TBitmap)/Columns
FrameHeight# = TextureHeight(TBitmap)/Rows
TUStep = FrameWidth/TextureWidth(TBitmap)
TVStep = FrameHeight/TextureHeight(TBitmap)
Return Texture
End Function

Function ApplyTexture(Emitter,Texture,Frame=-1,Animated%=-1,FrameLength%=-1)
If EmitterExists( Emitter ) = 0 Then Return False
E.LotusEmitter = Object.LotusEmitter(Int(EntityName(Emitter)))
If E = Null Then Return False
ETexture = Object.LotusTexture(Texture)
If Frame > -1 Then EFrame = Frame EFrameStart = Frame
If Animated > -1 Then EAnimated = Animated
If FrameLength > -1 Then EFrameLength = FrameLength
End Function

Function SetTextureTiles(Texture,Rows,Columns)
T.LotusTexture = Object.LotusTexture(Texture)
If T = Null Or T = gLotusNullTexture Then Return False
Rows = Min(Rows,1):Columns = Min(Columns,1)
TRows = Rows
TColumns = Columns
FrameWidth# = TextureWidth(TBitmap)/Columns
FrameHeight# = TextureHeight(TBitmap)/Rows
TUStep = FrameWidth/TextureWidth(TBitmap)
TVStep = FrameHeight/TextureHeight(TBitmap)
Return True
End Function

Function SetTextureBlendModes(Texture,Alpha=True,Multiply=False,Add=True,RebuildSurfaces = 0)
T.LotusTexture = Object.LotusTexture(Texture)
If T = Null Then Return False
Brush = CreateBrush()
BrushTexture Brush,TBitmap
BrushFX Brush,1+2+16+32

If Add > 0 And (TAdd = 0 Or RebuildSurfaces > 0)
TAdd = CreateSurface(gLotusParticleMesh)
BrushBlend Brush,3
PaintSurface TAdd,Brush
ElseIf Add = 0 And TAdd <> 0 Then
TAdd = 0
Rebuild = True
EndIf

If Alpha > 0 And (TAlpha = 0 Or RebuildSurfaces > 0)
TAlpha = CreateSurface(gLotusParticleMesh)
BrushBlend Brush,1
PaintSurface TAlpha,Brush
ElseIf Alpha = 0 And TAlpha <> 0 Then
TAlpha = 0
Rebuild = True
EndIf

If Multiply > 0 And (TMultiply = 0 Or RebuildSurfaces > 0)
TMultiply = CreateSurface(gLotusParticleMesh)
BrushBlend Brush,2
PaintSurface TMultiply,Brush
ElseIf Multiply = 0 And TMultiply <> 0 Then
TMultiply = 0
Rebuild = True
EndIf

If Rebuild Then RebuildLotusTextures()

FreeBrush Brush
End Function

Function FreeLotusTexture(Texture)
T.LotusTexture = Object.LotusTexture(Texture)
If T = Null Then Return False
FreeTexture TBitmap
Delete T
RebuildLotusTextures()
End Function

Function ClearLotusTextures()
For T.LotusTexture = Each LotusTexture
If T <> gLotusNullTexture Then
FreeTexture TBitmap
Delete T
EndIf
Next

RebuildLotusTextures()
End Function

Function RebuildLotusTextures()
FreeEntity gLotusParticleMesh
gLotusParticleMesh = CreateMesh()
EntityFX gLotusParticleMesh,1+2+16+32

Brush = CreateBrush()
BrushFX Brush,1+2+16+32

BrushBlend Brush,1
gLotusNullTextureAlpha = CreateSurface(gLotusParticleMesh)
PaintSurface gLotusNullTextureAlpha,Brush

FreeBrush Brush

For T.LotusTexture = Each LotusTexture
If T <> gLotusNullTexture Then SetTextureBlendModes Handle(T),Abs(TAlpha),Abs(TMultiply),Abs(TAdd),1
Next
End Function

Function TextureUsesAdd(Texture)
T.LotusTexture = Object.LotusTexture(Texture)
If T = Null Then Return False
If T = gLotusNullTexture Then Return True
If TAdd <> 0 Then Return True
End Function

Function TextureUsesMultiply(Texture)
T.LotusTexture = Object.LotusTexture(Texture)
If T = Null Then Return False
If T = gLotusNullTexture Then Return True
If TAlpha <> 0 Then Return True
End Function

Function TextureUsesAlpha(Texture)
T.LotusTexture = Object.LotusTexture(Texture)
If T = Null Then Return False
If T = gLotusNullTexture Then Return True
If TAlpha <> 0 Then Return True
End Function

;; DEFLECTOR
Function DeflectorExists(Deflector)
For D.LotusDeflector = Each LotusDeflector
If DEntity = Deflector Then
Return DEntity
EndIf
Next
Return 0
End Function

Function CreateDeflector(Parent=0)
D.LotusDeflector = New LotusDeflector
DRadius = 0
DStrength = .5
DActive = 0
DEntity = CreatePivot()
NameEntity DEntity,Handle(D)
Return DEntity
End Function

Function SetDeflectorStrength(Deflector, Strength#=.5)
If DeflectorExists(Deflector) = 0 Then Return False
D.LotusDeflector = Object.LotusDeflector(EntityName(Deflector))
If D = Null Then Return False
DStrength = Strength
End Function

Function SetDeflectorActive(Deflector,Active = 1)
If DeflectorExists(Deflector) = 0 Then Return False
D.LotusDeflector = Object.LotusDeflector(EntityName(Deflector))
If D = Null Then Return False
DActive = Active
End Function

Function SetDeflectorRadius(Deflector, Radius#=0)
If DeflectorExists(Deflector) = 0 Then Return False
D.LotusDeflector = Object.LotusDeflector(EntityName(Deflector))
If D = Null Then Return False
DRadius = Radius
End Function

Function ActivateDeflector(Deflector)
If DeflectorExists(Deflector) = 0 Then Return False
D.LotusDeflector = Object.LotusDeflector(EntityName(Deflector))
If D = Null Then Return False
DActive = True
End Function

Function DeActivateDeflector(Deflector)
If DeflectorExists(Deflector) = 0 Then Return False
D.LotusDeflector = Object.LotusDeflector(EntityName(Deflector))
If D = Null Then Return False
DActive = False
End Function



;; EMITTER
Function NameEmitter(Emitter,Name$)
If EmitterExists( Emitter ) = 0 Then Return False
E.LotusEmitter = Object.LotusEmitter(Int(EntityName(Emitter)))
If E = Null Then Return False
EName = Name$
End Function

Function GetEmitterName$(Emitter)
If EmitterExists( Emitter ) = 0 Then Return False
E.LotusEmitter = Object.LotusEmitter(Int(EntityName(Emitter)))
If E = Null Then Return False
Return EName
End Function

Function CreateEmitter%(Texture = 0)
If Texture = 0 Then Texture = Handle(gLotusNullTexture)
If cUSE_EMITTERCONES Then
P = CreateCone(4)
For S = 1 To CountSurfaces(P)
Surface = GetSurface(P,S)
For V = 0 To CountVertices(Surface)-1
eV# = 1.0-VertexY(Surface,V)/2
eU# = VertexX(Surface,V)/2
If eV > 1 Then eV = eV - .5
If eV < 0 Then eV = eV + .5
If eV > 1 Then Stop
VertexTexCoords Surface,V,eU,eV,0,0
Next
Next
Surface = 0
EntityTexture P,gLotusEmitterTexture
EntityFX P,1
RotateMesh P,-90,0,0
PositionMesh P,0,0,-2
Else
P = CreatePivot()
EndIf

HideEntity P
E.LotusEmitter = New LotusEmitter
NameEntity P,Handle(E)

EWeight = 1
ETexture = Object.LotusTexture(Texture)
EEntity = P
EWaitSpan = 1
EDWaitSpan = 1
ECircleSpeedX = 1
ECircleSpeedY = 1
ECircleSpeedZ = 1
ESizeFromX = 1
ESizeFromY = 1
ESizeFromZ = 1
ESizeToX = 1
ESizeToY = 1
ESizeToZ = 1
EWaveSpeedX = 1
EWaveSpeedY = 1
EWaveSpeedZ = 1
ERedFrom = 255
EBlueFrom = 255
EGreenFrom = 255
ERedTo = 255
EBlueTo = 255
EGreenTo = 255
EAlphaFrom = 1.0
EBlendMode = 1
ELifeSpan = 80
EEmissionRate = 1
ECull = 1
ESorting = 1
EViewMode = 1
ELifeMode = 1
EChildMode = 1
EActiveSpan = -1
EActive = -1
Return P
End Function

Function LoadEmitter%(Path$,Flags%=59,Alpha=1,Multiply=0,Add=0)
For T.LotusTexture = Each LotusTexture
If Lower(TPath$) = Lower(Path$) Then Exit
Next
If T <> Null Then
Return CreateEmitter(Handle(T))
EndIf

Texture = LoadLotusTexture(Path$,Flags,Alpha,Multiply,Add)
Return CreateEmitter(Texture)
End Function

Function KillLotusEmitter(Emitter) ;; Recommendation: When calling this or FreeEmitter(E), call it like so: YourEmitter = FreeEmitter(YourEmitter) so that the integer, YourEmitter, gets set to zero
If EmitterExists( Emitter ) = 0 Then Return False
E.LotusEmitter = Object.LotusEmitter(Int(EntityName(Emitter)))
If E = Null Then Return False

If EEmitSoundChannel Then StopChannel( EEmitSoundChannel )
Delete E
FreeEntity Emitter
Return 0
End Function

Function FreeEmitter(Emitter)
Return KillLotusEmitter( Emitter )
End Function

Function ClearEmitters() ;; Reset all references to emitters to 0 after calling this
For E.LotusEmitter = Each LotusEmitter
KillLotusEmitter EEntity
Next
End Function

Function EmitterExists(Emitter)
For E.LotusEmitter = Each LotusEmitter
If EEntity = Emitter Then Return EEntity
Next
Return 0
End Function

Function CopyEmitter(Emitter)
If EmitterExists( Emitter ) = 0 Then Return False
EOld.LotusEmitter = Object.LotusEmitteR(Int(EntityName$(Emitter)))
If EOld = Null Then Return False
If cUSE_EMITTERCONES Then
P = CreateCone(4)
For S = 1 To CountSurfaces(P)
Surface = GetSurface(P,S)
For V = 0 To CountVertices(Surface)-1
eV# = 1.0-VertexY(Surface,V)/2
eU# = VertexX(Surface,V)/2
If eV > 1 Then eV = eV - .5
If eV < 0 Then eV = eV + .5
If eV > 1 Then Stop
VertexTexCoords Surface,V,eU,eV,0,0
Next
Next
Surface = 0
EntityTexture P,gLotusEmitterTexture
EntityFX P,1
RotateMesh P,-90,0,0
PositionMesh P,0,0,-2
Else
P = CreatePivot()
EndIf
HideEntity P
E.LotusEmitter = New LotusEmitter
NameEntity P,Handle(E)
PositionEntity P,EntityX(Emitter,True),EntityY(Emitter,True),EntityZ(Emitter,True)
RotateEntity P,EntityPitch(Emitter,True),EntityYaw(Emitter,True),EntityRoll(Emitter,True)
ETexture = EOldTexture
EFrame = EOldFrame
EAnimated = EOldAnimated
EEntity = P
ETranslationJitterX = EOldTranslationJitterX
ETranslationJitterY = EOldTranslationJitterY
ETranslationJitterZ = EOldTranslationJitterZ
ETranslationX = EOldTranslationX
ETranslationY = EOldTranslationY
ETranslationZ = EOldTranslationZ
EVelocityX = EOldVelocityX
EVelocityY = EOldVelocityY
EVelocityZ = EOldVelocityZ
EAngleVelocityX = EOldAngleVelocityX
EAngleVelocityY = EOldAngleVelocityY
EAngleVelocityZ = EOldAngleVelocityZ
EAccelerationX = EOldAccelerationX
EAccelerationY = EOldAccelerationY
EAccelerationZ = EOldAccelerationZ
EAngleAccelerationX = EOldAngleAccelerationX
EAngleAccelerationY = EOldAngleAccelerationY
EAngleAccelerationZ = EOldAngleAccelerationZ
ESizeFromX = EOldSizeFromX
ESizeFromY = EOldSizeFromY
ESizeFromZ = EOldSizeFromZ
ESizeToX = EOldSizeToX
ESizeToY = EOldSizeToY
ESizeToZ = EOldSizeToZ
ESizeJitterX = EOldSizeJitterX
ESizeJitterY = EOldSizeJitterY
ESizeJitterZ = EOldSizeJitterZ
EVelocityJitterX = EOldVelocityJitterX
EVelocityJitterY = EOldVelocityJitterY
EVelocityJitterZ = EOldVelocityJitterZ
ECubeX = EOldCubeX
ECubeY = EOldCubeY
ECubeZ = EOldCubeZ
ECylinderX = EOldCylinderX
ECylinderY = EOldCylinderY
ECylinderZ = EOldCylinderZ
EWaveRadiusX = EOldWaveRadiusX
EWaveRadiusY = EOldWaveRadiusY
EWaveRadiusZ = EOldWaveRadiusZ
EWaveSpeedX = EOldWaveSpeedX
EWaveSpeedY = EOldWaveSpeedY
EWaveSpeedZ = EOldWaveSpeedZ
ECircleSpeedX = EOldCircleSpeedX
ECircleSpeedY = EOldCircleSpeedY
ECircleSpeedZ = EOldCircleSpeedZ
ECircleRadiusX = EOldCircleRadiusX
ECircleRadiusY = EOldCircleRadiusY
ECircleRadiusZ = EOldCircleRadiusZ
ERandomRotationX = EOldRandomRotationX
ERandomRotationY = EOldRandomRotationY
ERandomRotationZ = EOldRandomRotationZ
ETranslationJitterUp = EOldTranslationJitterUp
ETranslationJitterDown = EOldTranslationJitterDown
EVelocityJitterUp = EOldVelocityJitterUp
EVelocityJitterDown = EOldVelocityJitterDown
ERedFrom = EOldRedFrom
EGreenFrom = EOldGreenFrom
EBlueFrom = EOldBlueFrom
EAlphaFrom = EOldAlphaFrom
ERedTo = EOldRedTo
EGreenTo = EOldGreenTo
EBlueTo = EOldBlueTo
EAlphaTo = EOldAlphaTo
EBlendMode = EOldBlendMode
ELifeSpan = EOldLifeSpan
EWaitSpan = EOldWaitSpan
EDWaitSpan = EOldDWaitSpan
EWaitSpanJitter = EOldWaitSpanJitter
EParticleMesh = EOldParticleMesh
EEmit = EOldEmit
ESizeJitterUniform = EOldSizeJitterUniform
EColorJitterRed = EOldColorJitterRed
EColorJitterGreen = EOldColorJitterGreen
EColorJitterBlue = EOldColorJitterBlue
EColorJitterAlpha = EOldColorJitterAlpha
EColorJitterUniform = EOldColorJitterUniform
EColorJitterDown = EOldColorJitterDown
EColorJitterUp = EOldColorJitterUp
EFrozen = EOldFrozen
EHidden = EOldHidden
EEmissionRate = EOldEmissionRate
EViewMode = EOldViewMode
ELifeMode = EOldLifeMode
EChildMode = EOldChildMode
EGravity = EOldGravity
EGravityEnabled = EOldGravityEnabled
EWeight = EOldWeight
ESizeJitterUp = EOldSizeJitterUp
ESizeJitterDown = EOldSizeJitterDown
ECull = EOldCull
ESorting = EOldSorting
ERollMode = EOldRollMode
ERange = EOldRange
ELifeSpanJitter = EOldLifeSpanJitter
ELifeSpanJitterUp = EOldLifeSpanJitterUp
ELifeSpanJitterDown = EOldLifeSpanJitterDown
EColorGraph = EOldColorGraph
ESizeGraph = EOldSizeGraph
EEmitSound = EOldEmitSound
EBounceSound = EOldBounceSound
ELoopEmitSound = EOldLoopEmitSound
EVelocityDecay = EOldVelocityDecay
ESplineMesh = EOldSplineMesh
EActiveSpan = EOldActiveSpan
EActive = EOldActive
EFreeOnEndActive = EOldFreeOnEndActive
EDeflectorsAffect = EOldDeflectorsAffect
EParent = EOldParent
EChild = EOldChild
ETrail = EOldTrail
EntityParent EEntity,GetParent(EOldEntity)
Return P
End Function

Function SortParticles()
Dim gAlphaPartArray#( Min(gLotusAlphaParticleCount-1,0), 1 )
For P.LotusParticle = Each LotusParticle
If PBlendMode = 1 And PSorting >= 1 Then
PositionEntity gLotusParticlePivot, PPositionX, PPositionY, PPositionZ, 1
gAlphaPartArray( ACount, 0 ) = -EntityDistance( gLotusCamera, gLotusParticlePivot )
gAlphaPartArray( ACount, 1 ) = Handle( P )
ACount = ACount + 1
EndIf
If ACount >= gLotusAlphaParticleCount Then Exit
Next

If gLotusAlphaParticleCount > 1 Then
lSort( 0, gLotusAlphaParticleCount-1 )
EndIf
End Function

;; UPDATE
Function UpdateLotusParticles(DeltaTime#=1,Camera=0)

gLotusParticlesDrawn = 0
Local ET% = MilliSecs()
; gLotusUpdateTimes( uptTimeAll ) = ET

; gLotusUpdateTimes( updTimeTexture ) = MilliSecs()
For T.LotusTexture = Each LotusTexture
If TAdd <> 0 Then ClearSurface TAdd,1,1
If TMultiply <> 0 Then ClearSurface TMultiply,1,1
If TAlpha <> 0 Then ClearSurface TAlpha,1,1
Next
; gLotusUpdateTimes( updTimeTexture ) = MilliSecs() - gLotusUpdateTimes( updTimeTexture )

If Camera = 0 Then
Camera = gLotusCamera
If Camera = 0 Then Return False
Else
gLotusCamera = Camera
EndIf

If DeltaTime > 0 Then
; gLotusUpdateTimes( updTimeEmit ) = MilliSecs()
For E.LotusEmitter = Each LotusEmitter
KillIt = False

EPositionX = EntityX(EEntity,1)
EPositionY = EntityY(EEntity,1)
EPositionZ = EntityZ(EEntity,1)

EAngleX = EntityPitch(EEntity,1)
EAngleY = EntityYaw(EEntity,1)
EAngleZ = EntityRoll(EEntity,1)

If EFrozen = False
If EEmit And EWaitA = 0 Then
CreateParticle EEntity
EndIf
EWaitA = EWaitA + DeltaTime
If EWaitA >= EWaitSpan Then
EWaitA = 0
EWaitSpan = EDWaitSpan+Rand(-EWaitSpanJitter,EWaitSpanJitter)
EndIf
If EActive > -1 Then
EActive = EActive - 1
If EActive = 0 Then
EActive = -1
StopEmitter( EEntity )
If EFreeOnEndActive >= 1 Then KillIt = True
EndIf
EndIf
If EEmitSound <> 0 And EEmitSoundChannel <> 0 And ELoopEmitSound > 0 And EEmit = 1 Then
If ChannelPlaying( EEmitSoundChannel ) <= 0 Then EEmitSoundChannel = PlaySound( EEmitSound )
ElseIf EEmitSound <> 0 And EEmitsoundChannel = 0 And EEmit = 1 Then
EEmitSoundChannel = PlaySound( EEmitSound )
ElseIf EEmitSoundChannel <> 0 And EEmit = 0 And ELoopEmitSound = 1 Then
StopChannel( EEmitSoundChannel )
EndIf

If EEmitSoundChannel <> 0 And EEmitSoundRange > 0 Then
Vol# = EntityDistance( EEntity, gLotusCamera ) / EEmitSoundRange
If Vol# > 1 Then Vol = 1
If Vol# < 0 Then Vol = 0
Vol# = 1.0 - Vol
ChannelVolume( EEmitSoundChannel, Vol# )
EndIf
EndIf

EWaitB = EWaitB + DeltaTime
EWaitC = EWaitC + DeltaTime
If EWaitB > EWaitSpan Then EWaitB = 0
If EWaitC > EWaitSpan Then EWaitC = 0

If KillIt = True Then KillLotusEmitter( EEntity )
Next
; gLotusUpdateTimes( updTimeEmit ) = MilliSecs() - gLotusUpdateTimes( updTimeEmit )

For LD.LotusDeflector = Each LotusDeflector
If LDActive Then
LDPositionX = EntityX(LDEntity,True)
LDPositionY = EntityY(LDEntity,True)
LDPositionZ = EntityZ(LDEntity,True)
EndIf
Next

; gLotusUpdateTimes( updTimePart ) = MilliSecs()
For P.LotusParticle = Each LotusParticle
If PLife >= 0 Then

N = 0
Decay# = 1.0
While N < DeltaTime*(Not PFrozen)
If PTrail <> Null Then
If PTrailWaitC <= 0 Then
PositionEntity PTrailEntity,PPositionX,PPositionY,PPositionZ,1
RotateEntity PTrailEntity,PAngleX,PAngleY,0,1
CreateParticle(PTrailEntity)
RotateEntity PTrailEntity,PTrailAngleX,PTrailAngleY,PTrailAngleZ,1
PositionEntity PTrailEntity,PTrailPositionX,PTrailPositionY,PTrailPositionZ,1
EndIf
EndIf
D# = Max(DeltaTime-N,1)
LFrom# = PLife/PLifeSpan
LTo# = 1.0 - LFrom#

PLastPositionX = PPositionX
PLastPositionY = PPositionY
PLastPositionZ = PPositionZ

PPositionX = PPositionX + PTranslationX*D
PPositionY = PPositionY + PTranslationY*D
PPositionZ = PPositionZ + PTranslationZ*D

PGravity = (PGravity - (.1*PWeight)*D)*PGravityEnabled
PPositionY = PPositionY + PGravity*D

OPitch# = PAngleX
OYaw# = PAngleY

If PSplineMesh = 0 Then
PAngleX = PAngleX + (PAngleVelocityX + PAngleAccelerationX*LTo)*D
PAngleY = PAngleY + (PAngleVelocityY + PAngleAccelerationY*LTo)*D
Else
Surface = GetSurface( PSplineMesh, 1 )
Vertices = CountVertices( Surface ) - 1
Vertex = Int( Vertices * LTo )
If Vertex <= 0 Then Vertex = Vertex + 1
NX# = VertexX( Surface, Vertex - 1 ) - VertexX( Surface, Vertex )
NY# = VertexY( Surface, Vertex - 1 ) - VertexY( Surface, Vertex )
NZ# = VertexZ( Surface, Vertex - 1 ) - VertexZ( Surface, Vertex )
RotateEntity PSplineMesh,OPitch,OYaw,0
TFormNormal -NX,-NY,-NZ,PSplineMesh,0
AlignToVector gLotusParticlePivot,TFormedX(),TFormedY(),TFormedZ(),3,1
PAngleX = EntityPitch( gLotusParticlePivot, 1 )
PAngleY = EntityYaw( gLotusParticlePivot, 1 )
EndIf

PAngleZ = PAngleZ + (PAngleVelocityZ + PAngleAccelerationZ*LTo)*D

If PAngleX <> OPitch Or PAngleY <> OYaw Then
RotateEntity gLotusParticlePivot,PAngleX,PAngleY,0
TFormVector POVelocityX,POVelocityY,POVelocityZ,gLotusParticlePivot,0
PVelocityX = TFormedX()
PVelocityY = TFormedY()
PVelocityZ = TFormedZ()
EndIf

If PSplineMesh <> 0 Then
PAngleX = OPitch
PAngleY = OYaw
EndIf

If PVelocityDecay# <> 0 Then
Decay# = (PVelocityDecay*LFrom)
EndIf

; MoveEntity gLotusParticlePivot,((PVelocityX+(PAccelerationX*LTo))*Decay)*D,((PVelocityY+(PAccelerationY*LTo))*Decay)*D,((PVelocityZ+(PAccelerationZ*LTo))*Decay)*D

If PDeflectorsAffect Then
PDeflectorSpeedX = PDeflectorSpeedX * .98
PDeflectorSpeedY = PDeflectorSpeedY * .98
PDeflectorSpeedZ = PDeflectorSpeedZ * .98

PositionEntity gLotusParticlePivot,PPositionX,PPositionY,PPositionZ

For LD.LotusDeflector = Each LotusDeflector
If LDActive = True And LDStrength <> 0 And LDRadius > 0 Then
Distance# = EntityDistance(LDEntity,gLotusParticlePivot)

If Distance# < LDRadius Then
Magnitude# = (1.0 - (Distance# / LDRadius))*LDStrength
If PWeight <> 0 Then Magnitude# = Magnitude# * PWeight

DX# = PPositionX - LDPositionX
DY# = PPositionY - LDPositionY
DZ# = PPositionZ - LDPositionZ

PDeflectorSpeedX = PDeflectorSpeedX + DX * Magnitude
PDeflectorSpeedY = PDeflectorSpeedY + DY * Magnitude
PDeflectorSpeedZ = PDeflectorSpeedZ + DZ * Magnitude
EndIf
EndIf
Next
EndIf

PPositionX = PPositionX + ((PVelocityX+(PAccelerationX*LTo))*Decay)*D + PDeflectorSpeedX*D
PPositionY = PPositionY + ((PVelocityY+(PAccelerationY*LTo))*Decay)*D + PDeflectorSpeedY*D
PPositionZ = PPositionZ + ((PVelocityZ+(PAccelerationZ*LTo))*Decay)*D + PDeflectorSpeedZ*D

If PMinY <> 0 Then
If PPositionY <= PMinY And PBounce > 0 Then
PBounces = PBounces + 1

If PBounceMax > 0 And PBounces > PBounceMax Then
KillIt = True
Exit
EndIf

PPositionY = PMinY + .01

PVelocityX = PVelocityX * PBounceDecay
PVelocityY = PVelocityY * PBounceDecay
PVelocityZ = PVelocityZ * PBounceDecay

PGravity = -PGravity*(PBounceDecay*1.3)

If PBounceSound <> 0 Then PBounceSoundChannel = PlaySound( PBounceSound )
ElseIf PPositionY <= PMinY And PBounce = 0 Then
KillIt = True
Exit
EndIf
EndIf

Select PLifeMode
Case 1
PLife = PLife - D#
Case 2
PLife = PLifeSpan - (ET - PLifeBegan)
End Select

N = N + 1
Wend

If KillIt = True Then
KillParticle P
KillIt = False
ElseIf PBlendMode <> 1 Or PSorting = False
DrawLotusParticle P,gLotusTPivot
EndIf
Else
KillParticle P
EndIf
Next
; gLotusUpdateTimes( updTimePart ) = MilliSecs() - gLotusUpdateTimes( updTimePart )
EndIf

; gLotusUpdateTimes( updTimeSort ) = MilliSecs()
SortParticles()
; gLotusUpdateTimes( updTimeSort ) = MilliSecs() - gLotusUpdateTimes( updTimeSort )

; gLotusUpdateTimes( updTimeDrawAlpha ) = MilliSecs()
For HJ = 0 To gLotusAlphaParticleCount - 1
DrawLotusParticle Object.LotusParticle( gAlphaPartArray( HJ, 1 ) ), gLotusTPivot
Next
; gLotusUpdateTimes( updTimeDrawAlpha ) = MilliSecs() - gLotusUpdateTimes( updTimeDrawAlpha )

; gLotusUpdateTimes( uptTimeAll ) = MilliSecs() - gLotusUpdateTimes( uptTimeAll )
End Function

Comments :


big10p(Posted 1+ years ago)

 Incomplete code listing, Noel. Looks like you've hit the limit imposed on archive entries. You'll have to break it down into 2 or more listings.