読者です 読者をやめる 読者になる 読者になる

`(kakko ,man)

Find a guide into tomorrow by taking lessons from the past

Lisp Game Programming 再履修 <その3>

再履修

師走に入って何かと慌ただしくなる前にドンドン行ってみよう。
前回の続きから。

Draw-game 関数の特徴は、player を画面の中心に表示し、player が移動するのと連動して、周りの表示を変化させていくというもの。

では、具体的に見てみよう。

まず、y には player の現在位置から上にイメージファイル 7 つ分引いた値をセットし、これが描画の「上端」になる。
同時に、「上端」のウィンドウ内の表示位置を screen-x = 0 つまり表示するウィンドウの上枠ギリギリにセットし、高さ分(15 回)繰り返す。

また、x には player の現在位置から左にイメージファイル 8 つ分引いた値をセットし、これが描画の「左端」になる。
同じように、「左端」のウィンドウ内の表示位置を screen-y = 0 つまり表示するウィンドウの左枠ギリギリにセットし、横幅分(16 回)繰り返す。

そして、level インスタンス内にセットした width と x 、height と y を比較してウィンドウ内の範囲に描画を限定し、data(配列:22 × 40)に格納した elementを取り出す。
element が 'empty 以外であれば、そのイメージに合ったイメージファイルを描画する。

同時に、x y が player-position と同じであれば、player の現在の status に応じたイメージデータを描画するというもの。

;; step1 <Draw Game>
;; -----------------------------------------------------------------------------------------------  
(defparameter +tile-size+ 32)
(defparameter +screen-tile-width+ 16)
(defparameter +screen-tile-height+ 15) 
(defparameter +screen-width+ (* +screen-tile-width+ +tile-size+))          ; screen size 512*480
(defparameter +screen-height+ (* +screen-tile-height+ +tile-size+))

(defun Draw-game (level player-position status)
  (sdl:clear-display sdl:*black*)
  (loop for y from (- (cdr player-position) (floor +screen-tile-height+ 2)); player-positon -7
        for screen-y from 0  
        repeat +screen-tile-height+
        do (loop for x from (- (car player-position) (floor +screen-tile-width+ 2)); player-position -8
                 for screen-x from 0
                 repeat +screen-tile-width+                                ; drawing range 16*15
                 when (and (< -1 x (width level))                          ; within map
                           (< -1 y (height level)))
                 do (let ((element (aref (data level) y x)))               ; set char to element
                      (unless (eql element 'empty)
                        (sdl:draw-surface-at-* (case element               ; draw element except for empty
                                               (wall *wall-image*)
				               (dirt *dirt-image*)
					       (rock *rock-image*)
					       (diamond *diamond-image*)
					       (exit *door-image*))
					         (* screen-x +tile-size+)    ; position x
                                                 (* screen-y +tile-size+)))) ; position y
                 do (when (and (= x (car player-position))
                               (= y (cdr player-position)))                  ; according to player status
                      (sdl:draw-surface-at-* (ecase status                   ; draw char image 
                                             (:playing *player-image*)
                                             (:victory *victory-image*)
                                             (:dead *death-image*))
                                               (* screen-x +tile-size+)      ; position x
                                               (* screen-y +tile-size+)))))) ; position y

ここで注意が 1 つ。
case(ecase)で判断する際、'wall や 'dirt ではなく、単に wall や dirt として '(クオート)をつけない。この部分はノーマークだった。へへへ!

注)詳しくは、「実践 Common Lisp」 の 286 ページを参照してくださいね!本屋さんの立ち読みで調べました。
  あっ、店員さんの目があるのでちゃんと買いましたよ、もちろん。
  居酒屋での飲み会1回分くらいかな?薄い財布から「野口くん」が去っていきました。


さてと、player を移動させるためのキー入力に必要な関数を確認しておく。
今回、この関数は、(:idle () のループの中に書き込む。
Common-shooter や Common-abodagro では (:key-down-event (:key key) や (:key-up-event (:key key) の場所に配置したが、シューティングと違ってリアルタイムなキー割り込みは必要ないし、もしリアルタイムな処理が必要であれば、根本から設計の変更が必要になる。(と思うけど、自信なし。)

こんな感じ。

	(:key-down-event (:key key)  ; do nothing
	  (case key))
 
	(:key-up-event (:key key)    ; do nothing
	  (case key)) 

        (:idle ()
         ; Game body
	  (when (= (mod frame 5) 0) 
	    (let((next-position (copy-tree player-position)))                        ; update next-position(x,y)
              (cond ((sdl:get-key-state :SDL-KEY-UP)    (decf (cdr next-position)))  ; up   -> y -1
                    ((sdl:get-key-state :SDL-KEY-DOWN)  (incf (cdr next-position)))  ; down -> y +1
	            ((sdl:get-key-state :SDL-KEY-LEFT)  (decf (car next-position)))  ; left -> x -1
	            ((sdl:get-key-state :SDL-KEY-RIGHT) (incf (car next-position)))  ; right-> x +1
	   	    ((sdl:get-key-state :SDL-KEY-Q)     (return-from Common-boulderdash))) ; game window close
	      (let ((element (aref (data level) (cdr next-position) (car next-position))))
                (when (eql status :playing)
                  (when (member element '(empty dirt diamond exit))
                    (setf player-position next-position)                  ; set the player to next-position
                    (when (eql element 'diamond)                          ; if there is a diamond in that position 
                      (incf diamond-count))                               ; diamond +1 
                    (unless (eql element 'exit)                           ; if not exit position ,  empty that position
                      (setf (aref (data level) (cdr next-position) (car next-position)) 'empty)))))))

	  (when (and (equal player-position (exit-position level)) ; eql <--- compare atom  'rock etc  
                     (>= diamond-count (diamond-count level)))     ; equal <--- compare list (x y) etc
            (setf status :victory))

frame はループカウンターとして設定し、5 回毎ループしたときにキー入力の判定を行う。
playerの現在位置( x, y ) を next-position に player-positon のリストの木構造をまるっとコピーする。
それぞれのキーに応じて、next-position の ( x, y ) を増減する。q キーの場合はゲームウインドウをクローズする。
element に next-position の( x, y ) の内容('rock etc ) をセットし、player の status が :playing の時に element が 'empty 'dirt 'diamond 'exit の場合、next-positon を player-position にセットする。
その時、player の現在位置が 'diamond がある時は diamond-counter +1 とし、'exit でない場合は、next-position の場所を 'empty とする。

また、player-position と exit-posion が equal でかつ diamond-count が level インスタンスに格納された diamond-count (Parse-map で diamond-count にマップ内の 'diamond の総数をセット済)より >= の時(つまり全部取った場合)は status を :victory にセットする。

コメントアウトしていた、diamond-count の部分を復活させ、キー入力可能としたプログラムコードは以下。

stap2.lisp

;;; The Common-Boulderdash
;;; Step1 <Define Packages> <Load Images>  <Game Level Class> <Exchange Char For Element>
;;;        <Map Parse> <Map Load> <Draw Game> <Initialize> <Game Frame>
;;; Step2 <Game Frame> <--- idle() + get-key-state 
;; -----------------------------------------------------------------------------------------------  

;; step1 <Define Package>
;; -----------------------------------------------------------------------------------------------
(defpackage :game
  (:use :common-lisp :lispbuilder-sdl)
  (:nicknames :boulderdash)
  (:export #:Common-boulderdash))
(in-package :game)

;; step1 <Load Images>
;; -----------------------------------------------------------------------------------------------  
(defvar *dirt-image* nil)
(defvar *wall-image* nil)
(defvar *rock-image* nil)
(defvar *diamond-image* nil)
(defvar *door-image* nil)
(defvar *player-image* nil)
(defvar *victory-image* nil)
(defvar *death-image* nil)

(defun Load-images ()
  (setf *dirt-image* (sdl:load-image "C:\\work\\Images\\dirt.png" :color-key(sdl:color :r 0 :g 0 :b 0))
        *wall-image* (sdl:load-image "C:\\work\\Images\\wall.png":color-key(sdl:color :r 0 :g 0 :b 0))
        *rock-image* (sdl:load-image "C:\\work\\Images\\rock.png":color-key(sdl:color :r 0 :g 0 :b 0))
        *diamond-image* (sdl:load-image "C:\\work\\Images\\diamond.png":color-key(sdl:color :r 0 :g 0 :b 0))
        *door-image* (sdl:load-image "C:\\work\\Images\\door.png":color-key(sdl:color :r 0 :g 0 :b 0))
        *player-image* (sdl:load-image "C:\\work\\Images\\player.png":color-key(sdl:color :r 0 :g 0 :b 0))
        *victory-image* (sdl:load-image "C:\\work\\Images\\victory.png":color-key(sdl:color :r 0 :g 0 :b 0))
        *death-image* (sdl:load-image "C:\\work\\Images\\death.png" :color-key(sdl:color :r 0 :g 0 :b 0))))

;; step1 <Game Level Class>
;; -----------------------------------------------------------------------------------------------  
(defclass level ()
  ((width :initarg :width :accessor width)
   (height :initarg :height :accessor height)
   (data :initarg :data :accessor data)
   (entry-position :initarg :entry-position :accessor entry-position)
   (exit-position :initarg :exit-position :accessor exit-position)
   (diamond-count :initarg :diamond-count :accessor diamond-count)))

;; step1 <Exchange Char For Element>
;; -----------------------------------------------------------------------------------------------  
(defun Char->element (char)
  (ecase char
    (#\space 'empty)
    (#\# 'wall)
    (#\- 'dirt)
    (#\o 'rock)
    (#\* 'diamond)
    (#\@ 'entry)
    (#\& 'exit)))

;; step1 <Map Parse>
;; -----------------------------------------------------------------------------------------------  
(defun Parse-map (lines)
  (let* ((width (length (first lines)))                                     ;  width <- length of 1 line
         (height (length lines))                                            ;  height <- number of lines 
         (data (make-array (list height width)))                            ;  data <- (height width)
         (entry nil)
         (exit nil)
         (diamond-count 0))

    (loop for y below height                                                ; decf height
          for line in lines                                                 ; line <- lines
          do (loop for x below width                                        ; decf width
                   for element = (Char->element (aref line x)) ; as -> for  ; exchange char for element
                   do (setf (aref data y x) element)                        ; data <- element
                   when (eql element 'entry)
                     do (setf entry (cons x y))                             ; set entry position (x,y)
                        (setf (aref data y x) 'empty)                       ; data <- empty
                   when (eql element 'exit)
                     do (setf exit (cons x y))                              ; set exit position (x,y) 
                   when (eql element 'diamond)
                     do (incf diamond-count)))                              ; diamond +1

    (make-instance 'level                                                   ; level instance
                   :width width
                   :height height
                   :data data
                   :entry-position entry
                   :exit-position exit
                   :diamond-count diamond-count)))                          ; all of the diamond

;; step1 <Map Load>
;; -----------------------------------------------------------------------------------------------  
(defun Load-map (level)
  (let ((filename (format nil "C:\\work\\Levels\\level~2,'0d.txt" level))) ; filename <- level01~03.txt
    (with-open-file (stream filename)                                      ; fileopen level01~03.txt  
      (loop for line = (read-line stream nil nil)   ; as -> for            ; read 1 line
            until (null line)                                              ; if true loop stop
            collect line into lines                                        ; lines <- line
            finally (return (Parse-map lines))))))                         ; goto Parse-map()

;; step1 <Draw Game>
;; -----------------------------------------------------------------------------------------------  
(defparameter +tile-size+ 32)
(defparameter +screen-tile-width+ 16)
(defparameter +screen-tile-height+ 15) 
(defparameter +screen-width+ (* +screen-tile-width+ +tile-size+))          ; screen size 512*480
(defparameter +screen-height+ (* +screen-tile-height+ +tile-size+))

(defun Draw-game (level player-position status)
  (sdl:clear-display sdl:*black*)
  (loop for y from (- (cdr player-position) (floor +screen-tile-height+ 2)); player-positon -7
        for screen-y from 0  
        repeat +screen-tile-height+
        do (loop for x from (- (car player-position) (floor +screen-tile-width+ 2)); player-position -8
                 for screen-x from 0
                 repeat +screen-tile-width+                                ; drawing range 16*15
                 when (and (< -1 x (width level))                          ; within map
                           (< -1 y (height level)))                                   
                 do (let ((element (aref (data level) y x)))               ; set char to element
                      (unless (eql element 'empty)
                        (sdl:draw-surface-at-* (case element               ; draw element except for empty
                                               (wall *wall-image*)
				               (dirt *dirt-image*)
					       (rock *rock-image*)
					       (diamond *diamond-image*)
					       (exit *door-image*))
					         (* screen-x +tile-size+)    ; position x
                                                 (* screen-y +tile-size+)))) ; position y
                 do (when (and (= x (car player-position))
                               (= y (cdr player-position)))                  ; according to player status
                      (sdl:draw-surface-at-* (ecase status                   ; draw char image 
                                             (:playing *player-image*)
                                             (:victory *victory-image*)
                                             (:dead *death-image*))
                                               (* screen-x +tile-size+)      ; position x
                                               (* screen-y +tile-size+)))))) ; position y

;; step1 <Initialize>
;; -----------------------------------------------------------------------------------------------  
(defun Initialize ()
  "graphics initialize"
  (setf (sdl:frame-rate) 60)                      ; frame rate set
  (setf *random-state* (make-random-state t))     ; random set
  (sdl:show-cursor nil))                          ; cursor not show

;; step1 <Game Frame>
;; -----------------------------------------------------------------------------------------------
(defun Common-boulderdash ()
  "main routine"
  (sdl:with-init (sdl:sdl-init-video sdl:sdl-init-audio) ; use video and audio
    (sdl:window 512 480 :position 'center                ; size 512*480, position center
                      ; :position #(192 50)              ;               position x(192) y(50)
                        :title-caption "BOULDERDASH"
                        :icon-caption  "BOULDERDASH"  
                        :flags '(sdl:sdl-doublebuf sdl:sdl-sw-surface))

    ; <Initialize>
      (Initialize)                                       ; graphics initialize

    ; <Load Images>
      (Load-images)                                      ; load images

    ;(Load-map 01)
      (let* ((level (load-map 1))
             (player-position (copy-tree (entry-position level)))
             (diamond-count 0)
             (status :playing)
             (frame 0))

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

	(:key-down-event (:key key)  ; do nothing
	  (case key))
 
	(:key-up-event (:key key)    ; do nothing
	  (case key)) 

        (:idle ()
         ; Game body
	  (when (= (mod frame 5) 0) 
	    (let((next-position (copy-tree player-position)))                        ; update next-position(x,y)
              (cond ((sdl:get-key-state :SDL-KEY-UP)    (decf (cdr next-position)))  ; up   -> y -1
                    ((sdl:get-key-state :SDL-KEY-DOWN)  (incf (cdr next-position)))  ; down -> y +1
	            ((sdl:get-key-state :SDL-KEY-LEFT)  (decf (car next-position)))  ; left -> x -1
	            ((sdl:get-key-state :SDL-KEY-RIGHT) (incf (car next-position)))  ; right-> y +1
	   	    ((sdl:get-key-state :SDL-KEY-Q)     (return-from Common-boulderdash))) ; game window close
	      (let ((element (aref (data level) (cdr next-position) (car next-position))))
                (when (eql status :playing)
                  (when (member element '(empty dirt diamond exit))
                    (setf player-position next-position)                  ; set the player to next-position
                    (when (eql element 'diamond)                          ; if there is a diamond in that position 
                      (incf diamond-count))                               ; diamond +1 
                    (unless (eql element 'exit)                           ; if not exit position ,  empty that position
                      (setf (aref (data level) (cdr next-position) (car next-position)) 'empty)))))))

	  (when (and (equal player-position (exit-position level)) ; eql <--- compare atom  'rock etc  
                     (>= diamond-count (diamond-count level)))     ; equal <--- compare list (x y) etc
            (setf status :victory))

	   ;<Draw Game>
            (Draw-game level player-position status)
            (incf frame)   ; frame +1

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

(Common-boulderdash)

OK! 動いた!
f:id:tomekame0126:20161127214539p:plain

こんだけ書いておけば、後でプログラムコードを見たときに思い出すのも早いだろうな。

Common-shooter や Common-abogadro でも詳細に書いておけばよかった!
https://github.com/tomekame0126


教訓:過去の自分は今の自分にあらず!