VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsCM_Map"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'Constant used for serializing and deserializing this character
Private Const m_cMapSep As String = "[CM ¶]"
Private Const m_cMapSepItem As String = "[CI ¼]"

Private Const m_cFOWBLOCKSIZE As Long = 30

Private Const m_cNAME As String = "clsCM_Map"
Private Const m_cHEADER As String = "DNDOnline Combat Map System v1.0"
Private m_sMapName As String
Private m_sMapBitMapName As String

Private m_baFOW() As Boolean
Private m_nHeight As Long
Private m_nWidth As Long
Private m_oMapItems As New Collection

Public Function Copy() As clsCM_Map

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Copy"
    Call WriteProcStart(sRoutineName)
    
    
    Dim sSer As String
    Set Copy = New clsCM_Map

    sSer = Serialize()
    Call Copy.DeSerialize(sSer)
    

    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function

Public Property Get Col() As Collection

    Set Col = m_oMapItems
    
End Property

Public Sub Remove(sGUID As String)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Remove"
    Call WriteProcStart(sRoutineName)
    
    
    Call m_oMapItems.Remove(sGUID)


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub

Public Sub RemoveAll()

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".RemoveAll"
    Call WriteProcStart(sRoutineName)
    
    
    While m_oMapItems.Count > 0
        Call m_oMapItems.Remove(1)
    Wend


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub

Public Function Find(sGUID As String) As clsCM_Item

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Find"
    Call WriteProcStart(sRoutineName)
    
    
    Dim oItem As clsCM_Item
    
    Set Find = Nothing

    For Each oItem In m_oMapItems
        If oItem.GUID = sGUID Then
            Set Find = oItem
        End If
    Next oItem


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function

Public Sub Update(sGUID As String, nX As Long, nY As Long, nWidth As Long, nHeight As Long)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Update"
    Call WriteProcStart(sRoutineName)
    
    
    Dim oItem As clsCM_Item

    Set oItem = Find(sGUID)
    If oItem Is Nothing Then
        Set oItem = New clsCM_Item
        Call m_oMapItems.Add(oItem, sGUID)
    End If
    
    oItem.GUID = sGUID
    oItem.X = nX
    oItem.Y = nY
    oItem.Width = nWidth
    oItem.Height = nHeight


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub

Public Sub Save(sFileName As String)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Save"
    Call WriteProcStart(sRoutineName)


    Dim nFreeFile As Long
    Dim sLineIn As String
    Dim oLoopItem As clsCM_Item
    Dim oMinion As clsCharacter
        
    nFreeFile = FreeFile
    Open sFileName For Output As #nFreeFile
    
        'First things first, write out our header
        Print #nFreeFile, m_cHEADER
        
        'Write our header information
            'Map Name
            Print #nFreeFile, MapName
            'Background bitmap name
            Print #nFreeFile, MapBitMapName
            '07/19/2004 Chris Hill  Save the dimensions.
            Print #nFreeFile, Width, Height
            '07/19/2004 Chris Hill  Save the FOW.
            Print #nFreeFile, SerializeFOW()
        
        'Now write out our minions and such first
            For Each oLoopItem In Col
            
                'First check to see if this is a char
                Set oMinion = GetCharacter(oLoopItem.GUID())
                If oMinion.IsMinion = True Then
                    'Save out our minion
                    Write #nFreeFile, oMinion.sGUID, oMinion.Serialize()
                    Write #nFreeFile, oLoopItem.GUID, oLoopItem.Serialize()
                End If
            Next oLoopItem
       
    Close #nFreeFile


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub

Public Sub Load(sFileName As String)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Load"
    Call WriteProcStart(sRoutineName)


    Dim nFreeFile As Long
    Dim sLineIn As String
    Dim sChar As String
    Dim sItem As String
    Dim sCharGUID As String
    Dim sItemGUID As String
    Dim oMinion As clsCharacter
    Dim oItem As clsCM_Item
    Dim nX As Long, nY As Long
    Dim nStatus As Long
    Dim nWidth As Long
    Dim nHeight As Long
    Dim sFOW As String
            
    'First step is to wipe out our current map
    Call RemoveAll
            
            
    nFreeFile = FreeFile
    Open g_cDNDONLINEDIR & sFileName For Input As #nFreeFile
    
        'First things first, make sure the header is valid!
        Line Input #nFreeFile, sLineIn
        If Not m_cHEADER = sLineIn Then
            Call Err.Raise(-1, sRoutineName, "File is not a DNDOnline Combat Map file.")
        End If
        
        'Read in our header information
            'Map Name
            Line Input #nFreeFile, sLineIn
            MapName = sLineIn
            'Background bitmap name
            Line Input #nFreeFile, sLineIn
            MapBitMapName = sLineIn
            'Size
            Input #nFreeFile, nWidth, nHeight
            Call SetMapSize(nWidth * m_cFOWBLOCKSIZE, nHeight * m_cFOWBLOCKSIZE)
            '07/19/2004 Chris Hill  Load the FOW.
            Input #nFreeFile, sFOW
            Call DeSerializeFOW(sFOW)
        
        'Now read in our items
            While EOF(nFreeFile) = False
                Input #nFreeFile, sCharGUID, sChar
                Input #nFreeFile, sItemGUID, sItem
                
                
                Call MakeProcessSendMsg(g_cSerizlizedMinionCode, sCharGUID, sChar)
                
                'First thing first... find our item
                Set oItem = Find(sCharGUID)
                
                'Changed it so that the item does not get updated if its already on the board
                If oItem Is Nothing Then
                    Set oItem = New clsCM_Item
                    Call oItem.DeSerialize(sItem)
                Else
                    nX = oItem.X()
                    nY = oItem.Y()
                    nStatus = oItem.Status()
                    Call oItem.DeSerialize(sItem)
                    oItem.X() = nX
                    oItem.Y() = nY
                    oItem.Status() = nStatus
                End If

                Call Update(sItemGUID, oItem.X, oItem.Y, oItem.Width, oItem.Height)
            Wend
        
    Close #nFreeFile


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub

