Gauche:拡張ライブラリ入門

参考

Gauche:MeCab

spigot学習(Cによる拡張)

ざっと眺める。ソースツリーのGauche/examples/spigotを参照する。

spigot.c

ライブラリです。

gauche.hとgauche/extend.hをincludeする。
関数はScmObjを返りとする。
関数の引数はCの型を書く
関数の内部ではSCM_NEW_ATOMIC2やらSCM_MAKE_INTやらSCM_VECTOR_ELEMENTSなど gauche.hに定義されているマクロを使って返り値を作成すること。
Scm_Init_sgigotの中は決まりごとっぽい。
- ScmModuleを作成
- spigot.soに結びつける
- ScmModuleにspigotって名前を付ける
- Scm_Init_spigotlib(module)する。ちなみにScm_Init_spigotlibはまだなくて、stubから生成される。まさにC界のデータとScheme(Gauche)界のデータをバインディングしている？

spigot.h: ヘッダです。 spigot.cに定義してて、外部公開するものを書いておく。ここにはScm_Init_spigotlibも含める必要がありそうなので注意。

spigotlib.stub: いわゆるスタブファイル。ここにC界で定義した関数名とScheme界に見せるプロシージャの名前とを関連付ける。文字列は、genstubで処理されるとそのままCのコードとして埋め込まれる。 "#include \"spigot.h\""が必要なようなので注意。
で、どうもこっちが裏方をやってくれているらしい。つまり拡張ライブラリで使えるようにしたCの関数をScheme界から呼び出せるようにするために仕組みを提供してくれている。

spigot.scm

scmライブラリファイル。

define-moduleする。
dynamic-loadでspigot.soをロードする。

以上結構単純な構造。

では、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できるようになる。

Gauche:MeCab学習

読みましょう。内容的には以前の内容なので少し古いけど、読んでも無駄じゃない。むしろ自動化されちゃったために分からない部分がちゃんと書いてある。

mqueue学習(C++によるglue)

今回は省略。
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もだいぶ違う。基本的にはライブラリがあるかどうかのチェックをしてるだけみたいなんだけど。それを入れた時点で見つけられないって叱られるのだ。

び(2006/09/04 00:47:20 PDT): Gauche-gdchartのconfigure.acは、肝心のgdchartライブラリの検出をサボっています(ひでー)。だって、特定のヘッダをインクルードしつつライブラリをリンクしてシンボルが解決されるかどうかを確認するためのストレートなマクロが見当たらなかったので。でも、pkgsrcで入れるとlibgdchart.soとしてインストールされるgdchartが、Ubuntu Linuxではlibgdc.soとしてインストールされているので、現在の決め打ちは明らかにNGです。そこで萎えて投げ出したんですな。本来は自前でマクロ書くべき。

仕切り直し

なんだか午前中は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をgauche-gd.hに変更

元祖gd.hと混乱するので変更します。あわせて、gdlib.stubの方も変更。ちゃんと一歩一歩、make checkまで確認して進めます。

元祖gd.hをincludeしてみる

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行ほどが気持ち悪いのでなんとかしたいです。
でも、とりあえず、正解の形は見えたので、これを目指せばいいってことで。。。

configure.acとMakefile.in一応おっけ？

とりあえず、以下のようになりました。

--- 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: Makefile.inにはCPPFLAGS, LDFLAGS, LIBSを追加。こいつの右辺の@CPPFLAGS@とかは後述のconfigureで書きかえちゃいます。あと、gd.soをmakeするときに、これらのオプションを追加するようにしておきます。どうやら--cppflagsとかその辺が対応します。どうやらと言っているのは、Gauche-gdchartなどの他のバインディングを参考に書いているからですよ。はい。

configure.ac: 詳しいことは知りませんが、例えば、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しておくこと。

graphic.gdへ変更

では、現在は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へ

とりあえず、はぢめてのSubversionって感じで。。。

gd.h

ざっと見てみる。まず、構造体からかなー。いや、よく分からないので簡単なところから。。。

では以下のところを作ってみる。

#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)

まずgdlib.stubへ、長いCのコードが出てきたらgd.cへ

という方針。これは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周りが未体験だから、そこに不安が残るけど。

classを追加

さて、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"
   ()
   ())

いくつかの疑問

