Last modified: 2010/05/14 01:58:48

Common LispでSDLを使おう計画

目的

lispbuilder-sdlを用いて、携帯アプリのプロトタイプをCommon Lispで作ってみようと思います。

追加設定

追加パッケージ

sudo aptitude install libsdl-ttf-2.0-dev

コンパイル

cd clbuild/source/lispbuilder-sdl-ttf
make
sudo cp build/liblispbuilder-sdl-ttf-glue.so /usr/local/lib/

SDLを包括するフレームワーク

(in-package :com.strnet.game-framework)

(defparameter *image-directory* "/home/kazamai/program/common-lisp/source/practice/")

(defparameter *font-path* "/usr/share/fonts/truetype/sazanami/sazanami-gothic.ttf")
(defparameter *screen-width* 240)
(defparameter *screen-height* 240)
(defparameter *frame-rate* 20)
(defparameter *font-size* 12)
(defparameter *title* "STR Mobile Game")
(defparameter *image-format* "png")
(defparameter *mouse-x* 0)
(defparameter *mouse-y* 0)
(defparameter *mouse-clicked* 0)


(defclass image-define ()
  ((id :initarg :id :initform nil :accessor id)
   (color-key-point :initarg :color-key-point :initform nil :accessor color-key-point)))


(defun get-font ()
  (make-instance 'ttf-font-definition
                 :size *font-size*
                 :filename (create-path *font-path*)))


(defparameter *key-state* nil)

(defun push-key-state (id)
  (pushnew id *key-state*))

(defun pop-key-state (id)
  (setf *key-state* (remove id *key-state*)))

(defun left? ()
  (member :STR_KEY_LEFT *key-state*))

(defun right? ()
  (member :STR_KEY_RIGHT *key-state*))

(defun up? ()
  (member :STR_KEY_UP *key-state*))

(defun down? ()
  (member :STR_KEY_DOWN *key-state*))


(defparameter *key-event* nil)

(defun match-key-event-p (id)
  (eql id *key-event*))

(defun set-key-event (id)
  (setf *key-event* id))

(defun reset-key-event ()
  (setf *key-event* nil))

(defun reset-mouse-event ()
  (setf *mouse-clicked* nil))


(defparameter *images* nil)

(defun load-image-data (img-define)
  (with-slots (id color-key-point) img-define
    (setf (aref *images* id)
          (sdl-image:load-image (create-path (format nil "~d.~(~a~)" id *image-format*) *image-directory*)
                                :color-key-at color-key-point))
    (or (aref *images* id) (error "image load failed. id: ~a" id))))
  
(defun init-images (image-defines)
  (setf *images* (make-array (length image-defines) :initial-element nil))
  (mapcar #'load-image-data image-defines))


(defun draw-image (id x y &key sx sy w h)
  (let ((img (aref *images* id)))
    (if (and sx sy w h)
        (set-cell-* sx sy w h :surface img))
    (draw-surface-at-* img x y)))

(defun draw-string (string x y &key (color *white*))
  (draw-string-solid-* string x y
                       :color color
                       :surface *default-display*))


(defmacro do-mainloop (image-defines &body body)
  `(with-init ()
     (window *screen-width* *screen-height* :title-caption *title*)
     (enable-unicode t)
     (unless (initialise-default-font (get-font))
       (error "Cannot initialize the font."))
    
     (init-images ,image-defines)

     (setf (sdl:frame-rate) *frame-rate*)

     (with-events ()
       (:quit-event () t)
       (:key-down-event (:key key)
                        (if (key= key :SDL-KEY-ESCAPE) (push-quit-event))
                        (if (key= key :SDL-KEY-LEFT) (push-key-state :STR_KEY_LEFT))
                        (if (key= key :SDL-KEY-RIGHT) (push-key-state :STR_KEY_RIGHT))
                        (if (key= key :SDL-KEY-UP) (push-key-state :STR_KEY_UP))
                        (if (key= key :SDL-KEY-DOWN) (push-key-state :STR_KEY_DOWN))
                        (if (key= key :SDL-KEY-Z) (set-key-event :STR_SOFTKEY_1))
                        (if (key= key :SDL-KEY-X) (set-key-event :STR_SOFTKEY_2))
                        (if (key= key :SDL-KEY-RETURN) (set-key-event :STR_FIRE)))
    
       (:key-up-event (:key key)
                      (if (key= key :SDL-KEY-LEFT) (pop-key-state :STR_KEY_LEFT))
                      (if (key= key :SDL-KEY-RIGHT) (pop-key-state :STR_KEY_RIGHT))
                      (if (key= key :SDL-KEY-UP) (pop-key-state :STR_KEY_UP))
                      (if (key= key :SDL-KEY-DOWN) (pop-key-state :STR_KEY_DOWN)))

       (:mouse-button-down-event (:button button :state state :x mouse-x :y mouse-y)
                                 (when (= 1 state)
                                   (setf *mouse-clicked* button)
                                   (setf *mouse-x* mouse-x)
                                   (setf *mouse-y* mouse-y)))
                                  
                   
       (:video-expose-event () (update-display))

       (:idle ()
              (fill-surface *black*)
              ,@body
              (update-display)))))

フレームワークサンプル

矢印キーを押すと画像が動くサンプル

(defpackage :com.strnet.mobile-game
  (:use :cl :com.strnet.game-framework)
  (:export :main))

(in-package :com.strnet.mobile-game)

(defparameter *image-defines* nil)
(push (make-instance 'image-define :id 0 :color-key-point #(0 0)) *image-defines*)

(defparameter *x* 0)
(defparameter *y* 0)

(defun main ()
  (do-mainloop *image-defines*

    (if (left?) (decf *x*))
    (if (right?) (incf *x*))
    (if (up?) (decf *y*))
    (if (down?) (incf *y*))

    (draw-image 0 *x* *y*)))