Imports IO
Imports IO.Directory

Public Class ScriptCheck

    Public files As New List(Of String)
    Public CurFilenum As Integer
    Public RRes As ScriptFile
    Public OverallDial As Integer
    Public CurDial As Integer

    Public CurX, CurY
    Public CurColor As Color
    Public CurShadColor As Color
    Public IsNewWin As Boolean
    Public FontData As List(Of Byte)

    Public Colors = New List(Of Color)

    'Public CurEow As Integer
    Public NextEowPointer As Integer

    Public SelectionCount As Integer
    Public Cursel As Integer


    Dim drawSurface As Bitmap


    Private Sub ScriptCheck_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        FontData = My.Computer.FileSystem.ReadAllBytes("D:\Games\PSX\Persona.2.Innocent.Sin\Export\0059_00_0_0_U").ToList
        Colors.Add(Color.Black)
        Colors.Add(Color.FromArgb(238, 238, 238))
        Colors.Add(Color.FromArgb(24, 24, 24))
        Colors.Add(Color.FromArgb(156, 156, 156))
        Colors.Add(Color.FromArgb(49, 49, 49))
        Colors.Add(Color.FromArgb(246, 82, 131))
        Colors.Add(Color.FromArgb(24, 24, 24))
        Colors.Add(Color.FromArgb(148, 213, 255))                           'Persona2 TEXT PALETTE
        Colors.Add(Color.FromArgb(24, 24, 49))
        Colors.Add(Color.FromArgb(131, 230, 131))
        Colors.Add(Color.FromArgb(24, 24, 24))
        Colors.Add(Color.FromArgb(230, 230, 74))
        Colors.Add(Color.FromArgb(49, 49, 24))
        Colors.Add(Color.FromArgb(255, 131, 49))
        Colors.Add(Color.FromArgb(49, 24, 24))

        drawSurface = New Bitmap(PictureBox1.ClientSize.Width * 5, PictureBox1.ClientSize.Height * 5)
        PictureBox1.Image = drawSurface


        FilesLoad.PerformClick()

    End Sub
    'Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
    '    e.Graphics.InterpolationMode = Drawing2D.InterpolationMode.NearestNeighbor
    '    e.Graphics.ScaleTransform(3, 3)
    '    e.Graphics.DrawImage(drawSurface, 0, 0)
    'End Sub


    Private Sub FilesLoad_Click(sender As Object, e As EventArgs) Handles FilesLoad.Click

        files = IO.Directory.GetFiles(Dir.Text, "*.TRNSL").ToList

        CurFilenum = 0
        CurDial = 0
        If files.Count = 0 Then MsgBox("No TRNSL files in init directory!") : Exit Sub
        InitFile(0)


    End Sub

    Public Sub InitFile(ByVal id As Integer)

        Dim a = New ScriptTools

        RRes = New ScriptFile
        a.ParseResource(My.Computer.FileSystem.ReadAllBytes(files(id)), RRes)
        ' PictureBox2.Parent = PictureBox1

        NextEowPointer = 0
        OverallDial = RRes.textPointers.Count
        CurDial = 0

        PrintText()




    End Sub

    Public Sub PrintText()

        If IsNewWin Then ClearWinAndReset()

        UpdateCurFileDial()

        ShowDialodID(CurDial)


    End Sub

    Public Sub ClearWinAndReset()

        PictureBox1.BackColor = Color.Transparent
        PictureBox1.Invalidate()
        drawSurface = New Bitmap(PictureBox1.ClientSize.Width * 5, PictureBox1.ClientSize.Height * 5)
        PictureBox1.Image = drawSurface

        CurX = 4
        CurY = 4

        IsNewWin = False

    End Sub



    Public Sub UpdateCurFileDial()

        CurFileText.Text = "f:  " & CurFilenum + 1 & " / " & files.Count
        CurFileName.Text = Split(files(CurFilenum), "\").ToList.Last
        CurrentDial.Text = "w:  " & CurDial + 1 & " / " & OverallDial

        ProgressBar1.Value = CurDial / OverallDial * 100

    End Sub


    Public Sub ShowDialodID(ByVal id As Integer)

        Dim m As List(Of Byte) = RRes.Text


        Dim a = RRes.textPointers(id)           'counter
        DemoText.Text = ""

        If NextEowPointer <> 0 Then a = NextEowPointer

        Do
            Dim c = get2(m, a)
            If c = &H122E Then                                                                  'Парсим код цвета текста
                CurColor = Colors(get2(m, a + 2))
                CurShadColor = Colors(get2(m, a + 2) + 1)
                a += 4
                GoTo endlineTest
            End If


            If c = &H1101 Then DemoText.Text &= vbCrLf : CurX = 3 : CurY += 14 : a += 2 : GoTo endlineTest                        ' Перенос строки
            If c = &H1131 Then DemoText.Text &= " " : CurX += 4 : a += 2 : GoTo endlineTest                        ' Табуляция (+12 пикс)

            If c = &H1208 Then DemoText.Text &= "[SelectionMenu][" & get2(m, a + 2) & "]" : SelectionCount = get2(m, a + 2) : Cursel = 0 : a += 4 : GoTo endlineTest                   ' Пауза 1с при воспроизведении диалога

            If c = &H1121 Then
                For vv = 0 To 3 : DrawChar(Asc("Суоу"(vv))) : Next
                a += 2 : GoTo endlineTest
            End If
            'Имя игрока
            If c = &H1120 Then
                For vv = 0 To 4 : DrawChar(Asc("Тацуя"(vv))) : Next
                a += 2
                GoTo endlineTest     'Фамилия игрока
            End If

            'Кликуха
            If c = 4372 Then
                For vv = 0 To 3 : DrawChar(Asc("Тацу"(vv))) : Next
                a += 2
                GoTo endlineTest     'Кликуха
            End If

            If c = &H1106 Then
                If get2(m, a + 2) = &H1102 Then
                    If get2(m, a + 4) = &H1103 Then 'Закрыть окна диалога!
                        IsNewWin = True
                        NextEowPointer = 0
                        Exit Do
                    Else
                        NextEowPointer = a + 4      'След диалог без закрытия окна
                        Exit Do
                    End If
                End If
            End If
            If c = &H1109 Then
                If get2(m, a + 2) = &H1102 Then
                    If get2(m, a + 4) = &H1103 Then 'Выбор варианта ответа!
                        IsNewWin = True
                        SelectionCount = 0 : Cursel = 0
                        a += 6 : GoTo endlineTest
                    End If
                End If
            End If



            If c = &H1103 Then Exit Do

            If c And &H1000 Then                 'COMMAND PARSE

                Dim comLen = c >> 8
                comLen = comLen And &HF 'command length check
                'Dim comCode = c And &HFF

                a += comLen * 2                      'Jump command
                GoTo endlineTest



            ElseIf c And &H2000 Then                                   'Если строка в моём однобайтном формате

                Dim charNum = c And &HFF
                a += 2
                For x = 1 To charNum
                    DemoText.Text &= Chr(m(a))
                    DrawChar(m(a))
                    a += 1
                Next
                If charNum And 1 Then a += 1                'if AND1 - +1
                GoTo endlineTest

            End If

            'draw any char from font!
            DrawChar(c)
            a += 2


endlineTest:

            'Читаем до следующего текст-поинтера или конца массива
            If id < RRes.textPointers.Count - 1 Then
                If a >= RRes.textPointers(id + 1) Then Exit Do
            Else
                If a >= m.Count - 1 Then Exit Do

            End If



        Loop



    End Sub

    Public Sub DrawChar(ByVal chr As Integer)

        Dim f = New FontTools
        Dim readAddr = 1152 + 18 * chr                                 '18 bytes per char

        'making shadow

        For a = 0 To 5
            Dim b1 As Byte = FontData(readAddr + (a * 3))
            Dim b2 As Byte = FontData(readAddr + (a * 3) + 1)
            Dim b3 As Byte = FontData(readAddr + (a * 3) + 2)
            Dim b1bits = New BitArray(BitConverter.GetBytes(b1))
            Dim b2bits = New BitArray(BitConverter.GetBytes(b2))
            Dim b3bits = New BitArray(BitConverter.GetBytes(b3))
            For x = 0 To 7
                If b1bits(x) Then drawpixel(x + CurX + 1, CurY + 1, True)
            Next

            Dim addX = CurX + 9
            For x = 0 To 7
                If b2bits(x) Then drawpixel(x + addX, CurY + 1, True)
                If x = 3 Then addX -= 12 : CurY += 1
            Next

            For x = 0 To 7
                If b3bits(x) Then drawpixel(x + CurX + 5, CurY + 1, True)
            Next
            CurY += 1
        Next

        CurY -= 12

        'making char

        For a = 0 To 5
            Dim b1 As Byte = FontData(readAddr + (a * 3))
            Dim b2 As Byte = FontData(readAddr + (a * 3) + 1)
            Dim b3 As Byte = FontData(readAddr + (a * 3) + 2)
            Dim b1bits = New BitArray(BitConverter.GetBytes(b1))
            Dim b2bits = New BitArray(BitConverter.GetBytes(b2))
            Dim b3bits = New BitArray(BitConverter.GetBytes(b3))
            For x = 0 To 7
                If b1bits(x) Then drawpixel(x + CurX, CurY, False)
            Next

            Dim addX = CurX + 8
            For x = 0 To 7
                If b2bits(x) Then drawpixel(x + addX, CurY, False)
                If x = 3 Then addX -= 12 : CurY += 1
            Next

            For x = 0 To 7
                If b3bits(x) Then drawpixel(x + CurX + 4, CurY, False)
            Next
            CurY += 1
        Next



        PictureBox1.Invalidate()
        CurY -= 12
        CurX += 6
    End Sub



    Public Sub drawpixel(ByVal x As Integer, ByVal y As Integer, ByVal isShadow As Boolean)

        For a = 0 To 2
            For b = 0 To 2
                If isShadow Then
                    drawSurface.SetPixel(x * 3 + a, y * 3 + b, CurShadColor)
                Else
                    drawSurface.SetPixel(x * 3 + a, y * 3 + b, CurColor)
                End If
            Next
        Next


    End Sub

    Public Function get2(ByRef f As List(Of Byte), ByVal Index As Integer)
        Return f(Index) + f(Index + 1) * 256
    End Function

    Private Sub NxFile_Click(sender As Object, e As EventArgs) Handles NxFile.Click
        If CurFilenum = files.Count - 1 Then

            CurFilenum = 0
        Else
            CurFilenum += 1
        End If



        InitFile(CurFilenum)
        UpdateCurFileDial()


    End Sub

    Private Sub PrevFile_Click(sender As Object, e As EventArgs) Handles PrevFile.Click
        If CurFilenum = 0 Then CurFilenum = files.Count


        CurFilenum -= 1

        InitFile(CurFilenum)
        UpdateCurFileDial()

    End Sub



    Private Sub NxDial_Click(sender As Object, e As EventArgs) Handles NxDial.Click
        If NextEowPointer <> 0 Then PrintText() : Exit Sub

        If CurDial = OverallDial - 1 Then
            CurDial = 0
            If CurFilenum <> files.Count - 1 Then
                CurFilenum += 1
                InitFile(CurFilenum)
                UpdateCurFileDial()
            End If
        Else
            CurDial += 1
        End If



        PrintText()

    End Sub

    Private Sub srch_Click(sender As Object, e As EventArgs) Handles srch.Click
        Dim a = files.FindIndex(Function(x) x.Contains(IDsrch.Text))

        If a = -1 Then
            MsgBox("File not found :(")
            Exit Sub
        Else
            InitFile(a)
            CurFilenum = a
            UpdateCurFileDial()
        End If


    End Sub

    Private Sub prevDial_Click(sender As Object, e As EventArgs) Handles prevDial.Click
        If CurDial = 0 Then CurDial = OverallDial
        NextEowPointer = 0
        CurDial -= 1
        PrintText()
    End Sub

    Private Sub Editor_Click(sender As Object, e As EventArgs) Handles Editor.Click
        Dim fil = Replace("""C:\Program Files (x86)\Notepad++\Notepad++.exe"" """ & files(CurFilenum) & """", ".TRNSL", "")

        Shell(fil)
    End Sub

    Private Sub ScriptCheck_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
        If e.KeyCode = Keys.Add Then NxDial.PerformClick()
    End Sub
End Class