Public Sub BltPlayer(ByVal Index As Long)
'****************************************************************
'* WHEN WHO WHAT
'* ---- --- ----
'* 07/12/2005 Shannara Optimized function.
'****************************************************************

Dim Anim As Byte
Dim x As Long, y As Long

' Only used if ever want to switch to blt rather then bltfast
With rec_pos
.top = GetPlayerY(Index) * PIC_Y + Player(Index).YOffset
.Bottom = .top + PIC_Y
.Left = GetPlayerX(Index) * PIC_X + Player(Index).XOffset
.Right = .Left + PIC_X
End With

' Check for animation
Anim = 0
If Player(Index).Attacking = 0 Then
Select Case GetPlayerDir(Index)
Case DIR_UP
If (Player(Index).YOffset < PIC_Y / 2) Then Anim = 1
Case DIR_DOWN
If (Player(Index).YOffset < PIC_Y / 2 * -1) Then Anim = 1
Case DIR_LEFT
If (Player(Index).XOffset < PIC_Y / 2) Then Anim = 1
Case DIR_RIGHT
If (Player(Index).XOffset < PIC_Y / 2 * -1) Then Anim = 1
End Select
Else
If Player(Index).AttackTimer + 500 > GetTickCount Then
Anim = 2
End If
End If

' Check to see if we want to stop making him attack
With Player(Index)
If .AttackTimer + 1000 < GetTickCount Then
.Attacking = 0
.AttackTimer = 0
End If
End With

With rec
.top = GetPlayerSprite(Index) * PIC_Y + PIC_Y
.Bottom = .top + PIC_Y
.Left = (GetPlayerDir(Index) * 3 + Anim) * PIC_X
.Right = .Left + PIC_X
End With

x = GetPlayerX(Index) * PIC_X + Player(Index).XOffset
y = GetPlayerY(Index) * PIC_Y + Player(Index).YOffset - 4

' Check if its out of bounds because of the offset
If y < 0 Then
y = 0
With rec
.top = .top + (y * -1)
End With
End If