Public Function SerializeFOW() As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".SerializeFOW"
    Call WriteProcStart(sRoutineName)
    
    
    Dim nX As Long, nY As Long
    Dim nCurLen As Long
    Dim bCurValue As Boolean
    nCurLen = 0
    SerializeFOW = ""
    
    If m_nWidth > 0 And m_nHeight > 0 Then
        For nX = 0 To m_nWidth
            For nY = 0 To m_nHeight
            
                If nCurLen = 0 Then
                    nCurLen = nCurLen + 1
                    bCurValue = m_baFOW(nX, nY)
                ElseIf Not bCurValue = m_baFOW(nX, nY) Then
                    If nCurLen = 1 Then
                        SerializeFOW = SerializeFOW & BoolToInt(bCurValue)
                    Else
                        SerializeFOW = SerializeFOW & "[" & BoolToInt(bCurValue) & nCurLen & "]"
                    End If
                    nCurLen = 1
                    bCurValue = m_baFOW(nX, nY)
                Else
                    nCurLen = nCurLen + 1
                End If
            
            Next nY
        Next nX
        
        If nCurLen > 0 Then
            SerializeFOW = SerializeFOW & "[" & BoolToInt(bCurValue) & nCurLen & "]"
        End If
    End If
    
    
    Call WriteProcStop(sRoutineName) ' Serialize)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function
Public Function DeSerializeFOW(sFOW As String) As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".DeSerializeFOW"
    Call WriteProcStart(sRoutineName)


    Dim sRemStr As String
    Dim nX As Long, nY As Long
    Dim nCurLen As Long
    Dim bCurValue As Boolean
    Dim nPos As Long
    
    sRemStr = sFOW
    
    If Len(sRemStr) > 0 Then
        For nX = 0 To m_nWidth
            For nY = 0 To m_nHeight
            
                If nCurLen > 0 Then
                    m_baFOW(nX, nY) = bCurValue
                    nCurLen = nCurLen - 1
                ElseIf Left(sRemStr, 1) = "[" Then
                    nPos = InStr(1, sRemStr, "]")
                    bCurValue = (Mid(sRemStr, 2, 1) = 1)
                    nCurLen = Mid(sRemStr, 3, nPos - 3)
                    sRemStr = Mid(sRemStr, nPos + 1)
                    m_baFOW(nX, nY) = bCurValue
                    nCurLen = nCurLen - 1
                Else
                    m_baFOW(nX, nY) = (Left(sRemStr, 1) = 1)
                    sRemStr = Mid(sRemStr, 2)
                End If
            
            Next nY
        Next nX
    End If
        
    
    DeSerializeFOW = sRemStr
    
    
    Call WriteProcStop(sRoutineName) ' sRemStr)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function

Public Function Serialize() As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Serialize"
    Call WriteProcStart(sRoutineName)
    
    
    Dim oLoopItem As clsCM_Item
    
    Serialize = MapName() & m_cMapSep
    Serialize = Serialize & MapBitMapName() & m_cMapSep
    Serialize = Serialize & Height() & m_cMapSep
    Serialize = Serialize & Width() & m_cMapSep
    Serialize = Serialize & SerializeFOW() & m_cMapSep
    
    'Now add in any sub-items we may have
    For Each oLoopItem In Col
        Serialize = Serialize & oLoopItem.Serialize() & m_cMapSepItem
    Next oLoopItem
    Serialize = Serialize & m_cMapSep
    
    
    Call WriteProcStop(sRoutineName) ' Serialize)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function
