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