1854 lines
72 KiB
VB.net
1854 lines
72 KiB
VB.net
Imports System.IO
|
||
Imports System.Text
|
||
Imports System.Runtime.Remoting.Metadata.W3cXsd2001
|
||
|
||
Public Class ScriptTools
|
||
|
||
Public Eng As Boolean
|
||
Public JapTextCounter As Integer
|
||
Public ColorCodes As List(Of CodeObject)
|
||
Public SpecialCodes As List(Of CodeObject)
|
||
Public Names As List(Of NameElement)
|
||
|
||
Public ScriptCodes As List(Of CodeObject)
|
||
|
||
Public Sub New()
|
||
|
||
'Dim e = New Ionic.Zlib.DeflateStream(,)
|
||
|
||
|
||
|
||
ColorCodes = New List(Of CodeObject)
|
||
|
||
ColorCodes.Add(New CodeObject With {.code = 11, .value = "yellow"})
|
||
ColorCodes.Add(New CodeObject With {.code = 1, .value = "white"})
|
||
ColorCodes.Add(New CodeObject With {.code = 3, .value = "gray"})
|
||
ColorCodes.Add(New CodeObject With {.code = 5, .value = "pink"})
|
||
ColorCodes.Add(New CodeObject With {.code = 7, .value = "blue"})
|
||
ColorCodes.Add(New CodeObject With {.code = 9, .value = "green"})
|
||
ColorCodes.Add(New CodeObject With {.code = 13, .value = "orange"})
|
||
ColorCodes.Add(New CodeObject With {.code = 4, .value = "gray4"})
|
||
ColorCodes.Add(New CodeObject With {.code = 18, .value = "color18"})
|
||
|
||
|
||
|
||
|
||
SpecialCodes = New List(Of CodeObject)
|
||
SpecialCodes.Add(New CodeObject With {.code = &H1C0, .value = "Jkrestik"})
|
||
'SpecialCodes.Add(New CodeObject With {.code = &H2F8, .value = "Jkvadrat"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H343, .value = "Jcircle"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H642, .value = "Jtreug"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H66B, .value = "JskobkL"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H66C, .value = "JskobkR"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H67E, .value = "Jheart"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H6F4, .value = "Jdoublekrug"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H70F, .value = "Jmelody"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H716, .value = "Jfilledkrug"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H717, .value = "Jfilledtriag"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H7EA, .value = "Jstar"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H96E, .value = "Jmale"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H96F, .value = "Jfemale"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H999, .value = "Jcircle2"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H9AC, .value = "JrotateL"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H9AD, .value = "JrotateR"})
|
||
SpecialCodes.Add(New CodeObject With {.code = &H9C3, .value = "Jsquare2"})
|
||
|
||
|
||
|
||
Names = New List(Of NameElement)
|
||
Names.Add(New NameElement With {.Codes = "2C012D01", .Dehash = "Майя"})
|
||
Names.Add(New NameElement With {.Codes = "ыь", .Dehash = "Эйкичи"})
|
||
Names.Add(New NameElement With {.Codes = "2ѓ>", .Dehash = "Гинко"})
|
||
Names.Add(New NameElement With {.Codes = "БУ", .Dehash = "Лиза"})
|
||
Names.Add(New NameElement With {.Codes = "2E01", .Dehash = "Дзюн"})
|
||
Names.Add(New NameElement With {.Codes = "87048705", .Dehash = "Фудзи"})
|
||
Names.Add(New NameElement With {.Codes = "4D021500C700", .Dehash = "Юкино"})
|
||
Names.Add(New NameElement With {.Codes = "1E07C201", .Dehash = "Кацуя"})
|
||
Names.Add(New NameElement With {.Codes = "1100A000A000", .Dehash = "Улала"})
|
||
Names.Add(New NameElement With {.Codes = "46081705F6048D004707", .Dehash = "Капитан Симадзу"})
|
||
Names.Add(New NameElement With {.Codes = "0604D601F902DB00", .Dehash = "Саеко"})
|
||
Names.Add(New NameElement With {.Codes = "83013501CA003602", .Dehash = "Баофу"})
|
||
Names.Add(New NameElement With {.Codes = "0604D601F902DB00", .Dehash = "Саеко"})
|
||
Names.Add(New NameElement With {.Codes = "0604D601F902DB00", .Dehash = "Саеко"})
|
||
Names.Add(New NameElement With {.Codes = "0604D601F902DB00", .Dehash = "Саеко"})
|
||
Names.Add(New NameElement With {.Codes = "0604D601F902DB00", .Dehash = "Саеко"})
|
||
|
||
|
||
'Script codes
|
||
ScriptCodes = New List(Of CodeObject)
|
||
ScriptCodes.Add(New CodeObject With {.code = &H60, .value = "__GetVar"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H1, .value = "_if1Go>>"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H2, .value = "_if0Go>>"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H4, .value = "_if!=Go>"})
|
||
'ScriptCodes.Add(New CodeObject With {.code = &H1, .value = "_DialEnd"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H6, .value = "if>!=<Go"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H7, .value = "_JumpTo>"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H8, .value = "_SetTemp"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H9, .value = "_AddVars"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &HD, .value = "__GoSub>"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &HE, .value = "__Return-->"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H10, .value = "_RndmzTo"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H12, .value = "__WaitTo"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H13, .value = "TextShow"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H1A, .value = "GetInput"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H1B, .value = "VarToTxt"})
|
||
|
||
'Avatar
|
||
'ScriptCodes.Add(New CodeObject With {.code = &H1C, .value = "AvtrLoad"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H1E, .value = "AvtrLoad", .descr = "AvatarID"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H1F, .value = "AvtEmSet", .descr = "TEST IT!"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H20, .value = "AvUnload", .descr = "or wait"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H22, .value = "_AvaFade", .descr = "opacity, speed?"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H23, .value = "AvaFWait"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H22, .value = "AvaSetXY"})
|
||
'ScriptCodes.Add(New CodeObject With {.code = &H23, .value = "AvaLdWit"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H26, .value = "WindShow"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H27, .value = "WinClose"})
|
||
|
||
'ScriptCodes.Add(New CodeObject With {.code = &H26, .value = "CamRotat"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H28, .value = "CamrMove"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H2A, .value = "CamrZoom"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H2C, .value = "CamSetXY"})
|
||
|
||
'ScriptCodes.Add(New CodeObject With {.code = &H30, .value = "CharLoad"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H33, .value = "CharLoad", .descr = "spriteID"})
|
||
'ScriptCodes.Add(New CodeObject With {.code = &H33, .value = "CharSet?"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H34, .value = "CharSett", .descr = "ID, SpriteID, X, Y, Z, Dir, ?"})
|
||
|
||
|
||
'ScriptCodes.Add(New CodeObject With {.code = &H37, .value = "ChSprPag"})
|
||
'ScriptCodes.Add(New CodeObject With {.code = &H3C, .value = "__SprSet"})
|
||
'ScriptCodes.Add(New CodeObject With {.code = &H3E, .value = "ChMvWait"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H39, .value = "CSetAnim"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H41, .value = "CRotToPl"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H45, .value = "CtrlLock"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H46, .value = "CtrUnlck"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H48, .value = "ChSubSet", .descr = "ID, SubroutineID, ?, ?"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H4A, .value = "CRotaDef"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H51, .value = "DungLoad"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H52, .value = "EvntLoad"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H53, .value = "CityLoad"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H59, .value = "VideoPly"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H5C, .value = "PausInit"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H5D, .value = "PauseFr_"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H5E, .value = "_VarTrue"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H5F, .value = "_VarFlse"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H73, .value = "__VarDec"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H74, .value = "__VarSet"})
|
||
|
||
'ScriptCodes.Add(New CodeObject With {.code = &H7A, .value = "__FullHP"})
|
||
'ScriptCodes.Add(New CodeObject With {.code = &H7C, .value = "__FullSP"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H7B, .value = "__GetVar"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H83, .value = "_isChar?"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H87, .value = "_getMney"})
|
||
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H92, .value = "ScrnFade"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H9B, .value = "MuscLoad"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H99, .value = "MusicPly"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H9E, .value = "SundStop"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H9F, .value = "MuscFade"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &HAC, .value = "ScreenNegative"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &HC3, .value = "SoundPly", .descr = "ID, Vol"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &HD4, .value = "meshMove"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &HD5, .value = "meshTurn"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &HD6, .value = "meshWait"})
|
||
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &HDC, .value = "FXSpLoad"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &HDD, .value = "FXSprSet"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &HE0, .value = "FXSprRun"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &HED, .value = "BattleLoad"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &HF3, .value = "ResetAll"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H100, .value = "WavMusic"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H103, .value = "ScreenClrFilter"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H10E, .value = "ShowTextInput"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H10F, .value = "LoadInputIdToVar"})
|
||
|
||
ScriptCodes.Add(New CodeObject With {.code = &H113, .value = "LoadDung", .descr = "Load dungeon XXYY. XX - Dungeon ID, YY - Dungeon exit"})
|
||
ScriptCodes.Add(New CodeObject With {.code = &H12B, .value = "LoadEvnt", .descr = "goto load event subroutine *(80072c70 + ID * 4)"})
|
||
|
||
' Enabled Chars
|
||
|
||
'80082E74 - 1 Maya
|
||
' EC8 - 2 Ulala
|
||
' F1C - 3 Katsuya
|
||
' F70 - 4 Baofu
|
||
' FC4 - 5 Nanjo
|
||
' 3018 - 6 Elly
|
||
' 306C - 7 Tatsuya
|
||
|
||
|
||
|
||
End Sub
|
||
|
||
Public Sub importTextFile(ByVal inputJfile As String, ByRef DialCount As Integer, ByRef LineCount As Integer)
|
||
|
||
Dim f = New List(Of Byte)
|
||
Dim TextPointers = New List(Of Integer)
|
||
Dim TextInputComparePointers = New List(Of Integer)
|
||
|
||
Dim txt = My.Computer.FileSystem.ReadAllText(inputJfile, Encoding.GetEncoding(1251))
|
||
Dim t As List(Of String) = Split(txt, vbCrLf).ToList
|
||
If t(0) <> "-----INIT SECTION" Then MsgBox("File not valid (no init section)") : Exit Sub
|
||
If t(2) <> "-----CHARACTER DATA SECTION" Then MsgBox("File not valid (no chardata section)") : Exit Sub
|
||
If t(4) <> "-----POINTERS DATA SECTION" Then MsgBox("File not valid (no pointers section)") : Exit Sub
|
||
If t(6) <> "-----SCRIPT DATA SECTION" Then MsgBox("File not valid (no script section)") : Exit Sub
|
||
If t(8) <> "-----TEXT SECTION" Then MsgBox("File not valid (no TEXT section)") : Exit Sub
|
||
|
||
'Recompiling scripts
|
||
|
||
'Init
|
||
Dim t1 = Split(t(1), ",").ToList
|
||
If t1.Count <> 6 Then MsgBox("Not valid init section!") : Exit Sub
|
||
|
||
For Each ii In t1
|
||
If Not IsNumeric(ii) Then MsgBox("Not numeric in INIT sect") : Exit Sub
|
||
f.AddRange(BitConverter.GetBytes(Convert.ToInt32(ii)).ToList)
|
||
Next
|
||
|
||
'CharData
|
||
Dim t3 = Split(t(3), ",").ToList
|
||
If t3.Count <> BitConverter.ToInt32(f.ToArray, 8) * 72 / 4 Then MsgBox("Not valid CHAR section!") : Exit Sub
|
||
|
||
For Each ii In t3
|
||
If Not IsNumeric(ii) Then MsgBox("Not numeric in CHAR sect") : Exit Sub
|
||
f.AddRange(BitConverter.GetBytes(Convert.ToInt32(ii)).ToList)
|
||
Next
|
||
|
||
|
||
'PointersData
|
||
Dim t5 = Split(t(5), ",").ToList
|
||
If t5.Count <> (BitConverter.ToInt32(f.ToArray, 16) - BitConverter.ToInt32(f.ToArray, 12)) / 4 Then MsgBox("Not valid REFS section!") : Exit Sub
|
||
|
||
For ii = 0 To t5.Count - 1
|
||
|
||
If Not IsNumeric(t5(ii)) Then MsgBox("Not numeric in REFS sect") : Exit Sub
|
||
If ii Mod 2 = 0 Then 'Если это параметр 13h (с чётным номером байта) - добавляем адрес в таблицу поинтеров текста
|
||
Dim bts() = BitConverter.GetBytes(Convert.ToInt32(t5(ii)))
|
||
If bts(0) = &H13 And bts(1) = 0 And bts(2) = 0 Then
|
||
TextPointers.Add(t5(ii + 1))
|
||
End If
|
||
|
||
If bts(0) = &HF And bts(1) = 1 And bts(2) = 0 Then
|
||
TextInputComparePointers.Add(t5(ii + 1))
|
||
End If
|
||
|
||
End If
|
||
|
||
|
||
|
||
|
||
f.AddRange(BitConverter.GetBytes(Convert.ToInt32(t5(ii))).ToList)
|
||
Next
|
||
|
||
'ScriptsData
|
||
Dim t7 = Split(t(7), ",").ToList
|
||
If t7.Count <> (BitConverter.ToInt32(f.ToArray, 20) - BitConverter.ToInt32(f.ToArray, 16)) / 4 Then MsgBox("Not valid SCRIPT section!") : Exit Sub
|
||
|
||
For Each ii In t7
|
||
If Not IsNumeric(ii) Then MsgBox("Not numeric in SCRIPT sect") : Exit Sub
|
||
f.AddRange(BitConverter.GetBytes(Convert.ToInt32(ii)).ToList)
|
||
Next
|
||
|
||
|
||
Dim idsection As Boolean = True
|
||
|
||
'Разбор текста и запихивание его в файл
|
||
Dim tx = Split(txt, "-----TEXT SECTION" & vbCrLf)(1)
|
||
Dim x = 0
|
||
Dim accum = New List(Of Byte)
|
||
Dim currentDialog As Integer
|
||
Dim currentInputCompare As Integer
|
||
Do
|
||
|
||
'Comments to end of line!
|
||
If tx(x) = "\" And tx(x + 1) = "\" Then
|
||
getEndOfLine(tx, x)
|
||
Continue Do
|
||
End If
|
||
|
||
|
||
If tx(x) = "[" Then
|
||
Dim skRes = getFromSkobki(tx, x)
|
||
|
||
If skRes = "input" Then 'Формирование данных для сравнения введённого текста. Нужно переписать поинтер последующего текста
|
||
|
||
f(TextInputComparePointers(currentInputCompare)) = BitConverter.GetBytes(accum.Count)(0)
|
||
f(TextInputComparePointers(currentInputCompare) + 1) = BitConverter.GetBytes(accum.Count)(1) 'Установка поинтера для сравнения введённого в игре текста
|
||
f(TextInputComparePointers(currentInputCompare) + 2) = BitConverter.GetBytes(accum.Count)(2)
|
||
currentInputCompare += 1
|
||
|
||
'Здесь заносим данные для сравнения посимвольно
|
||
Do While tx(x) <> "["
|
||
If tx(x) & tx(x + 1) = vbCrLf Then accum.AddRange({&H1, &H11}) : LineCount += 1 : x += 2 : Continue Do
|
||
accum.AddRange({Asc(tx(x)), 0}) 'simple char
|
||
x += 1
|
||
Loop
|
||
|
||
skRes = getFromSkobki(tx, x)
|
||
If skRes = "EOD3" Then
|
||
accum.AddRange({&H3, &H11})
|
||
f(TextPointers(currentDialog)) = BitConverter.GetBytes(accum.Count)(0)
|
||
f(TextPointers(currentDialog) + 1) = BitConverter.GetBytes(accum.Count)(1) 'Обновляем последний поинтер на текст
|
||
f(TextPointers(currentDialog) + 2) = BitConverter.GetBytes(accum.Count)(2) : x += 2 : idsection = True : Continue Do
|
||
'Полной конец всех строк для проверки + включаем секцию ID для проверки.
|
||
Else
|
||
MsgBox("Invalid exit from input test! " & inputJfile) : Exit Sub
|
||
End If
|
||
End If
|
||
|
||
|
||
If IsNumeric(skRes) And idsection Then
|
||
idsection = False
|
||
If currentDialog <> skRes Then
|
||
MsgBox("Error in IDs!" & vbCrLf & " id: " & currentDialog & vbCrLf & "SkRes: " & skRes & vbCrLf & "F: " & inputJfile, MsgBoxStyle.Critical)
|
||
Exit Sub
|
||
End If
|
||
DialCount += 1
|
||
x = x + 2
|
||
Continue Do 'its simple ID
|
||
End If
|
||
|
||
If skRes = "EOD" Then
|
||
accum.AddRange({&H6, &H11, &H2, &H11, &H3, &H11}) : currentDialog += 1
|
||
If currentDialog > TextPointers.Count - 1 Then Exit Do 'Last DIAL in file, but not EOF
|
||
f(TextPointers(currentDialog)) = BitConverter.GetBytes(accum.Count)(0)
|
||
f(TextPointers(currentDialog) + 1) = BitConverter.GetBytes(accum.Count)(1) 'Its NEW LINE
|
||
f(TextPointers(currentDialog) + 2) = BitConverter.GetBytes(accum.Count)(2)
|
||
If tx(x) & tx(x + 1) = vbCrLf Then x += 2 : idsection = True : Continue Do
|
||
End If
|
||
|
||
If skRes = "EOD723" Then
|
||
accum.AddRange({&H7, &H11, &H2, &H11, &H3, &H11}) : currentDialog += 1
|
||
If currentDialog > TextPointers.Count - 1 Then Exit Do 'Last DIAL in file, but not EOF
|
||
f(TextPointers(currentDialog)) = BitConverter.GetBytes(accum.Count)(0)
|
||
f(TextPointers(currentDialog) + 1) = BitConverter.GetBytes(accum.Count)(1) 'Its NEW LINE
|
||
f(TextPointers(currentDialog) + 2) = BitConverter.GetBytes(accum.Count)(2) : x += 2 : idsection = True : Continue Do
|
||
End If
|
||
|
||
If skRes = "EOD3" Then
|
||
accum.AddRange({&H3, &H11}) : currentDialog += 1
|
||
f(TextPointers(currentDialog)) = BitConverter.GetBytes(accum.Count)(0)
|
||
f(TextPointers(currentDialog) + 1) = BitConverter.GetBytes(accum.Count)(1) 'Its NEW LINE
|
||
f(TextPointers(currentDialog) + 2) = BitConverter.GetBytes(accum.Count)(2) : x += 2 : idsection = True : Continue Do
|
||
End If
|
||
|
||
|
||
|
||
If skRes = "EOw" Then
|
||
accum.AddRange({&H6, &H11, &H2, &H11}) 'Its END OF WINDOW
|
||
Continue Do
|
||
End If
|
||
|
||
If skRes = "EndSelection" Then
|
||
accum.AddRange({&H9, &H11, &H2, &H11, &H3, &H11}) : currentDialog += 1
|
||
If currentDialog > TextPointers.Count - 1 Then currentDialog -= 1 : Exit Do 'Last DIAL in file
|
||
f(TextPointers(currentDialog)) = BitConverter.GetBytes(accum.Count)(0)
|
||
f(TextPointers(currentDialog) + 1) = BitConverter.GetBytes(accum.Count)(1) 'Its NEW LINE
|
||
f(TextPointers(currentDialog) + 2) = BitConverter.GetBytes(accum.Count)(2)
|
||
If tx(x) & tx(x + 1) = vbCrLf Then x += 2 : idsection = True : Continue Do
|
||
End If
|
||
|
||
If skRes = "EOF" Then accum.AddRange({&H6, &H11, &H2, &H11, &H3, &H11}) : Exit Do 'END OF FILE!
|
||
If skRes = "EOF3" Then accum.AddRange({&H3, &H11}) : Exit Do 'END OF FILE!
|
||
If skRes = "EOF723" Then accum.AddRange({&H7, &H11, &H2, &H11, &H3, &H11}) : Exit Do 'END OF FILE!
|
||
|
||
|
||
If skRes = "surname" Then accum.AddRange({&H20, &H11}) : Continue Do '2011 - surname!!!
|
||
If skRes = "name" Then accum.AddRange({&H21, &H11}) : Continue Do
|
||
'2211 - Nick
|
||
|
||
If skRes = "pause" Then
|
||
accum.AddRange({&H5, &H12})
|
||
If tx(x) <> vbCr And tx(x) <> "[" Then 'NEED TO CONVERT BACK!
|
||
accum.AddRange({Math.Abs(Asc(tx(x)) - 32), 0}) : x += 1 : Continue Do 'Pause + 2 byte length (30 ~ 1 sec)
|
||
Else
|
||
If tx(x) = "[" Then
|
||
|
||
accum.Add(getFromSkobki(tx, x))
|
||
accum.Add(0) : Continue Do
|
||
Else
|
||
accum.AddRange({15, 0}) : Continue Do
|
||
End If
|
||
|
||
End If
|
||
Continue Do
|
||
End If
|
||
If skRes = "SelectionMenu" Then accum.AddRange({&H8, &H12}) : Continue Do
|
||
|
||
If skRes = "EOw0000" Then accum.AddRange({0, 0}) : Continue Do
|
||
|
||
If skRes.Length = 4 Then 'Try to parse other hex codes
|
||
accum.AddRange(SoapHexBinary.Parse(skRes).Value.ToList)
|
||
'x += 2
|
||
Continue Do
|
||
|
||
End If
|
||
|
||
If IsNumeric(skRes) Then
|
||
accum.AddRange(BitConverter.GetBytes(Convert.ToInt16(skRes)).ToList)
|
||
Continue Do
|
||
'Simply Code
|
||
Else
|
||
If skRes.Length > 4 Then
|
||
Dim d As String = skRes
|
||
If d.Substring(0, 4) = "col=" Then
|
||
Dim a As Byte = ColorCodes.Find(Function(q) q.value = d.Substring(4)).code 'color command
|
||
accum.AddRange({&H2E, &H12})
|
||
accum.AddRange({a, &H0})
|
||
Continue Do
|
||
End If
|
||
|
||
Dim spec As CodeObject = SpecialCodes.Find(Function(q) q.value = skRes) 'Special code convert IF
|
||
If Not IsNothing(spec) Then
|
||
accum.AddRange(BitConverter.GetBytes(Convert.ToInt16(spec.code)).ToList)
|
||
Continue Do
|
||
End If
|
||
|
||
End If
|
||
|
||
End If
|
||
|
||
|
||
End If
|
||
|
||
If tx(x) = vbTab Then accum.AddRange({&H31, &H11}) : x += 1 : Continue Do 'Tab and enter
|
||
|
||
If tx(x) & tx(x + 1) = vbCrLf Then accum.AddRange({&H1, &H11}) : LineCount += 1 : x += 2 : Continue Do
|
||
If tx(x) = vbLf Then accum.AddRange({&H1, &H11}) : LineCount += 1 : x += 1 : Continue Do
|
||
|
||
If Form1.NewTextMODE.Checked Then 'Новый режим вывода текста!!!
|
||
Dim SimpleTextAccum = New List(Of Byte)
|
||
Dim readCounter As Byte = 1
|
||
|
||
Do
|
||
If Asc(tx(x)) < 32 Or Asc(tx(x)) = 91 Then x -= 1 : Exit Do
|
||
SimpleTextAccum.Add(Asc(tx(x)))
|
||
x += 1
|
||
Loop
|
||
|
||
'if 1 or 2 bytes
|
||
If SimpleTextAccum.Count = 1 Then accum.AddRange({SimpleTextAccum(0), 0}) : GoTo Exitif
|
||
If SimpleTextAccum.Count = 2 Then accum.AddRange({SimpleTextAccum(0), 0, SimpleTextAccum(1), 0}) : GoTo Exitif
|
||
If SimpleTextAccum.Count = 0 Then GoTo Exitif
|
||
|
||
accum.Add(SimpleTextAccum.Count)
|
||
If SimpleTextAccum.Count > 47 Then Debug.WriteLine("W: text > 47(" & SimpleTextAccum.Count & ") Dial: " & currentDialog & " File: " & inputJfile & " ---" & String.Join("", SimpleTextAccum.ToArray))
|
||
accum.Add(&H20) 'command & length
|
||
accum.AddRange(SimpleTextAccum) 'attach textline
|
||
If SimpleTextAccum.Count And 1 Then accum.Add(0) ' if and 1 - add empty byte
|
||
Else
|
||
accum.AddRange({Asc(tx(x)), 0}) 'Finally - simple char
|
||
End If
|
||
Exitif:
|
||
|
||
x += 1
|
||
Loop While x < tx.Length - 1
|
||
|
||
If currentDialog <> TextPointers.Count - 1 Then
|
||
MsgBox("Pointers dont match text!" & vbCrLf & inputJfile & vbCrLf & "EODs: " & currentDialog + 1 & " <> pointers: " & TextPointers.Count)
|
||
|
||
End If
|
||
|
||
f.AddRange(accum)
|
||
Dim fArr = f.ToArray
|
||
|
||
|
||
'Сохраняем выходной файл
|
||
My.Computer.FileSystem.WriteAllBytes(inputJfile & ".TRNSL", f.ToArray, False)
|
||
'MsgBox("Imported. Saved to " & inputJfile & ".TRNSL")
|
||
|
||
End Sub
|
||
|
||
'Scobki encoding
|
||
Public Function getFromSkobki(ByRef tx As String, ByRef x As Integer)
|
||
x = x + 1
|
||
Dim accum = ""
|
||
Do While tx(x) <> "]"
|
||
accum &= tx(x)
|
||
x += 1
|
||
Loop
|
||
x += 1
|
||
Return accum
|
||
|
||
End Function
|
||
|
||
Public Sub getEndOfLine(ByRef tx As String, ByRef x As Integer)
|
||
|
||
Do
|
||
x += 1
|
||
Loop While tx(x) <> vbCr And tx(x + 1) <> vbLf
|
||
x += 2
|
||
|
||
End Sub
|
||
|
||
Public Sub ExportTextFile(ByVal inputJfile As String, ByVal inputEfile As String)
|
||
|
||
If Not File.Exists(inputJfile) Then MsgBox("Japanese resource file not found!!", MsgBoxStyle.Critical) : Exit Sub
|
||
Dim JRes = New ScriptFile
|
||
Dim ERes = New ScriptFile
|
||
|
||
Dim JapBytes = My.Computer.FileSystem.ReadAllBytes(inputJfile)
|
||
|
||
JRes.filename = Path.GetFileNameWithoutExtension(inputJfile)
|
||
|
||
If File.Exists(inputEfile) Then
|
||
Eng = True
|
||
ERes.filename = Path.GetFileNameWithoutExtension(inputEfile)
|
||
ParseResource(My.Computer.FileSystem.ReadAllBytes(inputEfile), ERes)
|
||
ParseText(ERes, True)
|
||
End If
|
||
|
||
ParseResource(JapBytes, JRes)
|
||
ParseText(JRes, False)
|
||
|
||
|
||
Dim combText = CombineParsedText(ERes, JRes)
|
||
If IsNothing(combText) Then Exit Sub
|
||
|
||
Dim combResData = compileData(JRes)
|
||
|
||
If JRes.Text.Count = 0 Then Exit Sub
|
||
My.Computer.FileSystem.WriteAllText(inputJfile & ".txt", combResData & combText, False)
|
||
|
||
End Sub
|
||
|
||
Public Function ConvertPSPTextFile(ByVal JapBytes As Byte())
|
||
|
||
|
||
Dim JRes = New ScriptFile
|
||
Dim ERes = New ScriptFile
|
||
|
||
ParseResource(JapBytes, JRes)
|
||
ParseText(JRes, False)
|
||
|
||
Dim combText = CombineParsedText(ERes, JRes)
|
||
If IsNothing(combText) Then Return ""
|
||
|
||
Dim combResData = compileData(JRes)
|
||
|
||
If JRes.Text.Count = 0 Then Return ""
|
||
'My.Computer.FileSystem.WriteAllText(inputJfile & ".txt", combResData & combText, False, Encoding.GetEncoding(1251))
|
||
|
||
Return combResData & combText
|
||
|
||
|
||
End Function
|
||
|
||
|
||
Public Function compileData(ByRef JRes As ScriptFile)
|
||
|
||
Dim txt As String = "-----INIT SECTION" & vbCrLf
|
||
txt &= $"{JRes.hz1},{JRes.hz2},{JRes.CharsCount},{JRes.RefsTablePointer},{JRes.ScriptTablePointer},{JRes.StartTextPointer}" & vbCrLf
|
||
|
||
txt &= "-----CHARACTER DATA SECTION" & vbCrLf
|
||
Dim cdata = JRes.CharsArr.ToArray
|
||
For a = 0 To JRes.CharsCount * 72 - 1 Step 4
|
||
txt &= BitConverter.ToInt32(cdata, a) & ","
|
||
Next
|
||
|
||
txt = txt.Substring(0, txt.Length - 1) 'Отрезаем последнюю запятую
|
||
|
||
txt &= vbCrLf & "-----POINTERS DATA SECTION" & vbCrLf
|
||
For a = 0 To JRes.refstable.Count - 1
|
||
txt &= JRes.refstable(a) & ","
|
||
Next
|
||
|
||
txt = txt.Substring(0, txt.Length - 1) 'Отрезаем последнюю запятую
|
||
|
||
txt &= vbCrLf & "-----SCRIPT DATA SECTION" & vbCrLf
|
||
For a = 0 To JRes.ScriptsTable.Count - 1
|
||
txt &= JRes.ScriptsTable(a) & ","
|
||
Next
|
||
txt = txt.Substring(0, txt.Length - 1) 'Отрезаем последнюю запятую
|
||
|
||
Return txt & vbCrLf
|
||
|
||
End Function
|
||
|
||
|
||
Public Function CombineParsedText(ByRef ERes As ScriptFile, ByRef JRes As ScriptFile)
|
||
Dim txt As String = "-----TEXT SECTION" & vbCrLf
|
||
|
||
If Not IsNothing(ERes.ParsedText) Then 'if englist is loaded
|
||
If ERes.ParsedText.Count <> JRes.ParsedText.Count Then
|
||
MsgBox(String.Format("Error parsing text! Eng and jap dialogs doesnt have same count!!! {0} vs {1}" & vbCrLf & "{2}", ERes.ParsedText.Count, JRes.ParsedText.Count, JRes.filename))
|
||
Return Nothing
|
||
End If
|
||
|
||
End If
|
||
|
||
For p = 0 To JRes.ParsedText.Count - 1
|
||
|
||
If Not IsNothing(ERes.ParsedText) Then 'load english version in comment
|
||
Dim etxt = Split(ERes.ParsedText(p), vbCrLf)
|
||
txt &= "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" & vbCrLf
|
||
For Each t In etxt
|
||
If Form1.UnKudosScript.Checked Then t = StringsOffsetEditorvb.Unkudos(t)
|
||
txt &= "\\ " & t & vbCrLf
|
||
Next
|
||
End If
|
||
txt &= "[" & p & "]" & vbCrLf
|
||
txt &= JRes.ParsedText(p) & vbCrLf
|
||
|
||
Next
|
||
|
||
Return txt
|
||
|
||
|
||
End Function
|
||
|
||
'specialCodesParse
|
||
'c001 f802 4303 4206 6b06 6c06 7e06 f406 0f07 1607 1707 ea07 6e09 6f09 9909 ac09 ad09 c309
|
||
|
||
|
||
|
||
Public Sub ParseText(ByRef Res As ScriptFile, ByVal isEnglish As Boolean)
|
||
|
||
Res.ParsedText = New List(Of String)
|
||
Dim a = 0 'counter
|
||
Dim txt As String = ""
|
||
|
||
If Res.Text.Count = 0 Then Exit Sub
|
||
|
||
Dim m As List(Of Byte) = Res.Text
|
||
|
||
If Not isEnglish Then GoTo isJapanese
|
||
|
||
|
||
' BitConverter.IsLittleEndian = False
|
||
|
||
|
||
Do
|
||
Dim c = get2(m, a)
|
||
'Dim c = Res.Text(a)
|
||
|
||
If c = &H122E Then Dim c2 = get2(m, a + 2) : txt &= "[" & ColorCodes.Find(Function(q) q.code = c2).value & "]" : a += 4 : Continue Do ' код цвета
|
||
If c = &H1101 Then
|
||
txt &= vbCrLf
|
||
a += 2
|
||
Continue Do ' Перенос строки
|
||
End If
|
||
If c = &H1208 Then txt &= "[Sel=" & get2(m, a + 2) & "]" : a += 4 : Continue Do
|
||
|
||
If c = &H1121 Then txt &= "[name]" : a += 2 : Continue Do 'Имя игрока из IS
|
||
If c = &H1120 Then txt &= "[surname]" : a += 2 : Continue Do 'Фамилия игрока из IS
|
||
'If c = &H1122 Then txt &= "[surname]" : a += 2 : Continue Do 'Фамилия игрока из IS
|
||
|
||
|
||
|
||
'If c = 5 Then
|
||
|
||
' If Res.Text(a + 1) = &H1E Then
|
||
' txt &= "[p]" : a += 2 : Continue Do 'Пауза
|
||
|
||
' End If
|
||
'End If
|
||
|
||
'ЧИТАЕМ ТЕКСТ
|
||
If c = &H1136 Then
|
||
|
||
a += 2
|
||
Dim curChr As Byte
|
||
Do
|
||
curChr = m(a)
|
||
If curChr = 0 Then a += 1 : Exit Do
|
||
txt &= Chr(curChr)
|
||
a += 1
|
||
Loop
|
||
|
||
If a And 1 Then a += 1
|
||
|
||
Continue Do
|
||
|
||
End If
|
||
|
||
'SIMPLE CHAR WITHOUT COMMAND
|
||
|
||
Dim aaa = SpecialCodes.Find(Function(q) q.code = c)
|
||
If IsNothing(aaa) Then
|
||
'Dim curCode0 = BitConverter.GetBytes(c)(0) 'Обрабатываем первый байт иероглифа и заменяем печатным текстом
|
||
'If curCode0 < 32 Then curCode0 += 32
|
||
txt &= m(a).ToString("X2") & m(a + 1).ToString("X2")
|
||
Else
|
||
txt &= "[" & aaa.value & "]" 'Если есть специальный код
|
||
End If
|
||
|
||
|
||
a += 2
|
||
Dim PointIndex As Integer = Res.textPointers.FindIndex(Function(x) x = a)
|
||
|
||
'Если дошли до след строки в поинтерах или это байт вне файла, то добавляем последнюю строку и выходим
|
||
If PointIndex > 0 Or a = Res.Text.Count Then
|
||
Res.ParsedText.Add(txt) : txt = ""
|
||
End If
|
||
|
||
|
||
Loop While a < Res.Text.Count
|
||
|
||
|
||
Exit Sub
|
||
isJapanese:
|
||
|
||
|
||
Do
|
||
Dim c = get2(m, a)
|
||
If c = &H122E Then 'Парсим код цвета текста
|
||
txt &= "[col=" & ColorCodes.Find(Function(q) q.code = get2(m, a + 2)).value & "]"
|
||
a += 4
|
||
GoTo endlineTest
|
||
End If
|
||
|
||
|
||
|
||
If c = &H1101 Then txt &= vbCrLf : a += 2 : GoTo endlineTest ' Перенос строки
|
||
If c = &H1120 Then txt &= " " : a += 2 : GoTo endlineTest ' PSP Space!!!
|
||
If c = &H1131 Then txt &= vbTab : a += 2 : GoTo endlineTest ' Табуляция (+12 пикс)
|
||
If c = &H1205 Then txt &= "[pause][" & get2(m, a + 2) & "]" : a += 4 : GoTo endlineTest ' Пауза при воспроизведении диалога
|
||
If c = &H1208 Then txt &= "[SelectionMenu][" & get2(m, a + 2) & "]" : a += 4 : GoTo endlineTest ' Пауза 1с при воспроизведении диалога
|
||
|
||
|
||
If c = &H1121 Then txt &= "[name]" : a += 2 : GoTo endlineTest 'Имя игрока
|
||
If c = &H1122 Then txt &= "[surname]" : a += 2 : GoTo endlineTest 'Фамилия игрока
|
||
|
||
|
||
If c = &H1109 Then
|
||
If get2(m, a + 2) = &H1102 Then
|
||
If get2(m, a + 4) = &H1103 Then 'Выбор варианта ответа!
|
||
txt &= "[EndSelection]"
|
||
'Res.ParsedText.Add(txt) : txt = ""
|
||
a += 6 : GoTo endlineTest
|
||
End If
|
||
End If
|
||
End If
|
||
|
||
|
||
If c = &H1106 Then
|
||
If get2(m, a + 2) = &H1102 Then
|
||
If get2(m, a + 4) = &H1103 Then 'Закрыть окна диалога!
|
||
If a + 6 > m.Count - 1 Then txt &= "[EOF]" Else txt &= "[EOD]" 'End of Dialog or End of File
|
||
'Res.ParsedText.Add(txt) : txt = ""
|
||
a += 6 : GoTo endlineTest
|
||
Else
|
||
If a + 6 > m.Count - 1 Then txt &= "[EOF]" Else txt &= "[EOw]" 'End of WINDOW without close!
|
||
'Res.ParsedText.Add(txt) : txt = "" :
|
||
a += 4 : GoTo endlineTest
|
||
End If
|
||
End If
|
||
End If
|
||
|
||
|
||
If c = &H1103 Then
|
||
If a + 4 > m.Count - 1 Then txt &= "[EOF3]" Else txt &= "[EOD3]" 'End of Dialog or End of File
|
||
a += 2 : GoTo endlineTest
|
||
End If
|
||
|
||
|
||
|
||
If c And &H1000 Then 'COMMAND PARSE
|
||
|
||
Dim comLen = c >> 8 'command length check
|
||
Dim comCode = c And &HFF
|
||
|
||
|
||
Dim c1 = m(a) : Dim c2 = m(a + 1)
|
||
|
||
Dim gg = c2 And 15
|
||
|
||
'Dim gg = comLen
|
||
|
||
For byteskip = 1 To gg
|
||
txt &= "[" & c1.ToString("X2") & c2.ToString("X2") & "]"
|
||
a += 2
|
||
c1 = m(a) : c2 = m(a + 1)
|
||
Next
|
||
|
||
|
||
|
||
ElseIf c And &H2000 Then 'Если строка в моём однобайтном формате
|
||
|
||
Dim charNum = c And &HFF
|
||
a += 2
|
||
For x = 1 To charNum
|
||
txt &= Chr(m(a))
|
||
a += 1
|
||
Next
|
||
If charNum And 1 Then a += 1 'if AND1 - +1
|
||
GoTo endlineTest
|
||
|
||
Else
|
||
|
||
'SIMPLE CHAR WITHOUT COMMAND
|
||
|
||
Dim aaa = SpecialCodes.Find(Function(q) q.code = c)
|
||
If IsNothing(aaa) Then
|
||
'Dim curCode0 = BitConverter.GetBytes(c)(0) 'Обрабатываем первый байт иероглифа и заменяем печатным текстом
|
||
'If curCode0 < 32 Then curCode0 += 32
|
||
|
||
'txt &= m(a).ToString("X2") & m(a + 1).ToString("X2")
|
||
txt &= Form1.chars(m(a) + m(a + 1) * 256)
|
||
|
||
'txt &= Chr(m(a)) & Chr(m(a + 1))
|
||
Else
|
||
txt &= "[" & aaa.value & "]" 'Если есть специальный код
|
||
End If
|
||
|
||
'отправляем в файл
|
||
|
||
a += 2 'Двигаем на 2 байта вперёд
|
||
|
||
End If
|
||
|
||
|
||
endlineTest:
|
||
|
||
|
||
Dim PointIndex As Integer = Res.textPointers.FindIndex(Function(x) x = a)
|
||
'Если дошли до след строки в поинтерах или это байт вне файла, то добавляем последнюю строку и выходим
|
||
If PointIndex > 0 Or a = Res.Text.Count Then
|
||
Res.ParsedText.Add(txt) : txt = ""
|
||
End If
|
||
|
||
|
||
|
||
Loop While a < m.Count - 1
|
||
|
||
For l = 0 To Res.ParsedText.Count - 1
|
||
|
||
For Each nm In Names
|
||
|
||
Res.ParsedText(l) = Res.ParsedText(l).Replace(nm.Codes, nm.Dehash)
|
||
|
||
Next
|
||
|
||
Next
|
||
|
||
|
||
|
||
End Sub
|
||
|
||
|
||
Public Sub ParseResource(ByRef bytes As Byte(), ByRef Res As ScriptFile)
|
||
|
||
'Making big script object from file
|
||
|
||
JapTextCounter = 0
|
||
|
||
Res.hz1 = BitConverter.ToInt32(bytes, 0) : Res.hz2 = BitConverter.ToInt32(bytes, 4)
|
||
|
||
'If Res.hz1 <> Res.hz2 Then 'Fixing Japanese Battle Text Script, Adding Header Int32
|
||
' Dim bL = New List(Of Byte)
|
||
' bL.AddRange(BitConverter.GetBytes(Res.hz1))
|
||
' bL.AddRange(bytes)
|
||
' Res.hz2 = Res.hz1
|
||
' bytes = bL.ToArray
|
||
'End If
|
||
|
||
Res.CharsCount = BitConverter.ToInt32(bytes, 8)
|
||
Res.RefsTablePointer = BitConverter.ToInt32(bytes, 12)
|
||
Res.ScriptTablePointer = BitConverter.ToInt32(bytes, 16)
|
||
Res.StartTextPointer = BitConverter.ToInt32(bytes, 20)
|
||
|
||
Res.textPointers = New List(Of Integer)
|
||
Res.CharsArr = New List(Of Byte)
|
||
Res.refstable = New List(Of Int32)
|
||
Res.ScriptsTable = New List(Of Int32)
|
||
Res.Text = New List(Of Byte)
|
||
|
||
Dim TextPointersToScript = New List(Of Integer)
|
||
|
||
'Copy chars data
|
||
|
||
|
||
For x = Res.hz2 To Res.CharsCount * 72 + Res.hz2 - 1 'reading char data after header
|
||
Res.CharsArr.Add(bytes(x))
|
||
Next
|
||
|
||
Dim refstableIndexes = Res.ScriptTablePointer - Res.RefsTablePointer / 8
|
||
|
||
For x = Res.RefsTablePointer To Res.ScriptTablePointer - 1 Step 8
|
||
Dim yy As UInt32 = BitConverter.ToInt32(bytes, x)
|
||
Dim zz As UInt32 = BitConverter.ToInt32(bytes, x + 4)
|
||
If bytes(x) = &H13 And bytes(x + 1) = 0 And bytes(x + 2) = 0 Then TextPointersToScript.Add(zz) : JapTextCounter += 1 'Reading text commands from main offset table
|
||
Res.refstable.Add(yy) '
|
||
Res.refstable.Add(zz)
|
||
|
||
|
||
Next
|
||
|
||
|
||
For Each x In TextPointersToScript
|
||
Res.textPointers.Add(BitConverter.ToInt32(bytes, x)) 'Reading text offsets from scripts table
|
||
Next
|
||
|
||
For x = Res.ScriptTablePointer To Res.StartTextPointer - 1 Step 4
|
||
Dim yy As Int32 = BitConverter.ToInt32(bytes, x) 'Storing script Bytes
|
||
Res.ScriptsTable.Add(yy)
|
||
Next
|
||
|
||
For x = Res.StartTextPointer To UBound(bytes)
|
||
Res.Text.Add(bytes(x))
|
||
Next
|
||
|
||
End Sub
|
||
|
||
Public Function get2(ByRef f As List(Of Byte), ByVal Index As Integer)
|
||
If IsNothing(f) Then Return 0
|
||
Return f(Index) + f(Index + 1) * 256
|
||
|
||
End Function
|
||
|
||
Public Function Read32bitNum(ByRef f As Byte(), ByVal bytenum As Integer)
|
||
|
||
Dim i As Long
|
||
i = f(bytenum) + f(bytenum + 1) * 256 + f(bytenum + 2) * 65536 + f(bytenum + 3) * 16777216
|
||
'If f(bytenum + 3) = 255 And f(bytenum + 2) = 255 And f(bytenum + 1) = 255 And f(bytenum) = 255 Then Return -1
|
||
Return i
|
||
End Function
|
||
|
||
|
||
|
||
Public Function MakeExportFile(ByRef JFile As Byte(), ByRef EFile As Byte(), ByRef cnt As Integer)
|
||
|
||
Dim retString = ""
|
||
Dim japPointers = New List(Of Integer)
|
||
Dim engPointers = New List(Of Integer)
|
||
Dim JPointersPointer = BitConverter.ToUInt16(JFile, 4)
|
||
Dim EPointersPointer = BitConverter.ToUInt16(EFile, 4)
|
||
Dim JTextPointer = BitConverter.ToUInt16(JFile, 6)
|
||
Dim ETextPointer = BitConverter.ToUInt16(EFile, 6)
|
||
Dim fileHeader = New List(Of Byte)
|
||
Dim engText = New List(Of String)
|
||
Dim japText = New List(Of String)
|
||
'Dim StrCount = (JTextPointer - JPointersPointer) / 2
|
||
|
||
'reading pointers
|
||
Dim pointersReader As Integer = JPointersPointer
|
||
For a = JPointersPointer To JTextPointer - 1 Step 2 : japPointers.Add(BitConverter.ToUInt16(JFile, a)) : Next a
|
||
For a = EPointersPointer To ETextPointer - 1 Step 2 : engPointers.Add(BitConverter.ToUInt16(EFile, a)) : Next a
|
||
'FormFileHeader
|
||
For a = 0 To ETextPointer - 1 : fileHeader.Add(JFile(a)) : Next
|
||
|
||
'reading eng String
|
||
For a = 0 To engPointers.Count - 1
|
||
Dim accum = "\\"
|
||
'Pointer2PointerReading System
|
||
|
||
Dim reader As Integer = ETextPointer + engPointers(a)
|
||
|
||
Do
|
||
'If reader >= lastbyte Then Exit Do
|
||
Dim s = EFile(reader)
|
||
|
||
'If reader + 3 < EFile.Count - 1 Then
|
||
'If s = 6 And EFile(reader + 1) = 2 And EFile(reader + 2) = 3 Then Exit Do
|
||
If s = 8 Then accum &= "[sel=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do
|
||
|
||
If s = 3 Then Exit Do
|
||
'End If
|
||
If s = 29 Then accum &= "[c=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do
|
||
If s = 14 Then accum &= "[0e=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do
|
||
If s = 30 Then accum &= "[1e=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do
|
||
If s = 1 Then accum &= vbCrLf & "\\" : reader += 1 : Continue Do
|
||
If s < 32 Then
|
||
accum &= "[" & s & "]"
|
||
Else
|
||
accum &= Chr(s)
|
||
End If
|
||
reader += 1
|
||
|
||
Loop While reader < UBound(EFile)
|
||
engText.Add(accum)
|
||
Next
|
||
|
||
'reading jap String
|
||
For a = 0 To japPointers.Count - 1
|
||
Dim accum = ""
|
||
'Pointer2PointerReading System
|
||
Dim lastbyte As Integer = 0
|
||
'If a = japPointers.Count - 1 Then
|
||
' lastbyte = JFile.ToList.Count - 1
|
||
'Else
|
||
' lastbyte = japPointers(a + 1) + JTextPointer
|
||
'End If
|
||
Dim reader As Integer = JTextPointer + japPointers(a)
|
||
|
||
Do
|
||
'Dim s = JFile(reader)
|
||
Dim chrr = BitConverter.ToUInt16(JFile, reader) 'Reading 2 Bytes!
|
||
|
||
If chrr = &H96E Then accum &= "[man]" : reader += 2 : Continue Do
|
||
If chrr = &H96F Then accum &= "[woman]" : reader += 2 : Continue Do
|
||
|
||
|
||
If chrr And &H1000 Then
|
||
'If reader + 7 <= UBound(JFile) - 1 Then
|
||
' If chrr = &H1101 And BitConverter.ToUInt16(JFile, reader + 2) = &H1106 And
|
||
' BitConverter.ToUInt16(JFile, reader + 4) = &H1101 And
|
||
' BitConverter.ToUInt16(JFile, reader + 6) = &H1103 Then accum &= "[END]" : Exit Do
|
||
'End If
|
||
|
||
'If reader + 5 <= lastbyte Then
|
||
' If chrr = &H1106 And BitConverter.ToUInt16(JFile, reader + 2) = &H1102 And
|
||
' BitConverter.ToUInt16(JFile, reader + 4) = &H1103 Then accum &= "[END623]" : Exit Do
|
||
'End If
|
||
|
||
If chrr = &H1103 Then accum &= "[0311]" : reader += 2 : Exit Do
|
||
|
||
If chrr = &H1205 Then accum &= "[p=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do
|
||
If chrr = &H120E Then accum &= "[0e=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do
|
||
If chrr = &H121E Then accum &= "[1e=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do
|
||
If chrr = &H121D Then accum &= "[c=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do
|
||
|
||
|
||
If chrr = &H1101 Then accum &= vbCrLf : reader += 2 : Continue Do
|
||
|
||
If chrr = &H1120 Then accum &= vbTab : reader += 2 : Continue Do
|
||
If chrr = &H1121 Then accum &= vbTab : reader += 2 : Continue Do
|
||
|
||
Dim c1 = JFile(reader) : Dim c2 = JFile(reader + 1)
|
||
|
||
Dim gg = c2 And 15
|
||
|
||
For byteskip = 1 To gg
|
||
accum &= "[" & c1.ToString("X2") & c2.ToString("X2") & "]"
|
||
reader += 2
|
||
c1 = JFile(reader) : c2 = JFile(reader + 1)
|
||
Next
|
||
Continue Do
|
||
|
||
|
||
End If
|
||
|
||
|
||
Dim aaa = SpecialCodes.Find(Function(q) q.code = chrr)
|
||
If IsNothing(aaa) Then
|
||
chrr = chrr And 255 : If chrr < 32 Then chrr += 32
|
||
accum &= Chr(chrr)
|
||
|
||
Else
|
||
accum &= "[" & aaa.value & "]" 'Если есть специальный код
|
||
End If
|
||
|
||
reader += 2
|
||
Loop While reader < UBound(JFile)
|
||
For Each nm In Names
|
||
accum = accum.Replace(nm.Codes, nm.Dehash)
|
||
Next
|
||
|
||
japText.Add(accum)
|
||
Next
|
||
|
||
|
||
For Each b In fileHeader
|
||
retString &= b & ","
|
||
Next
|
||
retString = retString.Substring(0, retString.Length - 1) & vbCrLf
|
||
|
||
For a = 0 To japPointers.Count - 1
|
||
retString &= "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" & vbCrLf
|
||
retString &= engText(a) & vbCrLf
|
||
retString &= "[" & a & "]" & vbCrLf
|
||
retString &= japText(a) & vbCrLf
|
||
cnt += 1
|
||
Next
|
||
|
||
|
||
Return retString
|
||
End Function
|
||
|
||
|
||
Public Sub importContactFile(ByVal inputJfile As String, ByRef DialCount As Integer, ByRef LineCount As Integer)
|
||
|
||
Dim f = New List(Of Byte)
|
||
Dim TextPointers = New List(Of Integer)
|
||
Dim RepeatPointers = New List(Of Integer)
|
||
|
||
Dim txt = My.Computer.FileSystem.ReadAllText(inputJfile, Encoding.GetEncoding(1251))
|
||
Dim t As List(Of String) = Split(txt, vbCrLf).ToList
|
||
|
||
'Recompiling scripts
|
||
|
||
'Init
|
||
Dim t1 = Split(t(0), ",").ToList
|
||
For Each ii In t1
|
||
If Not IsNumeric(ii) Then MsgBox("Not numeric in INIT sect!!") : Exit Sub
|
||
f.Add(Convert.ToByte(ii))
|
||
Next
|
||
|
||
Dim JPointersPointer = f(4) + f(5) * 256
|
||
Dim JTextPointer = f(6) + f(7) * 256
|
||
Dim StrCount = (JTextPointer - JPointersPointer) / 2
|
||
|
||
Dim tx As String = txt.Replace(t(0) & vbCrLf, "") 'Replace first line
|
||
|
||
Dim idsection As Boolean = True
|
||
|
||
Dim x = 0
|
||
Dim accum = New List(Of Byte)
|
||
|
||
Dim linesAccum = New List(Of String)
|
||
Dim TempLinesAccum = New List(Of Byte)
|
||
Dim currentDialog As Integer
|
||
|
||
Do
|
||
|
||
'Comments to end of line!
|
||
If tx(x) = "\" And tx(x + 1) = "\" Then
|
||
getEndOfLine(tx, x)
|
||
idsection = True
|
||
Continue Do
|
||
End If
|
||
|
||
If tx(x) = "#" Then TextPointers.Add(accum.Count) : x += 3 : currentDialog += 1 : Continue Do 'SimpleClose
|
||
|
||
'SPEC_CODES
|
||
If tx(x) = "[" Then
|
||
Dim skRes = getFromSkobki(tx, x)
|
||
|
||
If IsNumeric(skRes) And idsection Then
|
||
If skRes <> TextPointers.Count Then MsgBox("Error in pointers! ID " & skRes) : Exit Sub
|
||
idsection = False
|
||
DialCount += 1
|
||
x = x + 2
|
||
Continue Do 'its simple ID
|
||
End If
|
||
|
||
|
||
If skRes = "END623" Or skRes = "END" Or skRes = "311" Then
|
||
Dim curCount = accum.Count
|
||
currentDialog += 1
|
||
x += 2
|
||
Select Case skRes
|
||
Case "END623"
|
||
TempLinesAccum.AddRange({&H6, &H11, &H2, &H11, &H3, &H11})
|
||
Case "END"
|
||
TempLinesAccum.AddRange({&H6, &H11, &H3, &H11})
|
||
Case "311"
|
||
TempLinesAccum.AddRange({&H3, &H11})
|
||
End Select
|
||
|
||
'if thislineis Exist or not
|
||
Dim CRCstr = makeCRCString(TempLinesAccum)
|
||
Dim srcLine = linesAccum.FindIndex(Function(yy) yy = CRCstr)
|
||
If srcLine = -1 Then
|
||
linesAccum.Add(CRCstr) : accum.AddRange(TempLinesAccum) : TempLinesAccum.Clear() : TextPointers.Add(curCount) : RepeatPointers.Add(curCount) : Continue Do
|
||
Else
|
||
TextPointers.Add(RepeatPointers(srcLine)) : TempLinesAccum.Clear() : Continue Do
|
||
End If
|
||
End If
|
||
|
||
|
||
Dim spl = Split(skRes, "=")
|
||
|
||
If UBound(spl) = 1 Then 'Code = parsing
|
||
|
||
Select Case spl(0)
|
||
Case "0e"
|
||
TempLinesAccum.AddRange({&HE, &H12, spl(1), 0})
|
||
Case "1e"
|
||
TempLinesAccum.AddRange({&H1E, &H12, spl(1), 0})
|
||
Case "p"
|
||
TempLinesAccum.AddRange({&H5, &H12, spl(1), 0})
|
||
Case "c"
|
||
TempLinesAccum.AddRange({&H1D, &H12, spl(1), 0})
|
||
Case "col"
|
||
Dim ind = ColorCodes.Find(Function(q) q.value = spl(1)).code 'old style color
|
||
TempLinesAccum.AddRange({&H1D, &H12, ind, 0})
|
||
End Select
|
||
|
||
'x += 2
|
||
Continue Do
|
||
|
||
Else '2 hex codes parsing
|
||
|
||
'test specCodes
|
||
Dim spec As CodeObject = SpecialCodes.Find(Function(q) q.value = skRes) 'Special code convert IF
|
||
If Not IsNothing(spec) Then
|
||
TempLinesAccum.AddRange(BitConverter.GetBytes(Convert.ToInt16(spec.code)).ToList)
|
||
Continue Do
|
||
End If
|
||
|
||
If skRes.Length = 4 Then 'Try to parse other hex codes
|
||
TempLinesAccum.AddRange(SoapHexBinary.Parse(skRes).Value.ToList)
|
||
'x += 2
|
||
Continue Do
|
||
|
||
End If
|
||
|
||
End If
|
||
|
||
End If
|
||
|
||
|
||
If tx(x) = vbTab Then TempLinesAccum.AddRange({&H1, &H11}) : x += 1 : Continue Do 'Tab and enter
|
||
If tx(x) & tx(x + 1) = vbCrLf Then TempLinesAccum.AddRange({&H1, &H11}) : LineCount += 1 : x += 2 : Continue Do
|
||
If tx(x) = vbLf Then TempLinesAccum.AddRange({&H1, &H11}) : LineCount += 1 : x += 1 : Continue Do
|
||
|
||
Dim isSimple = False
|
||
If tx(x) = "^" Then x += 1 : isSimple = True 'SimpleLine Check
|
||
|
||
|
||
'SIMPLE TEXT ADDING
|
||
|
||
Dim SimpleTextAccum = New List(Of Byte)
|
||
Dim readCounter As Byte = 1
|
||
|
||
Do
|
||
If Asc(tx(x)) < 32 Or Asc(tx(x)) = 91 Then x -= 1 : Exit Do
|
||
SimpleTextAccum.Add(Asc(tx(x)))
|
||
x += 1
|
||
Loop
|
||
|
||
'if 1 or 2 bytes
|
||
If SimpleTextAccum.Count = 1 Then TempLinesAccum.AddRange({SimpleTextAccum(0), 0}) : x += 1 : Continue Do
|
||
|
||
|
||
TempLinesAccum.Add(SimpleTextAccum.Count)
|
||
TempLinesAccum.Add(&H20) 'command & length
|
||
TempLinesAccum.AddRange(SimpleTextAccum) 'attach textline
|
||
If SimpleTextAccum.Count And 1 Then TempLinesAccum.Add(0) ' if and 1 - add empty byte
|
||
|
||
If isSimple Then
|
||
Dim CRCstr = makeCRCString(TempLinesAccum)
|
||
linesAccum.Add(CRCstr) : TextPointers.Add(accum.Count) : accum.AddRange(TempLinesAccum) : TempLinesAccum.Clear() : RepeatPointers.Add(accum.Count)
|
||
' TextPointers.Add(accum.Count)
|
||
x += 3
|
||
Continue Do 'This is Simple Line
|
||
End If
|
||
|
||
|
||
x += 1
|
||
Loop While x < tx.Length - 1
|
||
|
||
|
||
'TextPointers.RemoveAt(TextPointers.Count - 1) 'Remove Last Pointer
|
||
|
||
'updateing text pointers
|
||
If TextPointers.Count <> StrCount Then
|
||
MsgBox(inputJfile & vbCrLf & "Pointers dsn't Match :( " & vbCrLf & StrCount & " <> " & TextPointers.Count)
|
||
End If
|
||
|
||
|
||
For a = 0 To StrCount - 1
|
||
f(JPointersPointer + a * 2) = BitConverter.GetBytes(TextPointers(a))(0)
|
||
f(JPointersPointer + a * 2 + 1) = BitConverter.GetBytes(TextPointers(a))(1)
|
||
Next
|
||
|
||
|
||
f.AddRange(accum)
|
||
|
||
|
||
'Сохраняем выходной файл
|
||
My.Computer.FileSystem.WriteAllBytes(inputJfile & ".ContTRNSL", f.ToArray, False)
|
||
|
||
|
||
End Sub
|
||
|
||
|
||
Public Function MakeSummonExport(ByRef JFile As Byte(), ByRef EFile As Byte(), ByRef cnt As Integer)
|
||
|
||
|
||
Dim retString = ""
|
||
|
||
Dim engText = New List(Of String)
|
||
Dim japText = New List(Of String)
|
||
'Dim StrCount = (JTextPointer - JPointersPointer) / 2
|
||
|
||
'reading pointers
|
||
|
||
Dim accum = "\\"
|
||
'Pointer2PointerReading System
|
||
|
||
Dim reader As Integer = 0
|
||
|
||
Do
|
||
'If reader >= lastbyte Then Exit Do
|
||
Dim s = EFile(reader)
|
||
|
||
'If reader + 3 < EFile.Count - 1 Then
|
||
'If s = 6 And EFile(reader + 1) = 2 And EFile(reader + 2) = 3 Then Exit Do
|
||
If s = 8 Then accum &= "[sel=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do
|
||
|
||
If s = 3 Then Exit Do
|
||
'End If
|
||
If s = 29 Then accum &= "[c=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do
|
||
If s = 14 Then accum &= "[0e=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do
|
||
If s = 30 Then accum &= "[1e=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do
|
||
If s = 1 Then accum &= vbCrLf & "\\" : reader += 1 : Continue Do
|
||
If s < 32 Then
|
||
accum &= "[" & s & "]"
|
||
Else
|
||
accum &= Chr(s)
|
||
End If
|
||
reader += 1
|
||
|
||
Loop While reader < UBound(EFile)
|
||
engText.Add(accum)
|
||
|
||
|
||
'reading jap String
|
||
|
||
accum = ""
|
||
'Pointer2PointerReading System
|
||
Dim lastbyte As Integer = 0
|
||
'If a = japPointers.Count - 1 Then
|
||
' lastbyte = JFile.ToList.Count - 1
|
||
'Else
|
||
' lastbyte = japPointers(a + 1) + JTextPointer
|
||
'End If
|
||
reader = 0
|
||
|
||
Do
|
||
'Dim s = JFile(reader)
|
||
Dim chrr = BitConverter.ToUInt16(JFile, reader) 'Reading 2 Bytes!
|
||
|
||
If chrr = &H96E Then accum &= "[man]" : reader += 2 : Continue Do
|
||
If chrr = &H96F Then accum &= "[woman]" : reader += 2 : Continue Do
|
||
|
||
|
||
If chrr And &H1000 Then
|
||
|
||
|
||
If chrr = &H1103 Then accum &= "[311]" : reader += 2 : Exit Do
|
||
|
||
If chrr = &H1205 Then accum &= "[p=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do
|
||
If chrr = &H120E Then accum &= "[0e=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do
|
||
If chrr = &H121E Then accum &= "[1e=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do
|
||
If chrr = &H121D Then accum &= "[c=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do
|
||
|
||
|
||
If chrr = &H1101 Then accum &= vbCrLf : reader += 2 : Continue Do
|
||
|
||
If chrr = &H1120 Then accum &= vbTab : reader += 2 : Continue Do
|
||
If chrr = &H1121 Then accum &= vbTab : reader += 2 : Continue Do
|
||
|
||
Dim c1 = JFile(reader) : Dim c2 = JFile(reader + 1)
|
||
|
||
Dim gg = c2 And 15
|
||
|
||
For byteskip = 1 To gg
|
||
accum &= "[" & c1.ToString("X2") & c2.ToString("X2") & "]"
|
||
reader += 2
|
||
c1 = JFile(reader) : c2 = JFile(reader + 1)
|
||
Next
|
||
Continue Do
|
||
|
||
|
||
|
||
End If
|
||
|
||
|
||
|
||
Dim aaa = SpecialCodes.Find(Function(q) q.code = chrr)
|
||
If IsNothing(aaa) Then
|
||
chrr = chrr And 255 : If chrr < 32 Then chrr += 32
|
||
accum &= Chr(chrr)
|
||
|
||
Else
|
||
accum &= "[" & aaa.value & "]" 'Если есть специальный код
|
||
End If
|
||
|
||
reader += 2
|
||
Loop While reader < UBound(JFile)
|
||
For Each nm In Names
|
||
accum = accum.Replace(nm.Codes, nm.Dehash)
|
||
Next
|
||
|
||
japText.Add(accum)
|
||
|
||
|
||
|
||
|
||
' retString = retString.Substring(0, retString.Length - 1) & vbCrLf
|
||
|
||
|
||
retString &= "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" & vbCrLf
|
||
retString &= engText(0) & vbCrLf
|
||
retString &= "[0]" & vbCrLf
|
||
retString &= japText(0) & vbCrLf
|
||
cnt += 1
|
||
|
||
Replace(retString, "[0611][0211][311]", "[END623]")
|
||
|
||
Return retString
|
||
|
||
|
||
|
||
End Function
|
||
|
||
Public Sub convertSummonScript(ByVal inputJfile As String, ByRef DialCount As Integer)
|
||
|
||
Dim TextPointers = New List(Of Integer)
|
||
Dim RepeatPointers = New List(Of Integer)
|
||
|
||
Dim txt = My.Computer.FileSystem.ReadAllText(inputJfile, Encoding.GetEncoding(1251))
|
||
Dim t As List(Of String) = Split(txt, vbCrLf).ToList
|
||
|
||
'Recompiling scripts
|
||
'Init
|
||
Dim tx As String = txt 'Replace first line
|
||
Dim idsection As Boolean = True
|
||
Dim x = 0
|
||
Dim accum = New List(Of Byte)
|
||
Dim linesAccum = New List(Of String)
|
||
Dim currentDialog As Integer
|
||
|
||
Do
|
||
|
||
'Comments to end of line!
|
||
If tx(x) = "\" And tx(x + 1) = "\" Then
|
||
getEndOfLine(tx, x)
|
||
idsection = True
|
||
Continue Do
|
||
End If
|
||
If tx(x) = "#" Then TextPointers.Add(accum.Count) : x += 3 : currentDialog += 1 : Continue Do 'SimpleClose
|
||
'SPEC_CODES
|
||
If tx(x) = "[" Then
|
||
Dim skRes = getFromSkobki(tx, x)
|
||
If IsNumeric(skRes) And idsection Then
|
||
idsection = False
|
||
DialCount += 1
|
||
x = x + 2
|
||
Continue Do 'its simple ID
|
||
End If
|
||
|
||
If skRes = "END623" Or skRes = "END" Or skRes = "311" Then
|
||
Dim curCount = accum.Count
|
||
currentDialog += 1
|
||
x += 2
|
||
Select Case skRes
|
||
Case "END623"
|
||
accum.AddRange({&H6, &H11, &H2, &H11, &H3, &H11})
|
||
Case "END"
|
||
accum.AddRange({&H6, &H11, &H3, &H11})
|
||
Case "311"
|
||
accum.AddRange({&H3, &H11})
|
||
End Select
|
||
Exit Do
|
||
End If
|
||
|
||
Dim spl = Split(skRes, "=")
|
||
|
||
If UBound(spl) = 1 Then 'Code = parsing
|
||
|
||
Select Case spl(0)
|
||
Case "0e"
|
||
accum.AddRange({&HE, &H12, spl(1), 0})
|
||
Case "1e"
|
||
accum.AddRange({&H1E, &H12, spl(1), 0})
|
||
Case "p"
|
||
accum.AddRange({&H5, &H12, spl(1), 0})
|
||
Case "c"
|
||
accum.AddRange({&H1D, &H12, spl(1), 0})
|
||
Case "col"
|
||
Dim ind = ColorCodes.Find(Function(q) q.value = spl(1)).code 'old style color
|
||
accum.AddRange({&H1D, &H12, ind, 0})
|
||
End Select
|
||
|
||
|
||
Continue Do
|
||
|
||
Else '2 hex codes parsing
|
||
|
||
'test specCodes
|
||
Dim spec As CodeObject = SpecialCodes.Find(Function(q) q.value = skRes) 'Special code convert IF
|
||
If Not IsNothing(spec) Then
|
||
accum.AddRange(BitConverter.GetBytes(Convert.ToInt16(spec.code)).ToList)
|
||
Continue Do
|
||
End If
|
||
|
||
If skRes.Length = 4 Then 'Try to parse other hex codes
|
||
accum.AddRange(SoapHexBinary.Parse(skRes).Value.ToList)
|
||
'x += 2
|
||
Continue Do
|
||
End If
|
||
|
||
End If
|
||
|
||
End If
|
||
|
||
|
||
If tx(x) = vbTab Then accum.AddRange({&H20, &H11}) : x += 1 : Continue Do 'Tab and enter
|
||
If tx(x) & tx(x + 1) = vbCrLf Then accum.AddRange({&H1, &H11}) : x += 2 : Continue Do
|
||
If tx(x) = vbLf Then accum.AddRange({&H1, &H11}) : x += 1 : Continue Do
|
||
|
||
|
||
|
||
|
||
|
||
'SIMPLE TEXT ADDING
|
||
|
||
Dim SimpleTextAccum = New List(Of Byte)
|
||
Dim readCounter As Byte = 1
|
||
|
||
Do
|
||
If Asc(tx(x)) < 32 Or Asc(tx(x)) = 91 Then x -= 1 : Exit Do
|
||
SimpleTextAccum.Add(Asc(tx(x)))
|
||
x += 1
|
||
Loop
|
||
|
||
'if 1 or 2 bytes
|
||
If SimpleTextAccum.Count = 1 Then accum.AddRange({SimpleTextAccum(0), 0}) : x += 1 : Continue Do
|
||
|
||
|
||
accum.Add(SimpleTextAccum.Count)
|
||
accum.Add(&H20) 'command & length
|
||
accum.AddRange(SimpleTextAccum) 'attach textline
|
||
If SimpleTextAccum.Count And 1 Then accum.Add(0) ' if and 1 - add empty byte
|
||
|
||
|
||
|
||
x += 1
|
||
Loop While x < tx.Length - 1
|
||
|
||
|
||
'TextPointers.RemoveAt(TextPointers.Count - 1) 'Remove Last Pointer
|
||
|
||
'updateing text pointers
|
||
'Сохраняем выходной файл
|
||
My.Computer.FileSystem.WriteAllBytes(inputJfile & ".SummonTRNSL", accum.ToArray, False)
|
||
|
||
|
||
End Sub
|
||
Public Sub ConvertForEdit(srcFile As String, destFile As String)
|
||
|
||
Dim txt = My.Computer.FileSystem.ReadAllText(srcFile, Encoding.GetEncoding(1251))
|
||
Dim destText = ""
|
||
Dim accum = ""
|
||
Dim x = 0
|
||
|
||
Dim t As List(Of String) = Split(Split(txt, "-----TEXT SECTION" & vbCrLf)(1), vbCrLf).ToList
|
||
Dim idsection As Boolean = True
|
||
|
||
For Each tx In t
|
||
x = 0
|
||
If tx.Length < 2 Then Continue For
|
||
If tx(x) = "\" And tx(x + 1) = "\" Then
|
||
idsection = True
|
||
Continue For
|
||
End If
|
||
|
||
Do
|
||
|
||
If tx(x) = "[" Then
|
||
Dim skRes = getFromSkobki(tx, x)
|
||
If IsNumeric(skRes) And idsection Then
|
||
idsection = False
|
||
destText &= "[" & skRes & "]" & vbCrLf
|
||
Continue For 'its simple ID
|
||
End If
|
||
|
||
If skRes = "END623" Or skRes = "END" Or skRes = "311" Or skRes = "EOF" Or skRes = "EOD3" Or skRes = "EndSelection" Then
|
||
|
||
destText &= accum & vbCrLf
|
||
accum = ""
|
||
idsection = True
|
||
Continue For
|
||
End If
|
||
|
||
If skRes = "EOw" Then accum &= vbCrLf
|
||
|
||
If skRes = "SelectionMenu" Then accum &= " --[выбор]" & vbCrLf
|
||
|
||
If skRes = "name" Then destText &= "Тацуя"
|
||
If skRes = "surname" Then destText &= "Суоу"
|
||
|
||
|
||
Continue Do
|
||
|
||
End If
|
||
If tx(x) = vbTab Then accum &= " " : x += 1 : Continue Do
|
||
If tx(x) = "~" Then accum &= "..." : x += 1 : Continue Do
|
||
|
||
accum &= tx(x)
|
||
x = x + 1
|
||
Loop While x < tx.Length
|
||
|
||
destText &= accum & vbCrLf
|
||
accum = ""
|
||
|
||
Next
|
||
|
||
My.Computer.FileSystem.WriteAllText(destFile, destText, False)
|
||
|
||
End Sub
|
||
Public Function makeCRCString(ByRef bts As List(Of Byte))
|
||
Dim a = ""
|
||
For Each b In bts
|
||
a &= Chr(b)
|
||
Next
|
||
Return a
|
||
End Function
|
||
|
||
|
||
Public Sub ParseScript(ByVal inputJfile As String)
|
||
|
||
If Mid(StrReverse(inputJfile), 1, 4) = "txt." Then MsgBox("ARE YOU AN IDIOT? ITS TXT!") : Exit Sub
|
||
|
||
Dim bytes = My.Computer.FileSystem.ReadAllBytes(inputJfile)
|
||
|
||
JapTextCounter = 0
|
||
Dim JapCompareCounter = 0
|
||
Dim res = New ScriptFile
|
||
res.hz1 = BitConverter.ToInt32(bytes, 0) : res.hz2 = BitConverter.ToInt32(bytes, 4)
|
||
|
||
res.CharsCount = BitConverter.ToInt32(bytes, 8)
|
||
res.RefsTablePointer = BitConverter.ToInt32(bytes, 12)
|
||
res.ScriptTablePointer = BitConverter.ToInt32(bytes, 16)
|
||
res.StartTextPointer = BitConverter.ToInt32(bytes, 20)
|
||
|
||
res.textPointers = New List(Of Integer)
|
||
res.CharsArr = New List(Of Byte)
|
||
res.refstable = New List(Of Int32)
|
||
res.ScriptsTable = New List(Of Int32)
|
||
res.Text = New List(Of Byte)
|
||
res.Chars = New List(Of String)
|
||
res.CharsCodes1 = New List(Of Integer)
|
||
res.CharsCodes2 = New List(Of Integer)
|
||
|
||
Dim TextPointersToScript = New List(Of Integer)
|
||
Dim ComparePointersToScript = New List(Of Integer)
|
||
|
||
Dim ScriptLength As Integer
|
||
|
||
For a = 0 To res.CharsCount - 1
|
||
Dim readingByte = res.hz2 + a * 72
|
||
Dim curchar = ""
|
||
For b = 0 To 68
|
||
If bytes(readingByte + b) < 32 Then res.Chars.Add(curchar) : curchar = "" : Exit For
|
||
curchar &= Chr(bytes(readingByte + b))
|
||
Next
|
||
res.CharsCodes1.Add(BitConverter.ToInt32(bytes, readingByte + 64))
|
||
res.CharsCodes2.Add(BitConverter.ToInt32(bytes, readingByte + 68))
|
||
Next
|
||
|
||
Dim refstableIndexes = res.ScriptTablePointer - res.RefsTablePointer / 8
|
||
|
||
Dim scrprgline As Integer
|
||
|
||
For x = res.RefsTablePointer To res.ScriptTablePointer - 1 Step 8
|
||
Dim isText = False
|
||
Dim isCompareText = False
|
||
Dim yy As UInt32 = BitConverter.ToInt16(bytes, x)
|
||
Dim zz As UInt32 = BitConverter.ToInt32(bytes, x + 4)
|
||
If bytes(x) = &H13 And bytes(x + 1) = 0 And bytes(x + 2) = 0 Then isText = True : TextPointersToScript.Add(zz) : JapTextCounter += 1 'Reading text commands from main offset table
|
||
|
||
If bytes(x) = &HF And bytes(x + 1) = 1 Then isCompareText = True : ComparePointersToScript.Add(zz) : JapCompareCounter += 1 'Reading compare commands from main offset table
|
||
res.refstable.Add(yy) '
|
||
res.refstable.Add(zz)
|
||
|
||
'Print BlockChar Subroutine
|
||
Dim charIndex = res.CharsCodes1.FindIndex(Function(q) q = scrprgline)
|
||
If charIndex > -1 Then res.ParsedScript &= res.Chars(charIndex) & ":" & vbCrLf
|
||
|
||
'Parsing script Command
|
||
Dim parsedComm = ScriptCodes.Find(Function(w) w.code = yy)
|
||
res.ParsedScript &= scrprgline.ToString("X4") & ": "
|
||
Dim descr = ""
|
||
If IsNothing(parsedComm) Then
|
||
res.ParsedScript &= yy.ToString("X8") & " "
|
||
Else
|
||
res.ParsedScript &= parsedComm.value & " "
|
||
If Not IsNothing(parsedComm.descr) Then descr = parsedComm.descr
|
||
End If
|
||
|
||
If x <> res.ScriptTablePointer - 1 Then
|
||
ScriptLength = BitConverter.ToInt32(bytes, x + 12) - BitConverter.ToInt32(bytes, x + 4)
|
||
Else
|
||
ScriptLength = 4
|
||
End If
|
||
|
||
'ScriptLength = ScriptLength / 4
|
||
For scr = zz To zz + ScriptLength - 1 Step 4
|
||
res.ParsedScript &= " " & BitConverter.ToInt32(bytes, scr).ToString("X8")
|
||
If yy = &HD Then res.ParsedScript &= " " & res.Chars(BitConverter.ToInt32(bytes, scr))
|
||
Next
|
||
|
||
If descr <> "" Then res.ParsedScript &= " (" & descr & ")"
|
||
|
||
If isText Then
|
||
Dim curTextAddr = BitConverter.ToInt32(bytes, zz) + res.StartTextPointer
|
||
Dim c = 0
|
||
Dim TextLine = readText(bytes, curTextAddr)
|
||
res.ParsedScript &= " id:" & TextPointersToScript.Count - 1 & TextLine
|
||
End If
|
||
|
||
If isCompareText Then
|
||
Dim curTextAddr = BitConverter.ToInt32(bytes, zz) + res.StartTextPointer
|
||
Dim c = 0
|
||
Dim TextLine = readText(bytes, curTextAddr)
|
||
res.ParsedScript &= " compareId:" & ComparePointersToScript.Count - 1 & " " & TextLine
|
||
End If
|
||
|
||
If yy = &HE Then res.ParsedScript &= vbCrLf
|
||
If yy = &H12 Then res.ParsedScript &= vbCrLf
|
||
If yy = &H7 Then res.ParsedScript &= vbCrLf
|
||
If yy = &H4 Then res.ParsedScript &= vbCrLf
|
||
If yy = &H2 Then res.ParsedScript &= vbCrLf
|
||
If yy = &H1 Then res.ParsedScript &= vbCrLf
|
||
|
||
res.ParsedScript &= vbCrLf
|
||
scrprgline += 1
|
||
|
||
|
||
Next
|
||
|
||
Dim ExportText = ""
|
||
|
||
For ch = 0 To res.Chars.Count - 1
|
||
ExportText &= ch.ToString("X2") & " " & res.CharsCodes1(ch).ToString("X8") & " " & res.CharsCodes2(ch).ToString("X8") & " " & res.Chars(ch) & vbCrLf
|
||
Next
|
||
|
||
ExportText &= vbCrLf & vbCrLf & res.ParsedScript
|
||
|
||
Dim d = New ScriptParserWin
|
||
d.Text = Path.GetFileNameWithoutExtension(inputJfile)
|
||
d.TextBox1.Text = ExportText
|
||
d.ShowDialog()
|
||
|
||
|
||
End Sub
|
||
|
||
Public Function readText(ByRef bytes As Byte(), ByRef curTextAddr As Integer)
|
||
Dim TextLine = " / "
|
||
|
||
Dim c = 0
|
||
If curTextAddr >= bytes.Length Then Return " --- WRON POINTER!"
|
||
Do
|
||
c = BitConverter.ToInt16(bytes, curTextAddr)
|
||
If c = &H1103 Then Exit Do
|
||
|
||
If c = &H1136 Then 'ENGLISH TEXT
|
||
curTextAddr += 2
|
||
Dim curCode = bytes(curTextAddr)
|
||
Do
|
||
If curCode > 31 Then TextLine &= Chr(curCode)
|
||
curTextAddr += 1
|
||
curCode = bytes(curTextAddr)
|
||
If curCode = 0 Then Exit Do
|
||
Loop
|
||
curTextAddr += 1 'jump 0
|
||
End If
|
||
|
||
If curTextAddr And 1 Then curTextAddr += 1 'if AND1 - +1
|
||
|
||
|
||
If c And &H2000 Then 'Если строка в моём однобайтном формате
|
||
|
||
Dim charNum = c And &HFF
|
||
curTextAddr += 2
|
||
For q = 1 To charNum
|
||
If curTextAddr >= bytes.Length Then Return " --- WRON TEXT!"
|
||
TextLine &= Chr(bytes(curTextAddr))
|
||
curTextAddr += 1
|
||
Next
|
||
'If charNum And 1 Then curTextAddr += 1 'if AND1 - +1
|
||
curTextAddr += charNum And 1 'if AND1 - +1
|
||
Continue Do
|
||
End If
|
||
If c And &H1000 Then
|
||
|
||
If c = &H1101 Then TextLine &= " / "
|
||
curTextAddr += (c >> 8 And &HF) * 2 : Continue Do 'BitShift / And / Jump command length
|
||
Else
|
||
TextLine &= Form1.chars(c)
|
||
End If
|
||
|
||
curTextAddr += 2
|
||
Loop While c <> &H1103
|
||
|
||
Return TextLine
|
||
End Function
|
||
|
||
End Class
|
||
|
||
|
||
Public Class ScriptFile
|
||
|
||
Public hz1 As Integer
|
||
Public hz2 As Integer
|
||
Public CharsCount As Integer
|
||
Public RefsTablePointer As Integer
|
||
Public ScriptTablePointer As Integer
|
||
Public ParsedScript As String
|
||
Public StartTextPointer As Integer
|
||
|
||
|
||
|
||
Public filename As String
|
||
|
||
Public textPointers As List(Of Integer)
|
||
|
||
Public CharsArr As List(Of Byte)
|
||
|
||
|
||
Public Chars As List(Of String)
|
||
Public CharsCodes1 As List(Of Integer)
|
||
Public CharsCodes2 As List(Of Integer)
|
||
|
||
|
||
Public refstable As List(Of Int32)
|
||
Public ScriptsTable As List(Of Int32)
|
||
|
||
|
||
|
||
Public Text As List(Of Byte)
|
||
|
||
Public ParsedText As List(Of String)
|
||
|
||
|
||
End Class
|
||
|
||
Public Class CodeObject
|
||
|
||
Public code As Integer
|
||
Public value As String
|
||
Public descr As String
|
||
|
||
End Class
|
||
|
||
Public Class TableElement
|
||
Public Addr As Integer
|
||
Public Code As Integer
|
||
Public Value As Integer
|
||
|
||
|
||
|
||
|
||
End Class
|
||
|
||
|
||
Public Class NameElement
|
||
Public Codes As String
|
||
Public Dehash As String
|
||
|
||
End Class |