Updated Dynamic lighting
From VbGORE Visual Basic Online RPG Engine
Contents |
Step 1
Open Client.vbp
Add to Project a New Module. Name it "Lighting" and Add:
<vb>
Option Explicit
Public MapLight() As Long
'Position of the user on the last light update Private UserUPX As Integer Private UserUPY As Integer
'Range of the screen that needs light updates Public LightUpdateMinX As Integer Public LightUpdateMinY As Integer Public LightUpdateMaxX As Integer Public LightUpdateMaxY As Integer
'Ambient Private pAmbient As Long Private AmbientFlood(1 To 4) As Long
'Contains the list of dynamic lights Public Lights() As DynamicLight Private LightsUBound As Long
'Indexes of our pre-defined lights Public CursorLightIndex As Long
Public Property Get LightAmbient() As Long 'Return the ambient light
LightAmbient = pAmbient
End Property
Public Property Let LightAmbient(ByVal Value As Long) 'Set the ambient light
'Confirm change If Value = pAmbient Then Exit Property
'Set the new value pAmbient = Value 'Set the ambient flood AmbientFlood(1) = pAmbient AmbientFlood(2) = pAmbient AmbientFlood(3) = pAmbient AmbientFlood(4) = pAmbient
End Property
Public Function AddLight(ByVal X As Long, ByVal Y As Long, ByVal Size As Single, ByVal Strength As Single) As Long
'Find the index
AddLight = NextFreeLightIndex
'Create the light
Set Lights(AddLight) = New DynamicLight
'Set up the light
With Lights(AddLight)
.X = X
.Y = Y
.Size = Size
.Strength = Strength
End With
End Function
Public Sub RemoveLight(ByVal Index As Long) 'Destroy the light
Set Lights(Index) = Nothing
End Sub
Public Sub RemoveAllLights() 'Destroy all the lights
LightsUBound = 0 Erase Lights
End Sub
Public Sub UpdateLights() 'Update all lights Dim i As Long
'Check if any lights need to be updated
If UserUPX = CharList(UserCharIndex).Pos.X Then
If UserUPY = CharList(UserCharIndex).Pos.Y Then
For i = 1 To LightsUBound
If Not Lights(i) Is Nothing Then
If Lights(i).NeedsUpdate Then
Exit For
End If
End If
Next i
If i > LightsUBound Then Exit Sub
End If
End If
UserUPX = CharList(UserCharIndex).Pos.X
UserUPY = CharList(UserCharIndex).Pos.Y
'Reset the tile lighting
ResetTileLights
'Update the dynamic lights
For i = 1 To LightsUBound
If Not Lights(i) Is Nothing Then Lights(i).UpdateLight
Next i
End Sub
Private Sub ResetTileLights() 'Resets all the tile lights to the ambient Dim X As Long Dim Y As Long
For X = LightMinX To LightMaxX
For Y = LightMinY To LightMaxY
CopyMemory MapData(X, Y).Light(1), AmbientFlood(1), 16
Next Y
Next X
End Sub
Private Function NextFreeLightIndex() As Long 'Finds the next free light index that can be used
'Recycled index
For NextFreeLightIndex = 1 To LightsUBound
If Lights(NextFreeLightIndex) Is Nothing Then Exit Function
Next NextFreeLightIndex
'Expand array
NextFreeLightIndex = LightsUBound + 1
LightsUBound = LightsUBound + 5
ReDim Preserve Lights(1 To LightsUBound)
End Function
Public Property Get LightMinX() As Long
LightMinX = ScreenMinX - 1 - TileBufferSize If LightMinX < 1 Then LightMinX = 1
End Property
Public Property Get LightMaxX() As Long
LightMaxX = ScreenMaxX + 1 If LightMaxX > MapInfo.Width Then LightMaxX = MapInfo.Width
End Property
Public Property Get LightMinY() As Long
LightMinY = ScreenMinY - 1 - TileBufferSize If LightMinY < 1 Then LightMinY = 1
End Property
Public Property Get LightMaxY() As Long
LightMaxY = ScreenMaxY + 1 If LightMaxY > MapInfo.Height Then LightMaxY = MapInfo.Height
End Property
</vb>
Step 2
Add to Project a New Class Module. Name it "DynamicLight" and Add:
<vb>
Option Explicit
'Light settings Private pSize As Single Private pStrength As Single
'Minimum number of pixels the light must move before it is updated (prevents excessive small updates) Const MinUpdateDist As Long = 10
'Position of the light Private pX As Long Private pY As Long
'Position of the light when it was last updated Private UpdatePX As Long Private UpdatePY As Long
'This value really should be removed... Public LightAddX As Long Public LightAddY As Long
'If the light needs to be updated (any of the values changed) Private bUpdate As Boolean
'Cached tile radius Private pRadius As Integer
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
Public Property Get Size() As Single
Size = pSize
End Property
Public Property Let Size(ByVal Value As Single)
If pSize = Value Then Exit Property pSize = Value pRadius = ((pSize / 32) * 1.33) + 1 bUpdate = True
End Property
Public Property Get Strength() As Single
Strength = pStrength
End Property
Public Property Let Strength(ByVal Value As Single)
If pStrength = Value Then Exit Property pStrength = Value bUpdate = True
End Property
Public Property Get NeedsUpdate() As Boolean 'If the light needs to be updated
NeedsUpdate = bUpdate
End Property
Public Property Get X() As Long
X = pX
End Property
Public Property Get Y() As Long
Y = pY
End Property
Public Property Let X(ByVal Value As Long)
If Value = pX Then Exit Property pX = Value If Abs(UpdatePX - pX) + Abs(UpdatePY - pY) > MinUpdateDist Then bUpdate = True
End Property
Public Property Let Y(ByVal Value As Long)
If Value = pY Then Exit Property pY = Value If Abs(UpdatePX - pX) + Abs(UpdatePY - pY) > MinUpdateDist Then bUpdate = True
End Property
Private Function CalcLight(ByVal X As Long, ByVal Y As Long, ByVal Light As Long) As Long Dim Dist As Long Dim ARGB(3) As Byte Dim i As Long Dim k As Long Dim a As Long
'If the light is already -1 (ARGB 255/255/255/255) we can not increase it
If Light = -1 Then
CalcLight = -1
Exit Function
End If
'Find the distance of the verticy and light Dist = Distance(X, Y, pX, pY)
'Confirm the distance is valid
If pSize > Dist Then
'Find the ARGB value of the light
CopyMemory ARGB(0), Light, 4
'Calculate the modifier value to the light once instead of for each color
a = ((pSize - Dist) * pStrength)
'Update the RGB values
For i = 0 To 2
'Calculate the new light value
k = CLng(ARGB(i)) + a
If k > 255 Then k = 255
If k < 0 Then k = 0
'Put the variable back now that we know it is in byte range
ARGB(i) = k
Next i
'Store the new light value
CalcLight = D3DColorARGB(ARGB(3), ARGB(2), ARGB(1), ARGB(0))
Else
'Return the original value since the light is too far away from the location to affect it
CalcLight = Light
End If
End Function
Private Function Distance(ByVal x1 As Long, ByVal Y1 As Long, ByVal x2 As Long, ByVal Y2 As Long) As Single
Distance = Sqr(((x2 - x1) * (x2 - x1)) + ((Y2 - Y1) * (Y2 - Y1)))
End Function
Public Sub UpdateLight() Dim CenterX As Integer Dim CenterY As Integer Dim lMinX As Long Dim lMinY As Long Dim lMaxX As Long Dim lMaxY As Long Dim r As Long Dim X As Long Dim Y As Long
bUpdate = False UpdatePX = pX UpdatePY = pY
'Find the tiles that the light will hit Engine_ConvertCPtoTP pX, pY, CenterX, CenterY lMinX = CenterX - pRadius lMinY = CenterY - pRadius lMaxX = CenterX + pRadius lMaxY = CenterY + pRadius 'Make sure the light stays inside the screen area (no need to update outside of the view) If lMinX < LightMinX Then lMinX = LightMinX If lMinY < LightMinY Then lMinY = LightMinY If lMaxX > LightMaxX Then lMaxX = LightMaxX If lMaxY > LightMaxY Then lMaxY = LightMaxY
'Loop through the tiles in the screen
For X = lMinX To lMaxX
For Y = lMinY To lMaxY
'Find the tile the light is coming from, and which corner
If X = MapInfo.Width And Y = MapInfo.Height Then
MapLight(X, Y) = CalcLight((X - LightAddX) * 32, (Y - LightAddY) * 32, MapData(X - 1, Y - 1).Light(4))
ElseIf X = MapInfo.Width Then
MapLight(X, Y) = CalcLight((X - LightAddX) * 32, (Y - LightAddY) * 32, MapData(X - 1, Y).Light(2))
ElseIf Y = MapInfo.Height Then
MapLight(X, Y) = CalcLight((X - LightAddX) * 32, (Y - LightAddY) * 32, MapData(X, Y - 1).Light(3))
Else
MapLight(X, Y) = CalcLight((X - LightAddX) * 32, (Y - LightAddY) * 32, MapData(X, Y).Light(1))
End If
Next Y Next X
'Apply the lights to the tiles
For X = lMinX To lMaxX - 1
For Y = lMinY To lMaxY - 1
With MapData(X, Y)
.Light(1) = MapLight(X, Y)
.Light(2) = MapLight(X + 1, Y)
.Light(3) = MapLight(X, Y + 1)
.Light(4) = MapLight(X + 1, Y + 1)
End With
Next Y
Next X
End Sub
</vb>
Step 3
Open frmMain:
Find Case DIMOFS_X add after Moved = 1 :
<vb>
Lights(CursorLightIndex).X = MousePos.X
</vb>
Find Case DIMOFS_Y add after Moved = 1 :
<vb>
Lights(CursorLightIndex).Y = MousePos.Y
</vb>
Step 4
Open General Module:
Find:
<vb>
'Erase particle effects LastEffect = 0 ReDim Effect(1 To NumEffects)
</vb>
After Add:
<vb>
'Erase all the lights RemoveAllLights
</vb>
Find and Remove:
<vb>
'Resize the save light buffer ReDim SaveLightBuffer(1 To MapInfo.Width, 1 To MapInfo.Height)
</vb>
Add in its Place:
<vb>
ReDim MapLight(1 To MapInfo.Width, 1 To MapInfo.Height) As Long
</vb>
Find:
<vb>
'Set light to default (-1) - it will be set again if it is not -1 from the code below
For i = 1 To 24
MapData(X, Y).Light(i) = -1
Next i
'Get lighting values
If ByFlags And 128 Then
For i = 1 To 4
MapData(X, Y).Light(i) = MapBuf.Get_Long
Next i
End If
If ByFlags And 256 Then
For i = 5 To 8
MapData(X, Y).Light(i) = MapBuf.Get_Long
Next i
End If
If ByFlags And 512 Then
For i = 9 To 12
MapData(X, Y).Light(i) = MapBuf.Get_Long
Next i
End If
If ByFlags And 1024 Then
For i = 13 To 16
MapData(X, Y).Light(i) = MapBuf.Get_Long
Next i
End If
If ByFlags And 2048 Then
For i = 17 To 20
MapData(X, Y).Light(i) = MapBuf.Get_Long
Next i
End If
If ByFlags And 4096 Then
For i = 21 To 24
MapData(X, Y).Light(i) = MapBuf.Get_Long
Next i
End If
'Store the lighting in the SaveLightBuffer
For i = 1 To 24
SaveLightBuffer(X, Y).Light(i) = MapData(X, Y).Light(i)
Next i
</vb>
Replace it with:
<vb>
'Get the map light values (not used with dynamic lights)
If ByFlags And 128 Then
For i = 1 To 4
MapBuf.Get_Long
Next i
End If
If ByFlags And 256 Then
For i = 5 To 8
MapBuf.Get_Long
Next i
End If
If ByFlags And 512 Then
For i = 9 To 12
MapBuf.Get_Long
Next i
End If
If ByFlags And 1024 Then
For i = 13 To 16
MapBuf.Get_Long
Next i
End If
If ByFlags And 2048 Then
For i = 17 To 20
MapBuf.Get_Long
Next i
End If
If ByFlags And 4096 Then
For i = 21 To 24
MapBuf.Get_Long
Next i
End If
'Set the ambient light
For i = 1 To 4
MapData(X, Y).Light(i) = LightAmbient
Next i
</vb>
Find:
<vb>
TileBufferOffset = ((10 - TileBufferSize) * 32)
</vb>
Add After:
<vb>
'Set the ambient light LightAmbient = -15132391 'Create the cursor light (these values are filled in later) CursorLightIndex = AddLight(0, 0, 240, 1.5)
</vb>
Step 5
Open TileEngine Module.
Find:
<vb>
Light(1 To 24) As Long
</vb>
Replace With:
<vb>
Light(1 To 4) As Long
</vb>
Find and Remove:
<vb>
Public Type LightType
Light(1 To 24) As Long
End Type Public SaveLightBuffer() As LightType
</vb>
Find and Remove:
<vb>
Erase SaveLightBuffer
</vb>
Find:
<vb>
For i = 1 To 24
MapData(X, Y).Light(i) = SaveLightBuffer(X, Y).Light(i)
</vb>
Replace With:
<vb>
For i = 1 To 4
MapData(X, Y).Light(i) = LightAmbient
</vb>
Find:
<vb>
'Change the light of all the tiles to white
For X = 1 To MapInfo.Width
For Y = 1 To MapInfo.Height
For i = 1 To 24
MapData(X, Y).Light(i) = -1
Next i
Next Y
Next X
</vb>
Replace With:
<vb>
'Change the light of all the tiles to white
For X = 1 To MapInfo.Width
For Y = 1 To MapInfo.Height
For i = 1 To 4
MapData(X, Y).Light(i) = -1
Next i
Next Y
Next X
</vb>
Find and Remove in Engine_Render_Screen:
<vb>
Dim LightOffset As Long
</vb>
Find:
<vb>
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 1#, 0
</vb>
Add After:
<vb>
'************** Dynamic lighting ************ UpdateLights
</vb>
Find:
<vb>
'Loop through the lower 3 layers
For Layer = 1 To 3
LightOffset = ((Layer - 1) * 4) + 1
'Loop through all the tiles we know we will draw for this layer
For j = 1 To TileLayer(Layer).NumTiles
With TileLayer(Layer).Tile(j)
'Check if we have to draw with a shadow or not (slighty changes because we have to animate on the shadow, not the main render)
If MapData(.TileX, .TileY).Shadow(Layer) = 1 Then
Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 1, True, ShadowColor, ShadowColor, ShadowColor, ShadowColor, 1
Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 0, True, MapData(.TileX, .TileY).Light(LightOffset), MapData(.TileX, .TileY).Light(LightOffset + 1), MapData(.TileX, .TileY).Light(LightOffset + 2), MapData(.TileX, .TileY).Light(LightOffset + 3)
Else
Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 1, True, MapData(.TileX, .TileY).Light(LightOffset), MapData(.TileX, .TileY).Light(LightOffset + 1), MapData(.TileX, .TileY).Light(LightOffset + 2), MapData(.TileX, .TileY).Light(LightOffset + 3)
End If
End With
Next j
Next Layer
</vb>
Replace With:
<vb>
'Loop through the lower 3 layers For Layer = 1 To 3
'Loop through all the tiles we know we will draw for this layer
For j = 1 To TileLayer(Layer).NumTiles
With TileLayer(Layer).Tile(j)
'Check if we have to draw with a shadow or not (slighty changes because we have to animate on the shadow, not the main render)
If MapData(.TileX, .TileY).Shadow(Layer) = 1 Then
Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 1, True, ShadowColor, ShadowColor, ShadowColor, ShadowColor, 1
Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 0, True, MapData(.TileX, .TileY).Light(1), MapData(.TileX, .TileY).Light(2), MapData(.TileX, .TileY).Light(3), MapData(.TileX, .TileY).Light(4)
Else
Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 1, True, MapData(.TileX, .TileY).Light(1), MapData(.TileX, .TileY).Light(2), MapData(.TileX, .TileY).Light(3), MapData(.TileX, .TileY).Light(4)
End If
End With
Next j
Next Layer
</vb>
Find:
<vb>
For Layer = 4 To 6
LightOffset = ((Layer - 1) * 4) + 1
For j = 1 To TileLayer(Layer).NumTiles
With TileLayer(Layer).Tile(j)
If MapData(.TileX, .TileY).Shadow(Layer) = 1 Then
Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 1, True, ShadowColor, ShadowColor, ShadowColor, ShadowColor, 1
Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 0, True, MapData(.TileX, .TileY).Light(LightOffset), MapData(.TileX, .TileY).Light(LightOffset + 1), MapData(.TileX, .TileY).Light(LightOffset + 2), MapData(.TileX, .TileY).Light(LightOffset + 3)
Else
Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 1, True, MapData(.TileX, .TileY).Light(LightOffset), MapData(.TileX, .TileY).Light(LightOffset + 1), MapData(.TileX, .TileY).Light(LightOffset + 2), MapData(.TileX, .TileY).Light(LightOffset + 3)
End If
End With
Next j
Next Layer
</vb>
Replace With:
<vb>
For Layer = 4 To 6
For j = 1 To TileLayer(Layer).NumTiles
With TileLayer(Layer).Tile(j)
If MapData(.TileX, .TileY).Shadow(Layer) = 1 Then
Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 1, True, ShadowColor, ShadowColor, ShadowColor, ShadowColor, 1
Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 0, True, MapData(.TileX, .TileY).Light(1), MapData(.TileX, .TileY).Light(2), MapData(.TileX, .TileY).Light(3), MapData(.TileX, .TileY).Light(4)
Else
Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 1, True, MapData(.TileX, .TileY).Light(1), MapData(.TileX, .TileY).Light(2), MapData(.TileX, .TileY).Light(3), MapData(.TileX, .TileY).Light(4)
End If
End With
Next j
Next Layer
</vb>
Find:
<vb>
'****** Update screen ******
</vb>
Add After:
<vb>
'Fixes problem with Lightcircle/Mousepos
If UserPos.X > 14 Then
Lights(CursorLightIndex).LightAddX = UserPos.X - 14
Else
Lights(CursorLightIndex).LightAddX = 0
End If
If UserPos.Y > 10 Then
Lights(CursorLightIndex).LightAddY = UserPos.Y - 10
Else
Lights(CursorLightIndex).LightAddY = 0
End If
</vb>