.starファイル

　最近からGNU Smalltalkのvar3.0をぼちぼちいじり始めているのですが、とりあえず最初に気付いたことは .starファイルをエディタなどで編集してはいけないという事。.starファイルはただのプレーンテキストかと思いきや実はちょっとしたアーカイブファイルみたいです。なので、以前の記事で書いたようにスシテムブラウザのフォントを変更するには、var2.xだとBloxBasic.stをエディタを使って自分で編集することができたのですが、var3.0でBloxBasic.stと同じ様な役割を持つファイル、BloxTK.starをエディタで編集しちゃうとエラーが出てシステムブラウザが起動しなくなります。
　.starファイルを編集したいならエディタなどを使わずにシステムブラウザを使う方が安全っぽいです。フォントを変更するなら、先ず Namespace Browser を開いて、 BLOX.Blox のクラスメソッド defaultFont(utilityカテゴリにいる) を編集してイメージを保存すればOK.
　まだ触り初めで解からん事が沢山あるのですが、インストール直後に gst-blox とコマンドをうつだけでシステムブラウザが起動したのはちょっと嬉しかった。

画像生成

　gnu-SmalltalkでCaptchaのような事をしたいのです。けど、今のところ画像を生成するようなメソッドやパッケージなどは用意されて無いようです。SqueakにはSW2Captchaというすごく便利そうなパッケージがある（Morphicで画像を生成しているらしい？）gstでもTcl/Tkの力を借りれば出来なくもないかな と思ったけど、そういえば、以前の記事で書いたようなエラーが出るのでCGIで利用するのは難しい。あと、 system: も結構便利そうだ。

Smalltalk system: 'tclsh auth.tcl'

こんな感じでCGIプログラムの中で認証用画像を生成させることが出来る。けど、もっとこう何かないかなぁ・・・と考えていたら、おぉ、そうだ CCall という機能がある。CCallとはCで書かれたモジュールを動的にリンクさせて、モジュール内の関数をgstから呼び出せるというものです。*1（リンクするのはDLDというクラスとそのメソッド達の仕事）これはSqueakの名前付きプリミティブというものに似た様なもんなんだろうか？ ならSqueakだとVMMakerというオリジナルプラグインが作れる強力なツールがある。gstにはそんなもの無いので、こりゃあ面倒くさいかなぁと思ったのですが、調べてみると CCall という仕組みは結構シンプルそうだったので、とりあえず簡単なテストモジュールを作ってみた。
　このモジュールでは GD library を利用させていただきました。GDライブラリはすごく便利ですごく多機能。けど、今回はほんのほんの一部の機能しか使ってません。

#include <stdio.h>
#include "gstpub.h"
#include "gd.h"

static VMProxy *vmProxy;

int imageString(char *string, char *fontname, unsigned char *fg, unsigned char *bg, double ptsize)
{
  gdImagePtr image;
  int background, foreground;
  int brect[8];
  int x, y;
  char *err;
  FILE *out;

  err = gdImageStringFT(NULL, &brect[0], 0, fontname, ptsize, 0.0, 0, 0, string);
  if (err) {return 1;}

  x = brect[2] - brect[6] + 6;
  y = brect[3] - brect[7] + 6;
  image = gdImageCreate(x, y);

  background = gdImageColorResolve(image, bg[0], bg[1], bg[2]);
  foreground = gdImageColorResolve(image, fg[0], fg[1], fg[2]);

  x = 3 - brect[6];
  y = 3 - brect[7];
  err = gdImageStringFT(image, &brect[0], foreground, fontname, ptsize, 0.0, x, y, string);
  if (err) {return 1;}

  out = fopen("auth.png", "wb");
  gdImagePng(image, out);

  fclose(out);

  gdImageDestroy(image);

  return 0;
}

void gst_initModule(VMProxy * proxy)
{
  vmProxy = proxy;
  vmProxy->defineCFunc("imageString", imageString);
}

