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

`(kakko ,man)

Find a guide into tomorrow by taking lessons from the past

Lisp Game Programming 2 <Stage 3>

さて、スクロールのテスト開始。

スクロール用のプログラムを以下のように追加(青字)して、CL-USER>(common-abogadro)を実行すると、想定どおりにスクロールした。

なお、赤字の*map1*を*map2*や *map3*に変更するとそれぞれのマップが表示される。

ab-stage2.lisp

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

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

;; step2 <Map>
;; -----------------------------------------------------------------------------------------------
(load "C:\\work\\map-list.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))))

;; step 2 <Scroll>
;; -----------------------------------------------------------------------------------------------
(defvar *scroll-cnt* 0)
(defvar *map-pointer* 64)    ; map start line
(defvar *draw-position-y* 0) ; y-axis start position
(defvar *atlas* *map1*)        ; map set

(defun Scroll-background (map)
 "draw background"
 (setf *draw-position-y* (+ -48 (mod *scroll-cnt* 64))) ; scroll start from y(-48) to y(16)
 (dotimes (i 8)    ; 8 row
  (dotimes (j 5) ; 5 column
   (sdl:draw-surface-at-* *images* (+ 160 (* j 64)) (+ *draw-position-y* (* i 64))
                           :cell (aref map (+ *map-pointer* i) j)))))

(defun Set-map-edge ()
  (incf *scroll-cnt*)
  (when (eql (mod *scroll-cnt* 64) 0) ; mapchip draw position
   (setf *draw-position-y* 0)
   (if (= *map-pointer* 0)       ; when scroll-line is 0 (end line)
    (setf *map-pointer* 64)    ; set scroll-line 64 (start line)
    (decf *map-pointer*))))     ; else scroll-line -1

(defun Scroll-mask ()
  (sdl:draw-box-* 160 0 320 16 :color sdl:*black*)        ; mask scroll upper side
  (sdl:draw-box-* 160 464 320 480 :color sdl:*black*)) ; mask scroll lower side

;; 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*)

    ; <Map Draw>
    (Scroll-background *atlas*) 
    (Scroll-mask)

    ; <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

    ; <Set-map-edge>
    (Set-map-edge) ; set map draw point

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

f:id:tomekame0126:20150529220028p:plain