読者です 読者をやめる 読者になる 読者になる

マインスイーパー

common lisp sbcl

端末上で動作するマインスイーパーをCommonLisp(SBCL)で実装してみた。
github: cl-mine-0.0.2

端末操作

端末操作部分のソースコードは以下のような感じ。
基本的には端末のエスケープシーケンスで(カーソル移動や画面クリア、文字色等の)制御を行っている。
ただ、キー入力をリアルタイムで取得可能にするのはエスケープシーケンスでは無理そうだったので、その部分はtcsetattr等のシステムコール(?)を使用している。

(defpackage console
  (:use :common-lisp :sb-alien)
  (:shadow :common-lisp format)
  (:export with-raw-mode clear move set-pos
           format newline formatln style))
(in-package :console)

;;; types ;;;
(deftype direction () '(member :up :down :left :right))  ; カーソル移動の方向
(deftype color () '(member :black :red :green :yellow :blue :magenta :cyan :white :normal))  ; 文字色、背景色

;;; constants ;;;
(defparameter +ESC+ (common-lisp:format nil "~c[" (code-char #8r33)))  ; エスケープシーケンスの開始文字列
(defparameter +STDIN_FD+ (sb-sys:fd-stream-fd sb-sys:*stdin*))  ; 標準入力のファイルディスクリプタ

;;; internal functions ;;;
;; 文字色のコード値を取得
(defun color-code (color)
  (declare (color color))
  (ecase color 
    (:black   30)
    (:red     31)
    (:green   32)
    (:yellow  33)
    (:blue    34)
    (:magenta 35)
    (:cyan    36)
    (:white   37)
    (:normal  39)))

;; cfmakeraw関数(キー入力リアルタイム取得用)はsb-posixパッケージに存在しないようなので読み込む
(define-alien-routine ("cfmakeraw" %cfmakeraw) void (termios* (* t)))
(defun cfmakeraw ()
  (let ((termios (sb-posix::allocate-alien-termios)))

    (%cfmakeraw termios)
    (unwind-protect
        (sb-posix::alien-to-termios termios)
      (sb-posix::free-alien-termios termios))))

;;; exported functions ;;;
;; 標準のformat関数の薄いラッパー
(defmacro format (control-string &rest format-arguments)
  `(progn (common-lisp:format t ,control-string ,@format-arguments)
          (force-output)))

;; 改行付きのformat関数
(defmacro formatln (control-string &rest format-arguments)
  `(progn (format ,control-string ,@format-arguments)
          (newline)))

;; 改行: tcsetattr関数にcfmakerawの戻り値を渡した場合(rawモード?)、改行には #\Newlineと#\Return の両方が必要
(defun newline ()
  (format "~c~c" #\Newline #\Return))

;; 文字色、背景色、太字、下線、文字色背景色反転、等を指定した文字列を返す
(defun style (x &key (color :normal) (bgcolor :normal) bold inverse underline)
  (declare (color color bgcolor))
  (common-lisp:format nil "~a~{~d;~}~d;~dm~a~a0m"
    +ESC+
    (remove nil (list (and bold 1) (and underline 4) (and inverse 7)))
    (color-code color)
    (+ (color-code bgcolor) 10)
    x
    +ESC+))

;; 上下左右へのカーソル移動
(defun move (direction &optional (delta 1))
  (declare (direction direction))
  (when (plusp delta)
    (format "~a~d~a" +ESC+ delta
            (ecase direction
              (:up    "A")
              (:down  "B")
              (:left  "D")
              (:right "C")))))

;; 画面クリア。lineがtの場合はカーソル行のみをクリア。
(defun clear (&key line)
  (if line
      (format "~a2K" +ESC+)
    (format "~a2J" +ESC+)))

;; 任意の位置へのカーソル移動
(defun set-pos (x y)
  (format "~a~d;~dH" +ESC+ y x))

;; 端末をrawモード(?)に切り替えてbodyを評価する
(defmacro with-raw-mode (&body body)
  (let ((old (gensym)))
    `(locally
      (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
      (let ((,old (sb-posix:tcgetattr +STDIN_FD+)))
        (unwind-protect
            (locally 
             (declare (sb-ext:unmuffle-conditions sb-ext:compiler-note))
             (sb-posix:tcsetattr +STDIN_FD+ sb-posix:tcsadrain (cfmakeraw))
             ,@body)
          (sb-posix:tcsetattr +STDIN_FD+ sb-posix:tcsanow ,old))))))

例えば、端末内をカーソル移動できるようにする場合は、以下のようなコードとなる。

;; 'e': ↑
;; 'd': ↓
;; 's': ←
;; 'f': →
;; 'c': exit
(console:with-raw-mode
 (loop
  (case (read-char)
    (#\e (console:move :up))
    (#\d (console:move :down))
    (#\s (console:move :left))
    (#\f (console:move :right))
    (#\c (return)))))

簡単なUIならこれで十分かもしれない。