　グダグダですみません。テスト用なのでお許しください。 brect 回りのマジックナンバーですが、 brect の各要素には文字列の大きさにぴったり合わせた四角形の数値が入ってます。各要素の値と何やら足したり引いたりしているのは、パディングの数値を指定しているみたいなものです。それで最終的な画像の大きさ（x, y）を得ています。そして、CCallで重要なのは gst_initModule() です。ここで関数名を登録しておかないとgstから呼び出すことが出来ません。とりあえず、グダグダながらも出来たので、次はコンパイルです。gstから利用するには共有ライブラリのほうが良いらしい。

gcc -shared -Wl,-soname,gd.so.1 -lgd -lpng -lz -ljpeg -lfreetype -ldl -lm -o GD-1.0.so gd.o

これで完成したGD-1.0.soを、 lib/smalltalk に置いておく。そして、gstから呼び出しテストをしたらエラーが出たので、GD.laファイルを手動で作る。

# The name that we can dlopen(3).
dlname='GD-1.0.so'

# Names of this library.
library_names='GD-1.0.so GD.so'

# Libraries that this one depends upon.
dependency_libs=' -lgd -lpng -lz -ljpeg -lfreetype -ldl -lm'

# Version information for GD.
current=0
age=0
revision=0

# Is this an already installed library?
installed=yes

# Should we warn about portability when linking against -modules?
shouldnotlink=yes

# Files to dlopen/dlpreopen
dlopen=''
dlpreopen=''

# Directory that this library needs to be installed in:
libdir='GST_DIR/lib/smalltalk'

このファイルも lib/smalltalk に置いておく。そして再び呼び出しテスト。の前に簡単なGDクラスとメソッドを作っておく。

Object subclass: #GD
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Image'!
GD comment: 'Use GD library'!

!GD class methodsFor: 'testing'!

imageString: aString font: fontPath foreGround: fg backGround: bg size: size
    <cCall: 'imageString' returning: #int args: #(#string #string #byteArray #byteArray #double)>
!!

そして呼び出す。

| authChars authString fontPath |

"最初にモジュールのロード"
DLD addModule: 'GD'.

"次にfilein"
FileStream fileIn: 'GST_DIR/share/smalltalk/GD/GD.st'.

"4桁の認証用文字列を作る"
fontPath := '/usr/share/fonts/truetype/msttcorefonts/Comic_Sans_MS_Bold.ttf'.
authChars := '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'.
authString := String new: 4.

1 to: 4 do: [:each |
    authString at: each put: (authChars at: (Random between: 1 and: authChars size))
].

"imageString()の呼び出し"
GD imageString: authString font: fontPath foreGround: #[255 255 255] backGround: #[0 0 0] size: 40.

無事呼び出せました。＾＾ ちなみに packages.xml に次の様な記述をしておいて、

<package>
  <name>GD</name>
  <filein>GD.st</filein>
  <module>GD</module>
  <directory>GD</directory>
</package>

そしてプログラムで

PackageLoader fileInPackage: 'GD'.

とすれば自動的に DLD addModule: をしてくれるみたいですが自分はまだ試していません。

このプログラムで出来た画像→
GD libraryの色々な機能を使えばもっと複雑な感じの画像を生成する事は出来るのですが、今日はもう時間切れ。

追記
　gstのページでCモジュールの作り方がちゃんと解説されていました（var.3.0対応）gst-package を使えばもっと楽に作れるのですね、知らなかったorz

Creating and distributing packages | GNU Smalltalk

さらに追記
パオロさんがgst3.0対応の記事を書いてくださいました。ありがとうございます。
CAPTCHA, the simplest gst external module

*1:追記: こうゆう機能の事を FFI (Foreign Function Interface) というらしいです。知らなかった＾＾；

gstの正規表現

　日本語も使えるんだ。今更気付いた。（遅すぎ）

#!/usr/bin/env gst

| string rwStr |
string := 'aてdigすlBaーa95Aj82とleぉぉぉ89348hg'.
rwStr := ReadWriteStream on: ''.

string onOccurrencesOfRegex: '[あ-ん]' do:
    [:regs |
        rwStr nextPutAll: regs match.
    ].

rwStr contents printNl.

もちろん、 '[^あ-ん]' とか 'ぉ{1,}' とかもちゃんとマッチする。自分の環境はUTF-8なのですが、他の環境だとどうなんだろう？

