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

レガシーコード生産ガイド

私に教えられることなら

Lispbuilder-SDLのサンプルを改造してみる

CommonLisp

なんとなく触ってなかったLispbuilder-SDLを触ってみることにした。

Linux MintSBCLで、(ql:quickload :lispbuilder-sdl)ですんなり入った。前に使ったっけ?GUIライブラリ調べたときにcffiとかのライブラリ揃ったのかな?

インストールやサンプルの実行はいっぱい他の記事があるので、始めの一歩を踏み出した記録に注力する。

目標は、WASDキーで画像を移動させる、とする。

画像も扱うので、lispbuilder-sdl-imageもquickloadしておく。libsdl-image1.2-devのインストールが必要かもしれない。

パッケージ定義

SLIMEでC-c C-kできるようにこう書いてる。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :lispbuilder-sdl)
  (ql:quickload :lispbuilder-sdl-image))

(defpackage rockmaso
  (:use :cl))

(in-package rockmaso)

サンプルを眺める

UsingLispbuilderSDL · lispbuilder/lispbuilder Wiki · GitHubのサンプルを眺めてみる。

動作は

  • マウスポインタの代わりに四角形を表示する
  • クリックすると四角形の色が変わる

というもの。

大まかに見ると、次のような構造になっている。(ついでに関数名をmainに変える)

;; 四角形の色
(defparameter *random-color* sdl:*white*)

(defun main ()
  (sdl:with-init ()
    ;; sdl:window でサイズとタイトルを指定して表示
    ;; sdl:frame-rateをsetfで書き換える。単位はfps?

    (sdl:with-events ()
      ;; (イベントのキーワード (引数的なもの) コード) で、
      ;; 各イベントが起きたときの動作を指定する  
      (:quit-event () t) ; 終了時。終了ステータスを返せばいいのかな
      (:key-down-event ()
        (sdl:push-quit-event)) ; 次のフレームで終了イベントを発火する
      (:idle ()
             ;; メインループ。後で詳しく中身を見る
             ))))

キーボード入力を正しくさばく

キーボードイベントを受け取る際に、どのキーが押されたかを調べてみる。

UsingLispbuilderSDL - lispbuilder - LISPBUILDER-SDL User Guide - Lispbuilder provides a range of libraries for developing useful portable Common Lisp applications - Google Project Hostingに引数的なものの一覧があるけど、どうやって受け取るかわからない。

github:key-down-eventで調べると、(:key k)という風に、(キーワード 束縛する変数)と使うみたいだ。

ウインドウの閉じるボタンで閉じれるみたいなので、キーボードを押すと終了せずに(:key k)で受け取ったkをprintしてみる。

:key-down-eventのハンドラを以下のように書き換えて

(:key-down-event (:key k)
  (print k))

適当にキーを押すと、

:SDL-KEY-A 
:SDL-KEY-Z 
:SDL-KEY-B 

とREPLにキーワードが出力された。WASDで上下移動、スペースキーでジャンプ……とprintする関数を作って、それに渡してみる。

ハンドラ

(defun keyboard-handler (key)
  (print
   (case key
     (:SDL-KEY-W "上")
     (:SDL-KEY-A "左")
     (:SDL-KEY-D "右")
     (:SDL-KEY-S "下")
     (:SDL-KEY-SPACE "飛"))))

イベント処理部

(:key-down-event (:key k) (keyboard-handler k))

試してみる。

ROCKMASO> (main)

"右" 
"下" 
"左" 
"上" 
"右" 
"飛"

核心部分に迫る

:idleイベントの中を見てみる。

      (:idle ()
             ;; マウスが左クリックされていたら、四角形の色をランダムに変える
             (when (sdl:mouse-left-p)
               (setf *random-color*
                     (sdl:color :r (random 255)
                                :g (random 255)
                                :b (random 255))))

             ;; 画面を一度黒でクリアする
             (sdl:clear-display sdl:*black*)

             ;; 四角形をマウス座標に描画する
             ;; マウスが四角形の中心に来る
             (sdl:draw-box
              (sdl:rectangle-from-midpoint-* (sdl:mouse-x) (sdl:mouse-y) 20 20)
              :color *random-color*)

             ;; 画面をアップデートする。標準でダブルバッファリング?
             (sdl:update-display))

