'' parse BMFont fnt file. And draw BMFont
''
'' by mieki256
'' license: CC0 / Public Domain
'' Last updated: <2024/02/15 04:54:02 +0900>

#ifndef __BMFONT__
#define __BMFONT__

Type bmfontchar
    As Integer id
    As Integer x
    As Integer y
    As Integer w
    As Integer h
    As Integer xoffset
    As Integer yoffset
    As Integer xadvance
    As Integer page
    As Integer chnl
End Type

Type bmfontkerning
    As Integer firstcode
    As Integer secondcode
    As Integer amount
End Type

Type bmfont
    As Integer id
    As String filename

    As Integer lineHeight
    As Integer baseh
    As Integer scaleW
    As Integer scaleH
    As Integer pages
    As Integer packed
    As Integer alphaChnl
    As Integer redChnl
    As Integer greenChnl
    As Integer blueChnl

    As String face
    As Integer size
    As Integer bold
    As Integer italic
    As String charset
    As Integer unicode
    As Integer stretchH
    As Integer smooth
    As Integer aa
    As String padding
    As String spacing
    As Integer outline

    As Integer charsCount
    As Integer kerningsCount

    As Integer charsCountReal
    As Integer kerningsCountReal

    As bmfontchar chardata(any)
    As bmfontkerning kerning(any)

    As Any Ptr img

    Declare Sub loadInfo(ByRef fntfile As String)
    Declare Sub dump()
    Declare Function loadImage overload () As Boolean
    Declare Function loadImage overload (ByRef fname As string) As Boolean
    Declare Sub drawstring(ByVal x As Integer, ByVal y As Integer, ByRef text As String, ByVal use_kerning As Boolean = False)
    Declare Sub destroy()

    Declare Sub splitdq(byref text As String, byref delim As String, result() as String)
End Type

'' ----------------------------------------
'' Draw string
Sub bmfont.drawstring(ByVal x As Integer, ByVal y As Integer, ByRef text As String, ByVal use_kerning As Boolean = False)
    Dim As Integer cx, cy, bh
    bh = this.baseh
    cx = x
    cy = y + bh
    Dim As ubyte ptr cp = strptr(text)
    For i As Integer = 0 To Len(text) - 1
        Dim As Integer c = *cp
        Dim As Integer x, y, w, h, xo, yo, xa, am
        x = this.chardata(c).x
        y = this.chardata(c).y
        w = this.chardata(c).w
        h = this.chardata(c).h
        xo = this.chardata(c).xoffset
        yo = this.chardata(c).yoffset
        xa = this.chardata(c).xadvance
        am = 0

        ' kerning
        If use_kerning And i > 0 Then
            Dim As Integer prevcode = *(cp - 1)
            For j As Integer = 0 To UBound(this.kerning) - 1
                If this.kerning(j).firstcode = prevcode And this.kerning(j).secondcode = c Then
                    am = this.kerning(j).amount
                    Exit For
                End If
            Next j
        End If

        Put (cx + xo + am, cy - bh + yo), this.img, (x, y) - Step(w - 1, h - 1), TRANS
        cx += xa
        cp += 1
    Next i
End Sub

'' ----------------------------------------
Sub bmfont.Splitdq(byref text As String, byref delim As String, result() as String)
    If text = "" Then Return

    Dim As ubyte ptr cp = strptr(text)
    Dim As ubyte ptr dp = strptr(delim)
    Dim As Integer slen = Len(text)
    Dim As Integer pi = 0
    Dim As Integer i = 0
    Dim As Boolean dqfg = False
    Dim As String s = ""

    Do
        If dqfg Then
            If (*cp = 34) Then dqfg = False
        ElseIf (*cp = 34) Then
            dqfg = True
        ElseIf (*cp = *dp) Then
            s = Mid(text, pi + 1, (i - pi))
            pi = i + 1
        End If

        cp += 1
        i += 1

        If i >= slen Then
            s = Mid(text, pi + 1, (i - pi))
            pi = i + 1
        End If

        If s <> "" Then
            ReDim preserve result(UBound(result) + 1)
            result(UBound(result)) = s
            s = ""
        End If
    Loop While (i < slen)
End Sub