追記
　ごめんなさい。正確にはこれはちゃんとマッチしているとは言えないかもしれない。日本語としてマッチしているんではなくて、 "$$<81>$" （UTF-8で'て'になります）みたいなバイトの並びとしてマッチしているだけのご様子。
おぉ！これはラッキー日本語使えるじゃん と早とちりしてしまった、おバカな俺でした。

さらに追記
　とはいってもそこそこ日本語が使えるようなのでこれはこれで結構良い感じ。ちなみに、正規表現のエンジン部分はRubyのregex.cを使っているようです。

テンプレートエンジン その2

　以前の記事で書いたしょぼいコードの件なのです。あのコードの中では大域変数を使っているのですが、それよりも Dictionary を使えばいいんじゃねーか？ ということで、ちょっと書き直し。

#!/usr/bin/env gst -Q

FileStream fileIn: 'GST_DIR/smalltalk/net/httpd/STT.st'.
!

| page diaryArray fileName sttTest workDir |

stdout nextPutAll: 'Content-Type: text/html; charset=UTF-8';nl;nl.

page := Dictionary new.
diaryArray := OrderedCollection new.
workDir := 'DIARY_DIR'.

page at: 'max' put: 5.
page at: 'title' put: 'STT てすと'.

sttTest := '
<html>
<head>
  <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
  <title>{%= self at: ''title'' %}</title>
  <style type="text/css">
<!--
  div.diary {
    width: 450px; 
    border-style: solid;
    margin-bottom: 30px;
  }
-->
  </style>
</head>
<body>
<!-- gst -->
{% ((self at: ''max'') = 0) ifTrue: [ %}
  {%= ''コンテンツが見付かりませんでしたTT'' %}
{% ] ifFalse: [ %}
    {% 1 to: (self at: ''max'') do: [:each | %}
      <div class="diary">
      {%= ((self at: ''diary'') at: each) contents %}
      </div>
    {% ] %}
{% ] %}
<!-- End Of gst -->
</body>
</html>'.

Directory working: workDir.

fileName := (Smalltalk getenv: 'QUERY_STRING').

(fileName = '')
    ifTrue: [
        Directory allFilesMatching: '*' do: [:each | diaryArray add: each].
    ]
    ifFalse: [
        Directory allFilesMatching: fileName do: [:each | diaryArray add: each]
    ].

(diaryArray size < 1)
    ifTrue: [
        page at: 'max' put: 0.
        (STTTemplate on: sttTest) evaluateOn: page stream: stdout.
    ]
    ifFalse: [
        (diaryArray size < (page at: 'max'))
            ifTrue: [
                page at: 'max' put: diaryArray size.
                page at: 'diary' put: diaryArray.
                (STTTemplate on: sttTest) evaluateOn: page stream: stdout.
            ]
            ifFalse: [
                page at: 'diary' put: diaryArray.
                (STTTemplate on: sttTest) evaluateOn: page stream: stdout.
            ].
    ].

ObjectMemory quit.
!

　ええ、相変わらずしょぼい事に変わりはないです。けど、 evaluateOn: に Dictionary を渡す事によって以前よりもだいぶ柔軟にSTTを使えているのではなかろうかと思うのですよ。しかし、何故最初にこの事に気付かなかったんだろう。おバカな俺。

gstでTcl/Tk8.5 解決

　昨日の記事で書いた GNU Smalltalk2.3.6+Tcl/Tk8.5 の問題が解決しました。

$ cd /usr/lib
$ sudo ln -s /usr/local/lib/libtcl8.5.so.0 libtcl8.5.so
$ sudo ln -s /usr/local/lib/libtk8.5.so.0 libtk8.5.so

