mieki256's diary

一応処理は書けたような気がする。もはや split() の動作ではなくなっているけれど…。

実処理は以下。

_splitdq.bi

' License: CC0 / Public Domain

#ifndef __SPLITDQ__
#define __SPLITDQ__

Sub 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
            ' check double quotation pair
            If (*cp = 34) Then dqfg = False
        ElseIf (*cp = 34) Then
            ' found double quotation
            dqfg = True
        ElseIf (*cp = *dp) Then
            ' found delimiter
            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

#endif

テストサンプルは以下。

_test_splitdq.bas

#include "splitdq.bi"

Dim As String text
'text = "char id=32   x=250   y=22    width=5     height=5     xoffset=-2    yoffset=21    xadvance=7     page=0  chnl=15"
text = "info face=""DejaVu Sans"" size=24 bold=1 italic=0 charset=""ANSI"" unicode=0 stretchH=100 smooth=1 aa=4 padding=0,0,0,0 spacing=1,1 outline=2"

Dim words() As String
splitdq(text, " ", words())

Print text
For i As Integer = 0 To UBound(words)
    Print "[" & words(i) & "]"
Next i
Print "    ...success."

fbc test_splitdq.bas でコンパイル。実行結果は以下。

> test_splitdq.exe
info face="DejaVu Sans" size=24 bold=1 italic=0 charset="ANSI" unicode=0 stretchH=100 smooth=1 aa=4 padding=0,0,0,0 spacing=1,1 outline=2
[info]
[face="DejaVu Sans"]
[size=24]
[bold=1]
[italic=0]
[charset="ANSI"]
[unicode=0]
[stretchH=100]
[smooth=1]
[aa=4]
[padding=0,0,0,0]
[spacing=1,1]
[outline=2]
    ...success.

ダブルクオーティションで挟まれた部分については区切り文字を無視するようにできた。

ただ、バグがありそうな気がする…。こういう文字列を渡すとおかしくなる、という場面がありそうな…。

処理の仕方も無駄がありそう。少なくとも処理速度は期待できない予感。

でもまあ、今回やりたいことはできそうだから、これでもいいか…。

一般的に split() ってどんな感じに実装されたりするのか気になってググってみた。

以下の事例を見て目ウロコ。元文字列の最後に区切り文字を追加してから処理を始めることで、ループがスッキリしてる…。その手があったか…。

_Split the string into substrings using delimiter - GeeksforGeeks


FreeBASIC版を書いてみた。ダブルクオーティションに対応させようとして、記述が長くなってしまったけれど…。

_splitstringa.bi

#ifndef __SPLITSTRINGA__
#define __SPLITSTRINGA__

Sub splitStringA(ByVal text As String, ByVal delim As String, result() as String, ByVal chk_dbqt As Boolean = False)
    If text = "" Then Return
    Dim As String src = text & delim
    Dim As String word = ""
    Dim As Boolean founded_dbqt = False

    For i As Integer = 0 To Len(src) - 1
        If founded_dbqt Then
            word &= Chr(src[i])
            If src[i] = 34 Then founded_dbqt = False  ' found double quote
        Else
            If src[i] <> delim[0] Then
                ' not delimiter
                word &= Chr(src[i])
                If chk_dbqt And src[i] = 34 Then founded_dbqt = True  ' found double quote
            Else
                ' found delimiter
                If word <> "" Then
                    ' word is not empty. save word to array
                    ReDim preserve result(UBound(result) + 1)
                    result(UBound(result)) = word
                    word = ""
                End If
            End If
        End If
    Next i
    If word <> "" Then
        ' word is not empty. save word to array
        ReDim preserve result(UBound(result) + 1)
        result(UBound(result)) = word
    End If
End Sub

#endif

使用サンプルは以下。fbc test_splitstringa.bas でコンパイル。

_test_splitstringa.bas

#include "splitstringa.bi"

Dim As String text
text = "char id=32   x=250   y=22    width=5     height=5     xoffset=-2    yoffset=21    xadvance=7     page=0  chnl=15"
'text = "info face=""DejaVu Sans"" size=24 bold=1 italic=0 charset=""ANSI"" unicode=0 stretchH=100 smooth=1 aa=4 padding=0,0,0,0 spacing=1,1 outline=2"

Dim words() As String
splitStringA(text, " ", words())
'splitStringA(text, " ", words(), True)  ' check double quote

