more Xlib

前回の最後に、.gdbinit内で定義されてたscheme寄りの便利関数を使った。gdb内から直接scmの関数を呼び出している。定義場所は、repl.cにあった。

void scm_iprin1(exp, port, writing)
     SCM exp;
     SCM port;
     int writing;
{

replのprint相当(改行無しなんで、lisp風に１がついている)。引数は、順番に表示したいS式、出力先のポート、最後のwritingは、displyとして使うかwriteとして使うかのスイッチになってる。

もう一度、.gdbinitの定義を見ておく

define disp
  call scm_iprin1($arg0, sys_protects[2], 0)
  echo \n
end

gdbのcallを使って呼出。第二引数は、current-portを表しているんだな。最後の０は、人が読み易いdisplay形式で表示してね、か。

この技、他のlisp/schemeを観光するのに使えるな。なかなか良いTipsだ。

外国から見えるお客様には、タイトルの意味判らないだろうな。 前回たまたま見付けたguile-xlibがコンパイル出来無かったので、scmでそのリベンジをしたって事だ。線と四角形を描くサンプル。

(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:GC-Line-Width 2))
(x:window-set! w x:CW-Event-Mask (+ x:Exposure-Mask x:Button-Press-Mask))

(x:flush d)
(x:draw-lines w g 10 10  100 100)
(x:flush d)
(x:fill-rectangle w g '(100 120)  '(70 50))
(x:flush d)

gcコンテキストを生成する時に、線の太さを２にしてみた。何か描画したら、フラッシュして、画面に反映させる事。

多角形を描くポリゴン関数は、設定方法がまだ解明出来ていない。円を描くArcは、説明書には軽く出ているんだけど、実装はされていない。

8章 グラフィック関数を見ながら頑張ってみる？ それはライト・ユーザーのやる事じゃ無い。 ああ、軽いユーザーってのは、オイラーみたいにつまみ食いをする人の事ね。

Arcって、汎用的な仕様なのね。この関数一つで、真円、楕円、扇型がかける。汎関数だな。 また、points関数等では、 複数の点や四角を一回の関数呼出で描画出来るようになってる。点とかの配列とその個数を与えるのか。こうすると、無駄なやりとりが減って好都合だな。

前回宿題にしてた、Windowを閉じると、無様なエラーになる件の対処。その方法として、キーボードからqが押されたら、終了って事にしたい。それ以外のキー入力は窓内に表示。

先にキーボード関係の扱いを調べておく。

キーの操作に伴うデータの流れ

キーボードに関連した各種のツール

素晴しい資料が提供されてた。さすが、FreeBSDな人。リナな人種にはこういう人はいないでしょう(大いなる偏見かも、まあ個人的感想だから許せ)。

例によってC言語で書下したコードが提示されてました。 キー入力を受け取る これを参考に、scheme語に翻訳しますかね。この方、巧にASCIIコードへの変換を逃げてます。これもhack技ですな。

