'' Bitmap ascii font
'' Request character 0x20 - 0x7f
'' Layout 16 x 6 character
'' Transparent color is RGB(255, 0, 255)
''
'' by mieki256
'' License: CC0 / Public Domain
'' Last updated: <2024/02/13 05:17:50 +0900>

#ifndef __BITMAPASCIIFONT__
#define __BITMAPASCIIFONT__

Type BitmapAsciiFont
    Dim As Any Ptr pixdata
    Dim As Integer imagewidth, imageheight
    Dim As Integer cwidth, cheight
    Dim As Integer startcode, endcode

    Declare Sub load_image(ByRef filename As String)
    Declare Sub draw_string(ByVal x As Integer, ByVal y As Integer, ByRef text As String)
    Declare Sub destroy()
End Type

Sub BitmapAsciiFont.load_image(ByRef filename As String)
    Dim As Integer f
    Dim As Long w, h

    ' open bitmap file
    f = FreeFile()
    Open filename For Binary Access Read As #f
    If Err > 0 Then Print "Error: Can not open file" : End

    ' get bitmap width and height
    Get #f, 19, this.imagewidth   ' get bmp width
    Get #f,   , this.imageheight  ' get bmp height
    Close #f

    ' load bitmap
    this.pixdata = ImageCreate(this.imagewidth, this.imageheight)
    bload filename, this.pixdata

    this.cwidth = this.imagewidth \ 16
    this.cheight = this.imageheight \ 6

    this.startcode = &H0020
    this.endcode = &H007f
End Sub

Sub BitmapAsciiFont.draw_string(ByVal x As Integer, ByVal y As Integer, ByRef text As String)
    Dim As Integer px, py, sz
    px = x
    py = y
    Dim As ubyte ptr p = Cast(ubyte ptr, StrPtr(text))
    For i As Integer = 0 To Len(text) - 1
        Dim As Integer sx0, sy0, sx1, sy1
        Dim As Integer c = *p
        c -= this.startcode
        If c < 0 Then Continue For
        sx0 = (c Mod 16) * this.cwidth
        sy0 = (c \ 16) * this.cheight
        sx1 = sx0 + this.cwidth - 1
        sy1 = sy0 + this.cheight - 1
        Put (px, py), this.pixdata, (sx0, sy0) - (sx1, sy1), TRANS
        px += this.cwidth
        p += 1
    Next i
End Sub

Sub BitmapAsciiFont.destroy()
    ImageDestroy this.pixdata
End Sub

#endif