'
' Custom WaterPlane actor entity
' Petr Schreiber, 05-04-2013
'
' -----
Type t_Texel
U As Double
V As Double
End Type
Type WaterPlane
textureID As Long
R As Byte
G As Byte
B As Byte
A As Byte
planeWidth As Single
planeHeight As Single
T(8, 4) As t_Texel
Move(8) As t_Texel
End Type
'[!] Constructor and destructor
Function WaterPlane_Create( sScene As Long, waterTexture As Long ) As Long ' -- Texture for water added as parameter
Dim eEntity As Long = TBGL_EntityGetFreeID(sScene)
Dim data As WaterPlane
Dim i As Long
' -- Custom initialization
' -- Texture for water from parameter
data.textureID = waterTexture
' -- Some defaults for now
data.R = 255
data.G = 255
data.B = 255
data.A = 128
data.planeWidth = 32
data.planeHeight = 32
For i = 1 To 8
data.T(i, 2).U = 1.0
data.T(i, 3).V = 1.0
data.T(i, 4).U = 1.0 : data.T(i, 4).V = 1.0
Next
data.Move(1).U = -0.0015 : data.Move(1).V = -0.0015
data.Move(2).U = 0 : data.Move(2).V = -0.0015
data.Move(3).U = 0.0015 : data.Move(3).V = -0.0015
data.Move(4).U = -0.0015 ': data.Move(4).V = 0
data.Move(5).U = 0.0015 ': data.Move(5).V = 0
data.Move(6).U = -0.0015 : data.Move(6).V = 0.0015
data.Move(7).U = 0 : data.Move(7).V = 0.0015
data.Move(8).U = 0.0015 : data.Move(8).V = 0.0015
TBGL_EntityCreateFuncSlot(sScene, eEntity, 0, "WaterPlane_Render")
TBGL_EntitySetUserData(sScene, eEntity, data)
Return eEntity
End Function
Function WaterPlane_Destroy(sScene As Long, eEntity As Long)
' -- Destructor is not that needed as TBGL has garbage collection...
TBGL_EntityDestroy(sScene, eEntity)
End Function
'[!] Rendering
Function WaterPlane_Render()
Dim element As TBGL_TENTITYIDENTIFIER At TBGL_CallingEntity
Dim data As WaterPlane At TBGL_EntityGetUserDataPointer(element.scene, element.entity)
Static i, j As Long
' -- Our custom coloring, with alpha support
TBGL_PushColor data.R, data.G, data.B, data.A
' -- Enable texturing
TBGL_PushState %TBGL_TEXTURING
TBGL_PushTexture data.textureID
' -- Enable alpha blending
TBGL_PushState %TBGL_BLEND
TBGL_PushBlendFunc %GL_SRC_ALPHA, %GL_ONE_MINUS_SRC_ALPHA
' -- Draw the quad, centered
TBGL_BeginPoly %GL_QUADS
TBGL_Normal 0, -1, 0
For i = 1 To 8
For j = 1 To 4
data.t(i,j).U += data.Move(i).U
data.t(i,j).V += data.Move(i).V
' of course has to multiply with Framerate later
' but omit here since it's not global in this script
Next
If data.t(i,1).U > 10 Then
data.t(i,1).U -= 10
data.t(i,1).V -= 10
data.t(i,2).U -= 10
data.t(i,2).V -= 10
data.t(i,3).U -= 10
data.t(i,3).V -= 10
data.t(i,4).U -= 10
data.t(i,4).V -= 10
ElseIf data.t(i,1).U < -10 Then
data.t(i,1).U += 10
data.t(i,1).V += 10
data.t(i,2).U += 10
data.t(i,2).V += 10
data.t(i,3).U += 10
data.t(i,3).V += 10
data.t(i,4).U += 10
data.t(i,4).V += 10
EndIf
TBGL_TexCoord2D data.t(i,1).U , data.t(i,1).V
TBGL_Vertex -data.planeWidth/2, 0, -data.planeHeight/2
TBGL_TexCoord2D data.t(i,2).U , data.t(i,2).V
TBGL_Vertex data.planeWidth/2, 0, -data.planeHeight/2
TBGL_TexCoord2D data.t(i,3).U , data.t(i,3).V
TBGL_Vertex data.planeWidth/2, 0, data.planeHeight/2
TBGL_TexCoord2D data.t(i,4).U , data.t(i,4).V
TBGL_Vertex -data.planeWidth/2, 0, data.planeHeight/2
Next
TBGL_EndPoly
' -- Feel free to add more layers, water animation...
' -- Restore blending state
TBGL_PopBlendFunc
TBGL_PopState
' -- Restore texuring state
TBGL_PopTexture
TBGL_PopState
' -- Restore coloring
TBGL_PopColor
End Function
'[!] Methods
Function WaterPlane_SetSize(sScene As Long, eEntity As Long, planeWidth As Single, planeHeight As Single)
Dim data As WaterPlane At TBGL_EntityGetUserDataPointer(sScene, eEntity)
data.planeWidth = planeWidth
data.planeHeight = planeHeight
End Function
Function WaterPlane_SetColorAlpha(sScene As Long, eEntity As Long, r As Byte, g As Byte, b As Byte, a As Byte)
Dim data As WaterPlane At TBGL_EntityGetUserDataPointer(sScene, eEntity)
data.r = r
data.g = g
data.b = b
data.a = a
End Function
OK, I also added something in the other unit but that was just lower alpha at line 47. And I wonder why just half of texture is visible... but that might be the overlapping 8 of faces since the textures have no own layers to scroll.
Bookmarks