読者です 読者をやめる 読者になる 読者になる

`(kakko ,man)

Find a guide into tomorrow by taking lessons from the past

Lisp Game Programming 2 <Stage 1>

Road to the Programmer

mapchipが1つだとスクロールが簡単に実現できた。

http://tomekame0126.hatenablog.com/entry/2014/07/03/055411

でも、地図のようなものはmapchipの組み合わせでできているため、Lispではどのようにスクロールを実現(市販のゲームのようなイメージ)できるか試してみる。

たぶん、mapchipにidを振っているから、idのリストを作って、そのリストを順番に読み込むパターンでいけるはず(と思う)。

まずは、前に作ったプログラムを応用し、お世話になったサイトのデータ(samplecg.bmp)を借用。

1枚に複数の画像がてんこ盛りの画像データを、キャラクターの大きさに合わせてidを振るように設定。

(すみません、画像データを使わせていただきます!)

http://mclass13.web.fc2.com/hsplecture/enemap2.htm

てなことで、一気にこんな感じのプログラムを2つ。

ab-stage1.lisp

;;;; The Common-Abogadro
;;; step1 <Game Frame> <Sprite Sheets> <Define Package> <Macro> <Character Object> <Draw>
;;;          <Initialize> <Key State> <Game Field>

;; step1 <Sprite Sheets>
;; -----------------------------------------------------------------------------------------------
(load "C:\\work\\sprite-sheets.lisp")

;; step1 <Define Package>
;; -----------------------------------------------------------------------------------------------
(defpackage :game
  (:use :common-lisp :lispbuilder-sdl :sprite-sheets)
  (:nicknames :shooting)
  (:export Common-abogadro))
(in-package :game)

;; step1 <Macro>
;; -----------------------------------------------------------------------------------------------
(defmacro define-class (name superclasses slots form)
  `(defclass ,name ,superclasses
    ,(mapcar (lambda (slot)
                     (let ((keyword (intern (symbol-name slot) :keyword)))
                    `(,slot :initarg ,keyword :initform ,form :accessor ,slot)))
                       slots)))

;;step1 <Character Object>
;; -----------------------------------------------------------------------------------------------
(define-class object ()
  (id x y width height) 0)
  ; id graphic id in image
  ; x upper left corner
  ; y upper left corner
  ; width from upper left corner
  ; height from upper left corner

(define-class entity (object)
  (dx dy explode-cnt state) 0)
  ; dx x direction speed
  ; dy y direction speed
  ; explode-cnt explosion counter(wait)
  ; state     ship      0:dead 1:alive 2:explosion 3:revival
  ;              enemy  0:dead 1:alive 2:damage   3:explosion

;; step1 <Draw Images>
;; -----------------------------------------------------------------------------------------------
(defun Draw (obj)
  "character draw"
  (sdl:draw-surface-at-* *images* (x obj) (y obj) :cell (id obj)))

;; step1 <Initialize>
;; -----------------------------------------------------------------------------------------------
(defun Initialize ()
  "graphics initialize"
  (setf (sdl:frame-rate) 60)                                ; frame rate set
  (setf *random-state* (make-random-state t)) ; random set
  (Set-imageid)                                                 ; imageid set
  (sdl:show-cursor nil))                                     ; cursor not show

;; step1 <Update Key State>
;; -----------------------------------------------------------------------------------------------
(define-class keystate ()
  (right left up down z lshift) nil)
  ; right right-key
  ; left left-key
  ; up up-key
  ; down down-key
  ; z z-key
  ; lshift lshift-key

(defgeneric Update-keystate (key boolean keystate))
(defmethod Update-keystate (key boolean keystate)
  (cond ((sdl:key= key :SDL-KEY-RIGHT)  (setf (right keystate) boolean))
            ((sdl:key= key :SDL-KEY-LEFT)    (setf (left keystate) boolean))
            ((sdl:key= key :SDL-KEY-UP)        (setf (up keystate) boolean))
            ((sdl:key= key :SDL-KEY-DOWN) (setf (down keystate) boolean))
            ((sdl:key= key :SDL-KEY-Z)           (setf (z keystate) boolean))
            ((sdl:key= key :SDL-KEY-LSHIFT) (setf (lshift keystate) boolean))))

;; step 1 <Move Ship>
;; -----------------------------------------------------------------------------------------------
(defgeneric Move-ship (ship keystate))
(defmethod Move-ship (ship keystate)
  (when (or (= (state ship) 1)                                        ; When ship is alive or revival
                  (= (state ship) 3))
  (cond ((right keystate) (progn (incf (x ship) (dx ship)) ; set ship id 1 (right turn)
                                                 (setf (id ship) 1)))
            ((left keystate) (progn (decf (x ship) (dx ship))  ; set ship id 2 (left turn)
                                               (setf (id ship) 2)))
            ((up keystate) (decf (y ship) (dy ship)))
            ((down keystate) (incf (y ship) (dy ship))))))

;; step1 <Fix Ship Position>
;; -----------------------------------------------------------------------------------------------
(define-class game-field ()
  (field-x field-y width height) 0)
  ; field-x game field upper left x
  ; field-y game field upper left y
  ; width game field width
  ; height game field height

(defgeneric Fix-ship-position (ship game-field))
(defmethod Fix-ship-position (ship game-field)
  "ship always inside game-field"
  (when (< (x ship) (field-x game-field))          (setf (x ship) (field-x game-field)))
  (when (< (y ship) (field-y game-field))          (setf (y ship) (field-y game-field)))
  (when (> (x ship) (- (width game-field) 32))  (setf (x ship) (- (width game-field) 32)))
  (when (> (y ship) (- (height game-field) 32)) (setf (y ship) (- (height game-field) 32))))

;; step1 <Game Frame>
;; -----------------------------------------------------------------------------------------------
(defun Common-abogadro ()
  "main routine"
  (sdl:with-init (sdl:sdl-init-video sdl:sdl-init-audio) ; use video and audio
    (sdl:window 640 480   :position 'center ; size 640*480, position center
                                    ; :position #(192 50)                   ; position x(192) y(50)
                                      :title-caption "ABOGADRO"
                                      :icon-caption "ABOGADRO"
                                      :flags '(sdl:sdl-doublebuf sdl:sdl-sw-surface))

  ; <Initialize>
  (Initialize) ; graphics initialize

  ; <Charactor Object>
  (let ((ship (make-instance 'entity :id 0 :x 304 :y 416 :width 32 :height 32 :dx 4 :dy 4 :state 1))
          (keystate (make-instance 'keystate))
          (game-field (make-instance 'game-field :field-x 160 :field-y 16 :width 480 :height 464)))

  (sdl:update-display)
  (sdl:with-events (:poll)
  (:quit-event ()
    t)

  ; <Update Key State>
  (:key-down-event (:key key)
    (if (sdl:key= key :SDL-KEY-ESCAPE)
          (sdl:push-quit-event)
         (Update-keystate key t keystate)))
  (:key-up-event (:key key)
    (Update-keystate key nil keystate)
        (setf (id ship) 0)) ; set ship id 0 (normal form)

  (:idle ()
  ; <Clear Display>
  (sdl:clear-display sdl:*black*)

  ; <Move Ship>
  (Move-ship ship keystate)

  ; <Fix Ship Position>
  (Fix-ship-position ship game-field)

  ; <Draw Images>
  (when (= (state ship) 1)
    (Draw ship)) ; draw ship

(sdl:update-display))))))

 

 sprite-sheets.lisp

(defpackage :sprite-sheets
 (:use :common-lisp)
 (:export #:*images*
                #:Set-imageid))

(in-package :sprite-sheets)

;; step1 <Sprite Sheets>
;; -----------------------------------------------------------------------------------------------
(defparameter *path-samplecg* "C:\\work\\graphics\\samplecg.bmp") ; set path to samplecg.bmp
(defvar *images*)
(defvar *imagecells*)

(defun Set-imageid ()
 "load image data and set id"
 (setf *images* (sdl:load-image *path-samplecg* :color-key(sdl:color :r 0 :g 0 :b 0)))
 (let* ((temp1cells (append (loop for x from 0 to 64 by 32              ;id 0 - 2
          collect (list x 0 32 32))))
    (temp2cells (loop for y from 0 to 16 by 16                             ;id 3 - 6
          append (loop for x from 96 to 112 by 16
             collect (list x y 16 16))))
     (temp3cells (append (loop for x from 128 to 224 by 32         ;id 7 -10
            collect (list x 0 32 32))))
     (temp4cells (append (loop for x from 0 to 224 by 32             ;id 11-18
            collect (list x 32 32 32))))
     (temp5cells (append (loop for x from 0 to 224 by 32             ;id 19-26
            collect (list x 64 32 64))))
    (temp6cells (loop for y from 128 to 384 by 64                        ;id 27-46
            append (loop for x from 0 to 192 by 64
             collect (list x y 64 64))))
    (temp7cells (append (loop for x from 0 to 128 by 64              ;id 47-49
            collect (list x 448 64 32))))
    (temp8cells (append (loop for x from 0 to 96 by 32                ;id 50-53
            collect (list x 480 32 32 ))))
    (temp9cells (loop for y from 0 to 192 by 64                            ;id 54-69
          append (loop for x from 256 to 448 by 64
           collect (list x y 64 64))))
    (temp10cells (loop for y from 256 to 384 by 96                      ;id 70-75
          append (loop for x from 256 to 448 by 96
           collect (list x y 96 96))))
    (temp11cells (append (loop for x from 192 to 384 by 64         ;id 76-79
           collect (list x 448 64 64))))
    (temp12cells (loop for y from 448 to 480 by 32                      ;id 80-85
           append (loop for x from 448 to 512 by 32
             collect (list x y 32 32)))))
    (setf *imagecells* (append temp1cells temp2cells temp3cells temp4cells
                                                    temp5cells temp6cells temp7cells temp8cells
                                                    temp9cells temp10cells temp11cells temp12cells)))
 (setf (sdl:cells *images*) *imagecells*))

 

見た目は、前に作ったのと同じ感じだけど、注意すべき点は青字の部分。

それから、左右のキーを押すとshipが左右に傾いた画像で移動するのが、お茶目な点。

加えて、今回はデータの読み込みが多いのでプログラムを最初から分けてみた。

(5/28)紫の部分をちょっと訂正。こんな書き方もあるってことで。

f:id:tomekame0126:20150529222221p:plain