`(kakko ,man)

Find a guide into tomorrow by taking lessons from the past

Lisp Game Programming 再履修 <その12> animation test

前回 multithreading③ のプログラムコードの動きもメモっておこう。

f:id:tomekame0126:20161226215321j:plain
f:id:tomekame0126:20161226215329j:plain

次は、何にも表示していないウィンドウ内にマップを表示すること。
そして、マップ上で player を動かしてみることが次のテーマとなる。

ちょっと味付けを変えて、player を動かすアニメーションのテストをやっておこう。

まずは、このファイルを利用して、キー操作で動かす復習。
f:id:tomekame0126:20161230094730p:plain

では行ってみよう。
キー操作に関する2種類のプログラムコードを用意した。
注)common-shooter ではシューティング用として keystate クラスを作成してキースキャンを行っている。
http://tomekame0126.hatenablog.com/entry/2014/07/06/074832

注)dx と dy は今後のために付け加えてある。テストなので、グローバル変数イヤーマフ( *変数* )はとっている。

player-animation-test.lisp

(defpackage :animation
  (:use :common-lisp)
  (:export #:animation-test))
(in-package :animation)

(defmacro define-class (name superclasses slots)
  `(defclass ,name ,superclasses
    ,(mapcar (lambda (slot)
               (let ((keyword (intern (symbol-name slot) :keyword)))
               `(,slot :initarg ,keyword :accessor ,slot)))
             slots)))

(define-class player ()
  (id          ; image-id number
   direction   ; up down left right
   x y         ; position x y
   dx dy))     ; speed

(defparameter +player-step+ 4)
(defvar current 0)     ; current image-id number

(defun Move-player (player)
    (case (direction player)
      (:north 		                     ;  UP
       (setf (id player) 5)       
         (decf (y player) +player-step+))
      (:south                                ; DOWN
       (setf (id player) 0)      
        (incf (y player) +player-step+)) 
      (:west                                 ; LEFT
       (setf (id player) 10)     
        (decf (x player) +player-step+))
      (:east                                 ; RIGHT
       (setf (id player) 15)   
         (incf (x player) +player-step+)))
    (setf (direction player) nil))           ; dirention reset

(defvar playerimage)
(defvar imagecells)

(defun Load-images ()
  (setf playerimage (sdl:load-image "C:\\work\\Images\\player.png"))           
  (setf imagecells (loop for y from 0 to 300 by 100
		     append (loop for x from 0 to 200 by 50
                       collect (list x y 50 100)))) 				      
  (setf (sdl:cells playerimage) imagecells))

(defun Play-game ()
  (sdl:with-init ()
    (sdl:window 800 600 :title-caption "player-animation-test")

    (setf (sdl:frame-rate) 25)    

    (Load-images)

    (let ((player (make-instance 'player
			       :id 0
			       :direction :SOUTH
                               :x 350
                               :y 150
                               :dx  0
			       :dy  0)))

      (sdl:with-events ()
        (:quit-event () 
	 t)

        (:idle ()
        (cond ((sdl:get-key-state :SDL-KEY-UP)    (setf (direction player) :NORTH))	                                        
              ((sdl:get-key-state :SDL-KEY-DOWN)  (setf (direction player) :SOUTH))	                                        
              ((sdl:get-key-state :SDL-KEY-LEFT)  (setf (direction player) :WEST))                                               
              ((sdl:get-key-state :SDL-KEY-RIGHT) (setf (direction player) :EAST))                                                 
              ((sdl:get-key-state :SDL-KEY-Q)     (return-from Play-game)))

         (sdl:clear-display sdl:*black*)
          
         (Move-player player)
                     	 	 
         (sdl:draw-surface-at-* playerimage (x player) (y player) :cell (+ (id player) current))
         (when (>= (incf current) (floor (length imagecells) 4))
	   (setf current 0))

         (sdl:update-display))))))

(Play-game)

player-animation-test2.lisp

(defpackage :animation
  (:use :common-lisp)
  (:export #:animation-test))
(in-package :animation)

(defmacro define-class (name superclasses slots)
  `(defclass ,name ,superclasses
    ,(mapcar (lambda (slot)
               (let ((keyword (intern (symbol-name slot) :keyword)))
               `(,slot :initarg ,keyword :accessor ,slot)))
             slots)))

(define-class player ()
  (id
   direction
   x y
   dx dy))

(defparameter +player-step+ 4)
(defvar current 0)

(defun Move-player (player)
    (case (direction player)
      (:north                               ; UP
       (setf (id player) 5)       
         (decf (y player) +player-step+))
      (:south                               ; DOWN
       (setf (id player) 0)      
        (incf (y player) +player-step+)) 
      (:west                                ; LEFT
       (setf (id player) 10)     
        (decf (x player) +player-step+))
      (:east                                ; RIGHT
       (setf (id player) 15)   
         (incf (x player) +player-step+)))
    (setf (direction player) nil))         ; dirention reset

(defvar playerimage)
(defvar imagecells)

(defun Load-images ()
  (setf playerimage (sdl:load-image "C:\\work\\Images\\player.png"))           
  (setf imagecells (loop for y from 0 to 300 by 100
		     append (loop for x from 0 to 200 by 50
                       collect (list x y 50 100)))) 				      
  (setf (sdl:cells playerimage) imagecells))

(defun Play-game ()
  (sdl:with-init ()
    (sdl:window 800 600 :title-caption "player-animation-test")

    (setf (sdl:frame-rate) 25)    
    (sdl:enable-key-repeat 1 1)
    (Load-images)

    (let ((player (make-instance 'player
			       :id 0
			       :direction :SOUTH
                               :x 350
                               :y 150
                               :dx  0
			       :dy  0)))

      (sdl:with-events ()
        (:quit-event () 
	 t)
	
        (:key-down-event ()
          (cond ((sdl:key-down-p :SDL-KEY-UP)    (setf (direction player) :NORTH)) 
                ((sdl:key-down-p :SDL-KEY-DOWN)  (setf (direction player) :SOUTH))     
                ((sdl:key-down-p :SDL-KEY-LEFT)  (setf (direction player) :WEST))
                ((sdl:key-down-p :SDL-KEY-RIGHT) (setf (direction player) :EAST))
                ((sdl:key-down-p :SDL-KEY-Q)     (return-from Play-game))))
         
        (:idle ()
         (sdl:clear-display sdl:*black*)
          
         (Move-player player)
                     	 	 
         (sdl:draw-surface-at-* playerimage (x player) (y player) :cell (+ (id player) current))
         (when (>= (incf current) (floor (length imagecells) 4))
	   (setf current 0))

         (sdl:update-display))))))

(Play-game)

違いは、(:idle () 内でキー入力を拾うか、(:key-down-event () 内でキーの割り込みを拾うかの差。
うーん。違いのわかる男の○○○○ンド! 
注)○○○○はキーバイね。キーバインド。ゴールドブレではありません。念のため。
両方ともこんな感じに表示されて動く。
f:id:tomekame0126:20161230103002p:plain
f:id:tomekame0126:20161230103006p:plain

また、このファイルでは、爆発のアニメーションとサウンド関係の復習をする。
f:id:tomekame0126:20161230094736p:plain

player-explosion-test.lisp

(defpackage :animation
  (:use :common-lisp)
  (:export #:explosion-test))
(in-package :animation)

(defvar player)
(defvar player-cells)
(defvar current)

(defun Load-images ()        
  (setf player (sdl:load-image "C:\\work\\Images\\explosion.png"))           
  (setf player-cells (loop for y from 0 to 48 by 48
                       append (loop for x from 0 to 260 by 65
                         collect (list x y 65 48))))
  (setf (sdl:cells player) player-cells))

(defvar explosion-sound)

(defun Open-sounds ()
  (sdl-mixer:open-audio :chunksize 1024 :channels 2)
  (sdl-mixer:allocate-channels 16))

(defun Stop-sound ()
  (when (sdl-mixer:sample-playing-p nil)
    (sdl-mixer:halt-sample)))

(defun Close-sound ()
   (sdl-mixer:free explosion-sound)
   (sdl-mixer:close-audio))

(defun Load-sounds ()  
  (handler-case     
      (setf explosion-sound (sdl-mixer:load-sample "C:\\work\\SoundS\\explosion.wav")) 
    (error ()
      (format t "Cannot open sound device. disabling sounds ~%")))) 	   

(defun Play-sample (sample)
  (sdl-mixer:play-sample sample)) 

(defun Animation-test ()
  (sdl:with-init ()
    (sdl:window 800 600 :title-caption "explosion-test")

    (setf (sdl:frame-rate) 50)  
    (setf current 0)
    
    (Load-images)

    (Open-sounds)
    (Load-sounds)

      (sdl:with-events ()
        (:quit-event () 
	  (Stop-sound)
          (Close-sound)
	 t)

        (:key-down-event ()
         (when (sdl:key-down-p :SDL-KEY-Q)
           (sdl:push-quit-event)))

        (:idle ()
         (sdl:clear-display sdl:*black*) 
         (sdl:draw-surface-at-* player (- 400 25) 250 :cell current)  
	 (Play-sample explosion-sound)
         
         (when (>= (incf current) (length player-cells))
           (setf current 0))
         (sdl:update-display)))))

(Animation-test)

こんな感じに表示される。
f:id:tomekame0126:20161230104006p:plain

では、また。

注)画像等は以下のサイトの Blaster のデータを参考にしている。
  http://matthieu.villeneuve.free.fr/dev/games/