Mirage Source

LastUpdateVitals As Long
LastUpdateSave As Long

Public Sub ServerLoop()
Dim i As Long
Dim x As Long
Dim y As Long

Dim Tick As Long

Dim tmr500 As Long
Dim tmr1000 As Long

Dim LastUpdateMapSpawnItems As Long

    ServerOnline = True
   
    Do While ServerOnline
        Tick = GetTickCount
       
        If Tick > tmr500 Then
            ' Check for disconnections
            For i = 1 To MAX_PLAYERS
                If frmServer.Socket(i).State > sckConnected Then
                    Call CloseSocket(i)
                End If
               
                ' Update the player
                If IsPlaying(i) Then
                    OnUpdate i
                End If
            Next
           
            ' Process NPC AI
            UpdateNpcAI
           
            tmr500 = GetTickCount + 500
        End If
       
        If Tick > tmr1000 Then
            ' Handle shutting down server
            If isShuttingDown Then
                Call HandleShutdown
            End If
           
            ' Handles closing doors
            For i = 1 To MAX_MAPS
                If Tick > TempTile(i).DoorTimer + 5000 Then
                    For x = 0 To MAX_MAPX
                        For y = 0 To MAX_MAPY
                            If Map(i).Tile(x, y).Type = TILE_TYPE_KEY Then
                                If TempTile(i).DoorOpen(x, y) = YES Then
                                    TempTile(i).DoorOpen(x, y) = NO
                                    Call SendDataToMap(i, SMapKey & SEP_CHAR & x & SEP_CHAR & y & SEP_CHAR & 0 & END_CHAR)
                                End If
                            End If
                        Next
                    Next
                End If
            Next
           
            tmr1000 = GetTickCount + 1000
        End If
       
        ' Checks to spawn map items every 5 minutes - Can be tweaked
        If Tick > LastUpdateMapSpawnItems Then
            UpdateMapSpawnItems
            LastUpdateMapSpawnItems = GetTickCount + 300000
        End If
       
        Sleep 1
        DoEvents
    Loop
End Sub

TempPlayer(Index).LastUpdateVitals = GetTickCount + 10000
TempPlayer(Index).LastUpdateSave = GetTickCount + 600000

''***************************************
' Events for updating
'***************************************
Sub OnUpdate(ByVal Index As Long)
Dim i As Long
   
    '*****************************
    '**  Checks to save player  **
    '*****************************
    If GetTickCount > TempPlayer(Index).LastUpdateSave Then
        SavePlayer Index
        TempPlayer(Index).LastUpdateSave = GetTickCount + 600000    ' 10 minutes
    End If
           
    '**************************************
    '**  Checks to update player vitals  **
    '**************************************
    If GetTickCount > TempPlayer(Index).LastUpdateVitals Then
        For i = 1 To Vitals.Vital_Count - 1
            If GetPlayerVital(Index, i) <> GetPlayerMaxVital(Index, i) Then
                Call SetPlayerVital(Index, i, GetPlayerVital(Index, i) + GetPlayerVitalRegen(Index, i))
                Call SendVital(Index, i)
            End If
        Next
        TempPlayer(Index).LastUpdateVitals = GetTickCount + 5000   ' 5 seconds
    End If
End Sub