Print "[" & text & "]"
For i As Integer = 0 To UBound(words)
    Print i & ": [" & words(i) & "]"
Next i
Print "end."

test_splitstringa.exe を実行。たしかに分割できている。

> test_splitstringa.exe
[char id=32   x=250   y=22    width=5     height=5     xoffset=-2    yoffset=21    xadvance=7     page=0  chnl=15]
0: [char]
1: [id=32]
2: [x=250]
3: [y=22]
4: [width=5]
5: [height=5]
6: [xoffset=-2]
7: [yoffset=21]
8: [xadvance=7]
9: [page=0]
10: [chnl=15]
end.

それとは別の実装事例。FreeBASICのWikiを眺めてたら、そもそも split() の実装サンプルが紹介されてた。まさかそんなページで紹介されていたとは…。

_Passing Arrays to Procedures - FreeBASIC Wiki Manual | FBWiki

内容的には、instr() で区切り文字を探して位置を求めて、頭からそこまでの文字列を配列に記録したら、その文字列分を元文字列から削除して処理を続けていた。サブルーチンに引数として元文字列を渡す際、値渡しで渡してるから、元文字列を破壊しても大丈夫ということなのだろう…。もしかすると strtok() を使った事例と考え方は似ているのかもしれない。

これも手元で動作確認してみた。

_splitstringb.bi

#ifndef __SPLITSTRINGB__
#define __SPLITSTRINGB__

Sub splitStringB(ByVal src As String, ByVal delim As String, result(Any) As String)
    Do
        Dim As Integer i = InStr(1, src, Chr(delim[0])) ' search delimiter
        ReDim Preserve result(UBound(result) + 1)
        If i = 0 Then
            ' not found delimiter. exit loop
            result(UBound(result)) = src
            Exit Do
        End If
        result(UBound(result)) = Left(src, i - 1)  ' save word to array
        src = Mid(src, i + 1)  ' delete word
    Loop
End Sub

#endif

使用サンプルは以下。fbc test_splitstringb.bas でコンパイル。

_test_splitstringb.bas

#include "splitstringb.bi"

Dim As String text
text = "char id=32   x=250   y=22    width=5     height=5     xoffset=-2    yoffset=21    xadvance=7     page=0  chnl=15"
'text = "info face=""DejaVu Sans"" size=24 bold=1 italic=0 charset=""ANSI"" unicode=0 stretchH=100 smooth=1 aa=4 padding=0,0,0,0 spacing=1,1 outline=2"

Dim words() As String
splitStringB(text, " ", words())

Print "[" & text & "]"
For i As Integer = 0 To UBound(words)
    Print i & ": [" & words(i) & "]"
Next i
Print "end."

ただ、この版は、区切り文字が連続して並んでる際、それぞれを配列変数に入れてしまう。

> test_splitstringb.exe
[char id=32   x=250   y=22    width=5     height=5     xoffset=-2    yoffset=21    xadvance=7     page=0  chnl=15]
0: [char]
1: [id=32]
2: []
3: []
4: [x=250]
5: []
6: []
...
34: [page=0]
35: []
36: [chnl=15]
end.

もしかすると文字列を切り出した後、文字列が空かどうかを調べて、空じゃなければ配列に格納するようにすればいいのだろうか…？

1文字=1byteの文字列なら処理が書けたので、せっかくだからマルチバイト文字列にも対応させられないものかと思い立ったのだけど。String を、マルチバイト文字列を格納する WString に書き換えれば済むかなと思ったらコンパイルすら通らず。

WString や ZString は、扱いが面倒らしい…。

_FreeBASICのワイド文字列が使いにくい件 - 飴屋ぷろじぇくと
_FreeBASIC Compiler - 飴屋ぷろじぇくと
_Problem passing and copying fixed length WSTRING array - freebasic.net

あらかじめ領域を固定で確保しておかないといけないとか、サブルーチンや関数に WString の配列変数を渡せないとか…。これはなかなか大変…。

区切り"文字"で分割する分にはまだこうして書けるけど、区切り"文字列"で分割できるように対応しようとするとちょっと大変そう。文字列検索/文字列探索アルゴリズムの話になって、KMP法とかBM法とかが出てくる…。

_文字列探索アルゴリズムとは？KMP法やBM法について解説
_文字列検索アルゴリズムについて #アルゴリズム - Qiita

BMFont というのは、ビットマップフォントのフォーマットの一種というか…。ビットマップフォントがギッチリと敷き詰められた画像と、どこに何の文字があるのか記述したテキストファイル(.fnt)を利用して、文字を描画する仕組み。