emacsでTAB押してたらインデントが残念なことになったけど、仕方ない。

かなり簡単に使えるんだな〜と感心。rectangle-from-mipoint-*みたいに便利な関数 もあるみたいなので、リファレンスも読もう。

画像を表示する

次はマウス座標に画像を描画してみる。

いくつかの画像が置かれた(スプライト)透過PNGの一部を表示する。http://www.usamimi.info/~ide/programe/stg_doc/stg-commonlisp.pdfLisp Game Programming 2 <Stage 1> - `(kakko ,man)を参考にした。

まとめると、以下の工程になる。だいたいSDLがinitされてから(with-init内)でやる必要がある。

(用語はノリで使ってるので、あてにしないで欲しい。間違いは指摘して欲しい。)

  • 表示するためには画像ファイルからサーフェスを作り、それを表示する
  • 透過PNGの場合、その作ったサーフェスを表示用に変換する必要がある
  • スプライトを指定するためには、cellsを(setf (sdl:cells サーフェス) cells)で指定する。
  • cellsは、切り出す部分の(x y width height)というリストのリスト。
  • 0始まりのインデックスで指定すると、使用できる。

ひとつずつ見てみる。

まずPNGからサーフェスの作成。これは簡単で、以下の関数が画像ファイルから読み込んで返してくれる。

(sdl-image:load-image ファイル名 :image-type :png)

次に透過用の変換。上と併せて、関数にまとめておく。

(defun load-surface (fname)
  (sdl:convert-to-display-format
   :surface (sdl-image:load-image fname :image-type :png)
   :enable-alpha t
   :pixel-alpha t)

サーフェス用と、cells用の変数を作っておく。

(defparameter *r-surface* nil)
(defparameter *r-cells*
  '((0 0 32 32))) ;; 少なくとも32x32ピクセルの画像を用意

描画するには、:idleイベントのハンドラ内で以下のように書く。

(sdl:draw-surface-at-* サーフェス (sdl:mouse-x) (sdl:mouse-y) :cell 0)

surface-atだと(多分)sdlのpointオブジェクトを使い、surface-at-*だとx,y座標をそれぞれ指定するという命名規則っぽい。

ここまでで「キーボード入力を処理する」「毎フレーム画像を描画する」という処理ができたので、一応この時点での全コードを載せておく。好きに使ってください。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :lispbuilder-sdl)
  (ql:quickload :lispbuilder-sdl-image))

(defpackage rockmaso
  (:use :cl))

(in-package rockmaso)

(defun keyboard-handler (key)
  (print
   (case key
     (:SDL-KEY-W "上")
     (:SDL-KEY-A "左")
     (:SDL-KEY-D "右")
     (:SDL-KEY-S "下")
     (:SDL-KEY-SPACE "飛"))))

