Monthly Archives: August 2007

前回(id:smeghead:20070825:ncurses2)の続き

ファイヤープロジェクト

http://www.fireproject.jp/

ここのサイトのの情報って幅広さと濃さが凄いですね。かなり前から色々な言語でお世話になっています。

matsuさんという方が個人で作成しているらしいです。頭が下がりますm(_ _)m

パッド

パッドを使用すると論理画面にまとめて表示データを格納しておいて,必要な分だけ物理画面で表示することが可能になる.しかも簡単に.

http://www.fireproject.jp/feature/c-language/curses/pad.html#2

以前、仮想画面と勘違いしていたのはパッドでした。ということでパッドを試してみました。

今回は、上のサイトで紹介されている「なんちゃってless」をcommon lispで書いてみました。

• オリジナルのなんちゃってlessから変更した点
  • w3mのようにカーソルがある点
  • キーバインドをw3m風に(といってもhjklqしか作ってません)

curses-wrapper.lisp

継ぎ接ぎだらけですがここに置いてみました。

追加したマクロ

(defmacro with-pad (pad-name initial-proc &body body)
`(progn
(setq ,pad-name ,initial-proc)
,@body
(delwin ,pad-name)))

less.lisp

(load "/usr/lib/clisp/asdf.lisp")
(setf asdf:*central-registry*
'(*default-pathname-defaults*
#p"/usr/lib/clisp/system/"))
(asdf:oos 'asdf:load-op :cffi :verbose nil)
(load "curses-wrapper.lisp")
(use-package :curses-wrapper)
(defun get-contents (file-name)
(with-open-file (stream file-name :direction :input)
(loop for line = (read-line stream nil 'eof)
until (equal line 'eof)
collect line)))
(defun setup-pad (contents)
(let ((pad-y 0)
(pad-x 0))
(loop for line in contents
for i from 0
do (mvwprintw *stdpad* i 0 line))
(defun pad-down ()
(if (and (eql (getcury *stdscr*) (1- *LINES*))
(< (+ pad-y *LINES*) (getmaxy *stdpad*)))
(prefresh *stdpad* (incf pad-y) pad-x 0 0 (1- *LINES*) (1- *COLS*))
(wmove *stdscr* (1+ (getcury *stdscr*)) (getcurx *stdscr*))))
(defun pad-up ()
(if (and (eql (getcury *stdscr*) 0)
(> pad-y 0))
(prefresh *stdpad* (decf pad-y) pad-x 0 0 (1- *LINES*) (1- *COLS*))
(wmove *stdscr* (1- (getcury *stdscr*)) (getcurx *stdscr*))))
(defun pad-left ()
(if (and (eql (getcurx *stdscr*) 0)
(> pad-x 0))
(prefresh *stdpad* pad-y (decf pad-x) 0 0 (1- *LINES*) (1- *COLS*))
(wmove *stdscr* (getcury *stdscr*) (1- (getcurx *stdscr*)))))
(defun pad-right ()
(if (and (eql (getcurx *stdscr*) (1- *COLS*))
(< (+ pad-x *COLS*) (getmaxx *stdpad*)))
(prefresh *stdpad* pad-y (incf pad-x) 0 0 (1- *LINES*) (1- *COLS*))
(wmove *stdscr* (getcury *stdscr*) (1+ (getcurx *stdscr*)))))))
(defun main (args)
(if (not args)
(format *error-output* "Usage: clisp less.lisp filename~%")
(progn
(let ((contents (get-contents (car args))))
(with-curses
(cbreak)
(noecho)
(scrollok *stdscr* FALSE)
(with-pad *stdpad* (newpad (length contents)
(loop for line in contents
maximize (length line)))
(setup-pad contents)
(refresh)
(prefresh *stdpad* 0 0 0 0 (1- *LINES*) (1- *COLS*))
(input-loop key
(((char-code #\q) (char-code #\Q)) (return))
((char-code #\h) (pad-left))
((char-code #\j) (pad-down))
((char-code #\k) (pad-up))
((char-code #\l) (pad-right)))))))))
(main *args*)

いろいろ試すいい機会なので、マクロとかクロージャも積極的に使う方向でやってみています。

でも大域変数使いすぎで汚ないです；；ncursesプログラミングはこんなもんなのかな？

実行方法

$ clisp less.lisp <text file name>

感想

パッドは便利。

id:smeghead:20070824:ncurses で最小限の状態でclispからncurses(Cライブラリ)呼出しを動かしてみたものの続きです。curses-wrapper.lispは、どんどん大きくなってきて、貼り付けられない状態になってます。

Ncurses 入門

http://linuxmag.sourceforge.jp/Japanese/March2002/article233.shtml

上のサイトにあるサンプルを、curses-wrapper.lispを使って、common lispに翻訳しました。翻訳なので、lispらしさは無いです。

(load "/usr/lib/clisp/asdf.lisp")
(setf asdf:*central-registry*
'(*default-pathname-defaults*
#p"/usr/lib/clisp/system/"))
(asdf:oos 'asdf:load-op :cffi :verbose nil)
(load "curses-wrapper.lisp")
(use-package :curses-wrapper)
(defconstant ENTER 10)
(defconstant ESCAPE 27)
(defun init_curses ()
(initscr)
(start_color)
(init_pair 1 COLOR_WHITE COLOR_BLUE)
(init_pair 2 COLOR_BLUE COLOR_WHITE)
(init_pair 3 COLOR_RED COLOR_WHITE)
(curs_set 0)
(noecho)
(keypad *stdscr* TRUE))
(defun draw_menubar (menubar)
(wbkgd menubar (COLOR_PAIR 2))
(waddstr menubar "Menu1")
(wattron menubar (COLOR_PAIR 3))
(waddstr menubar "(F1)")
(wattroff menubar (COLOR_PAIR 3))
(wmove menubar 0 20)
(waddstr menubar "Menu2")
(wattron menubar (COLOR_PAIR 3))
(waddstr menubar "(F2)")
(wattroff menubar (COLOR_PAIR 3)))
(defun draw_menu (start-col)
(let (items
(first-item (newwin 10 19 1 start-col)))
(wbkgd first-item (COLOR_PAIR 2))
;     (box first-item *ACS-VLINE* *ACS-HLINE*)
(setq items (loop for i from 1 to 8
collect (subwin first-item 1 17 (1+ i) (1+ start-col))))
(loop for item in items
for i from 1
do (wprintw item (format nil "Item~d" i)))
(wbkgd (first items) (COLOR_PAIR 1))
(wrefresh first-item)
(cons first-item items)))
(defun scroll-menu (items menu-start-col)
(let ((selected 0))
(loop for key = (getch)
do (case key
((258 259) ; KEY_DOWN KEY_UP
(wbkgd (nth (1+ selected) items) (COLOR_PAIR 2))
(wnoutrefresh (nth (1+ selected) items))
(if (equal key 258) ; KEY_DOWN
(setf selected (mod (1+ selected) (1- (length items))))
(setf selected (mod (+ selected (1- (length items)) -1) (1- (length items)))))
(wbkgd (nth (1+ selected) items) (COLOR_PAIR 1))
(wnoutrefresh (nth (1+ selected) items))
(doupdate))
((260 261) ; KEY_LEFT || key == KEY_RIGHT
(delete_menu items)
(touchwin *stdscr*)
(refresh)
(return (scroll-menu (draw_menu (- 20 menu-start-col)) (- 20 menu-start-col))))
((27) ; ESCAPE
(return))
((10) ; ENTER
(return selected))))))
(defun delete_menu (items)
(loop for item in items do
(delwin item)))
(defun main ()
(handler-case
(progn
(init_curses)
(bkgd (COLOR_PAIR 1))
(let ((menubar (subwin *stdscr* 1 80 0 0))
(messagebar (subwin *stdscr* 1 79 23 1)))
(draw_menubar menubar)
(move 2 1)
(printw "Press F1 or F2 to open the menus. ")
(printw "ESC quits.")
(refresh)
(loop for key = (getch)
until (equal key ESCAPE)
do
(let (selected_item menu_items)
(werase messagebar)
(wrefresh messagebar)
(cond
((equal key (KEY_F 1))
(setq menu_items (draw_menu 0))
(setq selected_item (scroll-menu menu_items 0))
(delete_menu menu_items)
(if (minusp selected_item)
(wprintw messagebar "You haven't selected any item.")
(wprintw messagebar (format nil "You have selected menu item ~d." (1+ selected_item))))
(touchwin *stdscr*)
(refresh))
((equal key (KEY_F 2))
(setq menu_items (draw_menu 20))
(setq selected_item (scroll-menu menu_items 20))
(delete_menu menu_items)
(if (minusp selected_item)
(wprintw messagebar "You haven't selected any item.")
(wprintw messagebar (format nil "You have selected menu item ~d." (1+ selected_item))))
(touchwin *stdscr*)
(refresh)))))
(delwin menubar)
(delwin messagebar))
(endwin))
(error (c)
(endwin)
(print "error!")
(print c))))
(main)

コメントアウトしてある部分ですが、box関数呼出しの第三、第四引数を扱おうとするとエラーが発生してしまう状態が回避できませんでした。box関数のプロトタイプ宣言は下のようになっていました。(curses.h)

extern NCURSES_EXPORT(int) box (WINDOW *, chtype, chtype);        /* generated */

chtypeってなんだろう。

#if 1 && defined(_LP64)
typedef unsigned chtype;
typedef unsigned mmask_t;
#else
typedef unsigned long chtype;
typedef unsigned long mmask_t;
#endif

curses-wrapper.lisp の中のbox関数と ACS_VLINE と ACS_HLINE に対応る型宣言を :unsigned-long にしてみたり、 :pointer にしてみたりしましたが、改善せず。こうゆうときに、Cの経験の少ないゆとりプログラマは弱いorz.

ふと疑問に思ったのは、共有ライブラリの実体には、#defineのマクロ定義は残っているんだろうか？プリプロセッサで評価されて消えてしまうんじゃないのか？でも、マクロ定義している関数は呼べてるな。externしてるのは呼べるようになってるのかな。

#define refresh()      wrefresh(stdscr)

あと、ちょっと嵌ったのは、caseマクロ の keys に指定する値が評価されないということ。

case は最初にキーとなる S 式を受け取り、そのあと cond と同様に複数の節が続きます。 cond には節の先頭に条件部がありましたが、 case の場合はキーリストというものがあります。まず、キーとなる S 式を評価します。次に、この評価結果とキーリストに格納された要素を比較します。このとき、キーリスト本体や要素は評価されないことに注意してください。

http://www.geocities.jp/m_hiroi/xyzzy_lisp/abclisp17.html

そのせいで、マジックナンバーが入ってます。

まぁ、制限付きですが、普通にncursesを呼出すことはできているので、lispらしく書き直していきたいです。

2個マクロ書いた。initscr と endwin とエラー処理(何もしてないけど)を纏めるwith-cursesと、キーボード入力待ちループ用のinput-loopです。しかし、それほど呼び出し側のコードがすっきりするわけでも無かった。

(defmacro with-curses (&body body)
`(handler-case
(progn
(initscr)
,@body
(endwin))
(error (c)
(endwin)
(apply #'format t
(simple-condition-format-control c)
(simple-condition-format-arguments c)))))
(defmacro input-loop (key &body test-proc-lst)
`(loop for ,key = (getch)
do (cond
,@(loop for test-proc in test-proc-lst
collect (if (and (listp (car test-proc)) (not (fboundp (car (car test-proc)))))
`((member ,key (list ,@(car test-proc)) :test #'equal) (progn ,@(cdr test-proc)))
`((equal ,key ,(car test-proc)) (progn ,@(cdr test-proc))))))))

gensymの使いどころがわかってないけど、input-loop の引数 key は、gensymが必要なんだろうか？