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
後から見たときに、どんなロジックだったかを確認する忘備録として①、②、③の部分を残しておくことにする。
① ⇒
② ⇒
③ ⇒
てな感じで、今回のプログラムコードの全体像は以下のとおり
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 ？）の？の部分に１～３の数字を入れることは言わずもがな！
diamond を全てゲットしてゴールにたどり着いた時の画面がこちら
途中で rock の下敷きになるとこんな感じ
Tomi Neste tneste さん。勉強になりました。