(defparameter *title* "rockmaso")
(defparameter *r-surface* nil)
(defparameter *r-cells*
  '((0 0 32 32)))

(defun make-surface (fname)
  (sdl:convert-to-display-format
   :surface (sdl-image:load-image fname :image-type :png)
   :enable-alpha t
   :pixel-alpha t))

(defun main ()
  (sdl:with-init ()
    (sdl:window 200 200 :title-caption *title*)
    (setf (sdl:frame-rate) 60)
    (setf *r-surface* (make-surface "rockmaso.png"))
    (setf (sdl:cells *r-surface*) *r-cells*)

    (sdl:with-events ()
      (:quit-event () t)
      (:key-down-event (:key k) (keyboard-handler k))
      (:idle ()
             ;; 画面を一度黒でクリアする
             (sdl:clear-display sdl:*black*)

             ;; サーフェスを表示する
             (sdl:draw-surface-at-* *r-surface* (sdl:mouse-x) (sdl:mouse-y) :cell 0)

             ;; 画面をアップデートする。標準でダブルバッファリング?
             (sdl:update-display)))))

キーボードで動かす

画面の広さをそのままステージの広さとし、スプライトの大きさ、プレイヤーの座標もシンプルにグローバル変数で管理する。座標はせっかくなのでCLOSを使う。

(defclass vec2d ()
  ((x :accessor vec2d-x :initform 0 :initarg :x)
   (y :accessor vec2d-y :initform 0 :initarg :y)))

(defparameter stage-width 200)
(defparameter stage-height 200)
(defparameter sprite-size 32)
(defparameter player-pos
  (make-instance 'vec2d :x 0 :y (- stage-height sprite-size)))

移動用の関数を作る。毎回make-instanceするとGCでの停止が凄そうなので、副作用無し版(実験用)と破壊的変更版の2種類を作る。

(defun check-x (x)
  (cond
    ((> 0 x) 0)
    ((>= x (- stage-width sprite-size))
     (- (1- stage-width) sprite-size))
    (t x)))

(defun check-y (y)
  (cond
    ((> 0 y) 0)
    ((>= y (- stage-height sprite-size))
     (- (1- stage-height) sprite-size))
    (t y)))

(defmethod add ((p1 vec2d) (p2 vec2d))
  (let* ((x1 (vec2d-x p1)) (y1 (vec2d-y p1))
         (x2 (vec2d-x p2)) (y2 (vec2d-y p2))
         (x (check-x (+ x1 x2)))
         (y (check-y (+ y1 y2))))
    (make-instance 'vec2d :x x :y y)))

(defmethod add! ((p1 vec2d) (p2 vec2d))
  (let* ((x1 (vec2d-x p1)) (y1 (vec2d-y p1))
         (x2 (vec2d-x p2)) (y2 (vec2d-y p2))
         (x (check-x (+ x1 x2)))
         (y (check-y (+ y1 y2))))
    (setf (vec2d-x p1) x)
    (setf (vec2d-y p1) y)))

(defparameter units
  (vector
   (make-instance 'vec2d :x  0 :y -1) ; up
   (make-instance 'vec2d :x  0 :y 1)  ; down
   (make-instance 'vec2d :x -1 :y 0)  ; left
   (make-instance 'vec2d :x  1 :y 0)  ; right
    ))

(defun dir-unit (dir)
  (case dir
    (:up    (aref units 0))
    (:down  (aref units 1))
    (:left  (aref units 2))
    (:right (aref units 3))))

(defun move (pos dir)
  (add pos (dir-unit dir)))

(defun move! (pos dir)
  (add! pos (dir-unit dir)))

keyboard-handlerの上下左右キーにmove!を割り当ててみる。

(defun keyboard-handler (key)
  (case key
    (:SDL-KEY-W (move! player-pos :up))
    (:SDL-KEY-A (move! player-pos :left))
    (:SDL-KEY-D (move! player-pos :right))
    (:SDL-KEY-S (move! player-pos :down))
    (:SDL-KEY-SPACE "飛")))

動いた!しかし、キーが押されたときのイベントに登録しているので、押された瞬間しか動かない。押しっぱなしだと移動し続けて欲しいので、sdl:key-down-p:idle内で判断する。

keyboard-handlerを書き換え、:idleから呼ぶ。

(defun keyboard-handler ()
  (when (sdl:key-down-p :SDL-KEY-W) (move! player-pos :up))
  (when (sdl:key-down-p :SDL-KEY-S) (move! player-pos :down))
  (when (sdl:key-down-p :SDL-KEY-D) (move! player-pos :right))
  (when (sdl:key-down-p :SDL-KEY-A) (move! player-pos :left)))

(defun main ()
  (sdl:with-init ()
    (sdl:window stage-width stage-height :title-caption *title*)
    (setf (sdl:frame-rate) 60)
    (setf *r-surface* (make-surface "rockmaso.png"))
    (setf (sdl:cells *r-surface*) *r-cells*)

    (sdl:with-events ()
      (:quit-event () t)
      (:idle ()
             ;; 画面を一度黒でクリアする
             (sdl:clear-display sdl:*black*)

             ;; プレイヤーの状態を更新
             (keyboard-handler)
  
             ;; サーフェスを表示する
             (sdl:draw-surface-at-* *r-surface*
                                    (vec2d-x player-pos)
                                    (vec2d-y player-pos)
                                    :cell 0)

             ;; 画面をアップデートする。標準でダブルバッファリング?
             (sdl:update-display)))))

f:id:phaendal:20150628102325g:plain

なめらかに動いた!

感想など

本当はスプライトをプレイヤーの状態によって動かして、左右で反転させるとこまで書こうと思ってたんだけど、画像の左右反転で詰まったのでここで一旦終了。おそらくsdl-gfx:rotate-surface-xyを使えばいいんだろうけど、エラーを解決できなかった。ドキュメントしっかりしてるしソースも見れるからがんばれば解決できるかな……

Lispが遅いんじゃなくて、Lispは遅い書き方を許容してしまうのだ、という言葉を思い出しながら書いてた。そういうの気にするのあんまり好きじゃないと自分では思ってたんだけど、ちょっと気にしてみると、意外と好きかもしれないと思った。食わず嫌いはダメだな〜

最終コード

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :lispbuilder-sdl)
  (ql:quickload :lispbuilder-sdl-image))

(defpackage rockmaso
  (:use :cl))

(in-package rockmaso)

(defparameter *title* "rockmaso")
(defparameter *r-surface* nil)
(defparameter *r-cells*
  '((0 0 32 32)))

(defparameter stage-width 200)
(defparameter stage-height 200)
(defparameter sprite-size 32)

(defclass vec2d ()
  ((x :accessor vec2d-x :initform 0 :initarg :x)
   (y :accessor vec2d-y :initform 0 :initarg :y)))

(defun check-x (x)
  (cond
    ((> 0 x) 0)
    ((>= x (- stage-width sprite-size))
     (- (1- stage-width) sprite-size))
    (t x)))

(defun check-y (y)
  (cond
    ((> 0 y) 0)
    ((>= y (- stage-height sprite-size))
     (- (1- stage-height) sprite-size))
    (t y)))

(defmethod add ((p1 vec2d) (p2 vec2d))
  (let* ((x1 (vec2d-x p1)) (y1 (vec2d-y p1))
         (x2 (vec2d-x p2)) (y2 (vec2d-y p2))
         (x (check-x (+ x1 x2)))
         (y (check-y (+ y1 y2))))
    (make-instance 'vec2d :x x :y y)))

(defmethod add! ((p1 vec2d) (p2 vec2d))
  (let* ((x1 (vec2d-x p1)) (y1 (vec2d-y p1))
         (x2 (vec2d-x p2)) (y2 (vec2d-y p2))
         (x (check-x (+ x1 x2)))
         (y (check-y (+ y1 y2))))
    (setf (vec2d-x p1) x)
    (setf (vec2d-y p1) y)))

(defparameter units
  (vector
   (make-instance 'vec2d :x  0 :y -1) ; up
   (make-instance 'vec2d :x  0 :y 1)  ; down
   (make-instance 'vec2d :x -1 :y 0)  ; left
   (make-instance 'vec2d :x  1 :y 0)  ; right
    ))

(defun dir-unit (dir)
  (case dir
    (:up    (aref units 0))
    (:down  (aref units 1))
    (:left  (aref units 2))
    (:right (aref units 3))))

(defun move (pos dir)
  (add pos (dir-unit dir)))

(defun move! (pos dir)
  (add! pos (dir-unit dir)))

(defparameter player-pos
  (make-instance 'vec2d :x 0 :y (- stage-height sprite-size)))

(defun make-surface (fname)
  (sdl:convert-to-display-format
   :surface (sdl-image:load-image fname :image-type :png)
   :enable-alpha t
   :pixel-alpha t))

(defun keyboard-handler ()
  (when (sdl:key-down-p :SDL-KEY-W) (move! player-pos :up))
  (when (sdl:key-down-p :SDL-KEY-S) (move! player-pos :down))
  (when (sdl:key-down-p :SDL-KEY-D) (move! player-pos :right))
  (when (sdl:key-down-p :SDL-KEY-A) (move! player-pos :left)))

(defun main ()
  (sdl:with-init ()
    (sdl:window stage-width stage-height :title-caption *title*)
    (setf (sdl:frame-rate) 60)
    (setf *r-surface* (make-surface "rockmaso.png"))
    (setf (sdl:cells *r-surface*) *r-cells*)

    (sdl:with-events ()
      (:quit-event () t)
      (:idle ()
             ;; 画面を一度黒でクリアする
             (sdl:clear-display sdl:*black*)

             ;; プレイヤーの状態を更新
             (keyboard-handler)
  
             ;; サーフェスを表示する
             (sdl:draw-surface-at-* *r-surface*
                                    (vec2d-x player-pos)
                                    (vec2d-y player-pos)
                                    :cell 0)

             ;; 画面をアップデートする。標準でダブルバッファリング?
             (sdl:update-display)))))
広告を非表示にする