なんと、これだけで解決。Tcl/Tk8.5をインストールしたのは /usr/local/lib なのですが、何故か /usr/lib から共有ライブラリを探していたために Object: DLD error: requested module blox-tk was not found というエラーが出たみたいです。なので、上記の方法でリンクを張ってやれば解決。コンパイルの結果に異常があると思い込んでいたために解決に時間がかかってしまったorz　コンパイルは問題無く成功していたようです。
　アンチエイリアスが有効になりだいぶ美しくなりました＾＾ システムブラウザで使われるフォントやフォントサイズを変更するには smalltalk/blox-tk/BloxBasic.st の992行目あたりにある、メソッドdefaultFont が返す値（フォント名とサイズ）を変更すればOKです。*1自分の環境で使えるフォントを調べるには、 BLOX.Blox fonts とすれば使えるフォント名が返ってきます。自分は Andale Mono を指定しているのですが、このようにフォント名にスペースが含まれる場合、 AndaleMono というふうにする必要があります。フォント名に誤りがあると結構大げさなエラーメッセージを吐いて起動できない時があるのでちょっとびっくりする＾＾； ちなみに、Tcl/Tk8.4を使っている時は、 andale-mono というふうにスペースの部分は"-"で埋める必要がありました。何故こうゆう違いがあるのかは不明です。

この画像を大きいサイズで見たいという方はこちらからどうぞ。（別窓で開きます）

追記
　どうもシステムブラウザが安定しないので、（クラス検索などをしていると、いきなりクラッシュして終了したりする）ためしに --enable-jit オプションを付けずにコンパイルし直したら安定した。このオプションを付けるとgstが速くなるのは良いんですが、ブラウザが安定しないのは困るので今回は外した。ちなみに、 --enable-gtk=blox オプションを付けると標準で GTK+ なブラウザ blox-gtk が使えます。けど、こちらはかなり安定してません。とにかく終了しまくりです。外観は格好いいんですけどねぇ。自分は環境に合わせて libgtk2.0-dev を入れてコンパイルしたのですが、 libgtk-dev(gtk1.2) だと安定するのかなぁ？（未確認）

*1:GNU Smalltalk3.0以降はこの方法が使えません。システムブラウザを使ってファイルを編集します。

gstでTcl/Tk8.5

　Tcl/Tk8.5の正式版がやっとリリースされたので早速導入してみたい。が、自分が使っているUbuntu用のバイナリはまだ無いようなので、ソースから入れる。

$ mkdir tcltkbuild
$ cd tcltkbuild
$ wget -c http://prdownloads.sourceforge.net/tcl/tcl8.5.0-src.tar.gz
$ wget -c http://prdownloads.sourceforge.net/tcl/tk8.5.0-src.tar.gz
$ tar zxf tcl8.5.0-src.tar.gz
$ tar zxf tk8.5.0-src.tar.gz
$ cd tcl8.5.0/unix
$ ./configure --enable-threads
$ make
$ sudo make install
$ make clean
$ cd ../../tk8.5.0/unix/
$ ./configure --enable-threads --enable-xft2 --with-tcl=/usr/local/lib
$ make
$ sudo make install
$ make clean

　--enable-xft2 オプションが重要なのです。これがないとアンチエイリアスなフォントが有効になりません。せっかく8.5からLinuxでもサポートされるようになったのにオプションを付け忘れてはいけない。と言いつつ自分はこのオプションを付け忘れて二度コンパイルするはめになったTT あと、Ubuntuだと libxft-dev がインストールされているか最初に確認したほうがいいかもしれない。これが無いとこのオプションを付けても意味が無い。とか言いつつ自分は最初その事に気付かなくて三度コンパイルするはめになったTT
　と言うわけで、無事（？）インストール出来たので、以前の記事でも書いたのですが、Linux/CentOSワークステーション環境構築で紹介されている方法でフォントの具合をテスト。
　おぉ！美しい！ 以前とは比べ物にならないぐらい良くなった。こりゃあ早速今あるTkアプリを全部8.5に対応させたいな。とりあえず、やっぱ最初にgnu-Smalltalkのシステムブラウザを対応させたいな。今のままでもまぁいいんですけど、アンチエイリアスなフォントが有効になればなお良さそうなので、ちと面倒臭いですが、これまたソースから入れ直すことにする。

$ cd src/smalltalk-2.3.6/
$ ./configure --prefix=/home/user/GST_DIR \
--with-tcl=/usr/local/lib --with-tk=/usr/local/lib
$ make
$ make install
$ make clean

