飴屋ぷろじぇくと

Category : FreeBASIC

--.--.--[--] スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

2014.11.12[水] FreeBASICの#Macroをテンプレート的に使ってみるテスト2


テンプレートマクロ第二弾。マップの実装です。但しあんまり速い実装ではありません。
マップというのはキーと値のペアを登録してキーを添え字にその値を取得できるクラスのことです。
map.bi
#define Map(T,V) T##_To_##V##_Map

#Macro Declare_Map(Ky,Va)
Type Map(Ky,Va)
Private:
    m_Keys(Any) As Ky
    m_Values(Any) As Va
Public:
    Declare Property Keys(i As Integer) As Ky
    Declare Property Items(i As Integer) As Va
    Declare Sub Clear
    Declare Property Size As Integer
    Declare Function add(k As Ky, v As Va) As Integer
    Declare Function find(k As Ky) As Integer
    Declare Operator [](k As Ky) ByRef As Va
End Type
#EndMacro

#Macro Implement_Map(Ky,Va)
Property Map(Ky,Va).Keys(i As Integer) As Ky
    Return m_Keys(i)
End Property

Property Map(Ky,Va).Items(i As Integer) As Va
    Return m_Values(i)
End Property

Property Map(Ky,Va).Size As Integer
    Return UBound(m_Keys) + 1
End Property

Sub Map(Ky,Va).Clear
    Erase m_Keys
    Erase m_Values
End Sub

Function Map(Ky,Va).add(k As Ky, v As Va) As Integer
    Dim u As Integer = UBound(m_Keys)
    Dim i As Integer
    if u < 0 Then
        Redim PreServe m_Keys(0), m_Values(0)
        m_Keys(0) = k
        m_Values(0) = v
        i = 0
    Else
        Dim n As Integer
        For n = 0 To u
            if m_Keys(n) >= k Then
                Exit For
            End If
        Next
        u = u + 1
        Redim PreServe m_Keys(u), m_Values(u)
        For i = u - 1 To n Step -1
            m_Keys(i + 1) = m_Keys(i)
            m_Values(i + 1) = m_Values(i)
        Next
        m_Keys(n) = k
        m_Values(n) = v
        i = n
    End If
    Return i
End Function

Function Map(Ky,Va).find(k As Ky) As Integer
    Dim u As Integer = UBound(m_Keys)
    Dim s As Integer = 0
    Dim t As Integer = u + 1
    Dim m As Integer = u \ 2
    
    Do While t > s + 1
        If k < m_Keys(m) Then
            t = m
            m = (s + t) \ 2
        ElseIf k > m_Keys(m) Then
            s = m
            m = (s + t) \ 2
        ElseIf k = keys(m) Then
            Return m
        Else
            Exit Do
        End If
    Loop
    Return -1
End Function

Operator Map(Ky,Va).[](k As Ky) ByRef As Va
    Dim n As Integer = find(k)
    if n = -1 Then
        Dim v As Va
        n = add(k, v)
    End If
    Return m_Values(n)
End Operator

#EndMacro


キーと値はキーでソートして格納し、検索はバイナリ検索で行っています。
要素数が膨大になると登録がかなりオーバーヘッドになりますのでもっと速い実装が欲しい場合は二分木のマップやハッシュマップ等を自力で作成するこををお勧めします。

使い方の例:
#include "map.bi"

Declare_Map(String,Long)
Implement_Map(String,Long)

Dim m As Map(String,Long)
Dim i As Integer

' []でアクセスするとそのキーの要素が自動で作られます
m["りんご"] = 45
m["みかん"] = 32
m["ぶどう"] = 210
m["めろん"] = 10000
m["すいか"] = 300
m["いちご"] = 15
m["れもん"] = 14675

'キーと値の列挙はそれぞれ別のインデックス付きプロパティでアクセスします。
For i = 0 To m.Size - 1
    Print m.Keys(i);" ";m.Items(i)
