Attribute VB_Name = "modMapData"
Option Explicit

Private file As String

Public Type BannedRace
    brRace As Race
    brRestartPointName As String
End Type

Public Type RestartPoint
    rpId As Integer
    rpName As String
    rpPoints() As Point3D
    rpChaosPoints() As Point3D
    rpMaps() As MapNo
    rpBannedRace As BannedRace
    rpBBS As Integer
    rpLocName As String
End Type

Public Type MapRestart
    mapRace As Race
    mapRestartPointName As String
    mapRestartPoint As RestartPoint
End Type

Public Type Map
    mapRange As AreaRange
    mapRestartRace() As MapRestart
End Type

Public Sub initialize()
    file = App.Path & "\" & "mapregion.txt"
End Sub

Public Sub convert()
Dim iHandle As Integer
Dim sLine As String

Dim maps() As Map
Dim restartPoints() As RestartPoint

Dim iMaps As Integer
Dim iRestartPoints As Integer

    iHandle = FreeFile
    Open file For Input As #iHandle
    
        While Not EOF(iHandle)
            Line Input #iHandle, sLine
            
            trunc sLine
            
            If (Not Left$(sLine, 2) = "//") Then
                If (Left$(sLine, 10) = "area_begin") Then
                    ReDim Preserve maps(iMaps)
                    maps(iMaps) = parseArea(iHandle)
                    inc iMaps
                ElseIf (Left$(sLine, 11) = "point_begin") Then
                    ReDim Preserve restartPoints(iRestartPoints)
                    restartPoints(iRestartPoints) = parsePoint(iHandle)
                    restartPoints(iRestartPoints).rpId = iRestartPoints
                    inc iRestartPoints
                End If
            End If
        Wend
    Close #iHandle
    
    reorganizeRestartPoints maps, restartPoints
    
    writeXML maps, restartPoints
End Sub

Private Sub writeXML(maps() As Map, restartPoints() As RestartPoint)
Dim iHandle As Integer

Dim q As Integer
Dim w As Integer

Dim iRangeId As Integer

    iHandle = FreeFile
    
    Open App.Path & "\mapregion.xml" For Output As #iHandle
    
        Print #iHandle, "<mapregion>"
        Print #iHandle, getTabs(1) & "<restartpoints>"
        
        For q = 0 To UBound(restartPoints())
            Print #iHandle, getTabs(2) & "<restartpoint id=""" & restartPoints(q).rpId & """ name=""" & restartPoints(q).rpName & """ bbs=""" & restartPoints(q).rpBBS & """ locname=""" & restartPoints(q).rpLocName & """>"
            For w = 0 To UBound(restartPoints(q).rpPoints())
                printPoint3D restartPoints(q).rpPoints(w), "point", 3, iHandle
            Next
            
            For w = 0 To UBound(restartPoints(q).rpChaosPoints())
                printPoint3D restartPoints(q).rpChaosPoints(w), "chaospoint", 3, iHandle
            Next
            
            If (Len(restartPoints(q).rpBannedRace.brRestartPointName) > 0) Then
                Print #iHandle, getTabs(3) & "<bannedrace race=""" & getRaceName(restartPoints(q).rpBannedRace.brRace) & """ restartId=""" & getRestartPoint(restartPoints(q).rpBannedRace.brRestartPointName, restartPoints()).rpId & """ />"
            End If
            
            Print #iHandle, getTabs(2) & "</restartpoint>"
        Next
        Print #iHandle, getTabs(1) & "</restartpoints>"
        
        Print #iHandle, ""
        
        Print #iHandle, getTabs(1) & "<regions>"
        For q = 0 To UBound(maps())
            Print #iHandle, getTabs(2) & "<region>"
            
            Print #iHandle, getTabs(3) & "<range id=""" & iRangeId & """>"
            Print #iHandle, getTabs(4) & "<zheight min=""" & maps(q).mapRange.zMin & """ max=""" & maps(q).mapRange.zMax & """ />"
            For w = 0 To UBound(maps(q).mapRange.points())
                printPoint2D maps(q).mapRange.points(w), 4, iHandle
            Next
            For w = 0 To 4
                Print #iHandle, getTabs(4) & "<restart race=""" & getRaceName(maps(q).mapRestartRace(w).mapRace) & """ restartId=""" & maps(q).mapRestartRace(w).mapRestartPoint.rpId & """ />"
            Next
            Print #iHandle, getTabs(3) & "</range>"
            
            Print #iHandle, getTabs(2) & "</region>"
            
            inc iRangeId
        Next
        
        Print #iHandle, getTabs(1) & "</regions>"
        Print #iHandle, "</mapregion>"
    Close #iHandle
