lispbuilder-sdl on mac - Nosの日記

どうせなのでもっとアクションゲーム的なのを作ったりできないかなーと思ってlispbuilder-sdlを入れてみた。前何回か入れようとして挫折しているが、今回はとりあえず例を実行出来るところまでは行った。

環境:

処理系はsbcl 1.2.2
quicklispは入れてある
パッケージ管理にmacportsを使っている(homebrewでも大丈夫だと思う)
OS X 10.9.4

先に書いておくとclispではまだ成功していない。逆にclozure clでは2段下のトラップのマスクがなくても大丈夫だった。

libsdl

macportsで libsdl-framework を入れておく。

$ sudo port install libsdl-framework
$ sudo port install libsdl_{gfx,image,mixer,net,ttf}-framework
# libsdl_sound-frameworkが入らないが今回は追求していない
# -> これっぽい: https://trac.macports.org/ticket/39798

lispbuilderライブラリ本体

(ql:quickload :lispbuilder-sdl)

を実行すると途中でライブラリがないと言われるので。
~/quicklisp/dists/quicklisp/software/lispbuilder-なんとか/lispbuilder-sdl/cocoahelper
に行ってmakeしてリトライする。なんとかの部分は一番新しい日付のもの。*1

(ql:quickload :lispbuilder-sdl-examples)
(lispbuilder-sdl-examples:mandelbrot)

とするとマンデルブロ集合が出てくる…はずなのだが floating point inexact とか言って怒られる。これについてぐぐってもどうも情報を見つけられないのだが、どうもsbclがC言語で普通例外として扱わない*2 FE_INEXACT、common lispでは FLOATING-POINT-INEXACT をトラップするようにしているからのような気がする。

~~sb-int:with-float-traps-masked を使うとこのトラップを一時的に無効化出来るようなのだが、~~
~~(sb-int:with-float-traps-masked~~
~~(:inexact) (sdl-examples:mandelbrot))~~
~~としてもエラーが出る。~~

~~この辺の扱いはsbclだと~~
~~CL-USER> (sb-int:get-floating-point-modes)~~
~~(:TRAPS (:OVERFLOW :INVALID :DIVIDE-BY-ZERO) :ROUNDING-MODE :NEAREST~~
~~:CURRENT-EXCEPTIONS (:INEXACT) :ACCRUED-EXCEPTIONS (:INEXACT) :FAST-MODE NIL)~~
~~と取り出せるぽい?で~~

~~CL-USER> (sb-int:set-floating-point-modes~~
~~:traps '(:overflow :divide-by-zero))~~
~~; No value~~
~~CL-USER> (sb-int:get-floating-point-modes)~~
~~(:TRAPS (:OVERFLOW :DIVIDE-BY-ZERO) :ROUNDING-MODE :NEAREST :CURRENT-EXCEPTIONS~~
~~(:INEXACT) :ACCRUED-EXCEPTIONS (:INEXACT) :FAST-MODE NIL)~~

~~とすると設定出来て、この状態だと(lispbuilder-sdl-examples:mandelbrot)がちゃんと動いて見える。~~

common lispの規格ではFLOATING-POINT-INEXACTがトラップされるかどうかは処理系依存という事になっている。昔は起きなかったということは最近のsbclのどこかのバージョンでこのへんの初期値が変わったのかな?

(sb-int:with-float-traps-masked
     (:invalid) (sdl-examples:mandelbrot))

でいいようだ。

clozure cl 1.8.1 ではこういうことをしなくてもいけた。clispはちょっと色々やってみたがまだ成功していない。こういう目的だとどっちにしろclispだと荷が重いかもしれないが。

14/5/14追記: slimeとの相性について

この記事を見たような気もする質問をstackoverflowで見かけ、回答したのでこちらにも追記しておく。
sbcl+slimeでlispbuilderやopengl系のライブラリのデモを実行すると、表示されるwindowのタイトルバーが表示されて操作も効かない、のような症状が現れる。
slimeがemacsとlispの間の通信に用いている方式はいくつかあって swank:*communication-style* で設定でき、デフォルトでは :spawn となっているのだが、このデフォルトの方式が何らかの理由でうまくいっていないのだろう。
~/.swank.lisp に

(setf swank:*communication-style* :fd-handler)

と記述しておくと正常に動いてくれる。しかしこれはバグなのだろうか?*3

link

sb-int:set-floating-point-modes https://github.com/sbcl/sbcl/blob/sbcl-1.2.2/src/code/float-trap.lisp#L58
sb-int:get-floating-point-modes (上の125行目)

おまけ

とりあえず定番のライフゲームを作ってみた

(require :lispbuilder-sdl)

(defparameter *board-size* 100)
(defparameter *life-initial-ratio* 0.3)
(defparameter *board* nil)

(defun make-board ()
  (loop for x below *board-size*
     collect (loop for y below *board-size*
		collect
		  (< (random 1.0) *life-initial-ratio*))))

(defun init-board ()
  (setf *board* (make-board)))

(defun count-neighbors (board x y)
  (count-if #'identity
	 (mapcar (lambda (dx dy)
		   (elt (elt board
			     (mod (+ y dy) *board-size*))
			(mod (+ x dx) *board-size*)))
		 '(1  1  1  0  0 -1 -1 -1)
		 '(1  0 -1  1 -1  1  0 -1))))

(defun alivep (board x y)
  (elt (elt board y) x))

(defun step-generation (board)
  (loop for y below *board-size* collect
       (loop for x below *board-size* collect
	    (if (alivep board x y)
		(member (count-neighbors board x y) '(2 3))
		(eq (count-neighbors board x y) 3)))))

(defun life ()
  (setf *board* (make-board))
  (let ((scale 2))
    (sdl:with-init ()
      (sdl:window 200 200 :title-caption "life")
      (setf (sdl:frame-rate) 10)

      (sdl:with-events ()
	(:quit-event () t)
	(:key-down-event () (sdl:push-quit-event))
	(:idle ()
	       (sdl:clear-display sdl:*black*)
	       (loop for x below *board-size* do
		    (loop for y below *board-size*
		       when (alivep *board* x y) do
			 (sdl:draw-box (sdl:rectangle :x (* scale x)
						      :y (* scale y)
						      :w scale
						      :h scale)
				       :color sdl:*white*)))
	       (setf *board* (step-generation *board*))
	       (sdl:update-display))))))

#+sbcl (sb-int:with-float-traps-masked (:invalid) (life))
#-sbcl (life)