　Tcl/Tkをソースから入れる際に --prefix オプションで指定していなかったので、デフォルトで /usr/local/lib にインストールされています。なのでその場所を --with オプションで指定してます。まったく問題無くコンパイル、インストール出来た様に思えたのですが、システムブラウザを起動しようとしたら、なんとエラーです。エラーの内容は、 Object: DLD error: requested module blox-tk was not found です。自分このエラーを見るのは初めてではないのです。最初にgstをソースから入れた時もこれとまったく同じエラーが出ました。これはDLDがTcl/Tkモジュールのダイナミックリンクに失敗した時に出るエラーらしいのですね。そしてその原因は大概gstのコンパイルに失敗していると。（いや、コンパイルには成功しているんだけど、Tcl/Tkモジュールの部分だけおかしくなっているらしい？実際システムブラウザ以外は問題無く動作する）んで、Tcl/Tk8.4を使っている時は tcl8.4-dev と tk8.4-dev を入れたら問題無く解決した。けど、今回はTcl/Tk自体ソースから入れているのでdevなんて必要ないし・・・ 何故？ ちなみに config.log などを見ても怪しい部分は見当たらない。本当に、何故なの？
　解決すべく色々検索してみると、なんだか他でもTcl/Tk8.5関連でちょくちょく問題が出てるなぁとか思っていたら、gstの本家のページがヒットした。
problem with tcl/tk 8.5 | GNU Smalltalk
　問題が確認されているのはバージョン2.95hらしいのですが、やっぱ今自分が使ってるバージョン（2.3.6）でもTcl/Tk8.5だと何か問題あるのかなぁ・・・　むぅ、解からん。とりあえず、こんなエラーがあったぞ という記録でした。

　このエラーが出た環境:
Ubuntu 7.04(feisty)
GNU Smalltalk 2.3.6 （ソースからインストール）
Tcl/Tk8.5.0 （ソースからインストール）

追記
　まったくもって問題は解決出来てなくてしょぼい追記ですが、gstのコンパイルオプションに --enable-jit を付けるとちょっと速くなる。つか、物によっては倍以上速くなった。
さらに追記
　解決しました＾＾

テンプレートエンジン

　gnu-Smalltalkをインストールすると、CGIから利用できるHTMLテンプレートエンジンらしき物もおまけで付いてくる。 smalltalk/net/httpd/STT.st がそれです。ちゃんとサンプルもある。↓

test
    | sttTest |

    sttTest := '
    <html>
    <head>
      <title>{%= self class %}</title>
    </head>
    <body>
    <table>
      {% self to: 10 do: [ :each | %}
        <tr>
          <td>{%= each printString %}</td>
          <td>{%= (each * 2) printString %}</td>
        </tr>
      {% ] %}
    </table>
    </body>
    </html>'.

    ^(STTTemplate on: sttTest) evaluateOn: 1.

　evaluateOn: に渡すオブジェクトがテンプレート内の self になります。 evaluateOn: の中では perform: してて、渡ってきたオブジェクトよって色々な仕事をしてくれてます。
　このサンプルプログラムの処理結果を見た感じでは、 to:do:[ 〜 ] で囲まれた部分がその回数分出力されて、それとは別で特別に出力が必要な処理は {%= 〜 %} で囲み、必要ない処理は {% 〜 %} で囲むようです。気を付けないといけないのは、この例だと一つの処理（{%= 〜 %}と{% 〜 %}）の終わりに"."は必要無いらしいです。"."が有るとエラーになります。（追記："."を付けてエラーになるのは {%= 〜 %} の場合）なんだか不明な点が幾つかあるんですが、とりあえずテストCGIを作ってみた。

#!/usr/bin/env gst -Q

FileStream fileIn: 'GST_PATH/smalltalk/net/httpd/STT.st'.
!

| max fileName sttTest path |

stdout nextPutAll: 'Content-Type: text/html; charset=UTF-8';nl;nl.

Diaryarray := OrderedCollection new.
path := 'DIARY_PATH/diary'.
max := 5.

sttTest := '
<html>
<head>
  <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
  <title>てすと</title>
  <style type="text/css">
<!--
  div.diary {
    width: 450px; 
    border-style: solid;
    margin-bottom: 30px;
  }
-->
  </style>
