Updated Dynamic lighting
From VbGORE Visual Basic Online RPG Engine
Contents |
[edit] Step 1
Open Client.vbp
Add to Project a New Module. Name it "Lighting" and Add:
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
[edit] Step 2
Add to Project a New Class Module. Name it "DynamicLight" and Add:
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
[edit] Step 3
Open frmMain:
Find Case DIMOFS_X add after Moved = 1 :
Lights(CursorLightIndex).X = MousePos.X
Find Case DIMOFS_Y add after Moved = 1 :
Lights(CursorLightIndex).Y = MousePos.Y
[edit] Step 4
Open General Module:
Find:
'Erase particle effects LastEffect = 0 ReDim Effect(1 To NumEffects)
After Add:
'Erase all the lights
RemoveAllLights
Find and Remove:
'Resize the save light buffer ReDim SaveLightBuffer(1 To MapInfo.Width, 1 To MapInfo.Height)
Add in its Place:
ReDim MapLight(1 To MapInfo.Width, 1 To MapInfo.Height) As Long
Find:
'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
Replace it with:
'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
Find:
TileBufferOffset = ((10 - TileBufferSize) * 32)
Add After:
'Set the ambient light LightAmbient = -15132391 'Create the cursor light (these values are filled in later) CursorLightIndex = AddLight(0, 0, 240, 1.5)
[edit] Step 5
Open TileEngine Module.
Find:
Light(1 To 24) As Long
Replace With:
Light(1 To 4) As Long
Find and Remove:
Public Type LightType Light(1 To 24) As Long End Type Public SaveLightBuffer() As LightType
Find and Remove:
Erase SaveLightBuffer
Find:
For i = 1 To 24 MapData(X, Y).Light(i) = SaveLightBuffer(X, Y).Light(i)
Replace With:
For i = 1 To 4 MapData(X, Y).Light(i) = LightAmbient
Find:
'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
Replace With:
'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
Find and Remove in Engine_Render_Screen:
Dim LightOffset As Long
Find:
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 1#, 0
Add After:
'************** Dynamic lighting ************
UpdateLights
Find:
'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
Replace With:
'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
Find:
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
Replace With:
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
Find:
'****** Update screen ******
Add After:
'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