End Sub

Private Sub printPoint2D(point As Point2D, iTabs As Integer, iHandle As Integer)
    Print #iHandle, getTabs(iTabs) & "<point X=""" & point.X & """ Y=""" & point.Y & """ />"
End Sub

Private Sub printPoint3D(point As Point3D, sTerm As String, iTabs As Integer, iHandle As Integer)
    Print #iHandle, getTabs(iTabs) & "<" & sTerm & " X=""" & point.X & """ Y=""" & point.Y & """ Z=""" & point.Z & """ />"
End Sub


Private Function getRestartPoint(name As String, ByRef restartPoints() As RestartPoint) As RestartPoint
Dim i As Integer

    For i = 0 To UBound(restartPoints())
        If (name = restartPoints(i).rpName) Then
            getRestartPoint = restartPoints(i)
        End If
    Next
End Function

Private Sub reorganizeRestartPoints(ByRef maps() As Map, ByRef restartPoints() As RestartPoint)
Dim i As Integer
Dim o As Integer
Dim a As Integer

    For i = 0 To UBound(maps())
        For a = 0 To 4
            For o = 0 To UBound(restartPoints())
                If (maps(i).mapRestartRace(a).mapRestartPointName = restartPoints(o).rpName) Then
                    maps(i).mapRestartRace(a).mapRestartPoint = restartPoints(o)
                End If
            Next
        Next
    Next
End Sub

Private Function parsePoint(iHandle As Integer) As RestartPoint
Dim sLine As String

Dim tempRP As RestartPoint

Dim points() As Point3D
Dim chaosPoints() As Point3D

Dim iPoints As Integer
Dim iChaosPoints As Integer
Dim iMaps As Integer

    Do
        Line Input #iHandle, sLine
        
        trunc sLine
    
        If (Left$(sLine, 10) = "point_name") Then
            tempRP.rpName = Mid$(sLine, 13, Len(sLine) - 13)
        ElseIf (Left$(sLine, 6) = "point=") Then
            ReDim Preserve points(iPoints)
            points(iPoints) = parsePoint3D(sLine, 5)
            inc iPoints
        ElseIf (Left$(sLine, 10) = "chao_point") Then
            ReDim Preserve chaosPoints(iChaosPoints)
            chaosPoints(iChaosPoints) = parsePoint3D(sLine, 10)
            inc iChaosPoints
        ElseIf (Left$(sLine, 11) = "banned_race") Then
            tempRP.rpBannedRace = parseBannedRace(sLine)
        ElseIf (Left$(sLine, 3) = "bbs") Then
            tempRP.rpBBS = Mid$(sLine, 5)
        ElseIf (Left$(sLine, 8) = "loc_name") Then
            tempRP.rpLocName = Mid$(sLine, 10)
        End If
    Loop Until sLine = "point_end"
    
    tempRP.rpPoints = points
    tempRP.rpChaosPoints = chaosPoints
    
    parsePoint = tempRP
End Function

Private Function parsePoint3D(ByVal sLine As String, iStart As Integer) As Point3D
Dim positions() As String

Dim point As Point3D

    sLine = Mid$(sLine, iStart + 3)
    sLine = Left$(sLine, Len(sLine) - 1)
    
    positions = Split(sLine, ";")
    
    point.X = positions(0)
    point.Y = positions(1)
    point.Z = positions(2)
    
    parsePoint3D = point
