more Xlib

iprin1

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

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

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

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

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

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

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

guileの敵をscmで討つ

外国から見えるお客様には、タイトルの意味判らないだろうな。 前回たまたま見付けた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コンテキストを生成する時に、線の太さを2にしてみた。何か描画したら、フラッシュして、画面に反映させる事。

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

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

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

keycode

前回宿題にしてた、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エラーになってしまう。もう、これ以上深入りは止める。

at gambit examples

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

Inside Gambit-C

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

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

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

喜びいさんで、コードを見ていくと、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って定義は、7個の引数を渡すんだよ。返り値は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側の名前なんで、正してもいいんだけど、みんな世の中の流れに(しぶしぶ)従っていますよ。

chicken

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

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

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

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

racket

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と言う割には、巨大だからね。

racket-minimal at FreeBSD

後日、HDDの容量がたっぷり有るFreeBSDなマシンでコンパイルしてみた。Makefileを見ると、libffi.soを使ってた。これでXと仲良くなるんでしょう。ファイル中にBCとかCSなんてのが出てくる。BCってのはbyte-codeで昔ながらの方法。CSってのはchez schemeって事で、連合軍だ。 やっぱりね。結合協定が成り立ったんですな。

/usr/ports/lang/racket-minimal/work/racket-8.2/src/cs/c/ChezScheme/ti3fb/bin/ti3fb/scheme -B /usr/ports/lang/racket-minimal/work/racket-8.2/src/cs/c/ChezScheme/ti3fb/boot/ti3fb/petite.boot -B /usr/ports/lang/racket-minimal/work/racket-8.2/src/cs/c/ChezScheme/ti3fb/boot/ti3fb/scheme.boot --script compile-file.ss --unsafe --compress   --dest "/usr/ports/lang/racket-minimal/work/racket-8.2/src/cs/c/./" regexp.sls /usr/ports/lang/racket-minimal/work/racket-8.2/src/cs/c/./chezpart.so /usr/ports/lang/racket-minimal/work/racket-8.2/src/cs/c/./rumble.so /usr/ports/lang/racket-minimal/work/racket-8.2/src/cs/c/./thread.so /usr/ports/lang/racket-minimal/work/racket-8.2/src/cs/c/./io.so
compiling regexp.sls with output to /usr/ports/lang/racket-minimal/work/racket-8.2/src/cs/c/./regexp.so
(time (compile-it))
    75 collections
    2.091498000s elapsed cpu time, including 0.897027000s collecting
    2.101515247s elapsed real time, including 0.902158333s collecting
    321959432 bytes allocated, including 298801000 bytes reclaimed
    74317824 bytes peak memory use
     :
ChezScheme/ti3fb/bin/ti3fb/scheme -B ChezScheme/ti3fb/boot/ti3fb/petite.boot -B ChezScheme/ti3fb/boot/ti3fb/scheme.boot --script ./to-vfasl.ss   ChezScheme/ti3fb/boot/ti3fb/petite.boot petite-v.boot

これコンパイル中の一節なんだけど、確かにchezが使われていたよ。

コンパイルに先だち必要な道具の準備が行われるんだけど、chezをDLとかはしていなかった。racket.tgzに同梱されてやってきたんだな。

racket-8.2/README

The Racket Programming Language
===============================

This is the
  Minimal Racket | All Platforms | Source + built packages
distribution for version 8.2.

確かにso書いてあるし。srcの中にchezがまんま 入っていたよ。 そして、コンパイルの現場は、 /usr/ports/lang/racket-minimal/work/racket-8.2/src/cs/c の中。ツールチェーンとしてchez scheme様が居たぞ。それにしても、何時コンパイルが終了するんだ? もう2時間も戦闘をしてるぞ。

コンパイル過程のログを見たら、パッケージングに多大な時間を費している事が判明。ちゃんと検証しておかないと大変な事になりますからね。と、言う事で、途中で打切りました。

chez support X11 ?

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

tinyscheme

少し骨休めをする。正真証明の小さいやつ。 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