Updated Dynamic lighting

From VbGORE Visual Basic Online RPG Engine

1 Step 1
2 Step 2
3 Step 3
4 Step 4
5 Step 5

[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