(require 'Xlib)
(define k2a '((24 . #\q) (25 . #\w) (38 . #\a) (52 . #\z)))
(define (get-ascii e)
  (let ((k (x:event-ref e X-event:keycode)))
    (cond ((assoc k k2a) => cdr)
          (else 'unknown))))

(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:Key-Press-Mask
                                    x:Button-Press-Mask))

(let loop ((e (x:next-event d)))
;  (display (x:event-ref e X-event:type))(display "\n")
  (case (x:event-ref e X-event:type)
    ((12) (display "expose\n"))
    ((2)  (let ((a (get-ascii e)))
            (if (eqv? a #\q)
                (begin (x:close w) (quit))
                (begin (display a)(newline)))))
    ((17) (x:close w)(quit))  ; x:Destroy-Notify
    ((4) (x:draw-string w g '(100 100) "BUTTON")
     (display "button pressed\n")))
  (loop (x:next-event d)))

冒頭に置いたテーブルは、キーコードからASCIIに変換するやつ(の未完成品)。次のget-asciiは、そのテーブルを引いてASCIIコードを返す。未定義なら、知らないって返す。

本当なら、ここでSHIFTキーが押されたとかを検出して、テーブルを切替、ちゃんとしたASCIIを返すべき(だけど、簡易版と言う事でサボリ)。

ループの中では、Key-Pressedに相当する(2)の所で、ASCIIコードがqなら、窓を閉じてから終了。そうでなかったら、ASCIIコードをコンソールに出してる(ここもサポってるな)。

更にループの中で、Destroy-Notifyを掴まえようとしたけど、アクロバティックな事をしないと駄目みたい。窓を強性的に閉じると相変わらずIOエラーになってしまう。もう、これ以上深入りは止める。

少しいじけて、他の事に手を出してみる。 .gdbinitの中にschemeを呼び出すTipsが出てたので、他のschemeにも応用しないともったいない。で、何をやり玉にあげるか？ しばし考えてgambitがよかろうと言う事にした。

Inside Gambit-C

./configure --enable-debug --with-x --enable-single-host

な、設定でコンパイルを初めたのはいいんだけど、１時間もかかったよ。インストール先を明示しなかったので、/usr/local/Gambitになってたし。

で、時間を持て余していてソースツリー内をうろうろ。面白いものを発見。X11-simpleですって。広告には、２つのウィンドウを作って、その中で玉を１００個づつバウンドさせますよ、ですって。思わぬ拾い物だな。パッケージから入れたんじゃ、こういう幸運には遭遇しないぞ。

喜びいさんで、コードを見ていくと、C-FFI機能を使って、Xを呼び出す仕組みになってた。その呼出規約が、 Xlib.scmに定義されてた。分かり易い例をあげる。

(define XFillRectangle
  (c-lambda (Display*      ;; display
             Drawable      ;; d
             GC            ;; gc
             int           ;; x
             int           ;; y
             unsigned-int  ;; width
             unsigned-int) ;; height
            int
            "XFillRectangle"))

XFillRectangleって定義は、７個の引数を渡すんだよ。返り値はintだよ。最後の文字列は、X側の関数名だな。C言語側とscheme側の型変換をしてくれるんだな。これが判れば、幾らでも移植出来るぞ。

そしてこれを使うscheme側のアプリ。勿論schemeの世界だ。 bounce.scmこんな名前になってた。

(##include "Xlib#.scm") ;; import Xlib procedures and variables

(define win-width   600)
(define win-height  401)
(define ball-width  25)
(define ball-height 25)
(define nb-balls    100)

こんな書き出しで始まる。

(XFillArc
 x11-display
 window
 gc
 x
 y
 ball-width
 ball-height
 (* 64 0)
 (* 64 360))

そして、途中経過で、玉の作成。25x25の箱に内接する円(直径25)。角度は馴染のある360度が使えるように、係数を乗じて調整してる。

こういうX流の指定の方が、中心座標と半径を与えて描画するより、応用範囲が広いのだな。

(XSelectInput
 x11-display
 window
 (+ KeyPressMask
    KeyReleaseMask
    ButtonPressMask
    ButtonReleaseMask
    PointerMotionMask
    EnterWindowMask
    LeaveWindowMask))

そして、これは、前回突っ込みを入れた、イベントの登録。やっぱりbit-orが無いので、+ で代用してるね。xxxMaskって、悪しき名前は継承してるね。scheme側の名前なんで、正してもいいんだけど、みんな世の中の流れに(しぶしぶ)従っていますよ。

scmとかgambitとか、一つを選ぶと、それと心中する事になる。いわゆる縦割りの弊害。そこでだ、今回みたいに、横割りで行こう。Xlibをサポートしてるschemeに注目するって事。

頑張っていそうな奴として、 eggsと言う、パッケージシステムを導入してるchickenなんかはどうよ？

http://eggs.call-cc.org/5/#graphics

chicken-install で、簡単にパッケージを導入出来るぞ。もう選り取りみどりだ。

schemeって事を隠して、GUIを全面に出してるやつもいるな。何だか、スピードの点でchez schemeと連合を組んだみたいだけど、最近はどうなっているんだろう。

ああ、chez schemeと言えば、私が昔やったchezの記事を参照してくださる方が、毎月10人ほどいらっしゃる。大した事書いていないのに、私の所に來るって事は、全世界的にみて、記事が不足してるって事なんだろうね。

Chez Scheme

昔のやつは、確かswingとか言うX関係者さんがいたように記憶してるけど、今流通してるchezには、そんなの無いな。

drraket = racket + GUI

先生が黒い窓恐怖症を緩和させて、授業を進めるために作ったんだな。

sakae@deb:~$ racket
Welcome to Racket v7.9 [bc].
> ,?
; General commands:
;   help (h ?): display available commands
;   exit (quit ex): exit racket
     :

racketの最小のやつがOpenBSDにも有るので、入れてみるか。 オイラーは、伝統的にCUIな人ですから。

最小の奴と言っても、結構大きそう。racoとか言うパッケージャーシステムも作成されるみたいだし。勿論、Xと接続する機構の根底にあるCFFIは、当然サポートしてる。これを使って、すぐにdrracketに成長させられるみたい。但しJITが必須とな。 軽くやってみようかと思ったけど、断念するよ。miniと言う割には、巨大だからね。

chez-schemeのMakefileを見ていたら、怪しいやつを発見。X11をサポートしてるっぽい。取り敢えずconfigureをしてみた。

root@fb:/usr/ports/lang/chez-scheme # make configure

===>  License APACHE20 accepted by the user
===>   chez-scheme-9.5.2 depends on file: /usr/local/sbin/pkg - found
===> Fetching all distfiles required by chez-scheme-9.5.2 for building
===>  Extracting for chez-scheme-9.5.2
=> SHA256 Checksum OK for chez-scheme-boot-a6fb-9.5.2.tar.xz.
=> SHA256 Checksum OK for chez-scheme-boot-i3fb-9.5.2.tar.xz.
=> SHA256 Checksum OK for cisco-ChezScheme-v9.5.2_GH0.tar.gz.
=> SHA256 Checksum OK for nanopass-nanopass-framework-scheme-v1.9_GH0.tar.gz.
=> SHA256 Checksum OK for madler-zlib-v1.2.11_GH0.tar.gz.
=> SHA256 Checksum OK for dybvig-stex-v1.2.1_GH0.tar.gz.
===>  Patching for chez-scheme-9.5.2
/bin/ln -sf /usr/ports/lang/chez-scheme/work/i3fb /usr/ports/lang/chez-scheme/work/ChezScheme-9.5.2/boot/
/usr/bin/sed -i.bak -e 's,/usr/X11R6,/usr/local,g'  -e 's,/usr/local,/usr/local,g'  -e 's,-liconv,,g' /usr/ports/lang/chez-scheme/work/ChezScheme-9.5.2/c/Mf-i3fb
===>   chez-scheme-9.5.2 depends on package: gmake>=4.3 - found
===>   chez-scheme-9.5.2 depends on package: libiconv>=1.14_11 - found
===>   chez-scheme-9.5.2 depends on file: /usr/local/lib/libncurses.so.6 - found
===>   chez-scheme-9.5.2 depends on file: /usr/local/libdata/pkgconfig/x11.pc - found
===>   chez-scheme-9.5.2 depends on shared library: libuuid.so - found (/usr/local/lib/libuuid.so)
===>  Configuring for chez-scheme-9.5.2

これを見る限りでは、やる気満々のように見うけられる。取り敢えずコンパイル・キューに入れておくか。

悪戯でバイナリーの中身から優意義な文字を抽出してみた。

sakae@deb:~$ strings /usr/bin/scheme | egrep 'lib.*.so'
/lib/ld-linux.so.2
libm.so.6
libdl.so.2
libtinfo.so.6
libz.so.1
liblz4.so.1
libpthread.so.0
libuuid.so.1
libc.so.6
libX11.so
sakae@deb:~$ ldd /usr/bin/scheme
        linux-gate.so.1 (0xb7fc1000)
        libm.so.6 => /lib/i386-linux-gnu/libm.so.6 (0xb7bf2000)
        libdl.so.2 => /lib/i386-linux-gnu/libdl.so.2 (0xb7bec000)
        libtinfo.so.6 => /lib/i386-linux-gnu/libtinfo.so.6 (0xb7bc3000)
        libz.so.1 => /lib/i386-linux-gnu/libz.so.1 (0xb7ba6000)
        liblz4.so.1 => /lib/i386-linux-gnu/liblz4.so.1 (0xb7b82000)
        libpthread.so.0 => /lib/i386-linux-gnu/libpthread.so.0 (0xb7b60000)
        libuuid.so.1 => /lib/i386-linux-gnu/libuuid.so.1 (0xb7b56000)
        libc.so.6 => /lib/i386-linux-gnu/libc.so.6 (0xb796d000)
        /lib/ld-linux.so.2 (0xb7fc3000)

libX11.soって、名前だけ？ ダイナミック呼出用？ 少し調べてみるか。

[sakae@fb /usr/ports/lang/chez-scheme/work/ChezScheme-9.5.2]$ grep libX11.so -rIl
./c/version.h
./i3fb/c/version.h

[sakae@fb /usr/ports/lang/chez-scheme/work/ChezScheme-9.5.2]$ grep -C 3 libX11.so ./c/version.h
--
#define LOCKF
#define DIRMARKERP(c) ((c) == '/')
#ifndef DISABLE_X11
#define LIBX11 "libX11.so"
#endif
#define SECATIME(sb) (sb).st_atimespec.tv_sec
#define SECCTIME(sb) (sb).st_ctimespec.tv_sec

今度は、LIBX11が何処で使われているかだな。./c/expenitor.c だった。

status = (display_name = getenv("DISPLAY"))
      && (handle = dlopen(LIBX11, RTLD_NOW))
      && (pXOpenDisplay = (Display *(*)(char *display_name))dlsym(handle, "XOpenDisplay"))
      && (pXDefaultRootWindow = (Window (*)(Display *))dlsym(handle, "XDefaultRootWindow"))
        :
      && (D = pXOpenDisplay(display_name))
      && (R = pXDefaultRootWindow(D))
      && (W = pXCreateSimpleWindow(D, R, 0, 0, 1, 1, 0, 0, 0))

何よこの極小なウィンドウは、隠れて何かやりたいんだな。このコードの後ろには、miniイベントループも控えていた。

こんなのを見てるって事は、俗に言う、木を見て森を見ず、、、だな。もっとマクロになれ。 ってんで、この少し前の方を見る。

/* move-line-down doesn't scroll the screen when performed on the last
   line on the freebsd and openbsd consoles.  the official way to scroll
   the screen is to use scroll-forward (ind), but ind is defined only
   at the bottom left corner of the screen, and we don't always know
   where the bottom of the screen actually is.  so we write a line-feed
   (newline) character and hope that will do the job. */
static void s_ee_line_feed(void) {
  putchar(0x0a);
}

#ifdef LIBX11
#include <dlfcn.h>
#include <X11/Xlib.h>
#include <X11/Xatom.h>
#include <sys/select.h>
#endif /* LIBX11 */

static ptr s_ee_get_clipboard(void) {
#ifdef LIBX11
  <abobe code>

ファイルの末尾に関数の登録簿が載ってた。なんだ、editorじゃん。

Section 2.2. Expression Editor

Chapter 14. Expression Editor

少し骨休めをする。正真証明の小さいやつ。 http://tinyscheme.sourceforge.net/home.html portsになってるけど、かまわず野良ビルド。リンカーでエラーを食ったので、makefileをちょいと修正。

(gdb) bt
#0  _thread_sys_read () at /tmp/-:3
#1  0x000007d345894b5e in _libc_read_cancel (fd=0, buf=0x7d313a2f000,
    nbytes=65536) at /usr/src/lib/libc/sys/w_read.c:27
#2  0x000007d34589f082 in __sread (cookie=0x7d345916600 <__sF>,
    buf=0x7d313a2f000 "", n=<optimized out>)
    at /usr/src/lib/libc/stdio/stdio.c:48
#3  0x000007d34589f2e8 in __srefill (fp=0x7d345916600 <__sF>)
    at /usr/src/lib/libc/stdio/refill.c:116
#4  0x000007d34589bb0a in _libc___srget (fp=0x7d345916600 <__sF>)
    at /usr/src/lib/libc/stdio/rget.c:46
#5  0x000007d0af38667e in basic_inchar (pt=<optimized out>) at scheme.c:1523
#6  inchar (sc=0x7f7ffffed5f0) at scheme.c:1509
#7  0x000007d0af386728 in skipspace (sc=<optimized out>) at scheme.c:1754
#8  token (sc=0x7f7ffffed5f0) at scheme.c:1778
#9  0x000007d0af38abde in opexe_0 (sc=0x7f7ffffed5f0, op=<optimized out>)
    at scheme.c:2545
#10 0x000007d0af388510 in Eval_Cycle (sc=0x7f7ffffed5f0, op=<optimized out>)
    at scheme.c:4470
#11 0x000007d0af38874d in scheme_load_named_file (sc=0x7f7ffffed5f0,
    fin=0x7d345916600 <__sF>, filename=0x0) at scheme.c:4831
#12 0x000007d0af38c4fd in main (argc=1, argv=0x7f7ffffee720) at scheme.c:5042

ああ、目がくらくらするAMD64版だったわい。

これ、組み込み用のschemeって事なので、Xlibと合体出来無いかな。難しそうだな。誰か勇気ある方いませんか？

This year's Index

Home