Next

'findメソッドは要素のインデックスを返します
Print m.find("りんご")
Print m.find("みかん")
Print m.find("とまと") '無い場合-1を返します

Print m["れもん"]
Print m["ぶどう"]
Print m["きゃべつ"] '[]アクセスの場合、存在しないキーは読み取りでも自動で作られます

スポンサーサイト

2014.11.08[土] FreeBASICの#Macroをテンプレート的に使ってみるテスト


FreeBASICは#defineや#includeなど、C言語のプリプロセッサ機能を取り込んでいてその殆どすべてが使えるようなんですが、さらにFB独自の拡張として#macro などという #define の複数行版が実装されてます。
FBでテンプレートと言えば、
http://ext.freebasic.net/tutorial/sat-04202013-2014/templates
http://ext.freebasic.net/dev-docs/files/ext/templates-bi.html
こんなのがあるようで、これはこれで力作みたいなんですが、利用者の少ない現状でこんなブラックボックスを紹介しても仕方がありません。ここはもっと中身が判るように、つまり読む人がFreeBASICという言語(本当はそのプリプロセッサですが)で何をしてるのか(何が出来るのか)が読み解けるように、C++のテンプレートのようなものを作って紹介してみようと思います。

定義:
#define Vector(T) T##_Vector

#Macro Declare_Vector(T)
#ifndef ___DECLARE__VECTOR__##T
#define ___DECLARE__VECTOR__##T
Type T##_Vector
    Dim v(Any) As T
    Declare Function Insert(i As Integer, value As T) As Integer
    Declare Function Remove(ByVal i As Integer) As Integer
    Declare Sub Clear()
    Declare Function Find(value As T) As Integer
    Declare Function Back() ByRef As T
    Declare Function Front() ByRef As T
    Declare Sub Push(value As T)
    Declare Sub Pop()
    Declare Operator [](i As Integer) ByRef As T
    Declare Property Size As Integer
    Declare Property Size (n As Integer)
End Type
#endif
#EndMacro

#Macro Implement_Vector(T)
Function T##_Vector.Insert(ByVal i As Integer, value As T) As Integer
    Dim n As Integer = UBound(v)
    Redim Preserve v(n+1)
    If i >= n+1 Then
        i = n+1
        v(i) = value
    Else
        Dim j As Integer
        If i < 0 Then i = 0
        For j = n To i Step -1
            v(j+1) = v(j)
        Next
        v(i) = value
    End If
    Return i
End Function
Function T##_Vector.Remove(ByVal i As Integer) As Integer
    Dim u As Integer = UBound(v)
    if i < 0 Then
        i = 0
    ElseIf i > u Then
        i = u
    End If
    if i >= 0 Then
        u = u - 1
        if u >= 0 Then
            Dim n As Integer
            For n = i To u
                v(n) = v(n+1)
            Next
            Redim Preserve v(u)
        Else
            Erase v
        End IF
    End If
    Return i
End Function
Sub T##_Vector.Clear()
    Erase v
End Sub
Function T##_Vector.Find(value As T) As Integer
    Dim i As Integer
    For i = 0 To UBound(v)
        If value = v(i) Then
            Return i
        End If
    Next
    Return -1
End Function
Function T##_Vector.Back() ByRef As T
    Return v(UBound(v))
End Function
Function T##_Vector.Front() ByRef As T
    Return v(LBound(v))
End Function
Sub T##_Vector.Push(value As T)
    Dim i As Integer = UBound(v) + 1
    Redim Preserve v(i)
    v(i) = value
End Sub
Sub T##_Vector.Pop()
    Dim i As Integer = UBound(v)
    if i > 0 then
        Redim Preserve v(i - 1)
    Else
        Erase v
    End If
End Sub
Operator T##_Vector.[](i As Integer) ByRef As T
    Return v(i)
