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