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

`(kakko ,man)

Find a guide into tomorrow by taking lessons from the past

Lisp Game Programming 再履修 <その4>

再履修

player が動きまわったときに、rock や diamond が落ちてくるロジックは以下

;; step3 <Handle-falling-objects>
;; -----------------------------------------------------------------------------------------------
(defun handle-falling-objects (level falling-objects player-position)
  (loop for y from (- (height level) 2) downto 0                       ; y : loop height-2 -> 0
     do (loop for x below (width level)                                ; x : loop width -> 0
       when (member (aref (data level) y x) '(rock diamond))           ; object(x,y) is 'rock or 'diamond
         do (cond ((and (eql (aref (data level) (1+ y) x) 'empty)      ; and under 'empty                         ①
                        (or (/= x (car player-position))               ;   or player(x) is not object(x)
                            (/= (1+ y) (cdr player-position))          ;      player(y) is not object((y+1)
                            (aref falling-objects y x)))               ;      object(x,y) = t
                    (rotatef (aref (data level) y x) (aref (data level) (1+ y) x)) ; object(x,y)<-->object(x,y+1)
                       (setf (aref falling-objects y x) nil            ; object(x,y) = nil 
                             (aref falling-objects (1+ y) x) t))       ; object(x,y+1) = t

                  ((and (eql (aref (data level) y (1- x)) 'empty)             ; left and under left 'empty    ②
                        (eql (aref (data level) (1+ y) (1- x)) 'empty)
                        (member (aref (data level) (1+ y) x) '(rock diamond)) ; under 'rock or 'diamond
                        (or (/= (1- x) (car player-position))                 ; or player(x) is not object(x-1)
                            (and (/= (1+ y) (cdr player-position))            ;    and player(y) is not object(y+1)
                                 (/= y (cdr player-position)))))              ;        player(y) is not object(y)
                    (rotatef (aref (data level) y x) (aref (data level) y (1- x))) ; object(x,y) <--> object(x-1,y)
                      (setf (aref falling-objects y x) nil             ; object(x,y) = nil 
                            (aref falling-objects y (1- x)) t))        ; object(x-1,y) = t

                  ((and (eql (aref (data level) y (1+ x)) 'empty)              ; right and under right 'empty   ③
                        (eql (aref (data level) (1+ y) (1+ x)) 'empty)
                        (member (aref (data level) (1+ y) x) '(rock diamond))  ; and under 'rock or 'diamond
                        (or (/= (1+ x) (car player-position))                  ; or player(x) is not object(x+1)
                            (and (/= (1+ y) (cdr player-position))             ;    and player(y) is not object(y+1) 
                                 (/= y (cdr player-position)))))               ;        player(y) is not object(y)
                    (rotatef (aref (data level) y x) (aref (data level) y (1+ x))) ; object(x,y) <--> object(x+1,y)
                      (setf (aref falling-objects y x) nil             ; object(x,y) = nil
                            (aref falling-objects y (1+ x)) t))        ; object(x+1,y) = t
                  (t
                    (setf (aref falling-objects y x) nil))))))         ; otherwise object(x,y) = nil

後から見たときに、どんなロジックだったかを確認する忘備録として①、②、③の部分を残しておくことにする。

① ⇒
f:id:tomekame0126:20161203070509j:plain
② ⇒
f:id:tomekame0126:20161203070544j:plain
③ ⇒
f:id:tomekame0126:20161203070624j:plain

てな感じで、今回のプログラムコードの全体像は以下のとおり

Common-boulderdash ⇒

;;; 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
;;; Step3 <Handle-falling-objects> 
;; -----------------------------------------------------------------------------------------------  

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

;; step3 <Handle-falling-objects>
;; -----------------------------------------------------------------------------------------------
(defun handle-falling-objects (level falling-objects player-position)
  (loop for y from (- (height level) 2) downto 0                       ; y : loop height-2 -> 0
     do (loop for x below (width level)                                ; x : loop width -> 0
       when (member (aref (data level) y x) '(rock diamond))           ; object(x,y) is 'rock or 'diamond
         do (cond ((and (eql (aref (data level) (1+ y) x) 'empty)      ; and under 'empty                         ①
                        (or (/= x (car player-position))               ;   or player(x) is not object(x)
                            (/= (1+ y) (cdr player-position))          ;      player(y) is not object((y+1)
                            (aref falling-objects y x)))               ;      object(x,y) = t
                    (rotatef (aref (data level) y x) (aref (data level) (1+ y) x)) ; object(x,y)<-->object(x,y+1)
                       (setf (aref falling-objects y x) nil            ; object(x,y) = nil 
                             (aref falling-objects (1+ y) x) t))       ; object(x,y+1) = t

                  ((and (eql (aref (data level) y (1- x)) 'empty)             ; left and under left 'empty    ②
                        (eql (aref (data level) (1+ y) (1- x)) 'empty)
                        (member (aref (data level) (1+ y) x) '(rock diamond)) ; under 'rock or 'diamond
                        (or (/= (1- x) (car player-position))                 ; or player(x) is not object(x-1)
                            (and (/= (1+ y) (cdr player-position))            ;    and player(y) is not object(y+1)
                                 (/= y (cdr player-position)))))              ;        player(y) is not object(y)
                    (rotatef (aref (data level) y x) (aref (data level) y (1- x))) ; object(x,y) <--> object(x-1,y)
                      (setf (aref falling-objects y x) nil             ; object(x,y) = nil 
                            (aref falling-objects y (1- x)) t))        ; object(x-1,y) = t

                  ((and (eql (aref (data level) y (1+ x)) 'empty)              ; right and under right 'empty   ③
                        (eql (aref (data level) (1+ y) (1+ x)) 'empty)
                        (member (aref (data level) (1+ y) x) '(rock diamond))  ; and under 'rock or 'diamond
                        (or (/= (1+ x) (car player-position))                  ; or player(x) is not object(x+1)
                            (and (/= (1+ y) (cdr player-position))             ;    and player(y) is not object(y+1) 
                                 (/= y (cdr player-position)))))               ;        player(y) is not object(y)
                    (rotatef (aref (data level) y x) (aref (data level) y (1+ x))) ; object(x,y) <--> object(x+1,y)
                      (setf (aref falling-objects y x) nil             ; object(x,y) = nil
                            (aref falling-objects y (1+ x)) t))        ; object(x+1,y) = t
                  (t
                    (setf (aref falling-objects y x) nil))))))         ; otherwise object(x,y) = nil

;; step1 <Game Frame>
;; -----------------------------------------------------------------------------------------------
(defun Common-boulderdash (level)
  "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 level))
             (player-position (copy-tree (entry-position level)))
             (diamond-count 0)	     
             (falling-objects (make-array (list (height level) (width level)) :initial-element nil))
             (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-> 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 (= (mod frame 5) 2)
            (handle-falling-objects level falling-objects player-position)) ; rock or diamond falls

	  (when (eql (aref (data level) (cdr player-position) (car player-position)) 'rock) ; if rock falls player-position
            (setf status :dead))                                                            ; set player status dead

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

レベルを変えて遊ぶときは、(Common-boulderdash ?)の?の部分に1~3の数字を入れることは言わずもがな!


diamond を全てゲットしてゴールにたどり着いた時の画面がこちら
f:id:tomekame0126:20161203072009p:plain

途中で rock の下敷きになるとこんな感じ
f:id:tomekame0126:20161203072552p:plain

Tomi Neste tneste さん。勉強になりました。