Xlib in scm

OpenBSDのパッケージから入れたscmはgdbからコントロールは勿論出来無い状態になっている。久し振りに自前でコンパイルしてみるか。しばし思考錯誤する。で、gdb付になったよ。

A）cd /usr/ports/lang/scm; make configure して、ソースを取寄せ、展開、パッチ当て、configure まで、実施。ここまでは、普通の手順だ。

B）cd /usr/ports/pobj/scm-5f1/scm; emacs build.scm ワークエリアへ移動。build.scmがMakefileの代わりを努めているので、編集。

(defcommand compile-c-files openbsd
  (lambda (files parms)
    (and (batch:try-chopped-command
          parms
          "cc" "-g" "-c"

ccの引数に、-g を追加する。

C）こうしておいて、lang/scmの中でmake install 。残念ながらinstall中にstripされちゃうので、ワークエリア中の、scmを/usr/local/bin/ へ、cpしてしまう(ちょっとダサイやり方だけど、楽だからね)。

適当に書下したコードのBUGを潰して行く。その前に、C語の該当する関数を眺めておく

Window XCreateSimpleWindow(display, parent, x, y, width, height, border_width,
border, background) 
Display *display;
Window parent;
int x, y;
unsigned int width, height;
unsigned int border_width;
unsigned long border;
unsigned long background; 

そしてこちらは、SCM語のマニュアルからの掲載

-- Function: x:create-window window position size border-width depth
         class visual field-name value ...
           :
-- Function: x:create-window window position size border-width border
         background
           :

同じ関数名で、引数の数が違うものが用意されている。引数の最初の幾つかは、同じ型だが、後ろの方は型が違う。それに、引数の個数も片や可変長、一方は6個に固定だ。器用な事するな。関数名を別にすれば良いのに。ボストンの頭の良い先生にはついていけない。

Breakpoint 1, x_create_window (swin=0x4b5e4180, spos=0x4b5e4178, sargs=0x4b5e3d\
30) at x.c:1009
1009      int len = ilength(sargs);
(gdb) bt 7
#0  x_create_window (swin=0x4b5e4180, spos=0x4b5e4178, sargs=0x4b5e3d30) at x.c\
:1009
#1  0x184e6bf3 in ceval_1 (x=0x4b5e3d60) at eval.c:2745
#2  0x184e686f in evalcar (x=<optimized out>) at eval.c:1354
#3  toplevel_define (xorig=<optimized out>, env=0x4b5e4260) at eval.c:737
#4  ceval_1 (x=<optimized out>) at eval.c:2387
#5  0x184e9d78 in ceval (x=0x4b5e4070, static_env=0x4b5e4260, env=0x4774) at ev\
al.c:2025
#6  0x184dab88 in tryload (filename=0x4b5e43f8, reader=0x4374) at repl.c:1898
(More stack frames follow...)

片方の端末でscmを起動しBUG入りを走らせた。もう一方の端末でemacsを起動してからアタッチした。そして目的関数にBPを置いて走らせた。一応バックトレースしたよ。個数は、BUGとり成就を祈願して７個にした。いやそれなら末広がりで８個がいいとか。。。面倒なら全部出すと１２フレームだったよ。

  SCM x_create_window(swin, spos, sargs)
       SCM swin, spos, sargs;
  {
    XPoint position, size;
    unsigned int border_width;
    Window window;
B   int len = ilength(sargs);

  =>ASRTER(NIMP(swin) && OPWINDOWP(swin), swin, ARG1, s_x_create_window);
    scm2XPoint(!0, spos, &position, (char *)ARG2, s_x_create_window);
    scm2XPoint(0, CAR(sargs), &size, (char *)ARG3, s_x_create_window);
      :

引数は３個目からは、リストにまとめてしまう仕様のようだ。そして、最初の引数が正当なものか検査してるんだな。

(gdb) n
Warning:
Cannot insert breakpoint 0.
Cannot access memory at address 0xddcc0212
siglongjmp () at /usr/src/lib/libc/arch/i386/gen/sigsetjmp.S:76
76              movl    4(%esp),%edx            # parameter, pointer to env

早速検査に引掛って、強制脱出のため、longjmpのルーチンへ飛び込んだよ。

エラーの内容とソースコードを見比べると、第一引数はwindow型のようだ。半信半疑で当初のコード中のdisplayを省略してみたぞ。

;ERROR: "scmXlib.scm": x:create-window: Wrong type in arg2 100
; in expression: (#@x:create-window (#@x:root-window #@d #@s) 100 100 25 ...

第一引数は満足したみたい。ここにはdisplay要素が含まれているから大丈夫なんだな。その代わり第二引数がおかしいとな。position型が欲しいのにただの数値だと言っている。

positionなら、X座標とY座標の組だろう。多分LISP系なら、リストなりベクターにまとめてしまえだろうね。サイズも窓の幅と高さの組だろう。

;ERROR: "scmXlib.scm": Wrong type to apply:  100
; in expression: (100 100)

ああ、急いでいて、やっちまっただ。リストの第一引数は関数名。それがいやなら、クォートせよ。データとして扱ってねだ。

これで、第一の難関は突破したぞ。少し、コードを味わっておく。

ASRTER(NIMP(swin) && OPWINDOWP(swin), swin, ARG1, s_x_create_window);
scm2XPoint(!0, spos, &position, (char *)ARG2, s_x_create_window);
scm2XPoint(0, CAR(sargs), &size, (char *)ARG3, s_x_create_window);
sargs = CDR(sargs);
GET_NEXT_INT(border_width, sargs, ARG4, s_x_create_window);
if (4==len) {
  unsigned long border;
  unsigned long background;
  GET_NEXT_INT(border, sargs, ARG5, s_x_create_window);
  GET_NEXT_INT(background, sargs, ARGn, s_x_create_window);
  window = XCreateSimpleWindow(XWINDISPLAY(swin), XWINDOW(swin),
                               position.x, position.y, /* initial placement */
                               size.x, size.y,
                               border_width,
                               border, background); /* pixel values */
} else {
  :
  window = XCreateWindow(XWINDISPLAY(swin), XWINDOW(swin),
                         position.x, position.y, /* initial placement */
                         size.x, size.y,
                         border_width,
                         depth,
                         class,
                         XVISUAL(svis),
                         valuemask,
                         &attributes);

なんだ、内部的に、XCreateSimpleWindowを使ってるじゃん。これが先生の頭の中身か。ソースが有るとソースかと納得出来る事が多いな。純粋なXでは、第一引数がDisplay型で第二引数がWindow型のparentだけど、scmでは、parentから分解して充当してる。ケチケチ作戦の発動だな。

scmを走らせると、引数に不備が有ると指摘してくれるんで、単なるもぐら叩きの連続だ。上記のように gdb + source + 多少の想像力で何とかなる。

何とかならないのは、前回の叩き台で出て来た、XSelectInputと言う関数。scmには、そんな関数は無い。無くても何とかなってるって事は裏道が有るに違いない。目を皿のようにしてマニュアルを眺めたよ。そう、元関数のやってる事を理解した上でね。

私の解釈では、許可するイベントを設定してるんだな。それにしては、ButtonPressMaskのMaskって何だ。用語の使い方を間違っていないか。素直なオイラーならButtonPressEnableにするぞ。まあ、これも頭の良いMITの方々が考えた事だから。。。

で、代替え品を発見した。

-- Function: x:window-set! window field-name value ...
    Changes the components specified by FIELD-NAMEs for the specified
    WINDOW.  The restrictions are the same as for `x:create-window'.
    The order in which components are verified and altered is server
    dependent.

これが使えそう。

(x:window-set! w event-mask (or x:Button-Press-Mask x:Exposure-Mask))

event-maskは、当初適当に書いておいたもので、正式には、x:CW-Event-Mask が正解。ここまでは、scmがちゃんと指摘してくれたので楽勝。問題は次のorの指定。

後にちゃんと動くようになって、ここに逆戻りしちゃったのだ。曰く、orの第一引数で指定したものしか、enableにならないんだ。

x11.scm

(define x:Button-Press-Mask 4)
(define x:Exposure-Mask 32768)

こんな風に定義されてるんで、orに適用してみる。

> (or x:Button-Press-Mask x:Exposure-Mask)
4
> (or x:Exposure-Mask x:Button-Press-Mask)
32768

ちゃんと機能と現象が一致した。解決策は、bit-or とかロジカルorだろうけど、どうもそんなの無いっぽい。足し算で我慢するか。取り敢えず、これが第二の難関ですかね。細かい事を言うと、整数のBIT幅を確認しておかないと、後に不思議なBUGになる鴨。

最後のMainLoop相当を、scheme流に実装した。叩き台では、whileを使ってたけどね。そんなのscmに無いのさ。

で、思ったように反応しない。こういうのが一番困る。まだエラーが出てくれた方が256倍は楽と思うぞ。苦肉の策として、ちゃんとループを回っているか？ イベントは届いているかを確認する為、print文(schemeの場合display文だけど)を埋め込んだ。

(let loop ((e (x:next-event d)))
  (display e)(display (x:event-ref e X-event:type))(display "\n")  ; for debug
  (case (x:event-ref e X-event:type)
    ((x:Expose) (display "expose\n"))
    ((x:Button-Press) (x:draw-string w g '(100 100) "BUTTON")
     (display "button pressed\n")))
  (loop (x:next-event d)))

下記の結果が、コンソールに出てきた。

#<X event: ButtonPress>4
#<X event: Expose>12
#<X event: ButtonPress>4

窓の中でマウス・クリックすると４が出力。窓枠をもってズリズリすると１２が出力された。でも窓中にはBUTTON表示されず。アレレのレレだ。摩訶ふしぎだ。caseが機能していない。

こうなると、疑うべきは、caseの使いかただな。gaucheのInfoを参照してみた。scmのマニュアルでは、R５RSは、載っていないんだ。そんなの常識でしょって態度。だから改めて常識を確認しましょって事だ。

-- Special Form: case key clause1 clause2 ...
    [R7RS+ base][SRFI-87] KEYは任意の式です。CLAUSEは以下の形式でなけれ
    ばなりません。
         ((DATUM ...) EXPR EXPR2 ...)
         ((DATUM ...) => PROC)
    ここで、各DATUMはSchemeオブジェクトの外部表現であり、全てのDATUMは
    異なっていなければなりません。最後のCLAUSEには次の形式を持つelse節
    が許されます。
         (else EXPR EXPR2 ...)
         (else => PROC)

    まずKEYが評価され、その結果がそれぞれのDATUMと比較されます。 KEYの
    値と‘eqv?’(see 等価参照)を使って一致するDATUM が見つかれば、対
    応するEXPRが順に評価され、その最後の値が‘case’の 値となります。
    ‘=>’を含む節はSRFI-87で定義されています。これらの節では、 KEYの結果
    がPROCに渡され、その結果が‘case’の値となります。

実を言うと、caseは初体験です。最初はifとかcondを使うんだろうなと、昔のscm本を見ていたら、caseが紹介されたので、取り入れてみた次第。このcaseって、FORTRANに有る、計算型gotoじゃなかろうか、なんてふと思ったぞ。

さらに心配だったので、gauche作者のshiroさんに尋ねてみた(gauche本を三田んだ)。そしたら、注意が載ってたぞ。DATUMは即値の必要があります。ですから変数では指定出来ませんですって。言われてみればそうだな。素早く飛んでけだから、いちいち評価なんてしていられない。

x11.scm

(define x:Button-Press 4)
(define x:Expose 12)

上記を参考に、即値に変更。

#<X event: ButtonPress>4
button pressed
#<X event: Expose>12
expose
#<X event: ButtonPress>4
button pressed

そしたら、ちゃんと動いた。取り敢えず移植完了ですかね。

;; Xlib sample code for scm(scheme)
(require 'Xlib)
(define d (x:open-display #f))
(define s (x:default-screen d))
(define w (x:create-window (x:root-window d s)
                           '(100 100)  '(256 256)  4
                           (x:screen-black d s)
                           (x:screen-white d s)))
(x:map-window  w)
(define g (x:create-gc  w))
(x:window-set! w x:CW-Event-Mask (+ x:Exposure-Mask x:Button-Press-Mask))

(let loop ((e (x:next-event d)))
;;  (display e)(display (x:event-ref e X-event:type))(display "\n") ; debug
  (case (x:event-ref e X-event:type)
    ((12) (display "expose\n"))
    ((4) (x:draw-string w g '(100 100) "BUTTON")
     (display "button pressed\n")))
  (loop (x:next-event d)))

見ての通り、ウィジット(部品)をブレッド・ボードに展開しただけの作りです。本当なら、(x:open-display #f)の結果のd等は、トップレベルに出し放なしにしないで、それなりの関数内に押し込めるのが筋。でも、あえてそうはしない。部品取り用ですから。

昨今、半導体不足の折、破棄された製品のボードから、部品を取り出して売ると言うのが横行してるらしい。時流に乘ってみた訳だな。

それから、DEBUG文は、もしもの為に残しているよ。

上記を走らせて、終了はどうする？ 出て来た窓の削除をすれば、取り敢えずおk。

XIO:  fatal IO error 0 (No error: 0) on X server "localhost:10.0"
      after 12 requests (11 known processed) with 0 events remaining.

こんな恨み言を出して終了してくれる。余り気分がいいとは言えないな。キーボードからq を入力したら、正しい手順で終了させる。ついでに、それ以外のキー入力は、窓内に表示させるぐらいは、発展問題として、やってみるか。

まて、それより、 江戸の敵を長崎で討つ が、先かな。