Lisp Game Programming 再履修 <その1>
今年は町内会の役員業務に忙殺され、しばらくLispでのプログラム作成から離れていたら、「Lispってなんですか?」みたいな状態になってしまった。
年齢相応のボケも進み、気力も続かないため、過去に作成されたLispのゲームプログラムをリメイクして、老いた脳みそを活性化させることにする。
インターネットで、「良い物件」を物色していたらこんなサイトが見つかった。
http://matthieu.villeneuve.free.fr/dev/games/
小手調べに「Boulder Dash」というゲームの構造を分析してみることにするが、「PAL」というライブラリを使用しているため、「Lispbuilder-SDL」で書き直すことで、Lispプログラムの再履修としよう。
まずは、ゲームの画面のみを表示するプログラムを「Lispbuilder-SDL」でリメイクするが、「Boulder Dash」をダウンロードすると画像ファイルと以下のようなマップデータが3つ用意されている。
画像ファイルとマップファイルを読み込んで表示してみよう。
level01.txt ⇒
######################################## #------ --*-o -----o-o------- ----o----# #-o@o------ ---------o*--o---- ----- --# #---------- -- -----o-o--o--------o----# #o- ---------o------o--o----o---o-----# #o oo---------oo--o--------o------o-o -# #---o--o--------o-----o- o--------o-oo-# ###############################---o--o-# #- ---o--*- --o-o----------*-o ------o-# #--*-----o----- --------o o--*----o---# #---o--o-o--------------oo-o--o--------# #- o----o--------oo -------o--o-*---- -# #-o-- --o- -----o-o*--*----o---o--*-o-# #-*o--------------ooo--o--------*-----o# #--------############################### # --------- ---*----o-----o---o-------# #oo---------oo--o--------o------o-o --&# #-o--o--------o-----o- ----*---o-oo---# #----o*-- --------o------o-o*------o---# #--- -- -o--o-oo---------o-o*------o--o# #-*----o----- --------- -o--o-o------o-# ########################################
step1.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> ;; ----------------------------------------------------------------------------------------------- ;; 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))) ;; 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) (:idle () ; Game body ;<Draw Game> (Draw-game level player-position status) (sdl:update-display)))))) (Common-boulderdash)
こんな感じで表示される。
ブログラム内容の確認は次回!