`(kakko ,man)

Find a guide into tomorrow by taking lessons from the past

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)

こんな感じで表示される。
ブログラム内容の確認は次回!

f:id:tomekame0126:20161125215402p:plain