Lisp Game Programming 再履修 ＜その３＞
師走に入って何かと慌ただしくなる前にドンドン行ってみよう。
前回の続きから。
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 ページを参照してくださいね！本屋さんの立ち読みで調べました。
あっ、店員さんの目があるのでちゃんと買いましたよ、もちろん。
居酒屋での飲み会１回分くらいかな？薄い財布から「野口くん」が去っていきました。
さてと、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)
ＯＫ！ 動いた！
こんだけ書いておけば、後でプログラムコードを見たときに思い出すのも早いだろうな。
Common-shooter や Common-abogadro でも詳細に書いておけばよかった！
https://github.com/tomekame0126
教訓：過去の自分は今の自分にあらず！