Public Function DeSerialize(sShape As String) As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".DeSerialize"
    Call WriteProcStart(sRoutineName) ' sShape)


    Dim oItem As clsCM_Item
    Dim sItems As String
    Dim saItems() As String
    Dim sItem As String
    Dim sFOW As String
    Dim sRemStr As String
    Dim nHeight As Long, nWidth As Long
    Dim i As Long
    sRemStr = sShape
    
    MapName = Left(sRemStr, InStr(sRemStr, m_cMapSep) - 1)
        sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cMapSep) - Len(m_cMapSep) + 1)
    MapBitMapName = Left(sRemStr, InStr(sRemStr, m_cMapSep) - 1)
        sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cMapSep) - Len(m_cMapSep) + 1)
    nHeight = Left(sRemStr, InStr(sRemStr, m_cMapSep) - 1)
        sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cMapSep) - Len(m_cMapSep) + 1)
    nWidth = Left(sRemStr, InStr(sRemStr, m_cMapSep) - 1)
        sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cMapSep) - Len(m_cMapSep) + 1)
    sFOW = Left(sRemStr, InStr(sRemStr, m_cMapSep) - 1)
        sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cMapSep) - Len(m_cMapSep) + 1)
    sItems = Left(sRemStr, InStr(sRemStr, m_cMapSep) - 1)
        sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cMapSep) - Len(m_cMapSep) + 1)

    'We have to artifically pump up these values because setmap size takes a pixel value.
    Call SetMapSize(nWidth * m_cFOWBLOCKSIZE, nHeight * m_cFOWBLOCKSIZE)
    Call DeSerializeFOW(sFOW)

    'Items
    Call RemoveAll
    saItems = Split(sItems, m_cMapSepItem)
    For i = 0 To UBound(saItems) - 1
        Set oItem = New clsCM_Item
        Call oItem.DeSerialize(saItems(i))
        Call Update(oItem.GUID, oItem.X, oItem.Y, oItem.Width, oItem.Height)
    Next i

    DeSerialize = sRemStr
    
    
    Call WriteProcStop(sRoutineName) ' sRemStr)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function

Public Property Get MapName() As String
    MapName = m_sMapName
End Property
Public Property Let MapName(sVal As String)
    m_sMapName = sVal
End Property

Public Property Get MapBitMapName() As String
    MapBitMapName = m_sMapBitMapName
End Property
Public Property Let MapBitMapName(sVal As String)
    m_sMapBitMapName = sVal
End Property

Public Function GetMapItemAt(nWorldX As Long, nWorldY As Long) As clsCM_Item

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetMapItemAt"
    Call WriteProcStart(sRoutineName)
    
    
    Dim oMapItem As clsCM_Item
    Dim oLabel As Label

    For Each oMapItem In Col()
        If nWorldX > oMapItem.X And nWorldX < oMapItem.X + oMapItem.Width And _
           nWorldY > oMapItem.Y And nWorldY < oMapItem.Y + oMapItem.Height Then
                Set GetMapItemAt = oMapItem
                Exit For
        End If
    Next oMapItem
    
    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function

Public Property Let FOW(nX As Long, nY As Long, bValue As Boolean)
    m_baFOW(nX, nY) = bValue
End Property
Public Property Get FOW(nX As Long, nY As Long) As Boolean
    If nX > UBound(m_baFOW, 1) Then
        Call Err.Raise(-1, "DNDOnline.clsCM_Map.FOW", "nX was <" & nX & "> when <" & UBound(m_baFOW, 1) & "> was the max value.")
    ElseIf nY > UBound(m_baFOW, 2) Then
        Call Err.Raise(-1, "DNDOnline.clsCM_Map.FOW", "nY was <" & nY & "> when <" & UBound(m_baFOW, 2) & "> was the max value.")
    Else
        FOW = m_baFOW(nX, nY)
    End If
End Property

Public Function SetMapSize(nWidth As Long, nHeight As Long)

    Dim nX As Long, nY As Long

    'If the map doesn't exist yet were ok... if it does we have to resize
    If m_nHeight = 0 And m_nWidth = 0 Then
        ReDim m_baFOW(0 To nWidth / m_cFOWBLOCKSIZE, 0 To nHeight / m_cFOWBLOCKSIZE) As Boolean

        m_nWidth = nWidth / m_cFOWBLOCKSIZE
        m_nHeight = nHeight / m_cFOWBLOCKSIZE

        'Set it all to true
        For nX = 0 To m_nWidth
            For nY = 0 To m_nHeight
                m_baFOW(nX, nY) = True
            Next nY
        Next nX
    Else
        ReDim m_baFOW(0 To nWidth / m_cFOWBLOCKSIZE, 0 To nHeight / m_cFOWBLOCKSIZE) As Boolean
    End If

End Function

Public Property Let Width(nValue As Long)
    m_nWidth = nValue
End Property
Public Property Get Width() As Long
    Width = m_nWidth
End Property

Public Property Let Height(nValue As Long)
    m_nHeight = nValue
End Property
Public Property Get Height() As Long
    Height = m_nHeight
End Property

Public Property Get FOWBlockSize() As Long
    FOWBlockSize = m_cFOWBLOCKSIZE
End Property