</head>
<body>
<!-- gst -->
  {% 1 to: self do: [:each | %}
    <div class="diary">
      {%= (Diaryarray at: each) contents %}
    </div>
  {% ] %}
<!-- End Of gst -->
</body>
</html>'.

Directory working: path.

fileName := (Smalltalk getenv: 'QUERY_STRING').
(fileName = '')
    ifTrue: [
        Directory allFilesMatching: '*' do: [:each | Diaryarray add: each].
    ]
    ifFalse: [
        Directory allFilesMatching: fileName do: [:each | Diaryarray add: each]
    ].
(Diaryarray size < 1)
    ifTrue: [
        stdout nextPutAll: 
            ((STTTemplate on: sttTest) evaluateOn: 0).
    ]
    ifFalse: [
        (Diaryarray size < max)
            ifTrue: [
                stdout nextPutAll: 
                    ((STTTemplate on: sttTest) evaluateOn: Diaryarray size).
            ]
            ifFalse: [
                stdout nextPutAll: 
                    ((STTTemplate on: sttTest) evaluateOn: max).
            ].
    ].

ObjectMemory quit.
!

　しょぼいテストっすね、ごめんなさい。
　このファイル内とテンプレート内（{%= 〜 %}と{% 〜 %}）ではスコープが違うので、 Diaryarray とかいう大域変数を用意してます。このCGIは何をするかというと、保存されている日記ファイルをディレクトリから検索したりして拾ってきてその内容を表示するという単純な物です。表示の仕方も検索もだいぶテキトーです。表示する件数は max の初期値や QUERY_STRING の値で微妙に変わってきます。
　今の所、ぜんぜん便利に使えてないんですが、便利に使おうとすると大域変数が沢山増えそうな感じもするし・・・　むぅ、もうちょっといじってみる。

追記
　テンプレートの中では ifTrue:ifFalse: が使えない？ 使うとエラーになる。けど、ifTrue: と ifFalse:だけなら使える。

<!-- gst -->
{% (self = 0) ifTrue: [ %}
    {%= ''コンテンツが見付かりませんでしたTT'' %}
{% ] %}
{% (self ~= 0) ifTrue: [ %}
    {% 1 to: self do: [:each | %}
      <div class="diary">
      {%= (Diaryarray at: each) contents %}
      </div>
    {% ] %}
{% ] %}
<!-- End Of gst -->

さらに追記
　こうすると ifTrue:ifFalse: が使えるようだ。

<!-- gst -->
{%
(self = 0)
  ifTrue: [^''コンテンツが見付かりませんでしたTT'' readStream]
  ifFalse: [
%}
    {% 1 to: self do: [:each | %}
      <div class="diary">
      {%= (Diaryarray at: each) contents %}
      </div>
    {% ] %}
{% ] %}
<!-- End Of gst -->

　テンプレート内で"^"を使って返す値はストリーム以外だとエラーになります。この例だと True の場合、出力されるのは返した文字列だけでHTMLの部分は出力されません。

さらにさらに追記
　テンプレートの書き方を勘違いしてました。こうするとちゃんと ifTrue:ifFalse: が使える。

<!-- gst -->
{% (self = 0) ifTrue: [ %}
  {%= ''コンテンツが見付かりませんでしたTT'' %}
{% ] ifFalse: [ %}
    {% 1 to: self do: [:each | %}
      <div class="diary">
      {%= (Diaryarray at: each) contents %}
      </div>
    {% ] %}
{% ] %}
<!-- End Of gst -->

　勘違いな書き方でエラーになったのはこんな感じ。

<!-- gst -->
{% (self = 0) ifTrue: [ %}
  {%= ''コンテンツが見付かりませんでしたTT'' %}
{% ] %} 
{% ifFalse: [ %}
    {% 1 to: self do: [:each | %}
      <div class="diary">
      {%= (Diaryarray at: each) contents %}
      </div>
    {% ] %}
{% ] %}
<!-- End Of gst -->

ごちゃごちゃしてて解かりづらいですが、まぁそう言うことらしいです。

さらにさらにさらに追記
　大域変数ではなくて、 Dictionary を使ったほうがいいかも。