P2EP_Toolkit/p2isPSX_CDToolkit/FontTools.vb

Public Class FontTools

    Dim drawSurface As Bitmap
    Public Colors = New List(Of Color)

    Public Function GetColors()
        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))



    End Function

    Public Sub convertTo16()

        'DONE

        Dim CurByte As Byte

        Dim tempByte As Byte
        Dim tempByte2 As Byte
        Dim tempByte3 As Byte
        Dim tempByte4 As Byte
        Dim vertCounter As Integer
        Dim newFont = New List(Of Byte)

        Dim fontRawData = My.Computer.FileSystem.ReadAllBytes("D:\Games\PSX\Persona 2 - Batsu (NTSC-J) [SLPS-02825]\Export/JapFont.bin")

        Dim ReadCounter = 64919
        Dim readAddr = 1152

        Do

            If readAddr >= ReadCounter Then Exit Do

            newFont.Add(ReverseBits(fontRawData(readAddr)))

            tempByte2 = ReverseBits(fontRawData(readAddr + 1))
            newFont.Add(tempByte2 And &HF0)



            tempByte3 = ReverseBits(fontRawData(readAddr + 2))



            Dim collby3 As Byte = (tempByte3 >> 4)

            newFont.Add(tempByte2 << 4 Or collby3) 'Need last 4 bits

            tempByte4 = tempByte3 << 4
            newFont.Add(tempByte4)

            readAddr += 3

            vertCounter += 1
            If vertCounter = 6 Then
                vertCounter = 0
                newFont.Add(0)
                newFont.Add(0)
                newFont.Add(0)
                newFont.Add(0)
                newFont.Add(0)
                newFont.Add(0)
                newFont.Add(0)
                newFont.Add(0)
            End If
        Loop

        My.Computer.FileSystem.WriteAllBytes("D:\Games\PSX\Persona 2 - Batsu (NTSC-J) [SLPS-02825]/Export/WatchMyFont.bin.bak", newFont.ToArray, False)


    End Sub

    'DONE

    Public Sub ConvertTo12()

        Dim CurByte As Byte
        Dim newFont = New List(Of Byte)

        Dim tempByte2 As Byte
        Dim tempByte3 As Byte
        Dim tempByte4 As Byte

        If Not My.Computer.FileSystem.FileExists(Form1.WorkDir.Text & "/JapFont.bin") Then MsgBox(Form1.WorkDir.Text & "/JapFont.bin not found. Check Export path!") : Exit Sub
        Dim fontHeader As Byte() = My.Computer.FileSystem.ReadAllBytes(Form1.WorkDir.Text & "/JapFont.bin")
        ReDim Preserve fontHeader(1151) 'Loading font header (1152 bytes of normal first font)
        newFont.AddRange(fontHeader.ToList)


        Dim vertCounter As Integer
        Dim fontRawData = My.Computer.FileSystem.ReadAllBytes(Form1.WorkDir.Text & "/WatchMyFont.bin")
        Dim ReadCounter = 82572
        Dim readAddr = 0

        Do

            If readAddr >= ReadCounter Then Exit Do
            newFont.Add(ReverseBits(fontRawData(readAddr)))

            tempByte2 = fontRawData(readAddr + 1) And &HF0
            tempByte3 = fontRawData(readAddr + 2) >> 4
            newFont.Add(ReverseBits(tempByte2 Or tempByte3))

            tempByte3 = fontRawData(readAddr + 2) << 4
            tempByte4 = fontRawData(readAddr + 3) >> 4
            newFont.Add(ReverseBits(tempByte3 Or tempByte4))

            readAddr += 4
            vertCounter += 1
            If vertCounter = 6 Then
                readAddr += 8
                vertCounter = 0

            End If


        Loop


        'Creating Rus 8x12 Font @ BA00 (47616)
        For aaa = 1 To 47616 - newFont.Count
            newFont.Add(0)
        Next

        readAddr = 32 * 32 ' Starting with CHR32 (space)

        Do
            For a = 0 To 11             '12 rows loop
                newFont.Add(ReverseBits(fontRawData(readAddr)))
                readAddr += 2                 'skip 2 bytes
            Next
            readAddr += 8           'skip empty 12*4 bytes
        Loop While readAddr < 256 * 32 'All symbols readed - exit




        For aaa = 1 To 65520 - newFont.Count
            newFont.Add(0)
        Next


        My.Computer.FileSystem.WriteAllBytes(Form1.WorkDir.Text & "/0059_00_0_0_U", newFont.ToArray, False)

        MsgBox("OK to /Export/0059_00_0_0_U", MsgBoxStyle.Information)


    End Sub




    Public Function ReverseBits(x As Byte) As Byte
        x = (((x And &HAA) >> 1) Or ((x And &H55) << 1))
        x = (((x And &HCC) >> 2) Or ((x And &H33) << 2))
        x = (((x And &HF0) >> 4) Or ((x And &HF) << 4))
        Return ((x))

    End Function



    Public Sub DrawChars(ByRef byt As List(Of Byte), ByRef df As Bitmap, ByVal y As Integer, ByRef CurColor As Integer)

        Dim curX = 10
        Dim curY = 10 + y
        'Load Font Here
        Dim font = New List(Of List(Of Byte))
        Dim fil = My.Computer.FileSystem.ReadAllBytes("D:\Games\PSX\Persona 2 - Batsu (NTSC-J) [SLPS-02825]\Export\WatchMyFont.bin.bak").ToList
        Dim charCount As Integer = fil.Count / 32
        For x = 0 To fil.Count - 32 Step 32
            Dim curChar = New List(Of Byte)
            curChar.AddRange(fil.GetRange(x, 32))
            font.Add(curChar)
        Next


        For a = 0 To byt.Count - 2 Step 2

            Dim c = byt(a) + byt(a + 1) * 256

            If c = &H1120 Or c = &H1131 Then
                curX = curX + 12
                Continue For
            End If

            If c = &H122E Then
                CurColor = byt(a + 2)
                a = a + 2
                Continue For
            End If

            If c = &H1103 Then
                y = y + 12
                Continue For
            End If

            'DrawChar(font(c), curX, curY, df, CurColor)
            DrawChar(font(c), curX, curY, df, 0)
            curX = curX + 12
notDraw:


        Next





    End Sub


    Public Sub DrawChar(ByRef ch As List(Of Byte), ByVal tx As Integer, ByVal ty As Integer, ByRef df As Bitmap, ByRef CurColor As Integer)

        Dim ch2 = New List(Of Byte)
        For Each C In ch
            ch2.Add(ReverseBits(C))
        Next
        Dim curSize = Form1.PictureBox1.Size

        Dim bits = New BitArray(ch2.ToArray)

        For x = 0 To 15
            For y = 0 To 15
                If x + tx >= curSize.Width Or y + ty >= curSize.Height Then Continue For

                If Not bits(x + 16 * y) Then Continue For
                DrawX2(x + tx, y + ty, df, Colors(CurColor))
            Next
        Next

        Form1.PictureBox1.Invalidate()

    End Sub


    Public Sub DrawX2(ByRef x As Integer, ByRef y As Integer, ByRef df As Bitmap, ByVal col As Color)


        df.SetPixel(x * 2, y * 2, col)
        df.SetPixel(x * 2 + 1, y * 2, col)
        df.SetPixel(x * 2, y * 2 + 1, col)
        df.SetPixel(x * 2 + 1, y * 2 + 1, col)


    End Sub
End Class