End Operator
Property T##_Vector.Size As Integer
    Return UBound(v) + 1
End Property
Property T##_Vector.Size (n As Integer)
    If n <= 0 Then
        Erase v
    Else
        Redim Preserve v(n-1)
    End If
End Property
#EndMacro

 お判りと思いますが、これは「ベクタもどき」です。FBの可変長配列のラッパーになってます。なぜ「もどき」かと言えば変態的とも言われているC++のテンプレートの仕様をマクロだけで踏襲するのは不可能でしょうから。なので定義は三つに分けました。

最初の定義は型の名前を作る単純な#defineです。定義中の##は文字列を結合してくれるマクロ内で使う演算子です。
Vector(タイプ名)とやると Vector_タイプ名 に置換されます。
次が#macroの一つ目、Type宣言を生成します。Declare_Vector(タイプ名)とか書きます。
最後に実装部を生成する#macroがあります。
Implement_Vector(タイプ名)で実装部を生成。こちらを分けた理由は、同じ型のVectorを複数のソースで使用している場合に実態がダブってしまわないようにするためです。複数のソースをコンパイルして一つの実行ファイルにまとめる場合、実装部は全体で一つにする必要があります。

こんな風に使います:
'Vector(String)の定義を生成
Declare_Vector(String)
'Vector(String)の実装を生成
Implement_Vector(String)
'変数宣言
Dim v As Vector(String)
v.Push "ABC"
v.Push "DEFG"
v.Push "HIJ"
Print v.Size
Print v[0]
Print v[1]
Print v[2]
Print v.back
Print v.front
Print v.find("DEFG")
Print v.find("XYZ")

各メソッドはC++のstd::vectorを真似てますがイテレータはありません。というかイテレータという仕掛けはBASIC的でない気がするのですが如何でしょうか?

話を戻して、このように
Declare_Vector(Integer)
Implement_Vector(Integer)
とやればIntegerを要素とするVectorも生成できますし、それだけでなく、
Declare_Vector(MyString)
Implement_Vector(MyString)
このようにユーザー定義型でも要素に出来てしまいます。
ただしその型の変数に対して演算子=、演算子Let等が使えるようになっていることが条件ですが。

最後にこのテンプレートの解説:
Insert 指定した場所に要素を挿入します。
Remove 指定した場所の要素を削除します。
Clear 全ての要素を削除します。
Find 指定した値の要素を検索し、そのインデックスを返します
Back 一番後ろの要素を返します
Front 最初の要素を返します
Push 一番後ろに値を追加します
Pop 一番後ろの要素を削除します
Size 要素数を取得/設定します
[] 添字を使ってアクセスします