End Function

Private Function parseBannedRace(ByVal sLine As String) As BannedRace
Dim Race As BannedRace
Dim sRace() As String

Dim i As Integer

    sLine = Mid$(sLine, 13)
    sLine = Mid$(sLine, 2)
    sLine = Left$(sLine, Len(sLine) - 1)
    
    sRace = Split(sLine, ";")
    
    If (UBound(sRace()) = 1) Then
        Race.brRace = getRace(sRace(0))
        Race.brRestartPointName = Mid$(sRace(1), 2)
        Race.brRestartPointName = Left$(Race.brRestartPointName, Len(Race.brRestartPointName) - 1)
    End If
    
    parseBannedRace = Race
End Function

Private Function parseArea(iHandle As Integer) As Map
Dim sLine As String

Dim tempMap As Map

Dim races(4) As MapRestart
Dim iRace As Integer

    Do
        Line Input #iHandle, sLine
        
        trunc sLine
        
        If (Left$(sLine, 5) = "range") Then
            tempMap.mapRange = parseRange(sLine)
        ElseIf (Left$(sLine, 4) = "race") Then
            races(iRace) = parseRace(sLine)
            inc iRace
        End If
    Loop Until sLine = "area_end"
    
    tempMap.mapRestartRace = races
    
    parseArea = tempMap
End Function

Private Function parseRange(ByVal sLine As String) As AreaRange
Dim tempRange As AreaRange

Dim sPoint() As String
Dim sPosition() As String

Dim point() As Point2D

Dim i As Integer
    
    sLine = Mid$(sLine, InStr(1, sLine, "{") + 1)
    sLine = Left$(sLine, InStrRev(sLine, "}") - 1)
    
    sPoint() = Split(sLine, "}")
    
    For i = 0 To UBound(sPoint()) - 1
        sPoint(i) = Mid$(sPoint(i), 2)
        If (Left$(sPoint(i), 1) = "{") Then sPoint(i) = Mid$(sPoint(i), 2)
        sPosition = Split(sPoint(i), ";")
        
        ReDim Preserve point(i)
        point(i).X = sPosition(0)
        point(i).Y = sPosition(1)
        
        tempRange.zMin = sPosition(2)
        tempRange.zMax = sPosition(3)
    Next
    
    tempRange.points = point
    
    parseRange = tempRange
End Function

Private Function parseRace(sLine As String) As MapRestart
Dim tempMR As MapRestart

    sLine = Mid$(sLine, InStr(1, sLine, "{") + 1)
    sLine = Left$(sLine, InStrRev(sLine, "}") - 1)
    
    tempMR.mapRace = getRace(Left$(sLine, InStr(1, sLine, ";") - 1))
    tempMR.mapRestartPointName = Mid$(sLine, InStr(1, sLine, ";") + 2)
    tempMR.mapRestartPointName = Left$(tempMR.mapRestartPointName, Len(tempMR.mapRestartPointName) - 1)
    
    parseRace = tempMR
End Function

Private Function getRace(Race As String) As Race
    Select Case Race
        Case "human"
            getRace = Human
        Case "darkelf"
            getRace = Darkelf
        Case "orc"
            getRace = Orc
        Case "dwarf"
            getRace = Dwarf
        Case "elf"
            getRace = Elf
    End Select
End Function

Private Function getRaceName(Race As Race) As String
    Select Case Race
        Case Human
            getRaceName = "human"
        Case Darkelf
            getRaceName = "darkelf"
        Case Orc
            getRaceName = "orc"
        Case Dwarf
            getRaceName = "dwarf"
        Case Elf
            getRaceName = "elf"
    End Select
End Function

Public Sub trunc(ByRef value As String)
    value = Replace$(value, " = ", "=")
    value = Replace$(value, vbTab, "")
    value = Trim$(value)
End Sub