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))