今年は町内会の役員業務に忙殺され、しばらくLispでのプログラム作成から離れていたら、「Lispってなんですか？」みたいな状態になってしまった。

年齢相応のボケも進み、気力も続かないため、過去に作成されたLispのゲームプログラムをリメイクして、老いた脳みそを活性化させることにする。

インターネットで、「良い物件」を物色していたらこんなサイトが見つかった。

http://matthieu.villeneuve.free.fr/dev/games/

小手調べに「Boulder Dash」というゲームの構造を分析してみることにするが、「PAL」というライブラリを使用しているため、「Lispbuilder-SDL」で書き直すことで、Lispプログラムの再履修としよう。

まずは、ゲームの画面のみを表示するプログラムを「Lispbuilder-SDL」でリメイクするが、「Boulder Dash」をダウンロードすると画像ファイルと以下のようなマップデータが３つ用意されている。

画像ファイルとマップファイルを読み込んで表示してみよう。

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 ⇒

( defpackage :game ( :use :common-lisp :lispbuilder-sdl ) ( :nicknames :boulderdash ) ( :export #:Common-boulderdash )) ( in-package :game ) ( 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 )))) ( 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 ))) ( defun Char->element ( char ) ( ecase char ( #\space ' empty ) ( #\# ' wall ) ( #\- ' dirt ) ( #\o ' rock ) ( #\* ' diamond ) ( #\@ ' entry ) ( #\& ' exit ))) ( defun Parse-map ( lines ) ( let* (( width ( length ( first lines ))) ( height ( length lines )) ( data ( make-array ( list height width ))) ( entry nil ) ( exit nil )) ( loop for y below height for line in lines do ( loop for x below width for element = ( Char->element ( aref line x )) do ( setf ( aref data y x ) element ) when ( eql element ' entry ) do ( setf entry ( cons x y )) ( setf ( aref data y x ) ' empty ) when ( eql element ' exit ) do ( setf exit ( cons x y )))) ( make-instance ' level :width width :height height :data data :entry-position entry :exit-position exit ))) ( defun Load-map ( level ) ( let (( filename ( format nil "C:\\work\\Levels\\level~2,'0d.txt" level ))) ( with-open-file ( stream filename ) ( loop for line = ( read-line stream nil nil ) until ( null line ) collect line into lines finally ( return ( Parse-map lines )))))) ( defparameter +tile-size+ 32 ) ( defparameter +screen-tile-width+ 16 ) ( defparameter +screen-tile-height+ 15 ) ( defparameter +screen-width+ ( * +screen-tile-width+ +tile-size+ )) ( 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 )) for screen-y from 0 repeat +screen-tile-height+ do ( loop for x from ( - ( car player-position ) ( floor +screen-tile-width+ 2 )) for screen-x from 0 repeat +screen-tile-width+ when ( and ( < -1 x ( width level )) ( < -1 y ( height level ))) do ( let (( element ( aref ( data level ) y x ))) ( unless ( eql element ' empty ) ( sdl:draw-surface-at-* ( case element ( wall *wall-image* ) ( dirt *dirt-image* ) ( rock *rock-image* ) ( diamond *diamond-image* ) ( exit *door-image* )) ( * screen-x +tile-size+ ) ( * screen-y +tile-size+ )))) do ( when ( and ( = x ( car player-position )) ( = y ( cdr player-position ))) ( sdl:draw-surface-at-* ( ecase status ( :playing *player-image* ) ( :victory *victory-image* ) ( :dead *death-image* )) ( * screen-x +tile-size+ ) ( * screen-y +tile-size+ )))))) ( defun Initialize () "graphics initialize" ( setf ( sdl:frame-rate ) 60 ) ( setf *random-state* ( make-random-state t )) ( sdl:show-cursor nil )) ( defun Common-boulderdash () "main routine" ( sdl:with-init ( sdl:sdl-init-video sdl:sdl-init-audio ) ( sdl:window 512 480 :position ' center :title-caption "BOULDERDASH" :icon-caption "BOULDERDASH" :flags '( sdl:sdl-doublebuf sdl:sdl-sw-surface )) ( Initialize ) ( Load-images ) ( let* (( level ( load-map 1 )) ( player-position ( copy-tree ( entry-position level ))) ( status :playing )) ( sdl:with-events ( :poll ) ( :quit-event () t ) ( :idle () ( Draw-game level player-position status ) ( sdl:update-display )))))) ( Common-boulderdash )

こんな感じで表示される。

ブログラム内容の確認は次回！