2014.11.07[金] FreeBASICのワイド文字列が使いにくい件(その2

まず前回のこの件ですが、
Windows版FreeBASICでの話ですが、Print命令等、コンソールに出力するステートメントには不具合があってWStringをまともに表示できません。出力文字数の計算に間違いがあるようで、漢字ひらがなカタカナ等多バイト文字を出そうとすると文字列が途中で途切れてしまいます。多分、ワイド文字での文字数分のバイト数(WindowsなのでSJISのバイト数)しか出力してないんだと思います。
 コンソールのフォントをラスターフォントにしてあるとこの症状が出て、MS ゴシックに変えると直りました。
cmdfont.png
その因果関係がよく判りませんが、内部処理の文字数取得とかがコンソールの状態に影響されるのでしょう。後で時間があったらFBのソースコードを見てみるつもりですが、とりあえず対処法が判ったので良しとします。

さて、本題のMyStringの実装の話になります。
「異常系が弱い」と書きましたが、案の定、初期状態のWStringを代入しようとしたり、MyStringが初期状態で何かしようとすると実行時にアクセス違反を起こして落ちてしまいました。
要はNULLポインタ問題ですね。
なのでその辺の対処をしました。
mystring.bi
Type MyString
Private:
    st As WString Ptr
Public:
    Declare Constructor
    Declare Constructor(s As WString)
    Declare Constructor(m As MyString)
    Declare Destructor
    Declare Operator Let(s As WString)
    Declare Operator Let(m As MyString)
    Declare Operator Cast ByRef As WString
    Declare Operator @ As WString Ptr
    Declare Operator [](i As Integer) As Integer
End Type
'Len()のオーバーロード
Declare Operator Len(m As MyString) As Integer

mystring.bas
#include "mystring.bi"

Constructor MyString
    st = 0
End Constructor

Constructor MyString(s As WString)
    This = s
End Constructor

Constructor MyString(m As MyString)
    This = m
End Constructor

Destructor MyString
    if st <> 0 Then
        Deallocate(st)
    End If
End Destructor

Operator MyString.Let(s As WString)
    Dim n As Integer = Len(*st)
    Dim ln As Integer = Len(s)
    If n < ln Then
        Dim p As WString Ptr = Reallocate(st, (Len(s) + 1) * Len(WString))
        if p <> 0 Then
            *p = s
            st = p
        Else
            *st = Left(s, n) '確保に失敗したら引数の方を切る
        End If
    ElseIf st <> 0 Then '自身がNULLでない
        if ln = 0 Then  '引数がNULLまたは空文字列
            (*st)[0] = 0
        Else
            *st = s
        End If
    End If
End Operator

Operator MyString.Let(m As MyString)
    This = *m.st
End Operator

Operator MyString.Cast ByRef As WString
    return *st
End Operator

Operator MyString.@ As WString Ptr
    return st
End Operator

Operator MyString.[](i As Integer) As Integer
    return (*st)[i]
End Operator

Operator Len(m As MyString) As Integer
    Return Len(*@m)
End Operator


あと、MidLeftRightの文字化け問題ですが、LeftRightに関しては第一引数がWStringとWString Ptrのどちらにも対応していて、こんな風に
Dim w As MyString = "文字列テスト1234"
Print Left(@w, 3)
Print Right(@w, 4)

変数の前に@(ポインタ演算子)をひとつ入れておけば問題を回避できることが判りました。
※前にも書きましたが、このMyStringは@を付けるとWStringのポインタを返すようになってます。

MidはWString Ptrではダメみたいです。
Dim value As MyString = "すとりんぐ"
Print Mid(*@value, 2, 2)
Print Mid(value & "", 2, 2)

このように*@を付けるか、結合演算をして明示的にWStringに変換させるしかありません。

今回はここまでです。

2014.11.05[水] FreeBASICのワイド文字列が使いにくい件


unicode.png

前に一度触れましたが、FreeBASICの標準データ型でユニコードを扱う文字列型ということになっているWString、これが結構不便なんです。
WString型は基本的に固定長でマニュアルでは可変長にするには自分で確保/拡張/解放(Allocate/Reallocate/Deallocate)するしかないようなことが書かれてますが、これは「BASIC言語としてどうなの?」と思いますよね。
そしてそんな仕様の為、変数宣言は必ずサイズを指定、もしくはポインタとして宣言が強要されます。
Dim w As WString * 16 = "ワイド" 'サイズを指定
Dim z As WString Ptr   'ポインタとして宣言
一応、宣言した長さ以上の文字列をセットすると自動的にそのサイズに収まるように切り詰められるのは「BASICらしい」とも言えますが、この制限のせいなのかリテラル文字列が文脈によってWString扱いになったりWString Ptr扱いになったりと仕様がちょっと歪なことになっています。

しかしこの制限の影響はこれだけにはとどまりません。

2014.10.30[木] WindowsリソースからFreeBASIC+GTK(その3)


UTAUを作った動機を知れば自ずと判ることなんですが、飴屋はこんな風に手間かけて手間を減らすツールを作るのが好きなんです。

というわけで、今回は画像関係の話題。

gtk-app-dlg.png

こんな画面をサンプルに載せましたが、このイメージ、実は問題がありまして、これって、実行時に画像を読み込んでいるんです。具体的にはGdkPixbufに読み込んでいます。
bitmap1 = gdk_pixbuf_new_from_file("./apple.bmp", NULL)
これを以下のようにしてGtkImageにして表示してます。
image1 = gtk_image_new_from_pixbuf(butmap1)
まあこれはこれで良いんですが、実行時に結合となると後々厄介かもしれないので本来のリソースのように実行ファイルに埋め込めないものかとやってみました。

まずソースにバイナリデータを記述するのですが、FreeBasicではこんな表記が出来るようです。
Dim pixdata As String = !"\212\234\127\128\129\065\066"
そしてデータはやたら長いので行継続記号"_"を使って、
Dim pixdata As String = _
!"\212\234\127\128\129\065\066\128\129\065\066\128\129\065\066" _
!"\234\127\128\129\065\212\173\129\065\128\066\128\129\154\170" _
!"\252\234\227\128\129\065\226\065\128\129\066\066\128\129\165"
こんな風に書きます。
変換プログラム内で画像ファイルをこのようなソースに変換するわけですが、折角なのでこちらでの画像の読み込みもGTKを使用しました。実装はこんな関数。
/*
 * 画像リソースをソースコードに変換する
 */

void pixToText(CodeData *cds, const char *filename, const char *pname) {
    string text;
    char fname[256];
    strcpy(fname, filename);
    fname[0] = ' ';
    char *p = strchr(fname, '"');
    if (p) *p = 0;
    strltrim(fname);
    GdkPixbuf *pixbuf = gdk_pixbuf_new_from_file(fname, NULL);
    int n_channels = gdk_pixbuf_get_n_channels(pixbuf);
    gboolean has_alpha = gdk_pixbuf_get_has_alpha(pixbuf);
    guchar *pix = gdk_pixbuf_get_pixels(pixbuf);
    int rowstride = gdk_pixbuf_get_rowstride(pixbuf);
    int bpsamp = gdk_pixbuf_get_bits_per_sample(pixbuf);
    int w = gdk_pixbuf_get_width(pixbuf);
    int h = gdk_pixbuf_get_height(pixbuf);
    int len = rowstride * h;
    sprintf(buf, "Const %s_n_channels As Integer = %d\n", pname, n_channels);
    text += buf;
    sprintf(buf, "Const %s_has_alpha As Integer = %d\n", pname, has_alpha);
    text += buf;
    sprintf(buf, "Const %s_bits_per_sample As Integer = %d\n", pname, bpsamp);
    text += buf;
    sprintf(buf, "Const %s_width As Integer = %d\n", pname, w);
    text += buf;
    sprintf(buf, "Const %s_height As Integer = %d\n", pname, h);
    text += buf;
    sprintf(buf, "Const %s_rowstride As Integer = %d\n", pname, rowstride);
    text += buf;
    sprintf(buf, "Const %s_pixcels As String = _\n!\"", pname);
    text += buf;
    for (int i = 0; i < len; i++) {
        sprintf(buf, "\\%03u", pix[i]);
        if (i > 0 && i % 25 == 0) {
            text += "\" _\n!\"";
        }
        text += buf;
    }
    text += "\"\n";
    
    sprintf(buf, "%s.bi", pname);
    FILE *fb = fopen(buf, "wt");
    fprintf(fb, "%s", text.c_str());
    fclose(fb);

    sprintf(buf, "#include \"%s.bi\"\n", pname);
    cds->incs += buf;
}

ソースに埋め込むコードは画像のバイナリデータをAscii表現しているので無駄に長くなります。なので出力ファイルを分割して画像のコードはインクルードファイルに格納しています。もちろん #include は自動で挿入されます。

Copyright © 飴屋/菖蒲

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。