_BMFont - AngelCode.com

以下の画像とテキストファイルを見てもらえばなんとなく分かるだろうか。


_bmfont_dejavu.fnt

info face="DejaVu Sans" size=24 bold=1 italic=0 charset="ANSI" unicode=0 stretchH=100 smooth=1 aa=4 padding=0,0,0,0 spacing=1,1 outline=2
common lineHeight=24 base=20 scaleW=256 scaleH=256 pages=1 packed=0 alphaChnl=1 redChnl=0 greenChnl=0 blueChnl=0
page id=0 file="bmfont_dejavu_0.png"
chars count=95
char id=32   x=250   y=22    width=5     height=5     xoffset=-2    yoffset=21    xadvance=7     page=0  chnl=15
char id=33   x=71    y=89    width=8     height=20    xoffset=0     yoffset=2     xadvance=9     page=0  chnl=15
...
char id=125  x=51    y=0     width=14    height=24    xoffset=0     yoffset=1     xadvance=14    page=0  chnl=15
char id=126  x=208   y=105   width=17    height=9     xoffset=0     yoffset=8     xadvance=17    page=0  chnl=15
kernings count=86
kerning first=45  second=84  amount=-3  
kerning first=45  second=86  amount=-1  
...
kerning first=89  second=46  amount=-3  
kerning first=118 second=44  amount=-1  

.fntファイルには、各文字について、x, y, w, h 等々が列挙されてる。各パラメータがどこに絡んでいるかは、以下のドキュメントが参考になりそう。

_How to render text - Bitmap Font Generator - Documentation
_File format - Bitmap Font Generator - Documentation
_Bitmap Font Generator - Documentation

まずは実験結果のスクリーンショットを。





等幅フォントと比べると、それらしい見た目になっている。

ただ、実装してみたものの、カーニングが妙な感じで悩んでしまって…。カーニングというのは、特定の文字と文字が並んだ時に間隔を調整して見た目の不自然さを減らす方法のこと。自分が仕様を正しく解釈できてない気配がしてきたので、今回はデフォルトでカーニング情報を利用しない状態にしておいた。一応、bmfont.drawstring() にフラグを指定すれば有効になるようにはしてある。

一部の文字が重なってしまっているのは、BMFont作成に使ったツール上で各パラメータの指定が適切ではなかったか、もしくは今回書いた処理にバグがあるのかもしれない。自分がBMFontの仕様を勘違いしている可能性は否定できない。

ちなみに、BMFont作成に使えるツールについては以前の日記にメモしてあった。

_mieki256's diary - ビットマップフォント画像を作れるツールについてメモ

ソースは以下。

実処理部分。

_bmfont.bi


テストサンプルその1。

_simple_sample.bas

#include "bmfont.bi"

Dim As bmfont bmfnt
bmfnt.loadInfo("bmfont_dejavu.fnt")

ScreenRes 320, 240, 32
bmfnt.loadImage()

bmfnt.drawstring(10, 10, "Hello World !")

sleep
bmfnt.destroy()

• #include "bmfont.bi" で bmfont というクラス相当(構造体 + 関数)が使えるようになる。
• bmfont.loadInfo() で .fntファイルを読み込んで解析して記録。
• bmfont.loadImage() で .fntファイルに書かれた画像ファイル(拡張子を .bmp に変更)をロード。
• bmfont.drawstring() でスクリーンに文字を描画。
• bmfont.destroy() でBMFont画像を破棄。

テストサンプルその2。コマンドラインオプションで .fntファイルを指定したり、.fntファイルの解析結果が上手くできているか確認するためのダンプ処理をつけてみた。

_test_bmfont.bas

Usage: test_bmfont.exe [INPUT.fnt] [--dump]

以下でコンパイル。

fbc simple_sample.bas
fbc test_bmfont.bas

今回利用したBMFontは以下。

_bmfont_dejavu.fnt
_bmfont_dejavu_0.bmp

_bmfont_roboto.fnt
_bmfont_roboto.bmp

_bmfont_vegur.fnt
_bmfont_vegur_0.bmp

各フォントの入手先と、フォントのライセンスについては、以下に書いておいた。

_readme.md


ファイル一式もzipにして置いておきます。自分が書いた部分は CC0 / Public Domain にしておくので使えそうなら自由に使ってください。

_fb_bmfont_20240215.zip