SDLを利用するECLのプログラムから実行バイナリを作成
compile-file/build-programによるビルド
compile-file、build-programを使って以下のようにプログラムをビルドすると、実行バイナリは作成されるものの、依存するパッケージなどがある場合に実行時にエラーが発生する。
CL-USER> (compile-file "src/lisp/lost-legacy.lisp" :system-p t)
CL-USER> (c:build-program "program-name"
:lisp-files '("src/lisp/lost-legacy.o"))
#P"program-name"
$ ./program-name
Condition of type: SIMPLE-PACKAGE-ERROR
There exists no package with name "LOST-LEGACY"
No restarts available.
Top level in: #<process TOP-LEVEL>
asdf:make-buildを使う
asdf:make-buildによってプログラムをビルドすると、問題なく実行可能なバイナリが作成される。まず、以下のようなシンプルな構成のプロジェクトを作る。
├── lost-legacy.asd
└── src
└── lisp
├── lost-legacy.lisp
└── package.lisp
lost-legacy.asd
(asdf:defsystem :lost-legacy
:serial t
:pathname "src/lisp"
:components ((:file "package")
(:file "lost-legacy"))
:depends-on (:asdf :sdl2 :sdl2-image))
depends-onの項目に:asdfを指定し、その後に必要なパッケージを列挙する。
次に、REPL上でプログラムをビルドする。最初にasdf:load-systemでビルドするパッケージをロードしておく。
REPL
CL-USER> (asdf:load-system :lost-legacy)
次に、asdf:make-buildでビルドする。:epilogue-codeは、実行バイナリの最後に実行する処理を追加する。ここでは、lost-legacyパッケージ内のmain関数を呼び出し、その処理が完了した後(si:exit)を実行して終了させるようにしている。
REPL
CL-USER> (asdf:make-build :lost-legacy
:type :program
:move-here #P"./"
:monolithic t
:epilogue-code '(progn
(lost-legacy:main)
(si:exit)))
作成されたバイナリは、./lost-legacyで問題なく実行できるようになる。ECLはlibecl.soをはじめいくつかの共有ライブラリに依存するので配布には問題が出そう。
$ ldd lost-legacy
linux-vdso.so.1 (0x00007ffd893cd000)
libecl.so.16.1 => /lib/x86_64-linux-gnu/libecl.so.16.1 (0x00007f4203052000)
libgmp.so.10 => /lib/x86_64-linux-gnu/libgmp.so.10 (0x00007f4202fca000)
libgc.so.1 => /lib/x86_64-linux-gnu/libgc.so.1 (0x00007f4202f52000)
libffi.so.6 => /lib/x86_64-linux-gnu/libffi.so.6 (0x00007f4202f42000)
libpthread.so.0 => /lib/x86_64-linux-gnu/libpthread.so.0 (0x00007f4202f1a000)
libdl.so.2 => /lib/x86_64-linux-gnu/libdl.so.2 (0x00007f4202f12000)
libm.so.6 => /lib/x86_64-linux-gnu/libm.so.6 (0x00007f4202d8a000)
libc.so.6 => /lib/x86_64-linux-gnu/libc.so.6 (0x00007f4202bc2000)
/lib64/ld-linux-x86-64.so.2 (0x00007f42038fa000)
ビルド用のインターフェースを作る
https://gitlab.com/hu.moonstone/deepspace で、ビルドのためのフロントインターフェースを作った。
$ deepspace -t project -o execute -n lost-legacy
で実行。
$ deepspace -t project -o build -n lost-legacy
で実行バイナリのビルドを行うようにした。
おまけ
package.lispとlost-legacy.lispのコードを以下に記述しておく。プログラム自体はSDLとSDL-imageを使ったもので、resources/images/ball.pngというファイルを用意し、それを表示させWASDで移動させるものになる。
package.lisp
(in-package :cl-user)
(defpackage :lost-legacy
(:use :cl)
(:export :main))
lost-legacy.lisp
(in-package :lost-legacy)
(defparameter *screen-width* 960)
(defparameter *screen-height* 540)
(defparameter *window* nil)
(defparameter *screen* nil)
(defparameter *renderer* nil)
(defparameter *image* nil)
(defparameter *image-tex* nil)
(defparameter *input-state* (make-hash-table))
(defparameter *pos-x* 120)
(defparameter *pos-y* 0)
(defun update-input-state (key value)
(setf (gethash key *input-state*) value))
(defun input-state (key)
(gethash key *input-state*))
(defun init-input-state-table ()
(update-input-state 'UP nil)
(update-input-state 'RIHGT nil)
(update-input-state 'DOWN nil)
(update-input-state 'LEFT nil)
(update-input-state 'TRIGGER-R1 nil)
(update-input-state 'TRIGGER-R2 nil)
(update-input-state 'TRIGGER-L1 nil)
(update-input-state 'TRIGGER-L2 nil)
(update-input-state 'START nil)
(update-input-state 'SELECT nil)
(update-input-state 'A nil)
(update-input-state 'B nil)
(update-input-state 'X nil)
(update-input-state 'Y nil))
(defun output-input-state ()
(if (input-state 'UP)
(print "UP"))
(if (input-state 'RIGHT)
(print "RIHGT"))
(if (input-state 'DOWN)
(print "DOWN"))
(if (input-state 'LEFT)
(print "LEFT")))
(defun make-window ()
(sdl2:create-window :title "SDL2 Window"
:x 0
:y 0
:w *screen-width*
:h *screen-height*
:flags '(:shown)))
(defun get-keysym (event)
(plus-c:c-ref event sdl2-ffi:sdl-event :key :keysym))
(defun key-state (keysym key)
(sdl2:scancode= (sdl2:scancode-value keysym) key))
(defun input-process (event event-type)
(output-input-state)
(case event-type
(:WINDOWEVENT
)
(:IDLE
)
(:MOUSEMOTION
)
(:MOUSEBUTTONUP
)
(:MOUSEBUTTONDOWN
)
(:KEYUP
(let ((keysym (get-keysym event)))
(when (key-state keysym :scancode-escape)
(sdl2:push-event :quit))
(when (key-state keysym :scancode-w)
(update-input-state 'UP nil))
(when (key-state keysym :scancode-d)
(update-input-state 'RIGHT nil))
(when (key-state keysym :scancode-s)
(update-input-state 'DOWN nil))
(when (key-state keysym :scancode-a)
(update-input-state 'LEFT nil))
))
(:KEYDOWN
(let ((keysym (get-keysym event)))
(when (key-state keysym :scancode-w)
(update-input-state 'UP t))
(when (key-state keysym :scancode-d)
(update-input-state 'RIGHT t))
(when (key-state keysym :scancode-s)
(update-input-state 'DOWN t))
(when (key-state keysym :scancode-a)
(update-input-state 'LEFT t))
))))
(defun update-process ()
(if (input-state 'UP)
(setf *pos-y* (- *pos-y* 1)))
(if (input-state 'RIGHT)
(setf *pos-x* (+ *pos-x* 1)))
(if (input-state 'DOWN)
(setf *pos-y* (+ *pos-y* 1)))
(if (input-state 'LEFT)
(setf *pos-x* (- *pos-x* 1))))
(defun draw ()
(sdl2:set-render-draw-color *renderer* 0 0 255 255)
(sdl2:render-clear *renderer*)
(sdl2:set-render-draw-color *renderer* 255 0 255 255)
(sdl2:query-texture *image-tex*)
(sdl2:render-draw-rect *renderer* (sdl2:make-rect 300 300 100 100))
(sdl2:render-fill-rect *renderer* (sdl2:make-rect 445 400 35 35))
(sdl2:render-copy *renderer* *image-tex*
:source-rect (sdl2:make-rect 0 0 32 32)
:dest-rect (sdl2:make-rect *pos-x* *pos-y* 32 32))
(sdl2:render-present *renderer*))
(defun main-loop (event)
(let ((event-quit))
(loop
:until event-quit
:do
(sdl2:next-event event :poll nil)
(let* ((event-type (sdl2:get-event-type event))
(event-id
(and (sdl2::user-event-type-p event-type)
(event :user :code))))
;; ウインドウクローズイベント処理
(if (eq :QUIT event-type)
(setf event-quit t))
(unless event-quit
;; 入力受付
(input-process event event-type)
;; パラメータ更新
(update-process)
;; 描画処理
(draw)
;; ウェイト
(sdl2:delay 10))))))
(defparameter *renderer* nil)
(defun game-main ()
(init-input-state-table)
(if (not (= (sdl2:init :video)))
(print "Error")
(print "success"))
(print (sdl2:was-init :video))
(setf *window* (make-window))
(setf *screen* (sdl2:get-window-surface *window*))
(setf *renderer* (sdl2:create-renderer *window* nil '(:software)))
(setf *image* (sdl2-image:load-image "resources/images/ball.png"))
(sdl2:set-color-key *image* :true (sdl2:map-rgb (sdl2:surface-format *image*) 0 #xFF 0))
(setf *image-tex* (sdl2:create-texture-from-surface *renderer* *image*))
(sdl2:query-texture *image-tex*)
(let ((event nil))
(unwind-protect (setf sdl2::*event-loop* t)
(sdl2:in-main-thread
(:background nil)
(sdl2:with-sdl-event (event)
(main-loop event)))
(setf sdl2::*event-loop* nil)))
(sdl2:free-surface *image*)
(sdl2:destroy-texture *image-tex*)
(sdl2:destroy-renderer *renderer*)
(sdl2:destroy-window *window*)
(sdl2:quit))
(defun main ()
(game-main))