Files
P2EP_Toolkit/p2isPSX_CDToolkit/ScriptTools.vb
sShemet 3475406781 CD extra & settings support
Written on book
2025-10-24 22:03:21 +05:00

1857 lines
73 KiB
VB.net
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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
If (Form1.CDExtraBtn.Checked) Then
accum.AddRange({&H20, &H11}) 'Special Tab
x += 1
Continue Do
End If
accum.AddRange({&H31, &H11})
x += 1
Continue Do 'Tab and enter
End If
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
Dim sT = If(IsNothing(ERes.ParsedText), JRes.ParsedText(p), ERes.ParsedText(p))
Dim etxt = Split(sT, vbCrLf)
txt &= "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" & vbCrLf
For Each t In etxt
If Form1.UnKudosScript.Checked Then t = StringsOffsetEditorvb.Unkudos(t)
txt &= "\\ " & t & vbCrLf
Next
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 &= vbTab : a += 2 : GoTo endlineTest ' PSP, IS and ExtraCD Tab
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