ざっと眺める。ソースツリーのGauche/examples/spigotを参照する。
ライブラリです。
ヘッダです。 spigot.cに定義してて、外部公開するものを書いておく。 ここにはScm_Init_spigotlibも含める必要がありそうなので注意。
いわゆるスタブファイル。
ここにC界で定義した関数名とScheme界に見せるプロシージャの名前とを関連付ける。
文字列は、genstubで処理されるとそのままCのコードとして埋め込まれる。
"#include \"spigot.h\""が必要なようなので注意。
で、どうもこっちが裏方をやってくれているらしい。
つまり拡張ライブラリで使えるようにしたCの関数をScheme界から呼び出せるようにするために仕組みを提供してくれている。
scmライブラリファイル。
以上結構単純な構造。
では、genstubしてみる。
> locate genstub /usr/local/share/gauche/0.8.7/lib/genstub
発見しました。このgenstubを使って.stubファイルから.cを生成してみる。
> gosh /usr/local/share/gauche/0.8.7/lib/genstub spigotlib.stub > ll : -rw------- 1 cut-sea users 1819 Sep 2 10:02 spigotlib.c :
生成されてる。 spigotlib.stubがcに変換されただけだから役割は変わらないだろう。
とりあえず、一通り眺めたので、ビルドしてみる。
> ./DIST gen > ./configure > make /usr/local/bin/gauche-package compile --verbose spigot spigot.c spigotlib.stub '/usr/local/lib/gauche/0.8.7/i386-unknown-netbsdelf3.99.24/gauche-config' --fixup-extension 'spigot' gcc -std=gnu99 -c -I'/usr/local/lib/gauche/0.8.7/include' -fPIC -DPIC -o 'spigot_head.o' 'spigot_head.c' gcc -std=gnu99 -c -I'/usr/local/lib/gauche/0.8.7/include' -fPIC -DPIC -o 'spigot.o' 'spigot.c' '/usr/local/lib/gauche/0.8.7/i386-unknown-netbsdelf3.99.24/gosh' genstub spigotlib.stub gcc -std=gnu99 -c -I'/usr/local/lib/gauche/0.8.7/include' -fPIC -DPIC -o 'spigotlib.o' 'spigotlib.c' gcc -std=gnu99 -c -I'/usr/local/lib/gauche/0.8.7/include' -fPIC -DPIC -o 'spigot_tail.o' 'spigot_tail.c' gcc -std=gnu99 -L'/usr/local/lib/gauche/0.8.7/i386-unknown-netbsdelf3.99.24' -L/usr/pkg/lib -Wl,-rpath /usr/local/lib -Wl,-rpath /usr/pkg/lib -Wl,-rpath /usr/lib -shared -o spigot.so 'spigot_head.o' 'spigot.o' 'spigotlib.o' 'spigot_tail.o' -lgauche -lcrypt -lutil -lm -lpthread
というわけで、spigot_head.cとかspigot_tail.cなんかも生成されてる。 中身はなんかメモリエリアのアドレスを捕まえてるっぽいんだけど不明。 まぁ気にするまい。
で、spigot_head.o spigot_tail.o spigot.o spigotlib.oとgaucheなどその他のライブラリとをリンケージしてDSOを生成という流れですね。
spigot.scmとspigot.soってことになりますね。 これらをインストールすればGaucheからuseできるようになる。
読みましょう。内容的には以前の内容なので少し古いけど、読んでも無駄じゃない。 むしろ自動化されちゃったために分からない部分がちゃんと書いてある。
今回は省略。
spigotは自分でCのライブラリを書く視点で、
mqueueは実在するCのためのCのライブラリがある場合に、
そのバインディングを書くためのサンプルらしい。
つまり、システムにはmqueue.soとmqueue.hがある場合に、 gauche-mqueue.soとmqueue.scmを作成して、こいつらを呼ぶっていう構造だね。
ってことは大抵はこっちの形態の方を使うことになるんだなー。
でも本質的にはなんも変わらないかな。
Cでプログラムを書く時に、.soファイルを自分で作ることがあるなら、
それを自分で作るか、既存の.soを使わせてもらうかの差ってだけだし。
では、完全に理解できてる訳じゃないけど、 とにかく書けば分かるだろうってことで見切り発車。
とりあえず、どんどんメモっていく。
> gauche-package generate Gauche-gd > cd Gauche-gd > mkdir graphic > mv gd.scm graphic
さっそく煮つまった。。。orz
なんか、Makefile.inだかconfigure.acだかに細工しないとダメみたい。
つまりCのライブラリがインストールされている先を埋めこんでやらなきゃならない。
ちなみにGauche-gdchartを見るとconfigure.acもだいぶ違う。
基本的にはライブラリがあるかどうかのチェックをしてるだけみたいなんだけど。
それを入れた時点で見つけられないって叱られるのだ。
なんだか午前中はcで書く以前に、Makefile.inやconfigure.acあたりを 何とかせにゃならんというのが見えてきて、ちょっと萎えそうなキモチです。 気を取り直して最初からもっかいやり直し。
> gauche-package generate Gauche-gd > cd Gauche-gd > ./DIST tgz > tar zxvf Gauche-gd-1.0.tgz > cd Gauche-gd-1.0 > ./configure > make > make check
まだ中身がないので当然ですが,passします。。。
元祖gd.hと混乱するので変更します。 あわせて、gdlib.stubの方も変更。 ちゃんと一歩一歩、make checkまで確認して進めます。
gdlib.stubに追加してみます。 やっぱりMakefile.inやconfigure.acあたりを知ってないと書けそうにないのですが、 とりあえず、ちびちびと。。。。 つまり、へたにautoconfとかの記法を使わずに、 即値で/usr/pkg/includeとか書きます。 これでOKなら、じゃー次にそう出力されるように変更していけば いーじゃんっていう高田純次的ユースケサンタマリア手法です。
で、最初にgauche-packageでgenerateしただけのもののと差分はこんだけです。
cut-sea@nkisi> diff -ur Gauche-gd.org Gauche-gd Only in Gauche-gd: DIST_EXCLUDE_X diff -ur Gauche-gd.org/Makefile.in Gauche-gd/Makefile.in --- Gauche-gd.org/Makefile.in 2006-09-02 13:38:34.000000000 +0900 +++ Gauche-gd/Makefile.in 2006-09-02 13:36:47.000000000 +0900 @@ -19,6 +19,11 @@ GAUCHE_PACKAGE = @GAUCHE_PACKAGE@ INSTALL = @GAUCHE_INSTALL@ +# add +CPPFLAGS = -I. -I/usr/pkg/include # @CPPFLAGS@ +LDFLAGS = # @LDFLAGS@ +LIBS = -lgd # @LIBS@ + # Other parameters SOEXT = @SOEXT@ OBJEXT = @OBJEXT@ @@ -45,7 +50,11 @@ all : $(TARGET) gd.$(SOEXT): $(gd_SRCS) - $(GAUCHE_PACKAGE) compile --verbose gd $(gd_SRCS) + $(GAUCHE_PACKAGE) compile --verbose \ + --cppflags="$(CPPFLAGS)" \ + --ldflags="$(LDFLAGS)" \ + --libs="$(LIBS)" \ + gd $(gd_SRCS) check : all @rm -f test.log Only in Gauche-gd: VERSION Only in Gauche-gd: configure Only in Gauche-gd: gauche-gd.h diff -ur Gauche-gd.org/gd.c Gauche-gd/gd.c --- Gauche-gd.org/gd.c 2006-09-02 13:38:34.000000000 +0900 +++ Gauche-gd/gd.c 2006-09-02 13:22:58.000000000 +0900 @@ -2,7 +2,7 @@ * gd.c */ -#include "gd.h" +#include "gauche-gd.h" /* * The following function is a dummy one; replace it for Only in Gauche-gd.org: gd.h diff -ur Gauche-gd.org/gdlib.stub Gauche-gd/gdlib.stub --- Gauche-gd.org/gdlib.stub 2006-09-02 13:38:34.000000000 +0900 +++ Gauche-gd/gdlib.stub 2006-09-02 13:24:56.000000000 +0900 @@ -3,7 +3,9 @@ ;;; " -#include \"gd.h\" +#include \"gauche-gd.h\" + +#include <gd.h> " ;; The following entry is a dummy one. cut-sea@nkisi>
これで、一応make checkまではOKで、
cut-sea@nkisi> ldd gd.so gd.so: -lcrypt.0 => /usr/lib/libcrypt.so.0 -lutil.7 => /usr/lib/libutil.so.7 -lm.0 => /usr/lib/libm387.so.0 -lm.0 => /usr/lib/libm.so.0 -lpthread.0 => /usr/lib/libpthread.so.0 -lgauche.0 => /usr/local/lib/libgauche.so.0 -ljpeg.62 => /usr/pkg/lib/libjpeg.so.62 -lz.0 => /usr/lib/libz.so.0 -lfreetype.6 => /usr/pkg/lib/libfreetype.so.6 -lpng12.0 => /usr/pkg/lib/libpng12.so.0 -lgd.2 => /usr/pkg/lib/libgd.so.2
と、ちゃんとlgdを指しているようです。
当然Makefile.inに入れた3行ほどが気持ち悪いのでなんとかしたいです。
でも、とりあえず、正解の形は見えたので、これを目指せばいいってことで。。。
とりあえず、以下のようになりました。
--- Gauche-gd.org/Makefile.in 2006-09-02 13:38:34.000000000 +0900 +++ Gauche-gd/Makefile.in 2006-09-02 14:02:37.000000000 +0900 @@ -19,6 +19,11 @@ GAUCHE_PACKAGE = @GAUCHE_PACKAGE@ INSTALL = @GAUCHE_INSTALL@ +# add +CPPFLAGS = @CPPFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + # Other parameters SOEXT = @SOEXT@ OBJEXT = @OBJEXT@ @@ -45,7 +50,11 @@ all : $(TARGET) gd.$(SOEXT): $(gd_SRCS) - $(GAUCHE_PACKAGE) compile --verbose gd $(gd_SRCS) + $(GAUCHE_PACKAGE) compile --verbose \ + --cppflags="$(CPPFLAGS)" \ + --ldflags="$(LDFLAGS)" \ + --libs="$(LIBS)" \ + gd $(gd_SRCS) check : all @rm -f test.log Only in Gauche-gd: VERSION Only in Gauche-gd: configure diff -ur Gauche-gd.org/configure.ac Gauche-gd/configure.ac --- Gauche-gd.org/configure.ac 2006-09-02 13:38:34.000000000 +0900 +++ Gauche-gd/configure.ac 2006-09-02 14:02:24.000000000 +0900 @@ -19,6 +19,15 @@ AC_PATH_PROG([GAUCHE_INSTALL], gauche-install) AC_PATH_PROG([GAUCHE_CESCONV], gauche-cesconv) +dnl add +dnl +CPPFLAGS="-I. -I`gdlib-config --includedir` $CPPFLAGS" +LDFLAGS="-L`gdlib-config --libdir` $LDFLAGS" +LIBS="-lgd $LIBS" +AC_SUBST(CPPFLAGS) +AC_SUBST(LDFLAGS) +AC_SUBST(LIBS) + dnl Usually these parameters are set by AC_PROG_CC, but we'd rather use dnl the same one as Gauche has been compiled with. SOEXT=`$GAUCHE_CONFIG --so-suffix` Only in Gauche-gd: gauche-gd.h diff -ur Gauche-gd.org/gd.c Gauche-gd/gd.c --- Gauche-gd.org/gd.c 2006-09-02 13:38:34.000000000 +0900 +++ Gauche-gd/gd.c 2006-09-02 13:22:58.000000000 +0900 @@ -2,7 +2,7 @@ * gd.c */ -#include "gd.h" +#include "gauche-gd.h" /* * The following function is a dummy one; replace it for Only in Gauche-gd.org/: gd.h diff -ur Gauche-gd.org/gdlib.stub Gauche-gd/gdlib.stub --- Gauche-gd.org/gdlib.stub 2006-09-02 13:38:34.000000000 +0900 +++ Gauche-gd/gdlib.stub 2006-09-02 13:24:56.000000000 +0900 @@ -3,7 +3,9 @@ ;;; " -#include \"gd.h\" +#include \"gauche-gd.h\" + +#include <gd.h> " ;; The following entry is a dummy one.
Makefile.inにはCPPFLAGS, LDFLAGS, LIBSを追加。 こいつの右辺の@CPPFLAGS@とかは後述のconfigureで書きかえちゃいます。 あと、gd.soをmakeするときに、これらのオプションを追加するようにしておきます。 どうやら--cppflagsとかその辺が対応します。 どうやらと言っているのは、Gauche-gdchartなどの他のバインディングを参考に書いているからですよ。はい。
詳しいことは知りませんが、 例えば、CPPFLAGS="-I. -I`gdlib-config --includedir` $CPPFLAGS"と書くと、 shellスクリプトみたいに展開してくれます。 さらにAC_SUBST(CPPFLAGS)とすれば、Makefile.inの@CPPFLAGS@という文字列を 置き換えてくれるらしいです。
configure.acに書いたgdlib-configってのはgdをインストールするとついてくるもので、
ヘッダやライブラリの本体がどのディレクトリパスにあるか教えてくれるもの。
こいつを使って、-Iや-Lにパスを教えてやろうという企みです。
じゃ、そういうほげほげconfigみたいのが無いライブラリだとどうなるのか?
そういう場合にはconfigure時にユーザに直接指定してもらうとか、
そういうことになるのかな。。。
ということで、その辺が分かってきたら、
他人の書いたバインディングを自分が使う時にも、
引っ掛かった時に調査できるようになる。(かも)
当然こまめにmake checkしておくこと。
では、現在はgdというモジュールになってるものをgraphic.gdという風に下位に持ち込みましょう。 graphicディレクトリを掘って、gd.scmをそこへ移動します。 でもって、それに合わせて変更です。
--- Gauche-gd.org/Makefile.in 2006-09-02 13:38:34.000000000 +0900 +++ Gauche-gd/Makefile.in 2006-09-02 15:38:11.000000000 +0900 @@ -19,6 +19,11 @@ GAUCHE_PACKAGE = @GAUCHE_PACKAGE@ INSTALL = @GAUCHE_INSTALL@ +# add +CPPFLAGS = @CPPFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + # Other parameters SOEXT = @SOEXT@ OBJEXT = @OBJEXT@ @@ -28,7 +33,7 @@ PACKAGE = Gauche-gd ARCHFILES = gd.$(SOEXT) -SCMFILES = gd.scm +SCMFILES = graphic/gd.scm HEADERS = TARGET = $(ARCHFILES) @@ -45,7 +50,11 @@ all : $(TARGET) gd.$(SOEXT): $(gd_SRCS) - $(GAUCHE_PACKAGE) compile --verbose gd $(gd_SRCS) + $(GAUCHE_PACKAGE) compile --verbose \ + --cppflags="$(CPPFLAGS)" \ + --ldflags="$(LDFLAGS)" \ + --libs="$(LIBS)" \ + gd $(gd_SRCS) check : all @rm -f test.log Only in Gauche-gd: VERSION Only in Gauche-gd: configure diff -ur Gauche-gd.org/configure.ac Gauche-gd/configure.ac --- Gauche-gd.org/configure.ac 2006-09-02 13:38:34.000000000 +0900 +++ Gauche-gd/configure.ac 2006-09-02 15:38:11.000000000 +0900 @@ -19,6 +19,15 @@ AC_PATH_PROG([GAUCHE_INSTALL], gauche-install) AC_PATH_PROG([GAUCHE_CESCONV], gauche-cesconv) +dnl add +dnl +CPPFLAGS="-I. -I`gdlib-config --includedir` $CPPFLAGS" +LDFLAGS="-L`gdlib-config --libdir` $LDFLAGS" +LIBS="-lgd $LIBS" +AC_SUBST(CPPFLAGS) +AC_SUBST(LDFLAGS) +AC_SUBST(LIBS) + dnl Usually these parameters are set by AC_PROG_CC, but we'd rather use dnl the same one as Gauche has been compiled with. SOEXT=`$GAUCHE_CONFIG --so-suffix` Only in Gauche-gd: gauche-gd.h diff -ur Gauche-gd.org/gd.c Gauche-gd/gd.c --- Gauche-gd.org/gd.c 2006-09-02 13:38:34.000000000 +0900 +++ Gauche-gd/gd.c 2006-09-02 15:38:11.000000000 +0900 @@ -2,7 +2,7 @@ * gd.c */ -#include "gd.h" +#include "gauche-gd.h" /* * The following function is a dummy one; replace it for @@ -27,7 +27,7 @@ SCM_INIT_EXTENSION(gd); /* Create the module if it doesn't exist yet. */ - mod = SCM_MODULE(SCM_FIND_MODULE("gd", TRUE)); + mod = SCM_MODULE(SCM_FIND_MODULE("graphic.gd", TRUE)); /* Register stub-generated procedures */ Scm_Init_gdlib(mod); Only in Gauche-gd.org/: gd.h Only in Gauche-gd.org/: gd.scm diff -ur Gauche-gd.org/gdlib.stub Gauche-gd/gdlib.stub --- Gauche-gd.org/gdlib.stub 2006-09-02 13:38:34.000000000 +0900 +++ Gauche-gd/gdlib.stub 2006-09-02 15:38:11.000000000 +0900 @@ -3,7 +3,9 @@ ;;; " -#include \"gd.h\" +#include \"gauche-gd.h\" + +#include <gd.h> " ;; The following entry is a dummy one. Only in Gauche-gd: graphic diff -ur Gauche-gd.org/test.scm Gauche-gd/test.scm --- Gauche-gd.org/test.scm 2006-09-02 13:38:34.000000000 +0900 +++ Gauche-gd/test.scm 2006-09-02 15:38:11.000000000 +0900 @@ -4,9 +4,9 @@ (use gauche.test) -(test-start "gd") -(use gd) -(test-module 'gd) +(test-start "graphic.gd") +(use graphic.gd) +(test-module 'graphic.gd) ;; The following is a dummy test code. ;; Replace it for your tests.
変更個所は広いので、漏れがないようにしないといけない。 通れば、ようやくgdに関係する本題の開発に着手できるようになる。
とりあえず、はぢめてのSubversionって感じで。。。
ざっと見てみる。 まず、構造体からかなー。 いや、よく分からないので簡単なところから。。。
では以下のところを作ってみる。
#define gdMaxColors 256 (snip) #define gdAlphaMax 127 #define gdAlphaOpaque 0 #define gdAlphaTransparent 127 #define gdRedMax 255 #define gdGreenMax 255 #define gdBlueMax 255 #define gdTrueColorGetAlpha(c) (((c) & 0x7F000000) >> 24) #define gdTrueColorGetRed(c) (((c) & 0xFF0000) >> 16) #define gdTrueColorGetGreen(c) (((c) & 0x00FF00) >> 8) #define gdTrueColorGetBlue(c) ((c) & 0x0000FF)
という方針。これはkoguroさんが普段やる時の方針らしい。 やっぱり真似てみよう。
Subversionを使い始めたので、それで見てみると。。。
cut-sea@nkisi> svn diff Index: graphic/gd.scm =================================================================== --- graphic/gd.scm (リビジョン 1) +++ graphic/gd.scm (作業コピー) @@ -4,6 +4,18 @@ (define-module graphic.gd (export test-gd ;; dummy + gdMaxColors + gdAlphaMax + gdAlphaOpaque + gdAlphaTransparent + gdRedMax + gdGreenMax + gdBlueMax + ;; + gdTrueColorGetAlpha + gdTrueColorGetRed + gdTrueColorGetGreen + gdTrueColorGetBlue ) ) (select-module graphic.gd) Index: gdlib.stub =================================================================== --- gdlib.stub (リビジョン 1) +++ gdlib.stub (作業コピー) @@ -14,7 +14,23 @@ (define-cproc test-gd () (return "test_gd")) +(define-enum gdMaxColors) +(define-enum gdAlphaMax) +(define-enum gdAlphaOpaque) +(define-enum gdAlphaTransparent) +(define-enum gdRedMax) +(define-enum gdGreenMax) +(define-enum gdBlueMax) +(define-cproc gdTrueColorGetAlpha (c::<int>) + (body <int> "SCM_RESULT = ((c & 0x7F000000) >> 24);")) +(define-cproc gdTrueColorGetRed (c::<int>) + (body <int> "SCM_RESULT = ((c & 0xFF0000) >> 16);")) +(define-cproc gdTrueColorGetGreen (c::<int>) + (body <int> "SCM_RESULT = ((c & 0x00FF00) >> 8);")) +(define-cproc gdTrueColorGetBlue (c::<int>) + (body <int> "SCM_RESULT = (c & 0x0000FF);")) + ;; Local variables: ;; mode: scheme ;; end:
おいおい、こんな適当で動くのかよーって思ったら。。。
cut-sea@nkisi> gosh -I. gosh> (use graphic.gd) #<undef> gosh> (apropos 'gd) gdAlphaMax (graphic.gd) gdAlphaOpaque (graphic.gd) gdAlphaTransparent (graphic.gd) gdBlueMax (graphic.gd) gdGreenMax (graphic.gd) gdMaxColors (graphic.gd) gdRedMax (graphic.gd) gdTrueColorGetAlpha (graphic.gd) gdTrueColorGetBlue (graphic.gd) gdTrueColorGetGreen (graphic.gd) gdTrueColorGetRed (graphic.gd) test-gd (graphic.gd) gosh> gdTrueColorGetAlpha #<subr gdTrueColorGetAlpha> gosh> (gdTrueColorGetAlpha #x808080) 0 gosh> (gdTrueColorGetRed #x123456) 18 gosh> (gdTrueColorGetGreen #x123456) 52 gosh> #x34 52 gosh> (gdTrueColorGetBlue #x123456) 86 gosh> #x56 86
スゲー!! なんか関数マクロをやっただけだけど、define-cprocがこんな風に動くんならなんとかなるかも。
あとdefine-cclass周りが未体験だから、そこに不安が残るけど。
さて、typedefでgdImageとかgdFontとかが書かれてるので、
こっちにも対応するものを追加する。
この辺は多分Gauche:MeCabに定義されているものをマネてやればいいんだろう。
あ、あと上でツッコミ頂いた部分の変更も入れてる。
それと、テストコードの方も溜まるとやらなそうなので、
ちょっとずつ実装して覚えている内に進めておく。
cut-sea@nkisi> svn diff Index: test.scm =================================================================== --- test.scm (リビジョン 1) +++ test.scm (作業コピー) @@ -13,6 +13,31 @@ (test* "test-gd" "gd is working" (test-gd)) +(test* "gdMaxColors" 256 + gdMaxColors) +(test* "gdAlphaMax" 127 + gdAlphaMax) +(test* "gdAlphaOpaque" 0 + gdAlphaOpaque) +(test* "gdAlphaTransparent" 127 + gdAlphaTransparent) +(test* "gdRedMax" 255 + gdRedMax) +(test* "gdGreenMax" 255 + gdGreenMax) +(test* "gdBlueMax" 255 + gdBlueMax) + +(test* "gdTrueColorGetAlpha" #x7f + (gdTrueColorGetAlpha #xff000000)) +(test* "gdTrueColorGetRed" #xff + (gdTrueColorGetRed #x00ff0000)) +(test* "gdTrueColorGetGreen" #xff + (gdTrueColorGetGreen #x0000ff00)) +(test* "gdTrueColorGetBlue" #xff + (gdTrueColorGetBlue #x000000ff)) + + ;; epilogue (test-end) Index: graphic/gd.scm =================================================================== --- graphic/gd.scm (リビジョン 2) +++ graphic/gd.scm (作業コピー) @@ -16,6 +16,9 @@ gdTrueColorGetRed gdTrueColorGetGreen gdTrueColorGetBlue + ;; + <gdimage> + <gdfont> ) ) (select-module graphic.gd) Index: gdlib.stub =================================================================== --- gdlib.stub (リビジョン 2) +++ gdlib.stub (作業コピー) @@ -23,14 +23,45 @@ (define-enum gdBlueMax) (define-cproc gdTrueColorGetAlpha (c::<int>) - (body <int> "SCM_RESULT = ((c & 0x7F000000) >> 24);")) + (expr <int> "((c & 0x7F000000) >> 24)")) (define-cproc gdTrueColorGetRed (c::<int>) - (body <int> "SCM_RESULT = ((c & 0xFF0000) >> 16);")) + (expr <int> "((c & 0xFF0000) >> 16)")) (define-cproc gdTrueColorGetGreen (c::<int>) - (body <int> "SCM_RESULT = ((c & 0x00FF00) >> 8);")) + (expr <int> "((c & 0x00FF00) >> 8)")) (define-cproc gdTrueColorGetBlue (c::<int>) - (body <int> "SCM_RESULT = (c & 0x0000FF);")) + (expr <int> "(c & 0x0000FF)")) +" +typedef struct ScmGdImageRec { + SCM_HEADER; + gdImage* image; +} ScmGdImage; + +SCM_CLASS_DECL(Scm_GdImageClass); +#define SCM_CLASS_GDIMAGE (&Scm_GdImageClass) +#define SCM_GDIMAGE(obj) ((ScmGdImage*)(obj)) +#define SCM_GDIMAGEP(obj) (SCM_XTYPEP(obj, SCM_CLASS_GDIMAGE)) +" + +(define-cclass <gdimage> :base "ScmGdImage*" "Scm_GdImageClass" + () + ()) + +" +typedef struct ScmGdFontRec { + SCM_HEADER; + gdFont* font; +} ScmGdFont; + +SCM_CLASS_DECL(Scm_GdFontClass); +#define SCM_CLASS_GDFONT (&Scm_GdFontClass) +#define SCM_GDFONT(obj) ((ScmGdFont*)(obj)) +#define SCM_GDFONTP(obj) (SCM_XTYPEP(obj, SCM_CLASS_GDFONT)) +" +(define-cclass <gdfont> :base "ScmGdFont*" "Scm_GdFontClass" + () + ()) + ;; Local variables: ;; mode: scheme ;; end:
確認するとこんな感じ。
cut-sea@nkisi> gosh -I. gosh> (use graphic.gd) #<undef> gosh> (apropos 'gd) <gdfont-meta> (graphic.gd) <gdfont> (graphic.gd) <gdimage-meta> (graphic.gd) <gdimage> (graphic.gd) gdAlphaMax (graphic.gd) gdAlphaOpaque (graphic.gd) gdAlphaTransparent (graphic.gd) gdBlueMax (graphic.gd) gdGreenMax (graphic.gd) gdMaxColors (graphic.gd) gdRedMax (graphic.gd) gdTrueColorGetAlpha (graphic.gd) gdTrueColorGetBlue (graphic.gd) gdTrueColorGetGreen (graphic.gd) gdTrueColorGetRed (graphic.gd) test-gd (graphic.gd) gosh> (d <gdimage>) #<class <gdimage>> is an instance of class <gdimage-meta> slots: name : <gdimage> cpl : (#<class <gdimage>> #<class <top>>) direct-supers: (#<class <top>>) accessors : () slots : () direct-slots: () num-instance-slots: 0 direct-subclasses: () direct-methods: () initargs : () defined-modules: () redefined : #f category : base gosh> (d <gdfont>) #<class <gdfont>> is an instance of class <gdfont-meta> slots: name : <gdfont> cpl : (#<class <gdfont>> #<class <top>>) direct-supers: (#<class <top>>) accessors : () slots : () direct-slots: () num-instance-slots: 0 direct-subclasses: () direct-methods: () initargs : () defined-modules: () redefined : #f category : base
categoryが:baseだと、Scheme界で、あとで継承できるらしい。。。
まず、<gdimage>とか<gdfont>を<gdImage>と<gdFont>に変更した。 あと、gdAlphaBlendがどういうものかよく分からなかったので、 ほったらかしにしてたけど、一応実装することにした。
cut-sea@nkisi> svn diff Index: test.scm =================================================================== --- test.scm (リビジョン 3) +++ test.scm (作業コピー) @@ -37,6 +37,10 @@ (test* "gdTrueColorGetBlue" #xff (gdTrueColorGetBlue #x000000ff)) +(test* "gdAlphaBlend" 2 + (gdAlphaBlend 1 2)) +(test* "gdAlphaBlend" 3 + (gdAlphaBlend 2 3)) ;; epilogue (test-end) Index: graphic/gd.scm =================================================================== --- graphic/gd.scm (リビジョン 3) +++ graphic/gd.scm (作業コピー) @@ -16,9 +16,10 @@ gdTrueColorGetRed gdTrueColorGetGreen gdTrueColorGetBlue + gdAlphaBlend ;; - <gdimage> - <gdfont> + <gdImage> + <gdFont> ) ) (select-module graphic.gd) Index: gdlib.stub =================================================================== --- gdlib.stub (リビジョン 3) +++ gdlib.stub (作業コピー) @@ -31,6 +31,9 @@ (define-cproc gdTrueColorGetBlue (c::<int>) (expr <int> "(c & 0x0000FF)")) +(define-cproc gdAlphaBlend (dest::<int> src::<int>) + (body <int> "SCM_RESULT = gdAlphaBlend(dest, src);")) + " typedef struct ScmGdImageRec { SCM_HEADER; @@ -43,7 +46,7 @@ #define SCM_GDIMAGEP(obj) (SCM_XTYPEP(obj, SCM_CLASS_GDIMAGE)) " -(define-cclass <gdimage> :base "ScmGdImage*" "Scm_GdImageClass" +(define-cclass <gdImage> :base "ScmGdImage*" "Scm_GdImageClass" () ()) @@ -58,7 +61,7 @@ #define SCM_GDFONT(obj) ((ScmGdFont*)(obj)) #define SCM_GDFONTP(obj) (SCM_XTYPEP(obj, SCM_CLASS_GDFONT)) " -(define-cclass <gdfont> :base "ScmGdFont*" "Scm_GdFontClass" +(define-cclass <gdFont> :base "ScmGdFont*" "Scm_GdFontClass" () ())
(define-cproc gdAlphaBlend (dest::<int> src::<int>) (body <int> "SCM_RESULT = gdAlphaBlend(dest, src);"))こういうの見ると、「あらら、C界とScheme界の名称が同じになっちゃった。 害はないような気がするけど、混乱しそうねぇ。 こういう場合ってgd:gdAlphaBlendってした方がいいのかしらん。 あるいはgd:AlphaBlendとか。
ほりゃ。
Index: test.scm =================================================================== --- test.scm (リビジョン 6) +++ test.scm (作業コピー) @@ -42,6 +42,32 @@ (test* "gdAlphaBlend" 3 (gdAlphaBlend 2 3)) +(test* "gdDashSize" 4 + gdDashSize) +(test* "gdStyled" -2 + gdStyled) +(test* "gdBrushed" -3 + gdBrushed) +(test* "gdStyledBrushed" -4 + gdStyledBrushed) +(test* "gdTiled" -5 + gdTiled) +(test* "gdTransparent" -6 + gdTransparent) +(test* "gdAntiAliased" -7 + gdAntiAliased) + +(define im (gdImageCreate 10 20)) +(test* "gdImageCreate" #t + (is-a? im <gdImage>)) +(test* "gdImageDestroy" #f + (gdImageDestroyed? im)) +(gdImageDestroy im) +(test* "gdImageDestroy" #t + (gdImageDestroyed? im)) + + + ;; epilogue (test-end) Index: graphic/gd.scm =================================================================== --- graphic/gd.scm (リビジョン 6) +++ graphic/gd.scm (作業コピー) @@ -20,6 +20,17 @@ ;; <gdImage> <gdFont> + ;; + gdDashSize + gdStyled + gdBrushed + gdStyledBrushed + gdTiled + gdTransparent + gdAntiAliased + gdImageCreate + gdImageDestroy + gdImageDestroyed? ) ) (select-module graphic.gd) Index: gdlib.stub =================================================================== --- gdlib.stub (リビジョン 6) +++ gdlib.stub (作業コピー) @@ -65,6 +65,29 @@ () ()) +(define-enum gdDashSize) +(define-enum gdStyled) +(define-enum gdBrushed) +(define-enum gdStyledBrushed) +(define-enum gdTiled) +(define-enum gdTransparent) +(define-enum gdAntiAliased) + +(define-cproc gdImageCreate (sx::<int> sy::<int>) + (body <gdImage> + "ScmGdImage* i = SCM_NEW(ScmGdImage);" + "SCM_SET_CLASS(i, SCM_CLASS_GDIMAGE);" + "i->image = gdImageCreate(sx, sy);" + "SCM_RESULT = i;")) + +(define-cproc gdImageDestroy(im::<gdImage>) + (body <void> + "gdImageDestroy(im->image);" + "im->image = NULL;")) + +(define-cproc gdImageDestroyed? (im::<gdImage>) + (expr <boolean> "(im->image == NULL)")) + ;; Local variables: ;; mode: scheme ;; end:
最後の方に追加したのが、gdImageCreateとgdImageDestroyってやつ。
これらに加えて、Gauche:MeCabにならってdestroyed?な述語関数も追加する。
はじめてエラー関係でハマりましたが、gosh genstub gdlib.stubとして、
生成されたgdlib.cを見ながらデバッグします。
returnとか、exprとかbodyとかの書式もとにかく試して、生成したCのコードを見て、 やり直すって感じでやっていけば、なんとか辿りつけます。 (ムダな力が入ってるっていわれそうだけど。。。)
とりあえず、インスタンスの生成と消滅ができるようになったのでOKかな。 あ、消滅ってのはgd側のdestroyをcallしておけば、 あとScheme界にある<gdImage>のインスタンス自身はGaucheがGCしてくれるハズなので、 問題はないでしょうということです。多分あってる。
あとはもうgd.hに定義されている関数の類を次々にdefine-cprocにしてけばいいハズ。
多分誰もが迷うのかもしれないけど、元実装の引数がvoid*とかの場合はどうすんの?
えーchar *とかは<string>として受けておいて、
Scm_GetStringConst(str)としてやればいいらしいのは分かったんだが、
void*については<void>としても<void>?としてもエラーが出るし、
genstubして生成したコードを見てもなんか違うくさい。
genstubにはType Handlingのコメントがあるので、そこのところを見てみる。
;; Type handling ;; ;; Stub's type system doesn't exactly match Scheme's, since stub has ;; to handle internal guts of Scheme implementations as well as ;; C type systems. We call the types used in the stub generator ;; "stub type", apart from "C type" and "Scheme type". ;; ;; For each existing conversion between C type and Scheme type, a stub ;; type is defined. For types that has one-to-one mapping between ;; C and Scheme (such as most aggregate types, for example, Scheme's ;; <u32vector> and C's ScmU32Vector*), there is only one stub type, ;; which uses the same name as the Scheme's. There are some stub types ;; that reflects C type variations: <int>, <int8>, <int16>, <int32>, ;; <uint>, <uint8>, <uint16>, <uint32> --- these are mapped to Scheme's ;; integer, but the range limit is taken into account. <fixnum> ;; refers to the integers that can be represented in an immediate integer. ;; Note that a stub type <integer> corresponds to Scheme's exact integers, ;; but it is mapped to C's ScmObj, since C's integer isn't enough to ;; represent all of Scheme integers. A stub type <void> is ;; used to denote a procedure return type. ;; ;; Each stub type has a "boxer" and an "unboxer". A boxer is a C name ;; of a function or a macro that takes an object of C type of the stub ;; type and returns a Scheme object. An unboxer is a C name of a function ;; or a macro that takes Scheme object and checks its vailidy, then ;; returns a C object of the C type or throws an error. ;; ;; Here's a summary of primitive stub types and the mapping each one ;; represents. ;; ;; stub type Scheme C Notes ;; ----------------------------------------------------------------- ;; <fixnum> <integer> int Integers within fixnum range ;; <integer> <integer> ScmObj Any exact integers ;; <real> <real> double ;; <number> <number> ScmObj Any numbers ;; ;; <int> <integer> int Integers representable in C ;; <int8> <integer> int ;; <int16> <integer> int ;; <int32> <integer> int ;; <short> <integer> short ;; <long> <integer> long ;; <uint> <integer> uint Integers representable in C ;; <uint8> <integer> uint ;; <uint16> <integer> uint ;; <uint32> <integer> uint ;; <ushort> <integer> ushort ;; <ulong> <integer> ulong ;; <float> <real> float Unboxed value casted to float ;; <double> <real> double Alias of <real> ;; ;; <boolean> <boolean> int Boolean value ;; <char> <char> ScmChar NB: not a C char ;; ;; <void> - void (Used only as a return type. ;; Scheme function returns #<undef>) ;; ;; <const-cstring> <string> const char* For arguments, string is unboxed ;; by Scm_GetStringConst. ;; For return values, C string is boxed ;; by SCM_MAKE_STR_COPYING. ;; ;; <pair> <pair> ScmPair* ;; <list> <list> ScmObj ;; <string> <string> ScmString* ;; <symbol> <symbol> ScmSymbol* ;; <vector> <vector> ScmVector* ;; : ;; ;; Pointer types can be qualified as 'maybe', by adding '?' at the ;; end of type name, e.g. '<string>?'. ;; If 'maybe' type appears as an argument type, the argument accepts #f ;; as well as the specified type, and translates #f to NULL. If 'maybe' ;; type appears as the return type, the result of C expression can be NULL ;; and the stub translates it to #f.
たぶんケース3かなー。2ではないのは確かだ。 とにかく、Ptrなんて名称がついてるAPIなんて邪悪すぎ。
ただ、PngやGifやBMPに対して、gdImageCreateFrom***/gdImageCreateFrom***Ctx/gdImageCreate***Ptrって 3種類がセットで用意されているクサいので、 基本的にはどれもgdImageをさしてるんだろうと推測できる。 まーそう考えるとケース3が妥当だろう。
あとはファイナライザのregisterをやってみた。 動作確認できてないけど、まーこんな感じなんでしょうかね。
Index: test.scm =================================================================== --- test.scm (リビジョン 6) +++ test.scm (作業コピー) @@ -42,6 +42,36 @@ (test* "gdAlphaBlend" 3 (gdAlphaBlend 2 3)) +(test* "gdDashSize" 4 + gdDashSize) +(test* "gdStyled" -2 + gdStyled) +(test* "gdBrushed" -3 + gdBrushed) +(test* "gdStyledBrushed" -4 + gdStyledBrushed) +(test* "gdTiled" -5 + gdTiled) +(test* "gdTransparent" -6 + gdTransparent) +(test* "gdAntiAliased" -7 + gdAntiAliased) + +(define im (gdImageCreate 10 20)) +(test* "gdImageCreate" #t + (is-a? im <gdImage>)) +(test* "gdImageDestroy" #f + (gdImageDestroyed? im)) +(gdImageDestroy im) +(test* "gdImageDestroy" #t + (gdImageDestroyed? im)) + +(define im (gdImageCreateTrueColor 10 20)) +(test* "gdImageCreateTrueColor" #t + (is-a? im <gdImage>)) + + + ;; epilogue (test-end) Index: graphic/gd.scm =================================================================== --- graphic/gd.scm (リビジョン 6) +++ graphic/gd.scm (作業コピー) @@ -20,6 +20,27 @@ ;; <gdImage> <gdFont> + ;; + gdDashSize + gdStyled + gdBrushed + gdStyledBrushed + gdTiled + gdTransparent + gdAntiAliased + gdImageCreate + gdImageDestroy + gdImageDestroyed? + gdImageCreatePalette + gdImageCreateTrueColor + ;; gd_io + <gdIOCtx> + Putword + Putchar + ;; + gdImageCreateFromPng + gdImageCreateFromPngCtx + gdImageCreateFromPngPtr ) ) (select-module graphic.gd) @@ -31,6 +52,8 @@ ;; Put your Scheme definitions here ;; +(define gdImageCreatePalette gdImageCreate) + ;; Epilogue (provide "graphic/gd") Index: gdlib.stub =================================================================== --- gdlib.stub (リビジョン 6) +++ gdlib.stub (作業コピー) @@ -5,6 +5,7 @@ " #include \"gauche-gd.h\" +#include <stdlib.h> #include <gd.h> " @@ -65,6 +66,94 @@ () ()) +(define-enum gdDashSize) +(define-enum gdStyled) +(define-enum gdBrushed) +(define-enum gdStyledBrushed) +(define-enum gdTiled) +(define-enum gdTransparent) +(define-enum gdAntiAliased) + +" +static void gdimage_finalize(ScmObj i, void *data) +{ + if(SCM_GDIMAGE(i) != NULL) + { + free(SCM_GDIMAGE(i)); + gdImageDestroy(SCM_GDIMAGE(i)->image); + SCM_GDIMAGE(i)->image = data; + return; + } +} +" + +(define-cproc gdImageCreate (sx::<int> sy::<int>) + (body <gdImage> + "ScmGdImage* i = SCM_NEW(ScmGdImage);" + "SCM_SET_CLASS(i, SCM_CLASS_GDIMAGE);" + "i->image = gdImageCreate(sx, sy);" + "Scm_RegisterFinalizer(SCM_OBJ(i), gdimage_finalize, NULL);" + "SCM_RESULT = i;")) + +(define-cproc gdImageDestroy (im::<gdImage>) + (body <void> + "gdImageDestroy(im->image);" + "im->image = NULL;")) + +(define-cproc gdImageDestroyed? (im::<gdImage>) + (expr <boolean> "(im->image == NULL)")) + +(define-cproc gdImageCreateTrueColor (sx::<int> sy::<int>) + (body <gdImage> + "ScmGdImage* i = SCM_NEW(ScmGdImage);" + "SCM_SET_CLASS(i, SCM_CLASS_GDIMAGE);" + "i->image = gdImageCreateTrueColor(sx, sy);" + "SCM_RESULT = i;")) + +" +typedef struct ScmGdIOCtxRec { + SCM_HEADER; + gdIOCtx* ctx; +} ScmGdIOCtx; + +SCM_CLASS_DECL(Scm_GdIOCtxClass); +#define SCM_CLASS_GDIOCTX (&Scm_GdIOCtxClass) +#define SCM_GDIOCTX(obj) ((ScmGdIOCtx*)(obj)) +#define SCM_GDIOCTXP(obj) (SCM_XTYPEP(obj, SCM_CLASS_GDIOCTX)) +" +(define-cclass <gdIOCtx> "ScmGdIOCtx*" "Scm_GdIOCtxClass" + () + ()) + +(define-cproc Putword (w::<int> ctx::<gdIOCtx>) + (body <void> "Putword(w, ctx->ctx);")) +(define-cproc Putchar (c::<int> ctx::<gdIOCtx>) + (body <void> "Putchar(c, ctx->ctx);")) + +(define-cproc gdImageCreateFromPng (file::<string>) + (body <gdImage> + "FILE* fd = fopen(Scm_GetStringConst(file), \"r\");" + "ScmGdImage* i = SCM_NEW(ScmGdImage);" + "SCM_SET_CLASS(i, SCM_CLASS_GDIMAGE);" + "i->image = gdImageCreateFromPng(fd);" + "SCM_RESULT = i;")) + +(define-cproc gdImageCreateFromPngCtx (in::<gdIOCtx>) + (body <gdImage> + "ScmGdImage* i = SCM_NEW(ScmGdImage);" + "SCM_SET_CLASS(i, SCM_CLASS_GDIMAGE);" + "i->image = gdImageCreateFromPngCtx(in->ctx);" + "SCM_RESULT = i;")) + +(define-cproc gdImageCreateFromPngPtr (size::<int> data::<foreign-pointer>) + (body <gdImage> + "ScmGdImage* i = SCM_NEW(ScmGdImage);" + "SCM_SET_CLASS(i, SCM_CLASS_GDIMAGE);" + "i->image = gdImageCreateFromPngPtr(size, SCM_FOREIGN_POINTER(data)->ptr);" + "SCM_RESULT - i;")) + + + ;; Local variables: ;; mode: scheme ;; end:
関数本体がCの式で書ける場合はexpr節を使えばSCM_RESULTへの代入はいらないです。 (2006/09/02 04:20:19 PDT)
(define-cproc gdTrueColorGetAlpha (c::<int>) (expr <int> "((c & 0x7F000000) >> 24)"))
koguro(2006/09/02 08:31:18 PDT): gdのAPIをよくみていないので外しているかもしれませんが、通常Scheme側でポインタの値を操作する必要はないと思いますので、拡張ライブラリ側でgdImagePtrに対応するクラスを定義する必要はないかと思います。c-wrapperはちょっと特殊で、CのAPIをそのまま利用者に見せることを目的としているため、ヘッダファイルで定義されていれば、ポインタ型でも何でもそのまま定義してしまっています。
> gauche-package generate Gauche-gd > cd Gauche-gd > mkdir graphic > mv gd.scm graphic
% gauche-package generate Gauche-gd graphic.gd
としておくと、あとの mv 云々がいりません。2006/09/02 08:44:31 PDT
void* は、C言語ではいくつかの異なる用途で使われるので、その本当の意味によって 扱いを変える必要があります。
いずれの場合も、Scheme界のデータへのポインタをC界へ渡す場合にはGCの 問題について考えておく必要があります。C界へ渡されたポインタはGaucheのGC からは見えないので、そのポインタへのScheme側からの参照が無くなってしまうと (C側では使われているのに)GCされてしまう可能性があります。 C側に安全にScheme側のポインタを渡せるかどうかというのはCの関数宣言を 見ただけでは判定不可能なので、C APIの仕様を睨んで扱いを決めます。