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らしく書き直していきたいです。