<gdimage-meta>と<gdfont-meta>
なんか知らんが<gdimage-meta>と<gdfont-meta>ってのが出来てるのが、 aproposの出力にみてとれる。ところが、これらはunbound variableと出るので、どうなってんのか不明。その内分かるんだろうか。。。
でも他のバインディングを見ても、どうもそんなんなさげなんだよね。そもそもんなものexportしてないのに。。。
元祖gd.hでtypedefされているのは?
<gdImage>のメンバに入れているのはgdImage*だ。これはgdImage構造体へのポインタなので、このあとnewなんかの実装でmallocしてつっこんでやればよさげとか思ってる。さて、gdImagePtrってのがgdImage*のaliasとしてtypedefされてるんだが、通常こういうのは無視していいのかな？それともなんかケアするのかな。。。
実はc-wrapperで読みこむと、どうも<gdImage>ってのと別に<gdImagePtr>なんかもできてる。ただ、こっちは普通のクラスじゃなくてc-structってもののようだけど。。。
命名方法
いまさらだけど、
```
(define-cproc gdAlphaBlend (dest::<int> src::<int>)
  (body <int> "SCM_RESULT = gdAlphaBlend(dest, src);"))
```
こういうの見ると、「あらら、C界とScheme界の名称が同じになっちゃった。害はないような気がするけど、混乱しそうねぇ。こういう場合ってgd:gdAlphaBlendってした方がいいのかしらん。あるいはgd:AlphaBlendとか。
ざっとgd.hを見た感じではだいたいgdもしくは、GDプレフィクスがついてるし。。。

初日終了&ダウンロード

Gauche-gd-1.0.tgzまで。

Create/Destroyつまりインスタンスの生成と消滅

ほりゃ。

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してくれるハズなので、問題はないでしょうということです。多分あってる。

あーorz
多分あってない。gdImageDestroyを必ず呼ぶとは限らんのよね。 <gdImage>を何物にも束縛せずに生成したものはGaucheがGCするけど、その場合にdestroyを呼ぶようにファイナライザを設定してやらなきゃならない。びさんのfirebirdのバインディングを後で参照しておくことー。cut-sea:2006/09/04 22:39:32 PDT

cprocの引数は？

あとはもう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.

ScmForeignPointerを使用

たぶんケース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)"))

Thanx! 早速変更してみました。

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* 型

void* は、C言語ではいくつかの異なる用途で使われるので、その本当の意味によって扱いを変える必要があります。

いくつかの異なるデータ型へのポインタを取ることができて、その型は別の引数で指定されている: 厳密にはunionで表現すべき用途ですね。この場合、一番良いのは Scheme関数はいろいろなSchemeオブジェクトを取れるようにしといて、cproc中で Schemeのデータ型によって型を指定する引数を計算してやるというような方法です。 Gauche-gl中のimage関連の関数なんかで多用されてるので見てみてください。

C言語にクロージャが無いのを補うため、関数ポインタと一緒に渡すopaqueなユーザデータ: この場合、Scheme関数ではSchemeクロージャを取るようにしておくのが良いでしょう。実際のC APIには、Schemeクロージャをopaqueなユーザデータとして渡し、関数ポインタの方は「呼ばれたらユーザデータをScmObj にキャストしてapplyする」というスタブ関数を渡しときます。

ライブラリ側で生成されるデータだが、中身を隠蔽するためにvoid*になっている: ライブラリ側で作られたopaqueなデータを、再びライブラリに返すような用途です。この場合は最初に作られたvoid*をScmForeignPointerでくるんでおいて、渡す時に中身を取り出せば良いでしょう。

ユーザ定義の拡張データを入れとくためのポインタ: この場合、Schemeから使うなら Schemeデータを渡すことになるので、ScmObjをvoid*にキャストすれば良いでしょう。

いずれの場合も、Scheme界のデータへのポインタをC界へ渡す場合にはGCの問題について考えておく必要があります。C界へ渡されたポインタはGaucheのGC からは見えないので、そのポインタへのScheme側からの参照が無くなってしまうと (C側では使われているのに)GCされてしまう可能性があります。 C側に安全にScheme側のポインタを渡せるかどうかというのはCの関数宣言を見ただけでは判定不可能なので、C APIの仕様を睨んで扱いを決めます。