'' ----------------------------------------
'' Load and parse BMFont .fnt file
Sub bmfont.loadInfo(ByRef fntfile As String)
    ' Open file
    Dim As Long f = FreeFile()
    If (Open(fntfile For Input As #f)) Then
        Print "Error: Cano not open " & fntfile : End -1
    End If

    ' Read lines. save to array
    ReDim As String ary()
    Dim As Integer count = 0
    Do until EOF(f)
        Dim As String s
        Line Input #f, s  ' Read 1 line
        ReDim Preserve ary(count + 1)
        ary(count) = s
        count += 1
    Loop

    Close #f  ' Close file

    Dim As Integer chars_num = 0
    Dim As Integer kernings_num = 0

    ' parse fnt file
    For i As Integer = 0 To UBound(ary)
        If ary(i) = "" Then continue For
        ReDim As String p()
        this.splitdq(ary(i), " ", p())

        Select Case p(0)
        Case "info"
            For j As Integer = 1 To UBound(p)
                Dim d() As String
                this.splitdq(p(j), "=", d())

                Select Case d(0)
                case "stretchH" : this.stretchH = ValInt(d(1))
                case "unicode"  : this.unicode  = ValInt(d(1))
                case "outline"  : this.outline  = ValInt(d(1))
                case "italic"   : this.italic   = ValInt(d(1))
                case "smooth"   : this.smooth   = ValInt(d(1))
                Case "size"     : this.size     = ValInt(d(1))
                case "bold"     : this.bold     = ValInt(d(1))
                case "aa"       : this.aa       = ValInt(d(1))
                case "charset"  : this.charset  = d(1)
                case "padding"  : this.padding  = d(1)
                case "spacing"  : this.spacing  = d(1)
                Case "face"     : this.face     = d(1)
                End Select
            Next j

        Case "common"
            For j As Integer = 1 To UBound(p)
                Dim As String d()
                this.splitdq(p(j), "=", d())

                Select Case d(0)
                case "lineHeight" : this.lineHeight = ValInt(d(1))
                case "alphaChnl"  : this.alphaChnl  = ValInt(d(1))
                case "greenChnl"  : this.greenChnl  = ValInt(d(1))
                case "blueChnl"   : this.blueChnl   = ValInt(d(1))
                case "redChnl"    : this.redChnl    = ValInt(d(1))
                case "scaleW"     : this.scaleW     = ValInt(d(1))
                case "scaleH"     : this.scaleH     = ValInt(d(1))
                case "packed"     : this.packed     = ValInt(d(1))
                case "pages"      : this.pages      = ValInt(d(1))
                case "base"       : this.baseh      = ValInt(d(1))
                End Select
            Next j

        Case "page"
            For j As Integer = 1 To UBound(p)
                Dim As String d()
                this.splitdq(p(j), "=", d())

                Select Case d(0)
                Case "id" : this.id = ValInt(d(1))
                Case "file"
                    Dim As String fn = Mid(p(j), 6)
                    this.filename = Mid(fn, 2, Len(fn) - 2)
                End Select
            Next j

        Case "chars"
            For j As Integer = 1 To UBound(p)
                Dim As String d()
                this.splitdq(p(j), "=", d())

                Select Case d(0)
                Case "count" : this.charsCount = ValInt(d(1))
                End Select
            Next j

        Case "char"
            Dim As bmfontchar cdt
            Dim As Integer id = 0
            For j As Integer = 1 To UBound(p)
                Dim As String d()
                this.splitdq(p(j), "=", d())

                Select Case d(0)
                Case "id"
                    id = ValInt(d(1))
                    cdt.id = id
                case "xadvance" : cdt.xadvance = ValInt(d(1))
                case "xoffset"  : cdt.xoffset  = ValInt(d(1))
                case "yoffset"  : cdt.yoffset  = ValInt(d(1))
                case "height"   : cdt.h        = ValInt(d(1))
                case "width"    : cdt.w        = ValInt(d(1))
                case "page"     : cdt.page     = ValInt(d(1))
                case "chnl"     : cdt.chnl     = ValInt(d(1))
                case "x"        : cdt.x        = ValInt(d(1))
                case "y"        : cdt.y        = ValInt(d(1))
                End Select
            Next j
            If id > UBound(this.chardata) Then ReDim preserve this.chardata(id)
            this.chardata(id) = cdt
            chars_num += 1

        Case "kernings"
            For j As Integer = 1 To UBound(p)
                Dim As String d()
                this.splitdq(p(j), "=", d())

                Select Case d(0)
                Case "count" : this.kerningsCount = ValInt(d(1))
                End Select
            Next j

        Case "kerning"
            Dim As bmfontkerning kdt
            For j As Integer = 1 To UBound(p)
                Dim As String d()
                this.splitdq(p(j), "=", d())

                Select Case d(0)
                case "second" : kdt.secondcode = ValInt(d(1))
                case "amount" : kdt.amount     = ValInt(d(1))
                case "first"  : kdt.firstcode  = ValInt(d(1))
                End Select
            Next j
            If kernings_num > UBound(this.kerning) Then ReDim preserve this.kerning(kernings_num)
            this.kerning(kernings_num) = kdt
            kernings_num += 1

        End Select
    Next i

    this.charsCountReal = chars_num
    this.kerningsCountReal = kernings_num
End Sub

'' ----------------------------------------
Sub bmfont.dump()
    Print "filename    = " & this.filename
    Print "face        = " & this.face
    Print "charset     = " & this.charset
    Print "unicode     = " & this.unicode
    Print "id          = " & this.id
    Print "size        = " & this.size
    Print "lineHeight  = " & this.lineHeight
    Print "base        = " & this.baseh
    Print "scaleW      = " & this.scaleW
    Print "scaleH      = " & this.scaleH
    Print "chars count           = " & this.charsCount
    Print "chars count (Real)    = " & this.charsCountReal
    Print "kernings count        = " & this.kerningsCount
    Print "kernings count (Real) = " & this.kerningsCountReal

#If 1
    '' dump chars information
    For i As Integer = 0 To UBound(this.chardata)
        Dim As Integer id, x, y, w, h, xo, yo, xa, pg, ch
        id = this.chardata(i).id
        x  = this.chardata(i).x
        y  = this.chardata(i).y
        w  = this.chardata(i).w
        h  = this.chardata(i).h
        xo  = this.chardata(i).xoffset
        yo  = this.chardata(i).yoffset
        xa  = this.chardata(i).xadvance
        pg  = this.chardata(i).page
        ch  = this.chardata(i).chnl
        Print i & ": id=" & id & ",xy(" & x & "," & y & "),wh(" & w & "," & h & "),ofs(" & xo & "," & yo & "),xadd=" & xa & ",page=" & pg & ",chnl=" & ch
    Next i
#endif

#If 1
    '' dump kerning information
    For i As Integer = 0 To UBound(this.kerning)
        Dim As Integer fc, sc, am
        fc = this.kerning(i).firstcode
        sc = this.kerning(i).secondcode
        am = this.kerning(i).amount
        Print i & ": kerning " & fc & "," & sc & " amount=" & am
    Next i
#endif
End Sub

'' ----------------------------------------
'' Load BMFont image. filename in .fnt file
Function bmfont.loadImage overload () As Boolean
    Dim As String fname = Mid(this.filename, 1, Len(this.filename) - 4) & ".bmp"
    this.img = ImageCreate(this.scaleW, this.scaleH)
    If this.img = 0 Then Print "Error: Can not ImageCreate()" : Return False
    bload fname, this.img
    Return True
End Function

'' ----------------------------------------
'' Load BMFont image. set filename
Function bmfont.loadImage overload (ByRef fname As string) As Boolean
    Dim As Integer f
    Dim As Long w, h

    ' Temporarily open the bmp file to get the size
    f = FreeFile()
    Open fname For Binary Access Read As #f
    If Err > 0 Then Print "Error: Can not open file" : Return 0
    Get #f, 19, w    ' get bmp width
    Get #f,   , h    ' get bmp height
    Close #f

    ' create image
    this.img = ImageCreate(w, h)
    If this.img = 0 Then Print "Error: Can not ImageCreate()" : Return False

    ' load bitmap to image
    bload fname, this.img
    Return True
End Function

'' ----------------------------------------
'' Destroy BMFont image
Sub bmfont.destroy()
    ImageDestroy this.img
End Sub

#endif