Call DD_BackBuffer.BltFast(x, y, DD_SpriteSurf, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
End Sub

Public Sub BltPlayerTop(ByVal Index As Long)
'****************************************************************
'* WHEN WHO WHAT
'* ---- --- ----
'* 07/12/2005 Shannara Optimized function.
'****************************************************************

Dim Anim As Byte
Dim x As Long, y As Long

' Only used if ever want to switch to blt rather then bltfast
With rec_pos
.top = GetPlayerY(Index) * PIC_Y + Player(Index).YOffset
.Bottom = .top + PIC_Y
.Left = GetPlayerX(Index) * PIC_X + Player(Index).XOffset
.Right = .Left + PIC_X
End With

' Check for animation
Anim = 0
If Player(Index).Attacking = 0 Then
Select Case GetPlayerDir(Index)
Case DIR_UP
If (Player(Index).YOffset < PIC_Y / 2) Then Anim = 1
Case DIR_DOWN
If (Player(Index).YOffset < PIC_Y / 2 * -1) Then Anim = 1
Case DIR_LEFT
If (Player(Index).XOffset < PIC_Y / 2) Then Anim = 1
Case DIR_RIGHT
If (Player(Index).XOffset < PIC_Y / 2 * -1) Then Anim = 1
End Select
Else
If Player(Index).AttackTimer + 500 > GetTickCount Then
Anim = 2
End If
End If

' Check to see if we want to stop making him attack
With Player(Index)
If .AttackTimer + 1000 < GetTickCount Then
.Attacking = 0
.AttackTimer = 0
End If
End With

With rec
.top = GetPlayerSprite(Index) * PIC_Y
.Bottom = .top + PIC_Y
.Left = (GetPlayerDir(Index) * 3 + Anim) * PIC_X
.Right = .Left + PIC_X
End With

x = GetPlayerX(Index) * PIC_X + Player(Index).XOffset
y = GetPlayerY(Index) * PIC_Y + Player(Index).YOffset - 4

' Check if its out of bounds because of the offset
y = y - 32
If y < 0 And y > -32 Then
With rec
.top = .top - y
y = 0
End With
End If

Call DD_BackBuffer.BltFast(x, y, DD_SpriteSurf, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
End Sub

Public Sub GameLoop()
'****************************************************************
'* WHEN WHO WHAT
'* ---- --- ----
'* 07/12/2005 Shannara Optimized function, added font constants.
'****************************************************************

Dim Tick As Long
Dim TickFPS As Long
Dim FPS As Long
Dim x As Long
Dim y As Long
Dim i As Long
Dim rec_back As RECT

' Set the focus
frmMirage.picScreen.SetFocus

' Set font
Call SetFont(FONT_NAME, FONT_SIZE)

' Used for calculating fps
TickFPS = GetTickCount
FPS = 0

Do While InGame
Tick = GetTickCount

' Check to make sure they aren't trying to auto do anything
If GetAsyncKeyState(VK_UP) >= 0 And DirUp = True Then DirUp = False
If GetAsyncKeyState(VK_DOWN) >= 0 And DirDown = True Then DirDown = False
If GetAsyncKeyState(VK_LEFT) >= 0 And DirLeft = True Then DirLeft = False
If GetAsyncKeyState(VK_RIGHT) >= 0 And DirRight = True Then DirRight = False
If GetAsyncKeyState(VK_CONTROL) >= 0 And ControlDown = True Then ControlDown = False
If GetAsyncKeyState(VK_SHIFT) >= 0 And ShiftDown = True Then ShiftDown = False

' Check to make sure we are still connected
If Not IsConnected Then InGame = False

' Check if we need to restore surfaces
If NeedToRestoreSurfaces Then
DD.RestoreAllSurfaces
Call InitSurfaces
End If

' Blit out tiles layers ground/anim1/anim2
For y = 0 To MAX_MAPY
For x = 0 To MAX_MAPX
Call BltTile(x, y)
Next x
Next y

' Blit out the items
For i = 1 To MAX_MAP_ITEMS
If MapItem(i).Num > 0 Then
Call BltItem(i)
End If
Next i

' Blit out the npcs
For i = 1 To MAX_MAP_NPCS
Call BltNpc(i)
Next i

' Blit out players
For i = 1 To MAX_PLAYERS
If IsPlaying(i) And GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
Call BltPlayerTop(i)
End If
Next i

' Blit out tile layer fringe
For y = 0 To MAX_MAPY
For x = 0 To MAX_MAPX
Call BltFringeTile(x, y)
Next x
Next y

' Lock the backbuffer so we can draw text and names
TexthDC = DD_BackBuffer.GetDC
For i = 1 To MAX_PLAYERS
If IsPlaying(i) And GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
Call BltPlayerName(i)
End If
Next i

' Blit out attribs if in editor
If InEditor Then
For y = 0 To MAX_MAPY
For x = 0 To MAX_MAPX
With Map.Tile(x, y)
If .Type = TILE_TYPE_BLOCKED Then Call DrawText(TexthDC, x * PIC_X + 8, y * PIC_Y + 8, "B", QBColor(BrightRed))
If .Type = TILE_TYPE_WARP Then Call DrawText(TexthDC, x * PIC_X + 8, y * PIC_Y + 8, "W", QBColor(BrightBlue))
If .Type = TILE_TYPE_ITEM Then Call DrawText(TexthDC, x * PIC_X + 8, y * PIC_Y + 8, "I", QBColor(White))
If .Type = TILE_TYPE_NPCAVOID Then Call DrawText(TexthDC, x * PIC_X + 8, y * PIC_Y + 8, "N", QBColor(White))
If .Type = TILE_TYPE_KEY Then Call DrawText(TexthDC, x * PIC_X + 8, y * PIC_Y + 8, "K", QBColor(White))
If .Type = TILE_TYPE_KEYOPEN Then Call DrawText(TexthDC, x * PIC_X + 8, y * PIC_Y + 8, "O", QBColor(White))
End With
Next x
Next y
End If

' Blit the text they are putting in
Call DrawText(TexthDC, 0, (MAX_MAPY + 1) * PIC_Y - 20, MyText, RGB(255, 255, 255))

' Draw map name
If Map.Moral = MAP_MORAL_NONE Then
Call DrawText(TexthDC, Int((MAX_MAPX + 1) * PIC_X / 2) - (Int(Len(Trim(Map.Name)) / 2) * , 1, Trim(Map.Name), QBColor(BrightRed))
Else
Call DrawText(TexthDC, Int((MAX_MAPX + 1) * PIC_X / 2) - (Int(Len(Trim(Map.Name)) / 2) * , 1, Trim(Map.Name), QBColor(White))
End If

' Check if we are getting a map, and if we are tell them so
'If GettingMap = True Then
' Call DrawText(TexthDC, 50, 50, "Receiving Map...", QBColor(BrightCyan))
'End If

' Release DC
Call DD_BackBuffer.ReleaseDC(TexthDC)

' Get the rect for the back buffer to blit from
With rec
.top = 0
.Bottom = (MAX_MAPY + 1) * PIC_Y
.Left = 0
.Right = (MAX_MAPX + 1) * PIC_X
End With

' Get the rect to blit to
Call DX.GetWindowRect(frmMirage.picScreen.hWnd, rec_pos)
With rec_pos
.Bottom = .top + ((MAX_MAPY + 1) * PIC_Y)
.Right = .Left + ((MAX_MAPX + 1) * PIC_X)
End With

' Blit the backbuffer
Call DD_PrimarySurf.Blt(rec_pos, DD_BackBuffer, rec, DDBLT_WAIT)

' Check if player is trying to move
Call CheckMovement

' Check to see if player is trying to attack
Call CheckAttack

' Process player movements (actually move them)
For i = 1 To MAX_PLAYERS
If IsPlaying(i) Then
Call ProcessMovement(i)
End If
Next i

' Process npc movements (actually move them)
For i = 1 To MAX_MAP_NPCS
If Map.Npc(i) > 0 Then
Call ProcessNpcMovement(i)
End If
Next i

' Change map animation every 250 milliseconds
If GetTickCount > MapAnimTimer + 250 Then
If MapAnim = 0 Then
MapAnim = 1
Else
MapAnim = 0
End If
MapAnimTimer = GetTickCount
End If

' Lock fps
Do While GetTickCount < Tick + 50
DoEvents
Loop

' Calculate fps
If GetTickCount > TickFPS + 1000 Then
GameFPS = FPS
TickFPS = GetTickCount
FPS = 0
Else
FPS = FPS + 1
End If

DoEvents

Loop

frmMirage.Visible = False
frmSendGetData.Visible = True
Call SetStatus("Destroying game data...")

' Shutdown the game
Call GameDestroy

' Report disconnection if server disconnects
If IsConnected = False Then
Call MsgBox("Thank you for playing " & GAME_NAME & "!", vbOKOnly, GAME_NAME)
End If
End Sub