Lisp Game Programming 2 <Stage 13-1 Structure>
参考にしているサイトのショットパターンをそのまま利用するのが近道と判断し、それをLispで記述した。
当初考えたとおり、ショットパターンの構造体を作りそれを配列にしてみた。
なお、HSPでは360度を256分割した数値で表現しているため、それを考慮して数値を変換している。
構造体のメンバはコメントどおりの意味で以下のとおり。
battery-angle : 砲台の向き（角度）
direction-battery-angle : 砲台が回転するかしないか、回転する場合はその角度
number-battery : 砲台の数
number-battery-shot : 1砲台あたりの弾数
battery-direction : 真下もしくはshipの方向にショット
betweentime : ショット間のインターバル
aftertime : 次のショットパターンへのインターバル
shotspeed : ショットスピード
実験してみた結果、Stage2のボスキャラの弾幕で数値を下げるとうまく動かないところがあったため、一部数値
を変更している。
これは、エラー表示もなにも出ないのに弾幕だけが表示されなくなるという魔訶不思議な現象。
SBCLでもeclでも同じような状況になるため、なぜStage2の時だけ発生するのかは謎のまま。
※ちなみにStage2のボスキャラのショットパターンを入れ替えても同じような状況が発生した。
shot-data.lisp⇒
(defpackage :shot-data (:use :common-lisp) (:export #:shotdata #:shotdata-battery-angle #:shotdata-direction-battery-angle #:shotdata-number-battery #:shotdata-number-battery-shot #:shotdata-battery-direction #:shotdata-aftertime #:shotdata-betweentime #:shotdata-shotspeed #:*shot-pattern-data*)) (in-package :shot-data) ;; step13 <Enemy-shot-data> ;; ----------------------------------------------------------------------------------------------- (defstruct shotdata battery-angle direction-battery-angle ; revolving or not revolving number-battery ; battery number-battery-shot; shot battery-direction ; direction of ship betweentime ; time between 1 shot and 1 shot aftertime ; waiting time for next shot patttern shotspeed) ; dot move (defvar shotdata) (setf shotdata (make-shotdata)) (defvar shotdata0) (setf shotdata0 (make-shotdata :battery-angle '(90) ; 1way ;-- 90 degree is center position --; :direction-battery-angle 0 ; not revolving :number-battery 1 ; 1 battery :number-battery-shot 1; 1 shot :battery-direction 1 ; direction of ship :betweentime 0 ; waiting time for next shot :aftertime 64 :shotspeed 5)) ; 5 dot move (defvar shotdata1) (setf shotdata1 (make-shotdata :battery-angle '(79 90 101) ;3way :direction-battery-angle 0 ; not revolving :number-battery 3 ; 3 battery :number-battery-shot 1; 1 shot :battery-direction 0 ; below :betweentime 0 ; waiting time for next shot :aftertime 64 :shotspeed 4)) ; 4 dot move (defvar shotdata2) (setf shotdata2 (make-shotdata :battery-angle '(79 90 101) ;3way :direction-battery-angle 0 ; not revolving :number-battery 3 ; 3 battery :number-battery-shot 1; 1 shot :battery-direction 1 ; direction of ship :betweentime 0 ; waiting time for next shot :aftertime 64 :shotspeed 3)) ; 3 dot move (defvar shotdata3) (setf shotdata3 (make-shotdata :battery-angle '(79 169 259 349) ; 4 way :direction-battery-angle 6 ; revolve :number-battery 4 ; 4 battery :number-battery-shot 5; 5 shot :battery-direction 0 ; below :betweentime 2 ; waiting time for next shot :aftertime 32 :shotspeed 3)) ; 3 dot move (defvar shotdata4) (setf shotdata4 (make-shotdata :battery-angle '(90) ;1 way :direction-battery-angle 0 ; not revolving :number-battery 1 ; 1 battery :number-battery-shot 5; 5 shot :battery-direction 1 ; direction of ship :betweentime 2 ; waiting time for next shot :aftertime 64 :shotspeed 4)) ; 4 dot move (defvar shotdata5) (setf shotdata5 (make-shotdata :battery-angle '(48 62 76 90 104 118 132) ;7 way :direction-battery-angle 0 ; not revolving :number-battery 7 ; 7 battery :number-battery-shot 1; 1 shot :battery-direction 1 ; direction of ship :betweentime 0 ; waiting time for next shot :aftertime 64 :shotspeed 3)) ; 3 dot move (defvar shotdata6) (setf shotdata6 (make-shotdata :battery-angle '(69 73 77 82 98 103 107 111) ; 8way :direction-battery-angle 0 ; not revolving :number-battery 8 ; 8 battery :number-battery-shot 5; 5 shot :battery-direction 1 ; direction of ship :betweentime 4 ; waiting time for next shot :aftertime 32 :shotspeed 8)) ; 8 dot move (defvar shotdata7) (setf shotdata7 (make-shotdata :battery-angle '(79 90 101) ;3way :direction-battery-angle 0 ; not revolving :number-battery 3 ; 3 battery :number-battery-shot 5; 5 shot :battery-direction 1 ; direction of ship :betweentime 4 ; waiting time for next shot :aftertime 16 :shotspeed 6)) ; 6 dot move (defvar shotdata8) (setf shotdata8 (make-shotdata :battery-angle '(11 23 34 45 56 68 79 90 101 113 124 135 146 158 169 180 191 203 214 225 236 248 259 270 281 293 304 315 326 338 349 360);32 way :direction-battery-angle 0 ; not revolving :number-battery 32 ; 32 battery :number-battery-shot 1; 1 shot :battery-direction 0 ; below :betweentime 0 ; waiting time for next shot :aftertime 8 ; original 4 but don't work <--------- :shotspeed 4)) ; 4 dot move (defvar shotdata9) (setf shotdata9 (make-shotdata :battery-angle '(17 28 39 51 62 73 84 96 107 118 129 141 152 163 174 186 197 208 219 231 242 253 264 276 287 298 309 321 332 343 354 6);32way :direction-battery-angle 0 ; not revolving :number-battery 32 ; 32 battery :number-battery-shot 1; 1 shot :battery-direction 0 ; below :betweentime 0 ; waiting time for next shot :aftertime 16 :shotspeed 4)) ; 4 dot move (defvar shotdata10) (setf shotdata10 (make-shotdata :battery-angle '(90) ;1 way :direction-battery-angle 0 ; not revolving :number-battery 1 ; 1 battery :number-battery-shot 10; 10 shot :battery-direction 1 ; direction of ship :betweentime 8 ; original 2 but don't work <---------- :aftertime 64 :shotspeed 8)) ; 8 dot move (defvar shotdata11) (setf shotdata11 (make-shotdata :battery-angle '(180) ;1 way like screw :direction-battery-angle 8 ; revolve :number-battery 1 ; 1 battery :number-battery-shot 64; 64 shot :battery-direction 1 ; direction of ship :betweentime 1 :aftertime 16 :shotspeed 6)) ; 6 dot move (defvar shotdata12) (setf shotdata12 (make-shotdata :battery-angle '(79 101 124) ;3 way :direction-battery-angle -6 ; revolve :number-battery 3 ; 3 battery :number-battery-shot 5; 5 shot :battery-direction 1 ; direction of ship :betweentime 2 ; waiting time for next shot :aftertime 32 :shotspeed 6)) ; 6 dot move (defvar shotdata13) (setf shotdata13 (make-shotdata :battery-angle '(84 87 90 93 96) ;5 way :direction-battery-angle 0 ; not revolving :number-battery 5 ; 5 battery :number-battery-shot 5; 5 shot :battery-direction 1 ; direction of ship :betweentime 4 ; waiting time for next shot :aftertime 32 :shotspeed 8)) ; 8 dot move (defparameter *shot-pattern-data* (make-array 14)) (setf (aref *shot-pattern-data* 0) shotdata0) (setf (aref *shot-pattern-data* 1) shotdata1) (setf (aref *shot-pattern-data* 2) shotdata2) (setf (aref *shot-pattern-data* 3) shotdata3) (setf (aref *shot-pattern-data* 4) shotdata4) (setf (aref *shot-pattern-data* 5) shotdata5) (setf (aref *shot-pattern-data* 6) shotdata6) (setf (aref *shot-pattern-data* 7) shotdata7) (setf (aref *shot-pattern-data* 8) shotdata8) (setf (aref *shot-pattern-data* 9) shotdata9) (setf (aref *shot-pattern-data* 10) shotdata10) (setf (aref *shot-pattern-data* 11) shotdata11) (setf (aref *shot-pattern-data* 12) shotdata12) (setf (aref *shot-pattern-data* 13) shotdata13)
Lisp Game Programming 2 <Stage 12>
Stage12では、shipが敵や敵弾と衝突したときのプログラムを組みこんでみる。
また、STAGEが切り替わるためには、デカキャラを倒す必要があり、普通の敵より激しい爆発として作成したのが以下のプログラム。
これで「ほぼ」完成！(弾幕を除き）
;; Step12 <Ship Hit P> ;; ----------------------------------------------------------------------------------------------- (defgeneric Ship-hit-p (ship enemy-manager balloon-manager score shot-manager)) (defmethod Ship-hit-p (ship enemy-manager balloon-manager score shot-manager) (when (= (state ship) 1) (let ((hit 0)) (dolist (enemy (enemy-list enemy-manager)) (when (and (or (= (state enemy) 1) ; if enemy is alive (= (state enemy) 2)) ; or enemy is damaged (> (+ (x ship) 16) (x enemy)) ; 16 is center of ship (< (+ (x ship) 16) (+ (x enemy) (width enemy))) ; width enemy (> (+ (y ship) 16) (y enemy)) (< (+ (y ship) 16) (+ (y enemy) (height enemy)))) ; height enemy (if (/= (kind enemy) 3) ; when not large enemy (setf (state enemy) 0 ; small or middle enemy explosion hit 1) (setf (state enemy) 3 ; large enemy is dameged hit 1)))) (dolist (enemy-shot (enemy-shot-list enemy-manager)) (when (and (= (state enemy-shot) 1) ; enemies shot and ship hit (> (+ (x ship) 16) (x enemy-shot)) (< (+ (x ship) 16) (+ (x enemy-shot) (width enemy-shot))) (> (+ (y ship) 16) (y enemy-shot)) (< (+ (y ship) 16) (+ (y enemy-shot) (height enemy-shot)))) (setf (state enemy-shot) 0 hit 1))) (when (= hit 1) ; hit on ship (Play-sample *crushed*) ; ship crushed sound (setf (state ship) 2 ; ship is explode (shot-list shot-manager) nil (balloon-cnt balloon-manager) 0 (balloon-list balloon-manager) nil (n-bomb score) 3 (explode-cnt ship) 0))))) ; ship explode count 0 ;; Step12 <Explode Counter> ;; ----------------------------------------------------------------------------------------------- (defgeneric Explode-counter (ship score game-field stage)) (defmethod Explode-counter (ship score game-field stage) (when (= (state ship) 2) ; ship is explode (incf (explode-cnt ship) 1) (when (= (explode-cnt ship) 100) (decf (n-ship score) 1) (when (> (n-ship score) 0) (setf (state ship) 3 ; set ship revival (revival-cnt ship) 0 (x ship) (- (* (field-x game-field) 2) (/ (width ship) 2)) (y ship) (- (height game-field) (* (height ship) 2))))))) ;; Step12 <Revive Counter> ;; ----------------------------------------------------------------------------------------------- (defgeneric Revive-counter (ship enemy-manager)) (defmethod Revive-counter (ship enemy-manager) (when (= (state ship) 3) ; ship is revival (incf (revival-cnt ship) 1) (when (>= (revival-cnt ship) 200) ; revival counter is over 200 (dolist (enemy (enemy-list enemy-manager)) (unless (and (or (= (state enemy) 1) ; if enemy is alive (= (state enemy) 2)) ; or enemy is damaged (> (+ (x ship) 16) (x enemy)) ; 16 is center of ship (< (+ (x ship) 16) (+ (x enemy) (width enemy))) ; width enemy (> (+ (y ship) 16) (y enemy)) (< (+ (y ship) 16) (+ (y enemy) (height enemy)))))) ; height enemy (setf (state ship) 1)))) ;; Step12 <Draw Ship Explosion> ;; ----------------------------------------------------------------------------------------------- (defgeneric Draw-ship-explosion (ship explosion)) (defmethod Draw-ship-explosion (ship explosion) (when (and (= (state ship) 2) (< (explode-cnt ship) 30)) (setf (x explosion) (- (x ship) 16) ; x : center of explosion (y explosion) (y ship)) ; y : center of explosion (cond ((<= (explode-cnt ship) 10) (setf (id explosion) 47)) ((and (> (explode-cnt ship) 10) (<= (explode-cnt ship) 20)) (setf (id explosion) 48)) ((> (explode-cnt ship) 20) (setf (id explosion) 49))) (Draw explosion))) ; draw ship explosion ;; Step12 <Draw Ship> ;; ----------------------------------------------------------------------------------------------- (defgeneric Draw-ship (ship)) (defmethod Draw-ship (ship) (when (or (= (state ship) 1) (and (= (state ship) 3) (> 5 (mod (revival-cnt ship) 10)))) ; ship flushes on and off (Draw ship))) ; draw ship revival
敵がデカキャラの場合の爆発に関係するプログラムは以下。
;; step12 <Set Explosion> ;; ----------------------------------------------------------------------------------------------- (defvar *rnd1*) (defvar *rnd2*) (defgeneric Set-explosion (explosion-manager enemy-manager)) (defmethod Set-explosion (explosion-manager enemy-manager) "set explosion" (dolist (enemy (enemy-list enemy-manager)) (when (and (= (state enemy) 3) (= (kind enemy) 3)) (when (and (= (mod (bomb-cnt explosion-manager) 15) 0) ; bomb-cnt is 150 -> 10 times (/= (bomb-cnt explosion-manager) 0)) (dotimes (i (bomb-number explosion-manager)) ; 5 bomb (let ((bomb (make-instance 'entity :id 64 :width 64 :height 64 :state 1))) (setf *rnd1* (random 96) ; x: from -32 to 96 *rnd2* (random 96)) ; y: from -32 to 96 (setf (x bomb) (- (+ (x enemy) *rnd1*) 32) (y bomb) (- (+ (y enemy) *rnd2*) 32)) (push bomb (bomb-list explosion-manager))))) (decf (bomb-cnt explosion-manager)) ; decrement bomb-cnt 150 -> 0 (when (= (bomb-cnt explosion-manager) 0) ; if bomb counter is 0 , reset 150 (setf (bomb-cnt explosion-manager) 150 (state enemy) 0 *stage-end-flag* t) ; stage end! (Stop-sound))))) ; BGM stop! ;; step12 <Explode Large Enemy> ;; ----------------------------------------------------------------------------------------------- (defvar *large-enemy-explodes-flag* nil) (defgeneric Explode-large-enemy (explosion-manager)) (defmethod Explode-large-enemy (explosion-manager) "large enemy explosion while 15 times loop" (dolist (bomb (bomb-list explosion-manager)) (incf (explode-cnt bomb) 1) (when (eql *large-enemy-explodes-flag* nil) (setf *large-enemy-explodes-flag* t) ; bomb explode sound on (Play-sample *bomb*)) ; bomb explode sound (when (= (explode-cnt bomb) 15) ; when bomb explode count is 15 (setf (state bomb) 0 ; set state of bomb 0 *large-enemy-explodes-flag* nil)))) ;; step12 <Remove Explode large enemy> ;; ----------------------------------------------------------------------------------------------- (defgeneric Remove-explode-large-enemy (explosion-manager)) (defmethod Remove-explode-large-enemy (explosion-manager) "explode bomb remove from list" (setf (bomb-list explosion-manager) (delete-if #'(lambda (bomb) (= (state bomb) 0)) (bomb-list explosion-manager)))) ;; step12 <Draw Explosion Large Enemy> ;; ----------------------------------------------------------------------------------------------- (defgeneric Draw-explosion-large-enemy (explosion-manager)) (defmethod Draw-explosion-large-enemy (explosion-manager) (dolist (bomb (bomb-list explosion-manager)) (when (= (state bomb) 1) (cond ((and (>= (explode-cnt bomb) 0) (< (explode-cnt bomb) 5)) (setf (id bomb) 64)) ((and (>= (explode-cnt bomb) 5) (< (explode-cnt bomb) 10)) (setf (id bomb) 65)) ((and (>= (explode-cnt bomb) 10) (< (explode-cnt bomb) 15)) (setf (id bomb) 66))) (Draw bomb)))) ; draw bomb
メインルーチンにも当然追加が必要。
・・・・・・・・・・・・・・・・・・・・ ; <Enemy-hit-p :Damage Draw Explode> (Enemy-hit-p shot-manager enemy-manager) (Damage-counter enemy-manager score) (Explode-enemy enemy-manager) (Draw-enemy-explosion enemy-explosion enemy-manager) (Score-up score) ; <Large Enemy Explosion> (Set-explosion explosion-manager enemy-manager) (Explode-large-enemy explosion-manager) (Remove-explode-large-enemy explosion-manager) (Draw-explosion-large-enemy explosion-manager) ・・・・・・・・・・・・・・・・・・・・
Lisp Game Programming 2 <Stage 11>
Stage11では、左Shiftキーを押すと敵と敵の弾が全て破壊され、爆発するような関数を組み込むことにする。
以下のプログラムでは、bomb-managerクラスの作成と、shipが爆発中でなく且つボムが残っていて爆発中でない時に左Shiftキーを押すと、ボムが爆発してボムマークを１つ減らしている。
今後の予定としては、Stage12で衝突判定を組み込んでとりあえずの完成とし、作成したプログラムをすべて掲載することとしよう。
但し、全ての敵弾が一発一発発射されるため、ゲームとしては今一つなことから弾幕の設計を考えてみたい。でもどうやるんだろ？
何となく、ショットパターンの構造体を配列化するのが手っ取り早くできそうな気もするが、過去にLispで弾幕なんて作った例があるんだろうか？
探してみるけどどうだろ？（たぶん望み薄）
;; step11 <Set Bomb Key> ;; ----------------------------------------------------------------------------------------------- (define-class bomb-manager () (bomb-list bomb-cnt bomb-flag bomb-number) nil) ; bomb-list list of bomb ; bomb-cnt 60 times waiting ; bomb-flag on (exploding) / off(not exploding) ; bomb-number max 10 (defgeneric Set-bomb-key (ship bomb-manager keystate score)) (defmethod Set-bomb-key (ship bomb-manager keystate score) "bomb key push" (when (and (/= (state ship) 2) (/= (n-bomb score) 0) (eql (bomb-flag bomb-manager) nil) (eql (lshift keystate) t)) (decf (n-bomb score) 1) ; decrement n-bomb 3 -> 0 (setf (bomb-flag bomb-manager) t ; bomb-flag ON (lshift keystate) nil))) ; reset lshift key ;; step11 <Set Bomb> ;; ----------------------------------------------------------------------------------------------- (defvar *rnd1*) (defvar *rnd2*) (defgeneric Set-bomb (bomb-manager enemy-manager)) (defmethod Set-bomb (bomb-manager enemy-manager) "set bomb" (when (eql (bomb-flag bomb-manager) t) ; when bomb-flag is ON (when (and (= (mod (bomb-cnt bomb-manager) 15) 0) (> (bomb-cnt bomb-manager) 0)) (dotimes (i (bomb-number bomb-manager)) (let ((bomb (make-instance 'entity :id 67 :width 64 :height 64 :state 1))) (setf *rnd1* (random 256) *rnd2* (random 384)) (setf (x bomb) (+ 160 *rnd1*) (y bomb) (+ 16 *rnd2*)) (push bomb (bomb-list bomb-manager)))) (dolist (enemy (enemy-list enemy-manager)) (when (or (= (state enemy) 1) ; if enemy is alive (= (state enemy) 2)) ; or enemy is damaged (setf (state enemy) 2 (damage-cnt enemy) 0) (decf (life-cnt enemy) 1)))) (decf (bomb-cnt bomb-manager) 1) ; decrement bomb-cnt 60 -> 0 (when (= (bomb-cnt bomb-manager) 0) ; if bomb counter is 0 , reset 60 (setf (bomb-cnt bomb-manager) 60 ; and set bomb flag nil (bomb-flag bomb-manager) nil)))) ;; step11 <Explode Bomb> ;; ----------------------------------------------------------------------------------------------- (defvar *bomb-explodes-flag* nil) (defgeneric Explode-bomb (bomb-manager enemy-manager)) (defmethod Explode-bomb (bomb-manager enemy-manager) "bomb explosion while 15 times loop" (dolist (bomb (bomb-list bomb-manager)) (incf (explode-cnt bomb) 1) (when (eql *bomb-explodes-flag* nil) (setf *bomb-explodes-flag* t) ; bomb explode sound on (Play-sample *bomb*)) ; bomb explode sound (when (= (explode-cnt bomb) 15) ; when bomb explode count is 15 (setf (state bomb) 0 ; set state of bomb 0 *bomb-explodes-flag* nil) (dolist (enemy-shot (enemy-shot-list enemy-manager)) (setf (state enemy-shot) 0))))) ; set state of enemy-shot 0 ;; step11 <Remove Explode Bomb> ;; ----------------------------------------------------------------------------------------------- (defgeneric Remove-explode-bomb (bomb-manager)) (defmethod Remove-explode-bomb (bomb-manager) "explode bomb remove from list" (setf (bomb-list bomb-manager) (delete-if #'(lambda (bomb) (= (state bomb) 0)) (bomb-list bomb-manager)))) ;; step11 <Draw Bomb> ;; ----------------------------------------------------------------------------------------------- (defgeneric Draw-bomb (bomb-manager)) (defmethod Draw-bomb (bomb-manager) (dolist (bomb (bomb-list bomb-manager)) (when (= (state bomb) 1) (cond ((and (>= (explode-cnt bomb) 0) (< (explode-cnt bomb) 5)) (setf (id bomb) 67)) ((and (>= (explode-cnt bomb) 5) (< (explode-cnt bomb) 10)) (setf (id bomb) 68)) ((and (>= (explode-cnt bomb) 10) (< (explode-cnt bomb) 15)) (setf (id bomb) 69))) (Draw bomb)))) ; draw bomb
Lisp Game Programming 2 <Stage 10-2 Program>
まだ、衝突判定やオプションのボムを組み込んでいないが、一旦プログラムの全体像を見てみる。
※OSが7から10に変わったことで、それまでemacs+slimeで動作の検証に使っていたCCLが起動しなくなった。
こんな感じ！
Can't allocate required TLS indexes.
First available index value was 31
Process inferior-lisp exited abnormally with code 1
なんでだろ？
H27.1.31追記
たまたま、sbcl1.1.12がalexsandriaを読み込む部分でエラーになり、加えてeclも立ち上がらなくなったことから、よもやウィルス対策ソフトがじゃましているのでは？と思い、止めてみたらビンゴ！
作成途中のため、現在は無敵モードの状態。
STAGE10では、ゲームに必要なダメージカウンタ等様々なもの組み込んでみた。
step10の表示があるところが今回の追加点なので、確認してみてくださいな。
なお、ちょこちょこいじったので、今まで作成したプログラムに若干変更点がある。
特に、バルーンや敵弾の位置計算で使用していたfloorは、最後に描画するときにroundしてしまえばいいので描画関数も変更している。
なので、バルーンや敵の弾の計算で使っていたfloorは削除。
sb-stage10.lisp⇒
;;;; The Common-Abogadro ;;; step1 <Game Frame> <Sprite Sheets> <Define Package> <Macro> <Character Object> <Draw> ;;; <Initialize> <Key State> <Game Field> ;;; step2 <Map> <Scroll> ;;; step3 <Font> <Stage Class> <Start Stage Message> ;;; step4 <Game Start Message> <Game Over Message> <Judge Game Over> <Set Screen Mode> ;;; step5 <Score Panel> ;;; step6 <Move Shot> <Set Shot> <Remove Dead Shot> <Draw Shot> ;;; step7 <Generate Enemy> <Judge Stage End> <Move Enemy> <Change Id> <Remove Enemy> ;;; <Draw Enemy> <Reset Variables> <Rotate Map Pointer> ;;; step8 <Move Balloon> <Generate Balloon> <Draw Balloon> <Move Item> <Remove Item> ;;; <Hit Item> <Draw Item> ;;; step9 <Move Enemy Shot> <Set Enemy Shot> <Remove Dead Enemy Shot> ;;; step10 <Audio> <Enemy Hit P> <Damage Counter> <Explode Enemy> <Score Up> <Change Damaged Id> ;;; <Set Reset Id> ;; step1 <Sprite Sheets> ;; ----------------------------------------------------------------------------------------------- (load "C:\\work\\sprite-sheets.lisp") ;; step2 <Map> ;; ----------------------------------------------------------------------------------------------- (load "C:\\work\\map-list.lisp") ;; step7 <Enemy Map List> ;; ----------------------------------------------------------------------------------------------- (load "C:\\work\\enemy-map-list.lisp") ;; step7 <Enemy Map List> ;; ----------------------------------------------------------------------------------------------- (load "C:\\work\\move-pattern.lisp") ;; step10 <Audio> ;; ----------------------------------------------------------------------------------------------- (load "C:\\work\\audio-list.lisp") ;; step1 <Define Package> + audio ;; ----------------------------------------------------------------------------------------------- (defpackage :game (:use :common-lisp :lispbuilder-sdl :sprite-sheets :map-list :enemy-map-list :move-pattern :audio-list) (: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 imageid ; 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 (define-class foe (entity) (move-cnt damage-cnt life-cnt kind) 0) ; move-cnt moving counter (distance) ; damage-cnt enemy damage counter(wait) ; life-cnt enemy life counter (life time) ; kind kind of enemy (define-class enemy-manager () (enemy-list enemy-shot-list) nil) ; enemy-list enemy list ; enemy-shot-list enemy shot list (define-class shot-manager () (shot-list) nil) ; shot-list 4 shot store (define-class balloon-manager () (balloon-list balloon-cnt) nil) ; balloon-list list of balloon ; balloon-cnt max 2 balloon (define-class item-manager () (item-list item-flag) nil) ; item-list list of item ; item-flag item get flag (define-class score () (score highscore oneup n-ship n-bomb) 0) ; score score counter ; highscore hight score ; oneup plus one ship ; n-ship number of ship ; n-bomb number of bomb ;; step1 <Draw Images> ;; ----------------------------------------------------------------------------------------------- (defun Draw (obj) "character draw" (sdl:draw-surface-at-* *images* (round (x obj)) (round (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)))) ;; step3 <Font> ;; ----------------------------------------------------------------------------------------------- (defparameter *path-font16* "C:\\WINDOWS\\Fonts\\msmincho.ttc") (defparameter *font16* (make-instance 'sdl:ttf-font-definition :size 16 :filename (sdl:create-path *path-font16*))) (defvar *menu-font*) ; menu font (defun Set-font () (setf *menu-font* (sdl:initialise-font *font16*))) ;; Step3 <Stage Class> ;; ----------------------------------------------------------------------------------------------- (define-class stage () (stage-flag stage-number title-loop start) t) ; stage-flag on-stage or not ; stage-number map change ; title-loop waiting for input-key ; start game start ;; Step3 <Start Stage Message> ;; ----------------------------------------------------------------------------------------------- (defvar *atlas*) ; map set (defvar *enemymap*) ; enemy map set (defgeneric Stage-start-message (stage)) (defmethod Stage-start-message (stage) ; stage start message "Draw stage start message and set game parameters" (when (eql (stage-flag stage) t) (setf (stage-flag stage) nil) (incf (stage-number stage) 1) (case (stage-number stage) (1 (setf *atlas* *map1* *enemymap* *enemy-map1*)) (2 (setf *atlas* *map2* *enemymap* *enemy-map2*)) (t (setf *atlas* *map3* *enemymap* *enemy-map3*))) (sdl:clear-display sdl:*black*) (sdl:draw-string-solid-* (format nil "S T A G E ~d" (stage-number stage)) 272 208 :color sdl:*white* :font *menu-font*) (sdl:update-display) (sleep 3))) ;; step 2 <Scroll> ;; ----------------------------------------------------------------------------------------------- (defvar *scroll-cnt* 0) ; scroll counter (defvar *map-pointer* 64) ; map start line (defvar *draw-position-y* 0) ; y-axis start position (defvar *repeat* nil) ; scroll repeat flag (defvar *rotation* '(0 1 2 3 4 5 6 7)) ; map rotation list (defun Rotate-map-pointer () "Move last element to front of the list" (let ((x *rotation*)) ; list rotation right (setf *rotation* (append (last x) (butlast x))))) ; --> (8 0 1 2 3 4 5 6 7) (defun Set-map-pointer () "Set map pointer" (incf *scroll-cnt* 2) ; 2 dot scroll (when (eql (mod *scroll-cnt* 64) 0) ; mapchip draw position (setf *draw-position-y* 0) (decf *map-pointer*) ; else scroll-line -1 (when (< *map-pointer* 0) ; when scroll-line is 0 (end line) (setf *repeat* t)))) ; map repeat flag on (defun Scroll-background (map) "draw background" (setf *draw-position-y* (+ -48 (mod *scroll-cnt* 64))) ; scroll start from y(-48) to y(16) (cond ((eql *repeat* nil) ; when map repeat flag off (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))))) ((eql *repeat* t) ; when map repeat flag on (when (= (mod *scroll-cnt* 64) 0) ; when 64 dot scroll (Rotate-map-pointer)) ; map rotate (dotimes (i 8) (setf *map-pointer* (nth i *rotation*)) ; read element of the list (dotimes (j 5) (sdl:draw-surface-at-* *images* (+ 160 (* j 64)) (+ *draw-position-y* (* i 64)) :cell (aref map *map-pointer* j))))))) (defun Scroll-mask () (sdl:draw-box-* 0 0 160 480 :color sdl:*black*) ; mask scroll left side (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 (sdl:draw-box-* 480 0 640 480 :color sdl:*black*)) ; mask scroll right side ;; Step4 <Game Start Message> ;; ----------------------------------------------------------------------------------------------- (defvar *screen-mode* 1) ; screen mode toggle switch 0:fullscreen 1:windowed (defvar *switch* nil) ; screen flag (defgeneric Game-start-message (pointer character stage keystate)) (defmethod Game-start-message (pointer character stage keystate) ; game start message "Draw game opening message" ; title (dotimes (i 8) ; show title (setf (x character) (+ 192 (* i 32)) (id character) (+ 19 i)) (Draw character)) ; memu (sdl:draw-string-solid-* "S T A R T" 224 328 :color sdl:*white* :font *menu-font*) ; show menu (if (= *screen-mode* 0) (sdl:draw-string-solid-* "S C R E E N : F U L L" 224 360 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* "S C R E E N : W I N D O W" 224 360 :color sdl:*white* :font *menu-font*)) (sdl:draw-string-solid-* "E X I T" 224 392 :color sdl:*white* :font *menu-font*) ; select menu (cond ((up keystate) ; select menu (decf (y pointer) 32) (setf (up keystate) nil) (when (<= (y pointer) 328) ; y:328 is START menu position (setf (y pointer) 328 (start stage) t))) ((down keystate) (incf (y pointer) 32) (setf (down keystate) nil) (when (>= (y pointer) 392) ; y:392 is EXIT menu position (setf (y pointer) 392 (start stage) nil))) ((lshift keystate) (when (= (y pointer) 360) (if (= *screen-mode* 1) ; screen-mode toggle switch (setf *screen-mode* 0) ; 0:fullscreen 1:windowed (setf *screen-mode* 1)) (setf *switch* t)) (setf (lshift keystate) nil))) ; show pointer (sdl:draw-string-solid-* ">" (x pointer) (y pointer) :color sdl:*white* :font *menu-font*) ; game start or exit (cond ((and (z keystate) (eql (start stage) t) (= (y pointer) 328)) ; input z-key on start menu (setf (title-loop stage) nil (z keystate) nil)) ; z key state reset ((and (z keystate) (eql (start stage) nil) (= (y pointer) 392)) ; input z-key on exit menu (sdl:push-quit-event))) (sdl:update-display)) ;; Step7 <Reset Variables> ;; ----------------------------------------------------------------------------------------------- (defvar *enemy-map-pointer* 64) (defgeneric Reset-variables (stage enemy-manager balloon-manager score)) (defmethod Reset-variables (stage enemy-manager balloon-manager score) "reset variables" (setf (title-loop stage) t (stage-flag stage) t *scroll-cnt* 0 *draw-position-y* 0 *map-pointer* 64 *repeat* nil *enemy-map-pointer* 64 (enemy-list enemy-manager) nil (stage-number stage) 0 (balloon-cnt balloon-manager) 0 (score score) 0 (n-ship score) 3 (n-bomb score) 3)) ;; Step4 <Game Over Message> + score ;; ----------------------------------------------------------------------------------------------- (defgeneric Game-over-message (stage enemy-manager score balloon-manager)) (defmethod Game-over-message (stage enemy-manager score balloon-manager) "Draw game ending message" (sdl:clear-display sdl:*black*) ; message (sdl:draw-string-solid-* "君の活躍によりアボガドロ軍は撤退した。" 178 64 :color sdl:*white* :font *menu-font*) ; (sdl:draw-string-solid-* "THE ABOGADRO FORCES WITHDREW BY YOUR SUCCESS" ; 150 64 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* "C O N G R A T U L A T I O N S" 208 96 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* "Y O U R S C O R E" 224 160 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* (format nil "~5,'0d" (score score)) 380 160 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* "H I G H S C O R E" 224 192 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* (format nil "~d" (highscore score)) 380 192 :color sdl:*white* :font *menu-font*) (sdl:update-display) (sleep 10) (Reset-variables stage enemy-manager balloon-manager score)) ;; Step4 <Set Screen Mode> ;; ----------------------------------------------------------------------------------------------- (defun Set-screen-mode() (when (eql *switch* t) (if (= *screen-mode* 0) ; fullscreen-mode on (sdl:resize-window 640 480 :sw t :fullscreen t) (sdl:resize-window 640 480 :sw t)) (setf *switch* nil))) ; twice executing prevent ;; step5 <Score Panel> ;; ----------------------------------------------------------------------------------------------- (defgeneric Score-panel (score score-ship score-bomb)) (defmethod Score-panel (score score-ship score-bomb) "draw score and ships of rest" (sdl:draw-string-solid-* "SCORE:" 160 16 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* "HIGH-SCORE:" 320 16 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* (format nil "~5,'0d" (score score)) 208 16 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* (format nil "~d" (highscore score)) 408 16 :color sdl:*white* :font *menu-font*) (dotimes (i (- (n-ship score) 1)) (setf (x score-ship) (+ 160 (* 16 i))) (Draw score-ship)) (dotimes (i (n-bomb score)) (setf (x score-bomb) (+ 160 (* 16 i))) (Draw score-bomb))) ;; step6 <Move Shot> ;; ----------------------------------------------------------------------------------------------- (defgeneric Move-shot (shot-manager)) (defmethod Move-shot (shot-manager) "shot move" (dolist (shot (shot-list shot-manager)) (when (= (state shot) 1) ; shot is alive (decf (y shot) (dy shot))) ; shot 16 dot up (when (< (y shot) -16) ; out of screen (setf (state shot) 0)))) ; shote is dead ;; step6 <Set Shot> + Balloon Shot ;; ----------------------------------------------------------------------------------------------- (defgeneric Set-shot (shot-manager ship keystate balloon-manager)) (defmethod Set-shot (shot-manager ship keystate balloon-manager) "set shot" (when (and (/= (state ship) 2) ; if ship is not explode (eql (mod *scroll-cnt* 8) 0) ; 1 shot / 8 loop (eql (z keystate) t)) ; and set z key (when (< (length (shot-list shot-manager)) (* 4 (+ (balloon-cnt balloon-manager) 1))) (Play-sample *shot*) (let ((shot (make-instance 'entity :id 3 :width 4 :height 16 :dx 0 :dy 16 :state 1))) (setf (y shot) (- (y ship) (height shot)) ; set shot position (x shot) (+ (x ship) 14)) (push shot (shot-list shot-manager))) (when (/= (balloon-cnt balloon-manager) 0) (dolist (balloon (balloon-list balloon-manager)) (let ((shot (make-instance 'entity :id 3 :width 4 :height 16 :dx 0 :dy 16 :state 1))) (setf (y shot) (- (y balloon) (height shot)); set balloon shot position (x shot) (+ (x balloon) 14)) (push shot (shot-list shot-manager)))))))) ;; step6 <Remove Dead Shot> ;; ----------------------------------------------------------------------------------------------- (defgeneric Remove-dead-shot (shot-manager)) (defmethod Remove-dead-shot (shot-manager) "dead shot remove from list" (setf (shot-list shot-manager) (delete-if #'(lambda (shot) (= (state shot) 0)) (shot-list shot-manager)))) ;; step6 <Draw Shot> ;; ----------------------------------------------------------------------------------------------- (defgeneric Draw-shot (shot-manager)) (defmethod Draw-shot (shot-manager) (dolist (shot (shot-list shot-manager)) (when (= (state shot) 1) (Draw shot)))) ; draw shot ;; step7 <Generate Enemy> + Enemy Shot ;; ----------------------------------------------------------------------------------------------- (defgeneric Generate-enemy-item (map enemy-manager item-manager)) (defmethod Generate-enemy-item (map enemy-manager item-manager) (when (and (= (mod *scroll-cnt* 64) 0) (<= (length (enemy-list enemy-manager)) 10)); max 10 enemy (dotimes (j 10) (when (/= (aref map *enemy-map-pointer* j) -1) (case (aref map *enemy-map-pointer* j) ((7 50 80) ; when id is 7 or 50 or 80 (let ((enemy (make-instance 'foe ; small class enemy generate :id (aref map *enemy-map-pointer* j) :x (+ 160 (* j 32)) :y 0 :width 32 :height 32 :life-cnt 3 :kind 1 :state 1))) (push enemy (enemy-list enemy-manager)))) ((76 78) ; when id is 76 or 78 (let ((enemy (make-instance 'foe ; middle class enemy generate :id (aref map *enemy-map-pointer* j) :x (+ 160 (* j 32)) :y 0 :width 64 :height 64 :life-cnt 20 :kind 2 :state 1))) (push enemy (enemy-list enemy-manager)))) ((70 71 72) ; when id is 70 or 71 or 72 (let ((enemy (make-instance 'foe ; large class enemy generate :id (aref map *enemy-map-pointer* j) :x (+ 160 (* j 32)) :y 0 :width 96 :height 96 :life-cnt 300 :kind 3 :state 1))) (push enemy (enemy-list enemy-manager)))) ((17 18) ; when id is 17 or 18 (let ((enemy (make-instance 'foe ; item generate :id (aref map *enemy-map-pointer* j) :x (+ 160 (* j 32)) :y 0 :width 32 :height 32 :dx 0 :dy 2 :kind 4 :state 1))) (push enemy (item-list item-manager))))))) ; store items into item-list (when (/= *enemy-map-pointer* 0) (decf *enemy-map-pointer*)))) ; *enemy-map-pointer* 64 -> 0 (end position) ;; step7 <Judge Stage End> ;; ----------------------------------------------------------------------------------------------- (defgeneric Judge-stage-end (stage enemy-manager score balloon-manager)) (defmethod Judge-stage-end (stage enemy-manager score balloon-manager) (dolist (enemy (enemy-list enemy-manager)) (when (and (= (kind enemy) 3) ; large class enemy (= (state enemy) 0)) ; this enemy is dead (case (stage-number stage) ((1 2) ; 1 or 2 stage (setf (stage-flag stage) t *repeat* nil *map-pointer* 64 *enemy-map-pointer* 64 ; map and enemy-map set start position (enemy-list enemy-manager) nil)) ((3) ; 3rd stage (setf *repeat* nil *map-pointer* 64 *enemy-map-pointer* 64 (enemy-list enemy-manager) nil) (Game-over-message stage enemy-manager score balloon-manager)))))) ;; step7 <Move Enemy> ;; ----------------------------------------------------------------------------------------------- (defgeneric Move-enemy (enemy-manager game-field)) (defmethod Move-enemy (enemy-manager game-field) (dolist (enemy (enemy-list enemy-manager)) (when (or (= (state enemy) 1) (= (state enemy) 2)) (case (id enemy) ((7 8 9 14 15 16 80 81 82 83 84 85) ; id 7 8 9(yellow enemy) or id 80 81 82(purple enemy) (let((row (mod (move-cnt enemy) 16))) ; row from 0 to 15 (case (id enemy) ((7 8 9 14 15 16) ; id 7 8 9(yellow enemy) (setf (dx enemy) (aref *enemy-move-pattern1* row 0) (dy enemy) (aref *enemy-move-pattern1* row 1))) ((80 81 82 83 84 85) ; id 80 81 82(purple enemy) (setf (dx enemy) (aref *enemy-move-pattern3* row 0) (dy enemy) (aref *enemy-move-pattern3* row 1)))))) ((50 52 51 53) ; id 50 52(blue enemy) (let((row (mod (move-cnt enemy) 12))) ; row from 0 to 11 (setf (dx enemy) (aref *enemy-move-pattern2* row 0) (dy enemy) (aref *enemy-move-pattern2* row 1)))) ((76 78 77 79) ; id 76 78(middle class enemy) (if (or (= (id enemy) 76) (= (id enemy) 77)) (setf (dx enemy) (first *enemy-move-pattern4*) (dy enemy) (second *enemy-move-pattern4*)) (setf (dx enemy) (first *enemy-move-pattern5*) (dy enemy) (second *enemy-move-pattern5*)))) ((70 71 73 74) ; id 70 71(large class enemy) (let((row (mod (move-cnt enemy) 32))) ; row from 0 to 31 (if (or (= (id enemy) 70) (= (id enemy) 73)) (setf (dx enemy) (aref *enemy-move-pattern6* row 0) (dy enemy) (aref *enemy-move-pattern6* row 1)) (setf (dx enemy) (aref *enemy-move-pattern7* row 0) (dy enemy) (aref *enemy-move-pattern7* row 1))))) ((72 75) ; id 72(large class enemy) (setf (dx enemy) (first *enemy-move-pattern8*) (dy enemy) (second *enemy-move-pattern8*)))) (incf (x enemy) (dx enemy)) (incf (y enemy) (dy enemy)) (incf (move-cnt enemy) 1) (when (or (>= (y enemy) (height game-field)) ; bottom of game field (>= (x enemy) (width game-field)) ; right of game field (<= (x enemy) (- (field-x game-field) (* 32 (kind enemy))))) ; left of game field (setf (state enemy) 0))))) ;; step10 <Set Reset Id> ;; ----------------------------------------------------------------------------------------------- (defun Set-id (enemy) "Set enemy id" (case (id enemy) (7 (setf (id enemy) 14)) (8 (setf (id enemy) 15)) (9 (setf (id enemy) 16)) (50 (setf (id enemy) 51)) (52 (setf (id enemy) 53)) (80 (setf (id enemy) 83)) (81 (setf (id enemy) 84)) (82 (setf (id enemy) 85)) (76 (setf (id enemy) 77)) (78 (setf (id enemy) 79)) (70 (setf (id enemy) 73)) (71 (setf (id enemy) 74)) (72 (setf (id enemy) 75)))) (defun Reset-id (enemy) "Reset enemy id" (case (id enemy) (14 (setf (id enemy) 7)) (15 (setf (id enemy) 8)) (16 (setf (id enemy) 9)) (51 (setf (id enemy) 50)) (53 (setf (id enemy) 52)) (83 (setf (id enemy) 80)) (84 (setf (id enemy) 81)) (85 (setf (id enemy) 82)) (77 (setf (id enemy) 76)) (79 (setf (id enemy) 78)) (73 (setf (id enemy) 70)) (74 (setf (id enemy) 71)) (75 (setf (id enemy) 72)))) ;; step7 <Change Id> + explode ;; ----------------------------------------------------------------------------------------------- (defun Change-id (enemy) (when (= (state enemy) 1) (Reset-id enemy) (case (id enemy) ((7 8 9) (case (mod (floor (move-cnt enemy) 16) 4) ; enemy id change (0 (setf (id enemy) 7)) ; change pattern --> 0~~0, 1~~1, 2~~2 , 3~~3 (1 (setf (id enemy) 8)) ; id7 , id8 , id9 , id8 (2 (setf (id enemy) 9)) (3 (setf (id enemy) 8)))) ((50 52) (case (mod (floor (move-cnt enemy) 16) 2) ; enemy id change (0 (setf (id enemy) 50)) ; change pattern --> 0~~0, 1~~1 (1 (setf (id enemy) 52)))) ; id50 , id52 ((80 81 82) (case (mod (floor (move-cnt enemy) 16) 4) ; enemy id change (0 (setf (id enemy) 80)) ; change pattern --> 0~~0, 1~~1 , 2~~2 , 3~~3 (1 (setf (id enemy) 81)) ; id80 ,id81 , id82 , id81 (2 (setf (id enemy) 82)) (3 (setf (id enemy) 81))))))) ;; step10 <Change Damaged Id> ;; ----------------------------------------------------------------------------------------------- (defun Change-damaged-id (enemy) (when (= (state enemy) 2) (Set-id enemy) (case (id enemy) ((14 15 16) (case (mod (floor (move-cnt enemy) 16) 4) ; enemy id change (0 (setf (id enemy) 14)) ; change pattern --> 0~~0, 1~~1 , 2~~2 , 3~~3 (1 (setf (id enemy) 15)) ; id14 ,id15 , id16 ,id15 (2 (setf (id enemy) 16)) (3 (setf (id enemy) 15)))) ((51 53) (case (mod (floor (move-cnt enemy) 16) 2) ; enemy id change (0 (setf (id enemy) 51)) ; change pattern --> 0~~0, 1~~1 (1 (setf (id enemy) 53)))) ; id51 , id53 ((83 84 85) (case (mod (floor (move-cnt enemy) 16) 4) ; enemy id change (0 (setf (id enemy) 83)) ; change pattern --> 0~~0, 1~~1 , 2~~2 , 3~~3 (1 (setf (id enemy) 84)) ; id83 ,id84 , id85 , id84 (2 (setf (id enemy) 85)) (3 (setf (id enemy) 84))))))) ;; step7 <Remove Enemy> ;; ----------------------------------------------------------------------------------------------- (defgeneric Remove-enemy (enemy-manager)) (defmethod Remove-enemy (enemy-manager) (setf (enemy-list enemy-manager) (delete-if #'(lambda (enemy) (= (state enemy) 0)) (enemy-list enemy-manager)))) ;; step7 <Draw Enemy> + damage ;; ----------------------------------------------------------------------------------------------- (defgeneric Draw-enemy (enemy-manager)) (defmethod Draw-enemy (enemy-manager) (dolist (enemy (enemy-list enemy-manager)) (Change-id enemy) (Change-damaged-id enemy) (when (or (= (state enemy) 1) (= (state enemy) 2)) (Draw enemy)))) ;; step8 <Move Balloon> ;; ----------------------------------------------------------------------------------------------- (defun degree-radian (degree) ; convert from radian to degree (/ (* degree pi) 180)) ; degree -> radian (defvar *angle* 0) (defgeneric Move-balloon (balloon-manager ship)) (defmethod Move-balloon (balloon-manager ship) (when (or (= (state ship) 1) (= (state ship) 3)) (when (> *angle* 360) (setf *angle* 0)) (incf *angle* 4) (when (<= *angle* 360) (let ((i (balloon-cnt balloon-manager))) (dolist (balloon (balloon-list balloon-manager)) (if (= i 2) ; 48 is distance from left balloon to right balloon (setf (x balloon) (+ (x ship) (* (cos (degree-radian *angle*)) 48)) (y balloon) (+ (y ship) (* (sin (degree-radian *angle*)) 48))) (setf (x balloon) (- (x ship) (* (cos (degree-radian *angle*)) 48)) (y balloon) (- (y ship) (* (sin (degree-radian *angle*)) 48)))) (decf i 1)))))) ;; Step8 <Generate Balloon> ;; ----------------------------------------------------------------------------------------------- (defgeneric Generate-balloon (balloon-manager ship)) (defmethod Generate-balloon (balloon-manager ship) "balloon appear position set" (when (and (/= (balloon-cnt balloon-manager) 0) (< (length (balloon-list balloon-manager)) 2)) ; max 2 balloon (dotimes (i (balloon-cnt balloon-manager)) (let ((balloon (make-instance 'entity :id 10 :state 1))) (if (= i 0) (setf (x balloon) (- (x ship) 48)) (setf (x balloon) (+ (x ship) 48))) (setf (y balloon) (y ship)) (push balloon (balloon-list balloon-manager)))))) ;; step8 <Draw Balloon> ;; ----------------------------------------------------------------------------------------------- (defgeneric Draw-balloon (balloon-manager ship)) (defmethod Draw-balloon (balloon-manager ship) (when (and (or (/= (state ship) 1) (state ship) 3) (/= (balloon-cnt balloon-manager) 0)) (dolist (balloon (balloon-list balloon-manager)) (Draw balloon)))) ;; Step8 <Move Item> ;; ----------------------------------------------------------------------------------------------- (defgeneric Move-item (item-manager game-field)) (defmethod Move-item (item-manager game-field) "item move" (dolist (item (item-list item-manager)) (when (= (state item) 1) ; option-item is alive (incf (y item) (dy item))) ; option-item 16 dot down (when (> (y item) (height game-field)) ; out of screen (setf (state item) 0)))) ;; Step8 <Remove Item> ;; ----------------------------------------------------------------------------------------------- (defgeneric Remove-item (item-manager)) (defmethod Remove-item (item-manager) "item remove from list" (setf (item-list item-manager) (delete-if #'(lambda (item) (= (state item) 0)) (item-list item-manager)))) ;; Step8 <Hit Item> ;; ----------------------------------------------------------------------------------------------- (defvar *itemget-flag* nil) (defgeneric Hit-item-p (item-manager balloon-manager score ship)) (defmethod Hit-item-p (item-manager balloon-manager score ship) (when (/= (state ship) 2) (dolist (item (item-list item-manager)) (when(and (> (+ (x ship) 32) (x item)) (< (x ship) (+ (x item) 32)) (> (+ (y ship) 32) (y item)) (< (y ship) (+ (y item) 32))) (setf (state item) 0) ; item is disappered (when (eql *itemget-flag* nil) (setf *itemget-flag* t)) (when (= (id item) 17) (if (< (balloon-cnt balloon-manager) 2) (incf (balloon-cnt balloon-manager) 1) (incf (score score) 500))) (when (= (id item) 18) (incf (n-bomb score) 1)) (setf *itemget-flag* nil))))) ;; step8 <Draw Item> ;; ----------------------------------------------------------------------------------------------- (defgeneric Draw-item (item-manager)) (defmethod Draw-item (item-manager) (dolist (item (item-list item-manager)) (Draw item))) ;; Step9 <Move Enemy Shot> ;; ----------------------------------------------------------------------------------------------- (defgeneric Move-enemy-shot (enemy-manager game-field)) (defmethod Move-enemy-shot (enemy-manager game-field) "enemy shot move" (dolist (enemy-shot (enemy-shot-list enemy-manager)) (when (= (state enemy-shot) 1) ; set enemy-shot state alive (incf (x enemy-shot) (dx enemy-shot)) (incf (y enemy-shot) (dy enemy-shot)) (when (or (< (x enemy-shot) (- (field-x game-field) 8)) (> (x enemy-shot) (width game-field)) (< (y enemy-shot) (- (field-y game-field) 8)) (> (y enemy-shot) (height game-field))) (setf (state enemy-shot) 0))))) ;; Step9 <Set Enemy Shot> ;; ----------------------------------------------------------------------------------------------- (defvar *range-x*) (defvar *range-y*) (defvar *distance*) (defparameter *enemy-shot-max* 10) (defgeneric Set-enemy-shot (enemy-manager ship game-field)) (defmethod Set-enemy-shot (enemy-manager ship game-field) "enemy shot appear position set and move" (dolist (enemy (enemy-list enemy-manager)) (when (and (= (state enemy) 1) (>= (x enemy) 0) (< (x enemy) (- (width game-field) (width enemy))) ; 32 or 64 or 96 (>= (y enemy) 0) (< (y enemy) (- (height game-field) (width enemy))) ; 32 or 64 or 96 (= (mod (move-cnt enemy) 64) 0)) (when (< (length (enemy-shot-list enemy-manager)) *enemy-shot-max*) (let ((enemy-shot (make-instance 'entity :id 4 :width 8 :height 8 :dx 0 :dy 6 :state 0))) (push enemy-shot (enemy-shot-list enemy-manager)))) (dolist (enemy-shot (enemy-shot-list enemy-manager)) (when (= (state enemy-shot) 0) (case (kind enemy) ((1) (setf (y enemy-shot) (+ (y enemy) 12)) ; center of small class enemy x (setf (x enemy-shot) (+ (x enemy) 12))) ; center of small class enemy y ((2) (setf (y enemy-shot) (+ (y enemy) 28)) ; center of middle class enemy x (setf (x enemy-shot) (+ (x enemy) 28))) ; center of middle class enemy y ((3) (setf (y enemy-shot) (+ (y enemy) 44)) ; center of large class enemy x (setf (x enemy-shot) (+ (x enemy) 44)))) ; center of large class enemy y (let ((ship-x (+ (x ship) (/ (width ship) 2))) (ship-y (+ (y ship) (/ (height ship) 2))) (ene-shot-x (+ (x enemy-shot) (/ (width enemy-shot) 2))) (ene-shot-y (+ (y enemy-shot) (/ (height enemy-shot) 2)))) (setf *range-x* (- ship-x ene-shot-x)) (setf *range-y* (- ship-y ene-shot-y)) (setf *distance* (sqrt (+ (* *range-x* *range-x*) (* *range-y* *range-y*)))) (setf (dx enemy-shot) (* (/ *range-x* *distance*) 6)) (setf (dy enemy-shot) (* (/ *range-y* *distance*) 6))) (setf (state enemy-shot) 1)))))) ;; Step9 <Remove Dead Enemy Shot> ;; ----------------------------------------------------------------------------------------------- (defgeneric Remove-dead-enemy-shot (enemy-manager)) (defmethod Remove-dead-enemy-shot (enemy-manager) "dead enemy shot remove from list" (setf (enemy-shot-list enemy-manager) (delete-if #'(lambda (enemy-shot) (= (state enemy-shot) 0)) (enemy-shot-list enemy-manager)))) ;; Step9 <DrawEnemy Shot> ;; ----------------------------------------------------------------------------------------------- (defgeneric Draw-enemy-shot (enemy-manager)) (defmethod Draw-enemy-shot (enemy-manager) (dolist (enemy-shot (enemy-shot-list enemy-manager)) (when (= (state enemy-shot) 1) (Draw enemy-shot)))) ;; Step10 <Enemy Hit P> ;; ----------------------------------------------------------------------------------------------- (defvar *oneup-flag* nil) (defgeneric Enemy-hit-p (shot-manager enemy-manager)) (defmethod Enemy-hit-p (shot-manager enemy-manager) (dolist (shot (shot-list shot-manager)) (when (= (state shot) 1) ; if shot is on (dolist (enemy (enemy-list enemy-manager)) (when (and (or (= (state enemy) 1) ; if enemy is alive (= (state enemy) 2)) ; or enemy is damaged (> (+ (x shot) 4) (x enemy)) (< (x shot) (+ (x enemy) 32)) (> (+ (y shot) 16) (y enemy)) (< (y shot) (+ (y enemy) 32))) (setf (state enemy) 2 ; enemy is damaged (damage-cnt enemy) 0 ; damage counter on (state shot) 0) ; shot is off (when (> (life-cnt enemy) 0) (decf (life-cnt enemy) 1))))))) ;; Step10 <Score Up> ;; ----------------------------------------------------------------------------------------------- (defgeneric Score-up (score)) (defmethod Score-up (score) (when (> (score score) (highscore score)) (setf (highscore score) (score score))) (when (>= (score score) (oneup score)) (when (eql *oneup-flag* nil) (setf *oneup-flag* t) ; oneup sound on (Play-sample *oneup*)) ; oneup sound (incf (n-ship score) 1) ; plus one ship (setf (oneup score) (+ (oneup score) 100000) *oneup-flag* nil))) ; oneup sound off ;; Step10 <Damage Counter> ;; ----------------------------------------------------------------------------------------------- (defvar *damage-flag* nil) (defgeneric Damage-counter (enemy-manager score)) (defmethod Damage-counter (enemy-manager score) (dolist (enemy (enemy-list enemy-manager)) (when (= (state enemy) 2) ; if enemy is damaged (incf (damage-cnt enemy) 1) ; damage-cnt is 3 times loop (from 0 to 3) (when (eql *damage-flag* nil) (setf *damage-flag* t) ; damage sound on (Play-sample *damage*)) ; damage sound (when (= (damage-cnt enemy) 3) (decf (life-cnt enemy) 1) ; life-cnt is 3 times loop (form 3 to 0) (setf (damage-cnt enemy) 0 ; enemy's damage-cnt reset 0 (state enemy) 1 *damage-flag* nil)) ; damage sound off (when (= (life-cnt enemy) 0) (case (kind enemy) ((1) (incf (score score) 200)) ; small class enemy 200 point ((2) (incf (score score) 10000)) ; middle class enemy 10000 point ((3) (incf (score score) 30000))) ; large class enemy 30000 point (setf (state enemy) 3))))) ; enemy explode ;; Step10 <Explode Enemy> ;; ----------------------------------------------------------------------------------------------- (defvar *explodes-flag* nil) (defgeneric Explode-enemy (enemy-manager)) (defmethod Explode-enemy (enemy-manager) "enemy explosion while 16 times loop" (dolist (enemy (enemy-list enemy-manager)) (when (= (state enemy) 3) (incf (explode-cnt enemy) 1) (when (eql *explodes-flag* nil) (setf *explodes-flag* t) ; explode sound on (Play-sample *explodes*)) ; explode sound (when (= (explode-cnt enemy) 15) ; enemy explode count 15 (setf (state enemy) 0 *explodes-flag* nil))))) ; explode sound off ;; Step10 <Draw Enemy Explosion> ;; ----------------------------------------------------------------------------------------------- (defgeneric Draw-enemy-explosion (enemy-explosion enemy-manager)) (defmethod Draw-enemy-explosion (enemy-explosion enemy-manager) (dolist (enemy (enemy-list enemy-manager)) (when (= (state enemy) 3) (setf (x enemy-explosion) (x enemy) (y enemy-explosion) (y enemy)) (cond ((and (>= (explode-cnt enemy) 0) (< (explode-cnt enemy) 5)) (case (kind enemy) ((1) (setf (id enemy-explosion) 11)) ; bomb id 11 ((2 3) (setf (id enemy-explosion) 64)))) ; bomb id 64 ((and (>= (explode-cnt enemy) 5) (< (explode-cnt enemy) 10)) (case (kind enemy) ((1) (setf (id enemy-explosion) 12)) ; bomb id 12 ((2 3) (setf (id enemy-explosion) 65)))) ; bomb id 65 ((and (>= (explode-cnt enemy) 10) (< (explode-cnt enemy) 15)) (case (kind enemy) ((1) (setf (id enemy-explosion) 13)) ; bomb id 13 ((2 3) (setf (id enemy-explosion) 66))))) ; bomb id 66 (Draw enemy-explosion)))) ;; 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 ; <Set Font> (Set-font) ; set font ; <Audio> (Open-sound) ; sound open ; <Set 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)) (stage (make-instance 'stage :stage-number (or nil 0) :title-loop t)) (character (make-instance 'object :id 19 :y 100)) (pointer (make-instance 'object :x 208 :y 328)) (score (make-instance 'score :highscore 50000 :oneup 50000 :n-ship 3 :n-bomb 3)) (score-ship (make-instance 'object :id 5 :x 160 :y 48)) (score-bomb (make-instance 'object :id 6 :x 160 :y 448)) (shot-manager (make-instance 'shot-manager)) (enemy-manager (make-instance 'enemy-manager)) (balloon-manager (make-instance 'balloon-manager :balloon-cnt (or nil 0))) (item-manager (make-instance 'item-manager)) (enemy-explosion (make-instance 'object :id 11))) (sdl:with-events (:poll) (:quit-event () (setf *screen-mode* 1 *switch* nil) (Reset-variables stage enemy-manager balloon-manager score) 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 () ;<Title Loop> (when (eql (title-loop stage) t) ; title loop (sdl:clear-display sdl:*black*) (Game-start-message pointer character stage keystate)) ; <Game Loop> (when (eql (title-loop stage) nil) ; game loop ; <Set Screen Mode> (Set-screen-mode) ; <Clear Display> (sdl:clear-display sdl:*black*) ; <Show Message> (Stage-start-message stage) ; <Draw Map> (Scroll-background *atlas*) ; <Move Ship> (Move-ship ship keystate) ; <Fix Ship Position> (Fix-ship-position ship game-field) ; <Shot :Move Set Draw Delete> (Move-shot shot-manager) (Set-shot shot-manager ship keystate balloon-manager) (when (= (state ship) 1) (Draw ship)) ; draw ship (Draw-shot shot-manager) (Remove-dead-shot shot-manager) ; <Enemy :Move Generate Draw Remove> (Move-enemy enemy-manager game-field) (Generate-enemy-item *enemymap* enemy-manager item-manager) (Draw-enemy enemy-manager) (Remove-enemy enemy-manager) ; <Balloon :Move Set Draw> (Move-balloon balloon-manager ship) (Generate-balloon balloon-manager ship) (Draw-balloon balloon-manager ship) ; <Item : Move Draw Remove Hit> (Move-item item-manager game-field) (Draw-item item-manager) (Remove-item item-manager) (hit-item-p item-manager balloon-manager score ship) ; <Enemy-shot :Move Set Draw Remove> (Move-enemy-shot enemy-manager game-field) (Set-enemy-shot enemy-manager ship game-field) (Draw-enemy-shot enemy-manager) ; draw enemy shot (Remove-dead-enemy-shot enemy-manager) ; <Enemy-hit-p :Damage Draw Explode> (Enemy-hit-p shot-manager enemy-manager) (Damage-counter enemy-manager score) (Explode-enemy enemy-manager) (Draw-enemy-explosion enemy-explosion enemy-manager) (Score-up score) ; <Upper and Lower Window Mask> (Scroll-mask) ; <Draw Score Panel> (Score-panel score score-ship score-bomb) ; <Set Map Pinter> (Set-map-pointer) ; set map draw point ; <Judge Stage End> (Judge-stage-end stage enemy-manager score balloon-manager) (sdl:update-display))))))) (common-abogadro)
Lisp Game Programming 2 <Stage 10-1 Audio>
そろそろサウンドのプログラムを組み込んでおかないと、後から追加するのは面倒っぽいので、ゲームで使うサウンドを組み込むこととする。
Lisp Game Programmingで作ったプログラムをパッケージ化して流用。
audio-list.lisp⇒
(defpackage :audio-list (:use :common-lisp) (:export #:Open-sound #:Stop-sound #:Close-sound #:Play-music #:Play-music-once #:Play-sample #:*explodes* #:*explodem* #:*damage* #:*crushed* #:*itemget* #:*oneup* #:*bomb* #:*shot* #:*samplebgm1* #:*samplebgm2* #:*samplebgm3* #:*bossbgm* #:*endbgm*)) (in-package :audio-list) ;; step2 <Audio> ;; ----------------------------------------------------------------------------------------------- (defparameter *path-explodes-sound* "C:\\work\\sound\\explodes.wav") (defparameter *path-explodem-sound* "C:\\work\\sound\\explodem.wav") (defparameter *path-damage-sound* "C:\\work\\sound\\damage.wav") (defparameter *path-crushed-sound* "C:\\work\\sound\\crushed.wav") (defparameter *path-itemget-sound* "C:\\work\\sound\\itemget.wav") (defparameter *path-oneup-sound* "C:\\work\\sound\\oneup.wav") (defparameter *path-bomb-sound* "C:\\work\\sound\\bomb.wav") (defparameter *path-shot-sound* "C:\\work\\sound\\shot.wav") (defparameter *path-samplebgm1* "C:\\work\\sound\\samplebgm1.ogg") (defparameter *path-samplebgm2* "C:\\work\\sound\\samplebgm2.ogg") (defparameter *path-samplebgm3* "C:\\work\\sound\\samplebgm3.ogg") (defparameter *path-bossbgm* "C:\\work\\sound\\bossbgm.ogg") (defparameter *path-endbgm* "C:\\work\\sound\\endbgm.ogg") (defvar *explodes*) ; explodes sound (defvar *explodem*) ; explodem sound (defvar *damage*) ; damage sound (defvar *crushed*) ; crushed sound (defvar *itemget*) ; itemget sound (defvar *oneup*) ; oneup sound (defvar *bomb*) ; bomb sound (defvar *shot*) ; shot sound (defvar *samplebgm1*) ; BGM1 (defvar *samplebgm2*) ; BGM2 (defvar *samplebgm3*) ; BGM3 (defvar *bossbgm*) ; boss BGM (defvar *endbgm*) ; ending BGM (defun Open-sound () "load sound data and set" (sdl-mixer:open-audio :chunksize 1024 :channels 2) (sdl-mixer:allocate-channels 16) (setf *explodes* (sdl-mixer:load-sample *path-explodes-sound*) *explodem* (sdl-mixer:load-sample *path-explodem-sound*) *damage* (sdl-mixer:load-sample *path-damage-sound*) *crushed* (sdl-mixer:load-sample *path-crushed-sound*) *itemget* (sdl-mixer:load-sample *path-itemget-sound*) *oneup* (sdl-mixer:load-sample *path-oneup-sound*) *bomb* (sdl-mixer:load-sample *path-bomb-sound*) *shot* (sdl-mixer:load-sample *path-shot-sound*) *samplebgm1* (sdl-mixer:load-music *path-samplebgm1*) *samplebgm2* (sdl-mixer:load-music *path-samplebgm2*) *samplebgm3* (sdl-mixer:load-music *path-samplebgm3*) *bossbgm* (sdl-mixer:load-music *path-bossbgm*) *endbgm* (sdl-mixer:load-music *path-endbgm*))) (defun Stop-sound () "sound stop" (when (sdl-mixer:music-playing-p) (sdl-mixer:halt-music)) ; BGM stop (when (sdl-mixer:sample-playing-p nil) (sdl-mixer:halt-sample))) ; Shot,Bomb,etc soud stop (defun Close-sound () "close sound file" (sdl-mixer:free *explodes*) (sdl-mixer:free *explodem*) (sdl-mixer:free *damage*) (sdl-mixer:free *crushed*) (sdl-mixer:free *itemget*) (sdl-mixer:free *oneup*) (sdl-mixer:free *bomb*) (sdl-mixer:free *shot*) (sdl-mixer:free *samplebgm1*) (sdl-mixer:free *samplebgm2*) (sdl-mixer:free *samplebgm3*) (sdl-mixer:free *bossbgm*) (sdl-mixer:free *endbgm*) (sdl-mixer:close-audio)) (defun Play-music-once (music) "play music once" (sdl-mixer:play-music music)) ; BGM play once (defun Play-music (music) "play music loop" (sdl-mixer:play-music music :loop t :position 0)) ; BGM play loop (defun Play-sample (sample) "play sample" (sdl-mixer:play-sample sample)) ; shot sound etc
プログラムの最初のほうで、audio-list.lispを読み込み、Define Packageに:audio-listを追加して、利用できる環境を整える。
;; step10 <Audio> ;; ----------------------------------------------------------------------------------------------- (load "C:\\work\\audio-list.lisp") ;; step1 <Define Package> + audio ;; ----------------------------------------------------------------------------------------------- (defpackage :game (:use :common-lisp :lispbuilder-sdl :sprite-sheets :map-list :enemy-map-list :move-pattern :audio-list) (:nicknames :shooting) (:export #:Common-abogadro)) (in-package :game)
H27.10.10追記
MIDIデータを使用してみるとゲームの途中でMIDIのBGMを切り替える際にゲームがフリーズするため、OGGに変更した。
MP3でも実験したが、ゲームが突然止まるため、現状ではOGG一択の状況。
但し、OGGでもBGMを開始する時最初に雑音が入るが、まあまあ我慢できる範囲なので、OGGで行くことにした。
ちなみに、参考にしているサイトのHSPで作成されたプログラムを実行してみたら、やはりMIDIのBGMがゲーム途中で切り替わる時に１～２秒程度フリーズ状態になる。
ボスキャラが登場する際にそれまで演奏していたBGMを切り替える予定なので、これは致命的。
なので、samplebgm1.midファイル等は変換ソフトを利用して.oggに変更することとした次第。
windowsXPと7では、この点に大きな違いがあることが改めて分かった。
H27.10.19追記
MIDIからOGGに変更し、更にボスキャラ登場時のBGMを記載していなかったため、掲載したプログラムを入れ替えた。
参考にしているサイトでは、一部がリンク切れになっているため、ボスキャラ登場時のBGM等を利用できなくなっている。
このため、どこからかBGMファイルを調達する必要がある。
Lisp Game Programming 2 <Stage 9>
前回ではオプションを取ると自分の周りをバルーンが回るように設定したが、敵も弾をださないとつまらないので以下のプログラムを作ってみた。
敵が発射する弾は１方向のみだが、自分の移動先をめがけて撃ってくる。
これを実現するために、Lispのsqrt関数を使用した。
ab-stage9.lispの一部 ⇒
Move-enemy-shotは、敵の弾を移動させ、ゲームフィールドの外に全部（8dot）出たらenemy-shotのstateを0（dead）にするためのもの
;; Step9 <Move Enemy Shot> ;; ----------------------------------------------------------------------------------------------- (defgeneric Move-enemy-shot (enemy-manager game-field)) (defmethod Move-enemy-shot (enemy-manager game-field) "enemy shot move" (dolist (enemy-shot (enemy-shot-list enemy-manager)) (when (= (state enemy-shot) 1) ; set enemy-shot state alive (incf (x enemy-shot) (dx enemy-shot)) (incf (y enemy-shot) (dy enemy-shot)) (when (or (< (x enemy-shot) (- (field-x game-field) 8)) (> (x enemy-shot) (width game-field)) (< (y enemy-shot) (- (field-y game-field) 8)) (> (y enemy-shot) (height game-field))) (setf (state enemy-shot) 0)))))
Set-enemy-shotは、enemyがゲームフィールド内にいるときで、かつ64回分移動したときに弾を３つの大きさ敵の中心部から
自分に向けて発射するためのもの
;; Step9 <Set Enemy Shot> ;; ----------------------------------------------------------------------------------------------- (defvar *range-x*) (defvar *range-y*) (defvar *distance*) (defparameter *enemy-shot-max* 10) (defgeneric Set-enemy-shot (enemy-manager ship game-field)) (defmethod Set-enemy-shot (enemy-manager ship game-field) "enemy shot appear position set and move" (dolist (enemy (enemy-list enemy-manager)) (when (and (= (state enemy) 1) (>= (x enemy) 0) (< (x enemy) (- (width game-field) (width enemy))) ; 32 or 64 or 96 (>= (y enemy) 0) (< (y enemy) (- (height game-field) (width enemy))) ; 32 or 64 or 96 (= (mod (move-cnt enemy) 64) 0)) (when (< (length (enemy-shot-list enemy-manager)) *enemy-shot-max*) (let ((enemy-shot (make-instance 'entity :id 4 :width 8 :height 8 :dx 0 :dy 6 :state 0))) (push enemy-shot (enemy-shot-list enemy-manager)))) (dolist (enemy-shot (enemy-shot-list enemy-manager)) (when (= (state enemy-shot) 0) (case (kind enemy) ((1) (setf (y enemy-shot) (+ (y enemy) 12)) ; center of small class enemy x (setf (x enemy-shot) (+ (x enemy) 12))) ; center of small class enemy y ((2) (setf (y enemy-shot) (+ (y enemy) 28)) ; center of middle class enemy x (setf (x enemy-shot) (+ (x enemy) 28))) ; center of middle class enemy y ((3) (setf (y enemy-shot) (+ (y enemy) 44)) ; center of large class enemy x (setf (x enemy-shot) (+ (x enemy) 44)))) ; center of large class enemy y (let ((ship-x (+ (x ship) (/ (width ship) 2))) (ship-y (+ (y ship) (/ (height ship) 2))) (ene-shot-x (+ (x enemy-shot) (/ (width enemy-shot) 2))) (ene-shot-y (+ (y enemy-shot) (/ (height enemy-shot) 2)))) (setf *range-x* (- ship-x ene-shot-x)) (setf *range-y* (- ship-y ene-shot-y)) (setf *distance* (sqrt (+ (* *range-x* *range-x*) (* *range-y* *range-y*)))) (setf (dx enemy-shot) (floor (* (/ *range-x* *distance*) 6))) (setf (dy enemy-shot) (floor (* (/ *range-y* *distance*) 6)))) (setf (state enemy-shot) 1))))))
Remove-dead-enemy-shotは、敵の弾のstateが0（dead）のものをdeleteするもの
;; Step9 <Remove Dead Enemy Shot> ;; ----------------------------------------------------------------------------------------------- (defgeneric Remove-dead-enemy-shot (enemy-manager)) (defmethod Remove-dead-enemy-shot (enemy-manager) "dead enemy shot remove from list" (setf (enemy-shot-list enemy-manager) (delete-if #'(lambda (enemy-shot) (= (state enemy-shot) 0)) (enemy-shot-list enemy-manager))))
Draw-enemy-shotはその名のとおり、敵の弾がaliveのものを描画するもの
;; Step9 <Draw Enemy Shot> ;; ----------------------------------------------------------------------------------------------- (defgeneric Draw-enemy-shot (enemy-manager)) (defmethod Draw-enemy-shot (enemy-manager) (dolist (enemy-shot (enemy-shot-list enemy-manager)) (when (= (state enemy-shot) 1) (Draw enemy-shot))))
当然、以下のコードも本体のルーチンに追加する必要がある。
; <Enemy-shot :Move Set Draw Remove> (Move-enemy-shot enemy-manager game-field) (Set-enemy-shot enemy-manager ship game-field) (Draw-enemy-shot enemy-manager) ; draw enemy shot (Remove-dead-enemy-shot enemy-manager)
なお、Set-enemy-shotの中の、敵の弾の発射カウント(move-cnt enemy)は、先に登場した、Move-Enemyメソットの中で
カウントのためのincfを行っている。
もう少しプログラムを追加したら、全部のソースコードを見て一度全体像を把握することにしよう。
Lisp Game Programming 2 <Stage 8>
マップ上に登場する敵以外のもので「オプション」と「ボム」のアイテムがあるが、どのように処理しているのかざっと見てみると、こんな感じの動作をしている
オプション → 取ると、自分の周りを回転するバルーンが1個ずつ増え、最大は２個まで。
それ以上取ると、点数が５００点増える
ボム → 左下のボムマークが増えていき、ボム（爆弾を爆発させる）回数がボムマ
ーク分となる。
とりあえず、オプションがおもしろそうなので該当する部分のコードを書いてみる。
degree-radianの変換はどっかで見たような気もするが忘れた。
⇒ ab-stage8.lispの一部
;; Step8 <Move Balloon> ;; ----------------------------------------------------------------------------------------------- (defun degree-radian (degree) ; convert from radian to degree (/ (* degree pi) 180)) ; degree -> radian (defvar *angle* 0) (defgeneric Move-balloon (balloon-manager ship)) (defmethod Move-balloon (balloon-manager ship) (when (or (= (state ship) 1) (= (state ship) 3)) (when (> *angle* 360) (setf *angle* 0)) (incf *angle* 4) (when (<= *angle* 360) (let ((i (balloon-cnt balloon-manager))) (dolist (balloon (balloon-list balloon-manager)) (if (= i 2) ; 48 is distance from left balloon to right balloon (setf (x balloon) (+ (x ship) (floor (* (cos (degree-radian *angle*)) 48))) (y balloon) (+ (y ship) (floor (* (sin (degree-radian *angle*)) 48)))) (setf (x balloon) (- (x ship) (floor (* (cos (degree-radian *angle*)) 48))) (y balloon) (- (y ship) (floor (* (sin (degree-radian *angle*)) 48))))) (decf i 1)))))) ;; Step8 <Generate Balloon> ;; ----------------------------------------------------------------------------------------------- (defgeneric Generate-balloon (balloon-manager ship)) (defmethod Generate-balloon (balloon-manager ship) "balloon appear position set" (when (and (/= (balloon-cnt balloon-manager) 0) (< (length (balloon-list balloon-manager)) 2)) ; max 2 balloon (dotimes (i (balloon-cnt balloon-manager)) (let ((balloon (make-instance 'entity :id 10 :state 1))) (if (= i 0) (setf (x balloon) (- (x ship) 48)) (setf (x balloon) (+ (x ship) 48))) (setf (y balloon) (y ship)) (push balloon (balloon-list balloon-manager)))))) ;; step8 <Draw Balloon> ;; ----------------------------------------------------------------------------------------------- (defgeneric Draw-balloon (balloon-manager ship)) (defmethod Draw-balloon (balloon-manager ship) (when (and (or (/= (state ship) 1) (state ship) 3) (/= (balloon-cnt balloon-manager) 0)) (dolist (balloon (balloon-list balloon-manager)) (Draw balloon)))) ;; Step8 <Move Item> ;; ----------------------------------------------------------------------------------------------- (defgeneric Move-item (item-manager game-field)) (defmethod Move-item (item-manager game-field) "item move" (dolist (item (item-list item-manager)) (when (= (state item) 1) ; option-item is alive (incf (y item) (dy item))) ; option-item 16 dot down (when (> (y item) (height game-field)) ; out of screen (setf (state item) 0)))) ;; Step8 <Remove Item> ;; ----------------------------------------------------------------------------------------------- (defgeneric Remove-item (item-manager)) (defmethod Remove-item (item-manager) "item remove from list" (setf (item-list item-manager) (delete-if #'(lambda (item) (= (state item) 0)) (item-list item-manager)))) ;; Step8 <Hit Item> ;; ----------------------------------------------------------------------------------------------- (defvar *itemget-flag* nil) (defgeneric Hit-item-p (item-manager balloon-manager score ship)) (defmethod Hit-item-p (item-manager balloon-manager score ship) (when (/= (state ship) 2) (dolist (item (item-list item-manager)) (when(and (> (+ (x ship) 32) (x item)) (< (x ship) (+ (x item) 32)) (> (+ (y ship) 32) (y item)) (< (y ship) (+ (y item) 32))) (setf (state item) 0) ; item is disappered (when (eql *itemget-flag* nil) (setf *itemget-flag* t)) (when (= (id item) 17) (if (< (balloon-cnt balloon-manager) 2) (incf (balloon-cnt balloon-manager) 1) (incf (score score) 500))) (when (= (id item) 18) (incf (n-bomb score) 1)) (setf *itemget-flag* nil))))) ;; step8 <Draw Item> ;; ----------------------------------------------------------------------------------------------- (defgeneric Draw-item (item-manager)) (defmethod Draw-item (item-manager) (dolist (item (item-list item-manager)) (Draw item)))
当然、こんなものも必要になり、
(define-class balloon-manager () (balloon-list balloon-cnt) nil) ; balloon-list list of balloon ; balloon-cnt max 2 balloon (define-class item-manager () (item-list item-flag) nil) ; item-list list of item ; item-flag item get flag
メインループはこんな感じ。
;; 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 ; <Set Font> (Set-font) ; set font ; <Set 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)) (stage (make-instance 'stage :stage-number (or nil 0) :title-loop t)) (character (make-instance 'object :id 19 :y 100)) (pointer (make-instance 'object :x 208 :y 328)) (score (make-instance 'score :highscore 50000 :oneup 50000 :n-ship 3 :n-bomb 3)) (score-ship (make-instance 'object :id 5 :x 160 :y 48)) (score-bomb (make-instance 'object :id 6 :x 160 :y 448)) (shot-manager (make-instance 'shot-manager)) (enemy-manager (make-instance 'enemy-manager)) (balloon-manager (make-instance 'balloon-manager :balloon-cnt (or nil 0))) (item-manager (make-instance 'item-manager))) (sdl:with-events (:poll) (:quit-event () (setf *screen-mode* 1 *switch* nil) (Reset-variables stage enemy-manager balloon-manager score) 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 () ;<Title Loop> (when (eql (title-loop stage) t) ; title loop (sdl:clear-display sdl:*black*) (Game-start-message pointer character stage keystate)) ; <Game Loop> (when (eql (title-loop stage) nil) ; game loop ; <Set Screen Mode> (Set-screen-mode) ; <Clear Display> (sdl:clear-display sdl:*black*) ; <Show Message> (Stage-start-message stage) ; <Draw Map> (Scroll-background *atlas*) ; <Move Ship> (Move-ship ship keystate) ; <Fix Ship Position> (Fix-ship-position ship game-field) ; <Shot :Move Set Draw Delete> (Move-shot shot-manager) (Set-shot shot-manager ship keystate balloon-manager) (when (= (state ship) 1) (Draw ship)) ; draw ship (Draw-shot shot-manager) (Remove-dead-shot shot-manager) ; <Enemy :Move Generate Draw Remove> (Move-enemy enemy-manager game-field) (Generate-enemy-item *enemymap* enemy-manager item-manager) (Draw-enemy enemy-manager) (Remove-enemy enemy-manager) ; <Balloon :Move Set Draw> (Move-balloon balloon-manager ship) (Generate-balloon balloon-manager ship) (Draw-balloon balloon-manager ship) ; <Item : Move Draw Remove Hit> (Move-item item-manager game-field) (Draw-item item-manager) (Remove-item item-manager) (hit-item-p item-manager balloon-manager score ship) ; <Upper and Lower Window Mask> (Scroll-mask) ; <Draw Score Panel> (Score-panel score score-ship score-bomb) ; <Set Map Pinter> (Set-map-pointer) ; set map draw point ; <Judge Stage End> (Judge-stage-end stage enemy-manager score balloon-manager) (sdl:update-display)))))))
Lisp Game Programming 2 <Stage 7>
マップスクロール、スタート＆ゲームオーバー画面、敵の出現と作ってきたのでプログラムが長くなり、読みにくくなったため、表示方法を変更することとした。
※実はWeb系はまったくの苦手で、CSSって言葉を今回初めて知った。
Stage７では、マップと敵の出現を合体し、なおかつ、マップの最後に登場するデカキャラを倒してから次のステージに進むことを想定して、０～８番目のところでループするようにScroll-backgroundを変更し、Judge-stage-endを作成した。
また、Set-screen-modeでは :resizable t があると右上のウインドウ拡大ボタン？で画面が変に広がるため、この部分をカットした。
加えて、Game-start-messageで(lshift keystate)の下に(when (= (y pointer) 360)を入れるのを忘れていたので追加し、スコアパネル等もちょこちょこと追加。
デカキャラ登場画面でのマップのループ方法を思いつかなかったので、いつものように力技で芸のないプログラムとなったのが痛い点。
ここまでプログラムを作ってみて、COMMON LISPって、ゲームを作るのに向いているって感じがするんだけどどうでしょう？
あ、Rotate-map-pointerはいわゆるクロージャ?のつもりで書きました。ハイ。
ab-stage7.lisp⇒
;;;; The Common-Abogadro ;;; step1 <Game Frame> <Sprite Sheets> <Define Package> <Macro> <Character Object> <Draw> ;;; <Initialize> <Key State> <Game Field> ;;; step2 <Map> <Scroll> ;;; step3 <Font> <Stage Class> <Start Stage Message> ;;; step4 <Game Start Message> <Game Over Message> <Judge Game Over> <Set Screen Mode> ;;; step5 <Score Panel> ;;; step6 <Move Shot> <Set Shot> <Remove Dead Shot> ;;; step7 <Generate Enemy> <Judge Stage End> <Move Enemy> <Change Id> <Remove Enemy> ;;; <Draw Enemy> <Reset Variables> <Rotate Map Pointer> ;; step1 <Sprite Sheets> ;; ----------------------------------------------------------------------------------------------- (load "C:\\work\\sprite-sheets.lisp") ;; step2 <Map> ;; ----------------------------------------------------------------------------------------------- (load "C:\\work\\map-list.lisp") ;; step7 <Enemy Map List> ;; ----------------------------------------------------------------------------------------------- (load "C:\\work\\enemy-map-list.lisp") ;; step7 <Enemy Map List> ;; ----------------------------------------------------------------------------------------------- (load "C:\\work\\move-pattern.lisp") ;; step1 <Define Package> ;; ----------------------------------------------------------------------------------------------- (defpackage :game (:use :common-lisp :lispbuilder-sdl :sprite-sheets :map-list :enemy-map-list :move-pattern) (: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 imageid ; 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 (define-class foe (entity) (move-cnt damage-cnt life-cnt kind) 0) ; move-cnt moving counter (distance) ; damage-cnt enemy damage counter(wait) ; life-cnt enemy life counter (life time) ; kind kind of enemy (define-class enemy-manager () (enemy-list) nil) ; enemy-list list of enemy ;; 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)))) ;; step3 <Font> ;; ----------------------------------------------------------------------------------------------- (defparameter *path-font16* "C:\\WINDOWS\\Fonts\\msmincho.ttc") (defparameter *font16* (make-instance 'sdl:ttf-font-definition :size 16 :filename (sdl:create-path *path-font16*))) (defvar *menu-font*) ; menu font (defun Set-font () (setf *menu-font* (sdl:initialise-font *font16*))) ;; Step3 <Stage Class> ;; ----------------------------------------------------------------------------------------------- (define-class stage () (stage-flag stage-number title-loop start) t) ; stage-flag on-stage or not ; stage-number map change ; title-loop waiting for input-key ; start game start ;; Step3 <Start Stage Message> ;; ----------------------------------------------------------------------------------------------- (defvar *atlas*) ; map set (defvar *enemymap*) ; enemy map set (defgeneric Stage-start-message (stage)) (defmethod Stage-start-message (stage) ; stage start message "Draw stage start message and set game parameters" (when (eql (stage-flag stage) t) (setf (stage-flag stage) nil) (incf (stage-number stage) 1) (case (stage-number stage) (1 (setf *atlas* *map1* *enemymap* *enemy-map1*)) (2 (setf *atlas* *map2* *enemymap* *enemy-map2*)) (t (setf *atlas* *map3* *enemymap* *enemy-map3*))) (sdl:clear-display sdl:*black*) (sdl:draw-string-solid-* (format nil "S T A G E ~d" (stage-number stage)) 272 208 :color sdl:*white* :font *menu-font*) (sdl:update-display) (sleep 3))) ;; step 2 <Scroll> ;; ----------------------------------------------------------------------------------------------- (defvar *scroll-cnt* 0) ; scroll counter (defvar *map-pointer* 64) ; map start line (defvar *draw-position-y* 0) ; y-axis start position (defvar *repeat* nil) ; scroll repeat flag (defvar *rotation* '(0 1 2 3 4 5 6 7 8)) ; map rotation list (defun Rotate-map-pointer () "Move last element to front of the list" (let ((x *rotation*)) ; list rotation right (setf *rotation* (append (last x) (butlast x))))) ; --> (8 0 1 2 3 4 5 6 7) (defun Set-map-pointer () "Set map pointer" (incf *scroll-cnt* 2) ; 2 dot scroll (when (eql (mod *scroll-cnt* 64) 0) ; mapchip draw position (setf *draw-position-y* 0) (decf *map-pointer*) ; else scroll-line -1 (when (< *map-pointer* 0) ; when scroll-line is 0 (end line) (setf *repeat* t)))) ; map repeat flag on (defun Scroll-background (map) "draw background" (setf *draw-position-y* (+ -48 (mod *scroll-cnt* 64))) ; scroll start from y(-48) to y(16) (cond ((eql *repeat* nil) ; when map repeat flag off (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))))) ((eql *repeat* t) ; when map repeat flag on (when (= (mod *scroll-cnt* 64) 0) ; when 64 dot scroll (Rotate-map-pointer)) ; map rotate (dotimes (i 8) (setf *map-pointer* (nth i *rotation*)) ; read element of the list (dotimes (j 5) (sdl:draw-surface-at-* *images* (+ 160 (* j 64)) (+ *draw-position-y* (* i 64)) :cell (aref map *map-pointer* j))))))) (defun Scroll-mask () (sdl:draw-box-* 0 0 160 480 :color sdl:*black*) ; mask scroll left side (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 (sdl:draw-box-* 480 0 640 480 :color sdl:*black*)) ; mask scroll right side ;; Step4 <Game Start Message> ;; ----------------------------------------------------------------------------------------------- (defvar *screen-mode* 1) ; screen mode toggle switch 0:fullscreen 1:windowed (defvar *switch* nil) ; screen flag (defgeneric Game-start-message (pointer character stage keystate)) (defmethod Game-start-message (pointer character stage keystate) ; game start message "Draw game opening message" ; title (dotimes (i 8) ; show title (setf (x character) (+ 192 (* i 32)) (id character) (+ 19 i)) (Draw character)) ; memu (sdl:draw-string-solid-* "S T A R T" 224 328 :color sdl:*white* :font *menu-font*) ; show menu (if (= *screen-mode* 0) (sdl:draw-string-solid-* "S C R E E N : F U L L" 224 360 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* "S C R E E N : W I N D O W" 224 360 :color sdl:*white* :font *menu-font*)) (sdl:draw-string-solid-* "E X I T" 224 392 :color sdl:*white* :font *menu-font*) ; select menu (cond ((up keystate) ; select menu (decf (y pointer) 32) (setf (up keystate) nil) (when (<= (y pointer) 328) ; y:328 is START menu position (setf (y pointer) 328 (start stage) t))) ((down keystate) (incf (y pointer) 32) (setf (down keystate) nil) (when (>= (y pointer) 392) ; y:392 is EXIT menu position (setf (y pointer) 392 (start stage) nil))) ((lshift keystate) (when (= (y pointer) 360) (if (= *screen-mode* 1) ; screen-mode toggle switch (setf *screen-mode* 0) ; 0:fullscreen 1:windowed (setf *screen-mode* 1)) (setf *switch* t)) (setf (lshift keystate) nil))) ; show pointer (sdl:draw-string-solid-* ">" (x pointer) (y pointer) :color sdl:*white* :font *menu-font*) ; game start or exit (cond ((and (z keystate) (eql (start stage) t) (= (y pointer) 328)) ; input z-key on start menu (setf (title-loop stage) nil (z keystate) nil)) ; z key state reset ((and (z keystate) (eql (start stage) nil) (= (y pointer) 392)) ; input z-key on exit menu (sdl:push-quit-event))) (sdl:update-display)) ;; Step7 <Reset Variables> ;; ----------------------------------------------------------------------------------------------- (defvar *enemy-map-pointer* 64) (defgeneric Reset-variables (stage enemy-manager)) (defmethod Reset-variables (stage enemy-manager) "reset variables" (setf (title-loop stage) t (stage-flag stage) t *scroll-cnt* 0 *draw-position-y* 0 *map-pointer* 64 *enemy-map-pointer* 64 (enemy-list enemy-manager) nil (stage-number stage) 0)) ;; Step4 <Game Over Message> ;; ----------------------------------------------------------------------------------------------- (defgeneric Game-over-message (stage enemy-manager)) (defmethod Game-over-message (stage enemy-manager) "Draw game ending message" (sdl:clear-display sdl:*black*) ; message (sdl:draw-string-solid-* "君の活躍によりアボガドロ軍は撤退した。" 178 64 :color sdl:*white* :font *menu-font*) ; (sdl:draw-string-solid-* "THE ABOGADRO FORCES WITHDREW BY YOUR SUCCESS" ; 150 64 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* "C O N G R A T U L A T I O N S" 208 96 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* "Y O U R S C O R E 0000000 " ; <--dummy 224 160 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* "H I G H S C O R E 0005000" ; <--dummy 224 192 :color sdl:*white* :font *menu-font*) (sdl:update-display) (sleep 10) (Reset-variables stage enemy-manager)) ;; Step4 <Set Screen Mode> ;; ----------------------------------------------------------------------------------------------- (defun Set-screen-mode() (when (eql *switch* t) (if (= *screen-mode* 0) ; fullscreen-mode on (sdl:resize-window 640 480 :sw t :fullscreen t) (sdl:resize-window 640 480 :sw t)) (setf *switch* nil))) ; twice executing prevent ;; step5 <Score Panel> ;; ----------------------------------------------------------------------------------------------- (define-class score () (score highscore oneup n-ship n-bomb) 0) ; score score counter ; highscore hight score ; oneup plus one ship ; n-ship number of ship ; n-bomb number of bomb (defgeneric Score-panel (score score-ship score-bomb)) (defmethod Score-panel (score score-ship score-bomb) "draw score and ships of rest" (sdl:draw-string-solid-* (format nil "SCORE:") 160 16 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* (format nil "HIGH-SCORE:") 320 16 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* (format nil "~5,'0d" (score score)) 208 16 :color sdl:*white* :font *menu-font*) (sdl:draw-string-solid-* (format nil "~d" (highscore score)) 408 16 :color sdl:*white* :font *menu-font*) (dotimes (i (- (n-ship score) 1)) (setf (x score-ship) (+ 160 (* 16 i))) (Draw score-ship)) (dotimes (i (n-bomb score)) (setf (x score-bomb) (+ 160 (* 16 i))) (Draw score-bomb))) ;; step6 <Move Shot> ;; ----------------------------------------------------------------------------------------------- (define-class shot-manager () (shot-list) nil) ; shot-list 4 shot store (defgeneric Move-shot (shot-manager)) (defmethod Move-shot (shot-manager) "shot move" (dolist (shot (shot-list shot-manager)) (when (= (state shot) 1) ; shot is alive (decf (y shot) (dy shot))) ; shot 16 dot up (when (< (y shot) -16) ; out of screen (setf (state shot) 0)))) ; shote is dead ;; step6 <Set Shot> ;; ----------------------------------------------------------------------------------------------- (defgeneric Set-shot (shot-manager ship keystate)) (defmethod Set-shot (shot-manager ship keystate) "set shot" (when (and (/= (state ship) 2) ; if ship is not explode (eql (mod *scroll-cnt* 8) 0) ; 1 shot / 8 loop (eql (z keystate) t)) ; and set z key (when (< (length (shot-list shot-manager)) 4) (let ((shot (make-instance 'entity :id 3 :width 4 :height 16 :dx 0 :dy 16 :state 1))) (setf (y shot) (- (y ship) (height shot)) ; set shot position (x shot) (+ (x ship) 14)) (push shot (shot-list shot-manager)))))) ;; step6 <Remove Dead Shot> ;; ----------------------------------------------------------------------------------------------- (defgeneric Remove-dead-shot (shot-manager)) (defmethod Remove-dead-shot (shot-manager) "dead shot remove from list" (setf (shot-list shot-manager) (delete-if #'(lambda (shot) (= (state shot) 0)) (shot-list shot-manager)))) ;; step7 <Generate Enemy> ;; ----------------------------------------------------------------------------------------------- ;(defvar *enemy-map-pointer* 64) (defgeneric Generate-enemy (map enemy-manager)) (defmethod Generate-enemy (map enemy-manager) (when (and (= (mod *scroll-cnt* 64) 0) (<= (length (enemy-list enemy-manager)) 10)); max 10 enemy (dotimes (j 10) (when (/= (aref map *enemy-map-pointer* j) -1) (case (aref map *enemy-map-pointer* j) ((7 50 80) ; when id is 7 or 50 or 80 (let ((enemy (make-instance 'foe ; small class enemy generate :id (aref map *enemy-map-pointer* j) :x (+ 160 (* j 32)) :y 0 :kind 1 :state 1))) (push enemy (enemy-list enemy-manager)))) ((76 78) ; when id is 76 or 78 (let ((enemy (make-instance 'foe ; middle class enemy generate :id (aref map *enemy-map-pointer* j) :x (+ 160 (* j 32)) :y 0 :kind 2 :state 1))) (push enemy (enemy-list enemy-manager)))) ((70 71 72) ; when id is 70 or 71 or 72 (let ((enemy (make-instance 'foe ; large class enemy generate :id (aref map *enemy-map-pointer* j) :x (+ 160 (* j 32)) :y 0 :kind 3 :state 1))) (push enemy (enemy-list enemy-manager)))) ((17 18) ; when id is 17 or 18 (let ((enemy (make-instance 'foe ; item generate :id (aref map *enemy-map-pointer* j) :x (+ 160 (* j 32)) :y 0 :dx 0 :dy 2 :kind 4 :state 1))) (push enemy (enemy-list enemy-manager))))))) (when (/= *enemy-map-pointer* 0) (decf *enemy-map-pointer*)))) ; *enemy-map-pointer* 64 -> 0 (end position) ;; step7 <Judge Stage End> ;; ----------------------------------------------------------------------------------------------- (defgeneric Judge-stage-end (stage enemy-manager)) (defmethod Judge-stage-end (stage enemy-manager) (cond ((or (= *scroll-cnt* 5120) ; when 5120 roop goto stage2 64*64+64*8*2 (= *scroll-cnt* 10240)) ; when 5120*2 roop goto stage3 (setf (stage-flag stage) t *repeat* nil *map-pointer* 64 *enemy-map-pointer* 64 ; map and enemy-map set start position (enemy-list enemy-manager) nil)) ((= *scroll-cnt* 15360) ; when 5120*3 roop game over (setf *repeat* nil *map-pointer* 64 *enemy-map-pointer* 64 (enemy-list enemy-manager) nil) (Game-over-message stage enemy-manager)))) ;; step7 <Move Enemy> ;; ----------------------------------------------------------------------------------------------- (defgeneric Move-enemy (enemy-manager game-field)) (defmethod Move-enemy (enemy-manager game-field) (dolist (enemy (enemy-list enemy-manager)) (when (= (state enemy) 1) (case (id enemy) ((7 8 9 80 81 82) ; id 7 8 9(yellow enemy) or id 80 81 82(purple enemy) (let((row (mod (move-cnt enemy) 16))) ; row from 0 to 15 (case (id enemy) ((7 8 9) ; id 7 8 9(yellow enemy) (setf (dx enemy) (aref *enemy-move-pattern1* row 0) (dy enemy) (aref *enemy-move-pattern1* row 1))) ((80 81 82) ; id 80 81 82(purple enemy) (setf (dx enemy) (aref *enemy-move-pattern3* row 0) (dy enemy) (aref *enemy-move-pattern3* row 1)))))) ((50 52) ; id 50 52(blue enemy) (let((row (mod (move-cnt enemy) 12))) ; row from 0 to 11 (setf (dx enemy) (aref *enemy-move-pattern2* row 0) (dy enemy) (aref *enemy-move-pattern2* row 1)))) ((76 78) (if (= (id enemy) 76) (setf (dx enemy) (first *enemy-move-pattern4*) (dy enemy) (second *enemy-move-pattern4*)) (setf (dx enemy) (first *enemy-move-pattern5*) (dy enemy) (second *enemy-move-pattern5*)))) ((70 71) (let((row (mod (move-cnt enemy) 32))) ; row from 0 to 31 (if (= (id enemy) 70) (setf (dx enemy) (aref *enemy-move-pattern6* row 0) (dy enemy) (aref *enemy-move-pattern6* row 1)) (setf (dx enemy) (aref *enemy-move-pattern7* row 0) (dy enemy) (aref *enemy-move-pattern7* row 1))))) ((72) (setf (dx enemy) (first *enemy-move-pattern8*) (dy enemy) (second *enemy-move-pattern8*)))) (incf (x enemy) (dx enemy)) (incf (y enemy) (dy enemy)) (incf (move-cnt enemy) 1) (when (or (>= (y enemy) (height game-field)) ; bottom of game field (>= (x enemy) (width game-field)) ; right of game field (<= (x enemy) (- (field-x game-field) (* 32 (kind enemy))))) ; left of game field (setf (state enemy) 0))))) ;; step7 <Change Id> ;; ----------------------------------------------------------------------------------------------- (defgeneric Change-id (enemy)) (defmethod Change-id (enemy) (case (id enemy) ((7 8 9) (case (mod (floor (move-cnt enemy) 4) 4) ; enemy id change (0 (setf (id enemy) 7)) ; change pattern --> 0000, 1111 , 2222 , 3333 (1 (setf (id enemy) 8)) ; id7 , id8 , id9 , id8 (2 (setf (id enemy) 9)) (3 (setf (id enemy) 8)))) ((50 52) (case (mod (floor (move-cnt enemy) 2) 2) ; enemy id change (0 (setf (id enemy) 50)) ; change pattern --> 0000, 1111 (1 (setf (id enemy) 52)))) ; id50 , id52 ((80 81 82) (case (mod (floor (move-cnt enemy) 4) 4) ; enemy id change (0 (setf (id enemy) 80)) ; change pattern --> 0000, 1111 , 2222 , 3333 (1 (setf (id enemy) 81)) ; id80 ,id81 , id82 , id81 (2 (setf (id enemy) 82)) (3 (setf (id enemy) 81)))))) ;; step7 <Remove Enemy> ;; ----------------------------------------------------------------------------------------------- (defgeneric Remove-enemy (enemy-manager)) (defmethod Remove-enemy (enemy-manager) (setf (enemy-list enemy-manager) (delete-if #'(lambda (enemy) (= (state enemy) 0)) (enemy-list enemy-manager)))) ;; step7 <Draw Enemy> ;; ----------------------------------------------------------------------------------------------- (defgeneric Enemy-draw (enemy-manager)) (defmethod Enemy-draw (enemy-manager) (dolist (enemy (enemy-list enemy-manager)) (Change-id enemy) (Draw enemy))) ;; 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 ; <Set Font> (Set-font) ; set font ; <Set 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)) (stage (make-instance 'stage :stage-number (or nil 0) :title-loop t)) (character (make-instance 'object :id 19 :y 100)) (pointer (make-instance 'object :x 208 :y 328)) (score (make-instance 'score :highscore 50000 :oneup 50000 :n-ship 3 :n-bomb 3)) (score-ship (make-instance 'object :id 5 :x 160 :y 48)) (score-bomb (make-instance 'object :id 6 :x 160 :y 448)) (shot-manager (make-instance 'shot-manager)) (enemy-manager (make-instance 'enemy-manager))) (sdl:with-events (:poll) (:quit-event () (setf *screen-mode* 1 *switch* nil) (Reset-variables stage enemy-manager) 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 () ;<Title Loop> (when (eql (title-loop stage) t) ; title loop (sdl:clear-display sdl:*black*) (Game-start-message pointer character stage keystate)) ; <Game Loop> (when (eql (title-loop stage) nil) ; game loop ; <Set Screen Mode> (Set-screen-mode) ; <Clear Display> (sdl:clear-display sdl:*black*) ; <Show Message> (Stage-start-message stage) ; <Draw Map> (Scroll-background *atlas*) ; <Move Ship> (Move-ship ship keystate) ; <Fix Ship Position> (Fix-ship-position ship game-field) ; <Move Shot> (Move-shot shot-manager) ; <Set Shot> (Set-shot shot-manager ship keystate) ; <Draw Images> (when (= (state ship) 1) (Draw ship)) ; draw ship ; <Draw Shot> (dolist (shot (shot-list shot-manager)) (when (= (state shot) 1) (Draw shot))) ; draw shot ; <Delete Dead Shot> (Remove-dead-shot shot-manager) ; <Move Enemy> (Move-enemy enemy-manager game-field) ; <Generate Enemy> (Generate-enemy *enemymap* enemy-manager) ; <Draw Enemy> (Enemy-draw enemy-manager) ; <Remove enemy> (Remove-enemy enemy-manager) ; <Upper and Lower window Mask> (Scroll-mask) ; <Draw Score Panel> (Score-panel score score-ship score-bomb) ; <Set Map Pinter> (Set-map-pointer) ; set map draw point ; <Judge Stage End> (Judge-stage-end stage enemy-manager) (sdl:update-display)))))))
Lisp Game Programming 2<Stage 6-2>
<Stage 6-1>で作った,enemy-map-list.lispとmove-pattern.lispを読み込むテストプログラムを作ってみた。
画面イメージのidを使用しているため、敵の画像が回転したりするとidが切り替わる仕様のため、かなりゴチャゴチャしたプログラムとなってしまった。
たとえば、敵１（仮称）は7→8→9→8→7→････と画像が切り替わるため、Move-enemyメソットでは敵１のidすべての場合をcaseで判断している。
なお、敵１はid (7 8 9 )であり、敵２はid(80 81 82)となる。
面白いのは、画像のパターンが切り替わるところのプログラムで、オリジナルプログラムでの工夫の跡が読み取れる。
なお、青字の*enemy-map2*を*enemy-map1*や*enemy-map3*に代えると、当然違うパターンで敵が現れる。
enemy-test.lisp ⇒
;;;; The Common-Abogadro
;;;
;;; -------- Enemy Test --------
;;;
;; step1 <Sprite Sheets>
;; -----------------------------------------------------------------------------------------------
(load "C:\\work\\sprite-sheets.lisp")
;; step2 <Enemy Map List>
;; -----------------------------------------------------------------------------------------------
(load "C:\\work\\enemy-map-list.lisp")
;; step2 <Move Pattern>
;; -----------------------------------------------------------------------------------------------
(load "C:\\work\\move-pattern.lisp")
;; step1 <Define Package>
;; -----------------------------------------------------------------------------------------------
(defpackage :game
(:use :common-lisp :lispbuilder-sdl :sprite-sheets :enemy-map-list :move-pattern)
(:nicknames :shooting)
(:export #:Common-abogadro))
(in-package :game)
;; step2 <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)))
;;step2 <Character Object>
;; -----------------------------------------------------------------------------------------------
(define-class object ()
(id x y width height) 0)
; id graphic id in imageid
; 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
(define-class foe (entity)
(move-cnt damage-cnt life-cnt kind) 0)
; move-cnt moving counter (distance)
; damage-cnt enemy damage counter(wait)
; life-cnt enemy life counter (life time)
; kind kind of enemy
(define-class enemy-manager ()
(enemy-list) nil)
; enemy-list list of enemy
(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
;; step3 <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
(defvar *scroll-cnt* 0) ; scroll counter
(defvar *enemy-map-pointer* 64)
(defgeneric Generate-enemy (map enemy-manager))
(defmethod Generate-enemy (map enemy-manager)
(when (and (= (mod *scroll-cnt* 64) 0)
(<= *scroll-cnt* 4096))
(dotimes (j 10)
(when (/= (aref map *enemy-map-pointer* j) -1)
(case (aref map *enemy-map-pointer* j)
((7 50 80) ; when id is 7 or 50 or 80
(let ((enemy (make-instance 'foe ; small class enemy generate
:id (aref map *enemy-map-pointer* j)
:x (+ 160 (* j 32)) :y 0 :kind 1 :state 1)))
(push enemy (enemy-list enemy-manager))))
((76 78) ; when id is 76 or 78
(let ((enemy (make-instance 'foe ; middle class enemy generate
:id (aref map *enemy-map-pointer* j)
:x (+ 160 (* j 32)) :y 0 :kind 2 :state 1)))
(push enemy (enemy-list enemy-manager))))
((70 71 72) ; when id is 70 or 71 or 72
(let ((enemy (make-instance 'foe ; large class enemy generate
:id (aref map *enemy-map-pointer* j)
:x (+ 160 (* j 32)) :y 0 :kind 3 :state 1)))
(push enemy (enemy-list enemy-manager))))
((17 18) ; when id is 17 or 18
(let ((enemy (make-instance 'foe ; item generate
:id (aref map *enemy-map-pointer* j)
:x (+ 160 (* j 32)) :y 0 :dx 0 :dy 1 :kind 4 :state 1)))
(push enemy (enemy-list enemy-manager)))))))
(decf *enemy-map-pointer*)))
(defgeneric Move-enemy (enemy-manager game-field))
(defmethod Move-enemy (enemy-manager game-field)
(dolist (enemy (enemy-list enemy-manager))
(when (= (state enemy) 1)
(case (id enemy)
((7 8 9 80 81 82) ; id 7 8 9 or id 80 81 82 small size enemy
(let((row (mod (move-cnt enemy) 16))) ; row from 0 to 15
(case (id enemy)
((7 8 9) ; id 7 8 9(yellow)
(setf (dx enemy) (aref *enemy-move-pattern1* row 0)
(dy enemy) (aref *enemy-move-pattern1* row 1)))
((80 81 82) ; id 80 81 82(purple)
(setf (dx enemy) (aref *enemy-move-pattern3* row 0)
(dy enemy) (aref *enemy-move-pattern3* row 1))))))
((50 52) ; id 50 52(blue)
(let((row (mod (move-cnt enemy) 12))) ; row from 0 to 11
(setf (dx enemy) (aref *enemy-move-pattern2* row 0)
(dy enemy) (aref *enemy-move-pattern2* row 1))))
((76 78) ; id 76 78 middle size enemy
(if (= (id enemy) 76)
(setf (dx enemy) (first *enemy-move-pattern4*)
(dy enemy) (second *enemy-move-pattern4*))
(setf (dx enemy) (first *enemy-move-pattern5*)
(dy enemy) (second *enemy-move-pattern5*))))
((70 71) ; id 70 71 large size enemy
(let((row (mod (move-cnt enemy) 32))) ; row from 0 to 31
(if (= (id enemy) 70)
(setf (dx enemy) (aref *enemy-move-pattern6* row 0)
(dy enemy) (aref *enemy-move-pattern6* row 1))
(setf (dx enemy) (aref *enemy-move-pattern7* row 0)
(dy enemy) (aref *enemy-move-pattern7* row 1)))))
((72) ; id 72 large size enemy
(setf (dx enemy) (first *enemy-move-pattern8*)
(dy enemy) (second *enemy-move-pattern8*))))
(incf (x enemy) (dx enemy))
(incf (y enemy) (dy enemy))
(incf (move-cnt enemy) 1)
(when (or (>= (y enemy) (height game-field)) ; bottom of game field
(>= (x enemy) (width game-field)) ; right of game field
(<= (x enemy) (- (field-x game-field) (* 32 (kind enemy))))) ; left of game field
(setf (state enemy) 0)))))
(defgeneric Change-id (enemy))
(defmethod Change-id (enemy)
(case (id enemy)
((7 8 9)
(case (mod (floor (move-cnt enemy) 4) 4) ; enemy id change
(0 (setf (id enemy) 7)) ; change pattern --> 0000, 1111 , 2222 , 3333
(1 (setf (id enemy) 8)) ; id7 , id8 , id9 , id8
(2 (setf (id enemy) 9))
(3 (setf (id enemy) 8))))
((50 52)
(case (mod (floor (move-cnt enemy) 2) 2) ; enemy id change
(0 (setf (id enemy) 50)) ; change pattern --> 0000, 1111
(1 (setf (id enemy) 52)))) ; id50 , id52
((80 81 82)
(case (mod (floor (move-cnt enemy) 4) 4) ; enemy id change
(0 (setf (id enemy) 80)) ; change pattern --> 0000, 1111 , 2222 , 3333
(1 (setf (id enemy) 81)) ; id80 , id81 , id82 , id81
(2 (setf (id enemy) 82))
(3 (setf (id enemy) 81))))))
(defgeneric Remove-enemy (enemy-manager))
(defmethod Remove-enemy (enemy-manager)
(setf (enemy-list enemy-manager)
(delete-if #'(lambda (enemy) (= (state enemy) 0)) (enemy-list enemy-manager))))
(defgeneric Enemy-draw (enemy-manager))
(defmethod Enemy-draw (enemy-manager)
(dolist (enemy (enemy-list enemy-manager))
(Change-id enemy)
(Draw enemy)))
(defun Scroll-counter ()
(incf *scroll-cnt*))
;; 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 #(192 50) ; size 640*480, position x(192) y(50)
:title-caption "ABOGADRO"
:icon-caption "ABOGADRO"
:double-buffer t
:fullscreen nil)
; <Initialize>
(Initialize) ; graphics initialize
(let((enemy-manager (make-instance 'enemy-manager))
(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)
(:idle ()
; <Clear Display>
(sdl:clear-display sdl:*black*)
(Move-enemy enemy-manager game-field)
(Generate-enemy *enemy-map2* enemy-manager)
(Enemy-draw enemy-manager)
(Remove-enemy enemy-manager)
(Scroll-counter)
(sdl:update-display))))))
プログラムを実行すると、最後のキャラクタは円を描くように動く。
Lisp Game Programming 2 <Stage 6-1>
敵のいないシューティングゲームなんて、「○○の入らないコーヒーみたい」（このフレーズを知っている人は相当なオジサン）なので、オリジナルのサイトをまねてやってみた。かなり汚いコードになったが、動けばヨシと割り切る。
まずは、８つの敵の配置データを３面分作成。
50とか70というのは敵の画像データのid。
enemy-map-list.lisp ⇒
(defpackage :enemy-map-list
(:use :common-lisp)
(:export #:*enemy-map1* #:*enemy-map2* #:*enemy-map3*))
(in-package :enemy-map-list)
;; step3 <Enemy Map>
;; -----------------------------------------------------------------------------------------------
(defparameter *enemy-map1* (make-array '(65 10):initial-contents
'((-1 -1 -1 -1 70 -1 -1 -1 -1 -1) ; 0
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 50 50 -1 -1 -1 -1 -1 -1)
(-1 50 50 50 50 -1 -1 -1 -1 -1)
(-1 -1 50 50 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 7 -1 -1 -1 -1 -1 -1 50 -1)
(-1 7 -1 -1 -1 -1 -1 -1 50 -1)
(-1 7 -1 -1 -1 -1 -1 -1 50 -1) ; 10
(-1 7 -1 -1 -1 -1 -1 -1 50 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 17 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 76 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(80 -1 -1 -1 -1 -1 -1 -1 -1 80)
(80 -1 -1 -1 -1 -1 -1 -1 -1 80)
(80 -1 -1 -1 -1 -1 -1 -1 -1 80) ; 20
(80 -1 -1 -1 -1 -1 -1 -1 -1 80)
(80 -1 -1 -1 -1 -1 -1 -1 -1 80)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 18 -1 -1 -1 -1 -1 -1)
(50 -1 -1 -1 -1 -1 -1 -1 -1 50)
(-1 50 -1 -1 -1 -1 -1 -1 50 -1)
(-1 -1 50 -1 -1 -1 -1 50 -1 -1)
(-1 -1 -1 50 -1 -1 50 -1 -1 -1)
(-1 -1 -1 -1 -1 50 -1 -1 -1 -1)
(-1 -1 -1 -1 50 -1 -1 -1 -1 -1) ; 30
(-1 -1 -1 -1 -1 50 -1 -1 -1 -1)
(-1 -1 -1 -1 50 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 7 -1 -1 -1 -1 7 -1 -1)
(-1 7 -1 -1 -1 -1 -1 -1 7 -1)
(7 -1 -1 -1 -1 -1 -1 -1 -1 7)
(-1 7 -1 -1 -1 -1 -1 -1 7 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1) ; 40
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 76 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 17 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 80 -1 -1 -1 -1 -1 80 -1)
(-1 -1 80 -1 -1 -1 -1 -1 80 -1)
(-1 -1 80 -1 -1 -1 -1 -1 80 -1)
(-1 -1 80 -1 -1 -1 -1 -1 80 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1) ; 50
(-1 -1 -1 -1 50 50 -1 -1 -1 -1)
(-1 -1 -1 50 -1 -1 50 -1 -1 -1)
(-1 -1 50 -1 -1 -1 -1 50 -1 -1)
(-1 50 -1 -1 -1 -1 -1 -1 50 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 50 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 7 -1)
(-1 -1 -1 -1 -1 -1 -1 7 -1 -1)
(-1 -1 -1 -1 -1 -1 7 -1 -1 -1) ; 60
(-1 -1 -1 -1 17 -1 -1 -1 -1 -1)
(-1 7 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 7 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 7 -1 -1 -1 -1 -1 -1))))
(defparameter *enemy-map2* (make-array '(65 10) :initial-contents
'((-1 -1 -1 -1 71 -1 -1 -1 -1 -1) ; 0
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 7 -1 -1 -1 -1 7 -1 -1)
(-1 -1 -1 -1 78 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(78 -1 -1 -1 -1 -1 -1 -1 78 -1)
(-1 -1 -1 -1 -1 -1 -1 18 -1 -1)
(7 -1 80 -1 -1 -1 -1 -1 -1 -1) ; 10
(-1 50 -1 7 -1 80 -1 -1 -1 -1)
(-1 -1 7 -1 50 -1 80 -1 -1 -1)
(-1 -1 -1 50 -1 80 -1 -1 -1 -1)
(-1 -1 -1 -1 80 -1 7 -1 -1 -1)
(-1 -1 -1 -1 -1 50 -1 7 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 80 80 -1 -1 -1 -1 -1 7 -1)
(-1 80 80 -1 -1 -1 7 -1 -1 -1)
(-1 80 80 -1 -1 -1 -1 -1 7 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1) ; 20
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(78 -1 -1 -1 -1 -1 -1 -1 -1 78)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 18 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 7 -1)
(-1 7 -1 -1 -1 -1 -1 7 -1 -1)
(-1 -1 7 -1 -1 -1 -1 7 -1 -1)
(-1 -1 -1 7 -1 -1 -1 -1 -1 -1) ; 30
(80 -1 80 -1 80 80 -1 80 -1 80)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 80 80 -1 -1 -1 -1)
(-1 7 -1 -1 -1 -1 80 80 -1 -1)
(-1 -1 80 80 -1 -1 -1 -1 7 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 80 80)
(80 80 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 80 80 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1) ; 40
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(78 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 17 -1 -1 -1)
(-1 -1 7 -1 -1 -1 -1 7 -1 -1)
(-1 7 -1 50 -1 -1 50 -1 7 -1)
(-1 -1 7 -1 -1 -1 -1 7 -1 -1)
(-1 -1 -1 50 -1 -1 50 -1 -1 -1) ; 50
(-1 -1 7 -1 -1 -1 -1 7 -1 -1)
(-1 -1 -1 50 -1 -1 50 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(7 -1 -1 -1 -1 -1 -1 -1 -1 7)
(-1 80 -1 7 -1 -1 7 -1 80 -1)
(-1 -1 7 -1 -1 -1 -1 7 -1 -1)
(-1 -1 -1 80 -1 -1 -1 80 -1 -1)
(-1 -1 -1 -1 7 7 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 50 -1 50 50 -1 50 -1 -1) ; 60
(-1 -1 -1 17 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 50 -1 -1 50 -1 -1 -1)
(-1 -1 -1 -1 50 50 -1 -1 -1 -1)
(-1 -1 -1 -1 50 50 -1 -1 -1 -1))))
(defparameter *enemy-map3* (make-array '(65 10) :initial-contents
'((-1 -1 -1 -1 72 -1 -1 -1 -1 -1) ; 0
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 18 -1 -1 -1 -1 -1 -1)
(-1 76 -1 -1 -1 -1 -1 76 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1) ; 10
(-1 -1 -1 -1 -1 -1 -1 -1 7 -1)
(-1 -1 -1 -1 76 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 76 -1 -1 -1 -1 76 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 80 -1 80 -1 -1 -1 -1 -1)
(80 -1 -1 7 -1 -1 -1 -1 -1 80)
(-1 -1 -1 -1 -1 80 -1 80 -1 -1) ; 20
(-1 50 -1 -1 50 -1 -1 -1 -1 -1)
(-1 50 -1 -1 50 -1 -1 -1 7 -1)
(-1 50 -1 -1 50 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 17 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(78 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 80 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 80 -1)
(-1 78 -1 -1 -1 -1 -1 -1 -1 -1) ; 30
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 78 -1 -1 -1 78 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(50 50 50 -1 -1 -1 -1 -1 50 -1)
(50 50 50 -1 -1 -1 -1 -1 50 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1) ; 40
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(7 -1 -1 -1 76 -1 -1 -1 -1 -1)
(-1 7 -1 -1 -1 -1 -1 76 -1 -1)
(-1 -1 7 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 76 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 17 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 78 -1 -1 -1 -1 -1) ; 50
(-1 -1 80 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 80 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 80 -1 -1 -1 -1 -1)
(78 -1 -1 -1 -1 -1 -1 -1 -1 78)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1)
(50 -1 -1 -1 -1 -1 -1 -1 80 -1)
(-1 50 -1 -1 -1 -1 -1 -1 -1 -1)
(-1 -1 50 -1 -1 -1 80 -1 -1 -1)
(-1 -1 -1 50 -1 -1 -1 -1 -1 -1) ; 60
(-1 -1 -1 -1 -1 -1 -1 -1 7 -1)
(-1 -1 -1 -1 -1 -1 -1 7 -1 -1)
(-1 -1 -1 -1 -1 -1 7 -1 -1 -1)
(-1 -1 -1 -1 -1 7 -1 -1 -1 -1))))
プログラムの中では、それぞれの画像データにidを振っているので、-1は空白を意味するデータとしてセットする。
この配列は64→63→･･･→0行の順に読み込んでいくために使用する。
加えて、敵の動き方をｘ方向とｙ方向の移動量として（x y）の形で配列にした。
たとえば、（-8 4)は左に8ドット、下に４ドットを意味するから、*enemy-move-pattern1*では、敵が左右にフラフラ動きながら下降していくことになる。
move-pattern.lisp ⇒
(defpackage :move-pattern
(:use :common-lisp)
(:export #:*enemy-move-pattern1* #:*enemy-move-pattern2* #:*enemy-move-pattern3*
#:*enemy-move-pattern4* #:*enemy-move-pattern5* #:*enemy-move-pattern6*
#:*enemy-move-pattern7* #:*enemy-move-pattern8*))
(in-package :move-pattern)
;; step7 <Enemy-move-pattern>
;; -----------------------------------------------------------------------------------------------
(defparameter *enemy-move-pattern1* (make-array '(16 2) :initial-contents
'((-8 4) ; 0
(-6 4)
(-4 4)
(-2 4)
(0 4)
(2 4)
(4 4)
(6 4)
(8 4)
(6 4)
(4 4) ; 10
(2 4)
(0 4)
(-2 4)
(-4 4)
(-6 4))))
(defparameter *enemy-move-pattern2* (make-array '(12 2) :initial-contents
'((2 2) ; 0
(2 4)
(2 6)
(2 8)
(2 8)
(2 6)
(2 4)
(2 2)
(2 -1)
(2 -2)
(2 -2) ; 10
(2 -1))))
(defparameter *enemy-move-pattern3* (make-array '(16 2) :initial-contents
'((1 3) ; 0
(1 3)
(1 3)
(1 3)
(1 3)
(1 3)
(1 3)
(1 3)
(0 1)
(0 1)
(0 1) ; 10
(0 1)
(0 1)
(0 1)
(0 1)
(0 1))))
(defparameter *enemy-move-pattern4* '(0 2)) ; 0
(defparameter *enemy-move-pattern5* '(1 2)) ; 0
(defparameter *enemy-move-pattern6* (make-array '(32 2) :initial-contents
'((-2 1) ; 0
(-2 1)
(-2 1)
(-2 1)
(-2 1)
(-2 1)
(-2 1)
(-2 1)
(2 1)
(2 1)
(2 1) ; 10
(2 1)
(2 1)
(2 1)
(2 1)
(2 1)
(2 -1)
(2 -1)
(2 -1)
(2 -1)
(2 -1) ; 20
(2 -1)
(2 -1)
(2 -1)
(-2 -1)
(-2 -1)
(-2 -1)
(-2 -1)
(-2 -1)
(-2 -1)
(-2 -1) ; 30
(-2 -1))))
(defparameter *enemy-move-pattern7* (make-array '(32 2) :initial-contents
'((-2 -2) ; 0
(-2 -2)
(-2 -2)
(-2 -2)
(2 2)
(2 2)
(2 2)
(2 2)
(-2 2)
(-2 2)
(-2 2) ; 10
(-2 2)
(2 -2)
(2 -2)
(2 -2)
(2 -2)
(2 2)
(2 2)
(2 2)
(2 2)
(-2 -2) ; 20
(-2 -2)
(-2 -2)
(-2 -2)
(2 -2)
(2 -2)
(2 -2)
(2 -2)
(-2 2)
(-2 2)
(-2 2) ; 30
(-2 2))))
(defparameter *enemy-move-pattern8* '(0 0)) ; 0
敵の配置データを使用するとこんな感じの画面になる。
Lisp Game Programming 2 <Stage 5 Information>
ちょっと補足。
プログラムを見れば一目瞭然だけど、メニュー画面では、UP・DOWNキーを押すことでポインターが動き、メニューを指し示すことができる。
また、左のSHIFTキーを押すことで、スクリーンをFULLSCREENかWINDOWに切り替えることができ、STARTやEXITのところでＺキーを押すと選択したスクリーンモードで実行できる。
なお、日本語表示については、具体的には、lispbuilder-sdlをインストールしたホルダのlispbuilder-sdl-ttf ＞ sdl-ttf ＞ string-blended ,string-shaded,string-solidの３つのファイルをそれぞれ選択し、render-text-shadedをrender-utf8-shadedのように書き換えることで実現できるが、当然自己責任で。
プログラムでは、日本語のメッセージはコメントアウトしているため、表示するためにはコメントアウトをはずすし、英語のメッセージをコメントアウト。
Lisp Game Programming 2 <Stage 5>
３面切り替えのスクロールができたので、ここも一気にスタートメニューからゲームオーバーのメッセージまで作成。
ここでの工夫は、画面のモードの切り替え方法。
https://github.com/jueqingsizhe66/lispbuilder-1/blob/master/lispbuilder-sdl/examples/particles.lisp
どうしても、日本語でメッセージを出したい人はこちらを参照。
http://d.hatena.ne.jp/masatoi/20120914/1347600686
;; Step4 <Game Start Message>
;; -----------------------------------------------------------------------------------------------
(defvar *screen-mode* 1) ; screen mode toggle switch 0:fullscreen 1:windowed
(defvar *switch* nil) ; screen change flag
(defgeneric Game-start-message (pointer character stage keystate))
(defmethod Game-start-message (pointer character stage keystate) ; game start message
"Draw game opening message"
; title
(dotimes (i 8) ; show title
(setf (x character) (+ 192 (* i 32))
(id character) (+ 19 i))
(Draw character))
; memu
(sdl:draw-string-solid-* "S T A R T" 224 328 :color sdl:*white* :font *menu-font*) ; show menu
(if (= *screen-mode* 0)
(sdl:draw-string-solid-* "S C R E E N : F U L L" 224 360 :color sdl:*white* :font *menu-font*)
(sdl:draw-string-solid-* "S C R E E N : W I N D O W" 224 360 :color sdl:*white* :font *menu-font*))
(sdl:draw-string-solid-* "E X I T" 224 392 :color sdl:*white* :font *menu-font*)
; select menu
(cond ((up keystate) ; select menu
(decf (y pointer) 32)
(setf (up keystate) nil)
(when (<= (y pointer) 328) ; y:328 is START menu position
(setf (y pointer) 328
(start stage) t)))
((down keystate)
(incf (y pointer) 32)
(setf (down keystate) nil)
(when (>= (y pointer) 392) ; y:392 is EXIT menu position
(setf (y pointer) 392
(start stage) nil)))
((lshift keystate)
(if (= *screen-mode* 1) ; screen-mode toggle switch
(setf *screen-mode* 0) ; 0:fullscreen 1:windowed
(setf *screen-mode* 1))
(setf *switch* t)
(setf (lshift keystate) nil)))
; show pointer
(sdl:draw-string-solid-* ">" (x pointer) (y pointer) :color sdl:*white* :font *menu-font*)
; game start or exit
(cond ((and (z keystate) (eql (start stage) t) (= (y pointer) 328)) ; input z-key on start menu
(setf (title-loop stage) nil
(z keystate) nil)) ; z key state reset
((and (z keystate) (eql (start stage) nil) (= (y pointer) 392)) ; input z-key on exit menu
(sdl:push-quit-event)))
(sdl:update-display))
;; Step4 <Game Over Message>
;; -----------------------------------------------------------------------------------------------
(defgeneric Game-over-message (stage))
(defmethod Game-over-message (stage)
"Draw game ending message"
(sdl:clear-display sdl:*black*)
; message
; (sdl:draw-string-solid-* "君の活躍によりアボガドロ軍は撤退した。"
; 178 64 :color sdl:*white* :font *menu-font*)
(sdl:draw-string-solid-* "THE ABOGADRO FORCES WITHDREW BY YOUR SUCCESS" 150 64 :color sdl:*white* :font *menu-font*)
(sdl:draw-string-solid-* "C O N G R A T U L A T I O N S" 208 96 :color sdl:*white* :font *menu-font*)
(sdl:draw-string-solid-* "Y O U R S C O R E 0000000 " ; <--dummy
224 160 :color sdl:*white* :font *menu-font*)
(sdl:draw-string-solid-* "H I G H S C O R E 0005000" ; <--dummy
224 192 :color sdl:*white* :font *menu-font*)
(sdl:update-display)
(sleep 10)
; reset variables
(setf (title-loop stage) t
(stage-flag stage) t
*map-pointer* 64
(stage-number stage) 0))
;; Step4 <Judge Map End>
;; -----------------------------------------------------------------------------------------------
(defgeneric Judge-map-end(stage))
(defmethod Judge-map-end (stage)
(when (and (= (stage-number stage) 3) ; stage 3 and map-poiner is 0
(= *map-pointer* 0)) ; game over
(Game-over-message stage)))
;; Step4 <Set Screen Mode>
;; -----------------------------------------------------------------------------------------------
(defun Set-screen-mode()
(when (eql *switch* t)
(if (= *screen-mode* 0) ; fullscreen-mode on
(sdl:resize-window 640 480 :sw t :fullscreen t)
(sdl:resize-window 640 480 :sw t :resizable t))
(setf *switch* nil))) ; twice executing prevent
･･････････････････････････････
; <Set 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))
(stage (make-instance 'stage :stage-number (or nil 0) :title-loop t))
(character (make-instance 'object :id 19 :y 100))
(pointer (make-instance 'object :x 208 :y 328)))
(sdl:with-events (:poll)
(:quit-event ()
(setf *screen-mode* 1
*switch* nil)
t)
･･････････････････････････････
(:idle ()
;<Title Loop>
(when (eql (title-loop stage) t) ; title loop
(sdl:clear-display sdl:*black*)
(Game-start-message pointer character stage keystate))
; <Game Loop>
(when (eql (title-loop stage) nil) ; game loop
; <Set Screen Mode>
(Set-screen-mode)
; <Clear Display>
(sdl:clear-display sdl:*black*)
; <Show Message>
(Stage-start-message stage)
; <Draw Map>
(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 stage) ; set map draw point
; <Judge All Map Used>
(Judge-map-end stage)
(sdl:update-display)))))))
(６／６）インスタンスの状況が分からなかったため青字の部分を追加
Lisp Game Programming 2 <Stage 4>
せっかく３面のマップを用意したのだから、stage1→stage2→stage3と切り替わっていくプログラムとする。
まずは font
;; step1 <Fix Ship Position>
;; -----------------------------------------------------------------------------------------------
・・・・・・・・・・・・・・・・・
;; step3 <Font>
;; -----------------------------------------------------------------------------------------------
(defparameter *path-font16* "C:\\WINDOWS\\Fonts\\msmincho.ttc")
(defparameter *font16* (make-instance 'sdl:ttf-font-definition
:size 16
:filename (sdl:create-path *path-font16*)))
(defvar *menu-font*) ; menu font
(defun Set-font ()
(setf *menu-font* (sdl:initialise-font *font16*)))
そして stage class。初期設定では、title-loop を t
;; Step3 <Stage Class>
;; -----------------------------------------------------------------------------------------------
(define-class stage ()
(stage-flag stage-number title-loop start) t)
; stage-flag on-stage or not
; stage-number map change
; title-loop waiting for input-key
; start game start
さらに、「stage 1」を表示するための method
;; Step3 <Start Stage Message>
;; -----------------------------------------------------------------------------------------------
(defvar *atlas*) ; map set
(defgeneric Stage-start-message (stage))
(defmethod Stage-start-message (stage) ; stage start message
"Draw stage start message and set game parameters"
(when (eql (stage-flag stage) t)
(setf (stage-flag stage) nil)
(incf (stage-number stage) 1)
(case (stage-number stage)
(1 (setf *atlas* *map1*))
(2 (setf *atlas* *map2*))
(t (setf *atlas* *map3*)))
(sdl:clear-display sdl:*black*)
(sdl:draw-string-solid-*
(format nil "S T A G E ~d" (stage-number stage)) 272 208 :color sdl:*white* :font *menu-font*)
(sdl:update-display)
(sleep 3)))
初期設定では、title-loop を t にしているが、テストのため、インスタンスを作るときは nil で設定
;; step1 <Game Frame>
;; -----------------------------------------------------------------------------------------------
(defun Common-abogadro ()
・・・・・・・・・・・・・・・・・
; <Set Font>
(Set-font) ; set font
; <Set 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))
(stage (make-instance 'stage :stage-number (or nil 0) :title-loop nil)))
・・・・・・・・・・・・・・・・・
(:idle ()
; <Title Off>
(when (eql (title-loop stage) nil) ; game loop
(sdl:clear-display sdl:*black*)
; <Show Message>
(Stage-start-message stage)
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))))))
Lisp Game Programming 2 <Stage 2>
参考にさせていただいたサイトのリストを見たところ、キャラクタのidをリストにしていた。
これを参考に、先のプログラムで読み込んだid番号と比べてみたらこんなmap用のプログラムができた。
３面のmapを以下に用意したけど、スクロールの仕方はこんな感じ。
１．スタートの時はマップの一番上は６４のライン、一番下は７１のライン
２．次は上が６３のラインで下が７０のラインというように１ラインづつ動いていく
３．６４のラインから６３のラインに行くとき、６４×６４の大きさのmapchipのため、１dotずつ移動していく
map-list.lisp ⇒
(defpackage :map-list
(:use :common-lisp)
(:export #:*map1 #:*map2* #:*map3*))
(in-package :map-list)
;; step2 <Map>
;; -----------------------------------------------------------------------------------------------
(defparameter *map1* (make-array '(72 5) :initial-contents
'((54 61 61 61 54) ; 0
(54 61 62 61 54)
(54 61 61 61 54)
(54 62 61 62 54)
(54 61 61 61 54)
(54 61 62 61 54)
(54 61 61 61 54)
(54 62 62 62 54)
(54 61 61 61 54)
(54 63 63 63 54)
(54 58 60 59 54) ; 10
(56 58 60 59 56)
(55 58 60 59 55)
(54 58 60 59 54)
(54 57 57 57 54)
(54 58 57 59 54)
(54 57 57 57 54)
(54 58 57 59 54)
(54 57 57 57 54)
(54 58 57 59 54)
(54 57 57 57 54) ; 20
(56 58 60 59 56)
(55 58 60 59 55)
(54 58 60 59 54)
(54 57 60 57 54)
(54 58 60 59 54)
(54 58 57 59 54)
(54 58 60 59 54)
(54 57 60 57 54)
(54 58 60 59 54)
(54 58 57 59 54) ; 30
(56 58 60 59 56)
(55 58 60 59 55)
(54 58 60 59 54)
(54 57 60 57 54)
(54 58 60 59 54)
(54 57 60 57 54)
(54 58 60 59 54)
(54 57 60 57 54)
(54 58 60 59 54)
(54 57 60 57 54) ; 40
(56 58 60 59 56)
(55 58 60 59 55)
(54 57 57 59 54)
(54 58 57 59 54)
(54 58 57 59 54)
(54 58 57 59 54)
(54 58 57 59 54)
(54 58 57 59 54)
(54 58 57 59 54)
(54 58 57 57 54) ; 50
(56 58 60 59 56)
(55 58 60 59 55)
(54 58 57 57 54)
(54 58 57 59 54)
(54 58 57 59 54)
(54 58 57 59 54)
(54 58 57 59 54)
(54 58 57 59 54)
(54 58 57 59 54)
(54 57 57 59 54) ; 60
(56 58 60 59 56)
(55 58 60 59 55)
(54 58 60 59 54)
(54 58 57 59 54) ; 64 <-- start line
(54 58 60 59 54)
(54 58 57 59 54)
(54 58 60 59 54)
(54 58 57 59 54)
(54 58 60 59 54)
(54 58 57 59 54) ; 70
(56 58 60 59 56))))
(defparameter *map2* (make-array '(72 5) :initial-contents
'((28 29 28 27 29) ; 0
(35 36 27 35 36)
(27 28 27 29 27)
(35 36 28 35 36)
(28 27 29 28 27)
(35 36 28 35 36)
(27 28 27 29 29)
(35 36 29 35 36)
(28 27 29 27 28)
(27 29 28 28 27)
(27 28 27 29 27) ; 10
(29 27 29 28 27)
(28 29 28 27 29)
(29 28 27 29 30)
(28 29 28 29 27)
(29 28 27 29 28)
(27 28 29 28 29)
(28 35 36 29 27)
(27 29 29 27 28)
(29 28 27 28 29)
(28 28 27 29 27) ; 20
(27 29 32 27 28)
(29 28 29 27 28)
(27 28 29 28 29)
(28 27 29 27 29)
(27 29 28 31 27)
(27 28 29 27 29)
(28 27 29 27 28)
(29 27 28 28 29)
(27 28 27 29 35)
(28 29 27 28 27) ; 30
(29 27 28 27 29)
(27 28 29 28 27)
(28 27 28 27 29)
(27 29 29 28 27)
(29 33 34 29 28)
(28 27 29 28 29)
(27 29 28 29 27)
(27 28 29 27 28)
(29 27 28 35 36)
(28 27 28 29 27) ; 40
(29 28 27 28 27)
(28 29 27 29 28)
(27 28 29 32 27)
(28 29 27 28 29)
(27 29 28 27 28)
(28 28 29 27 29)
(27 29 28 29 27)
(27 28 29 27 28)
(28 29 28 29 27)
(36 28 29 28 27) ; 50
(28 29 27 27 29)
(29 27 33 34 28)
(28 29 27 28 27)
(29 31 28 29 27)
(27 28 29 28 29)
(28 29 28 29 27)
(29 27 28 27 28)
(27 35 36 28 29)
(28 27 28 29 27)
(27 28 27 28 29) ; 60
(28 29 28 29 27)
(27 28 29 27 28)
(28 29 28 27 29)
(28 27 29 28 27) ; 64 <-- start line
(29 28 27 30 29)
(27 29 28 27 28)
(28 27 29 28 29)
(29 28 27 29 27)
(28 27 29 28 27)
(27 29 28 29 28) ; 70
(28 27 29 28 27))))
(defparameter *map3* (make-array '(72 5) :initial-contents
'((44 45 44 43 45) ; 0
(43 44 43 45 44)
(43 44 43 45 43)
(45 43 44 43 45)
(44 43 45 44 43)
(45 43 44 45 43)
(43 44 43 45 45)
(44 43 45 43 44)
(44 39 45 43 44)
(43 45 44 44 43)
(43 44 43 45 43) ; 10
(45 43 45 44 43)
(44 45 44 43 45)
(45 44 43 45 44)
(44 45 44 45 43)
(45 44 43 45 44)
(43 41 45 44 45)
(44 43 45 43 40)
(42 45 45 43 44)
(45 44 43 44 45)
(44 44 43 38 43) ; 20
(43 45 44 43 44)
(45 44 45 43 44)
(43 44 45 44 45)
(39 43 45 43 45)
(43 45 44 46 43)
(43 44 45 43 45)
(37 43 45 43 44)
(45 43 40 44 45)
(43 44 43 45 43)
(44 45 43 44 43) ; 30
(45 43 44 43 41)
(43 44 45 44 43)
(44 43 44 43 45)
(43 45 37 44 43)
(45 44 43 45 44)
(44 43 45 44 45)
(43 45 44 45 43)
(43 44 45 43 44)
(45 43 44 45 43)
(44 43 44 45 43) ; 40
(42 44 43 44 43)
(44 45 43 45 44)
(43 44 45 44 38)
(44 39 43 44 45)
(43 45 44 43 44)
(44 44 45 43 45)
(43 45 44 45 43)
(43 44 41 43 44)
(37 45 44 45 43)
(43 44 45 44 43) ; 50
(44 45 43 43 46)
(45 43 44 45 44)
(44 45 43 44 43)
(45 43 44 41 43)
(43 44 45 44 45)
(44 45 44 45 43)
(45 43 44 43 44)
(43 44 45 38 45)
(44 43 44 45 43)
(43 44 43 44 45) ; 60
(44 43 44 45 43)
(39 44 45 43 44)
(44 45 44 43 45)
(44 43 45 44 43) ; 64 <-- start line
(45 44 43 41 45)
(43 45 44 43 44)
(42 43 45 44 45)
(45 44 43 45 43)
(44 43 45 44 43)
(43 45 44 45 44) ; 70
(44 43 45 44 43))))
（５／２８）紫の部分の名前をちょっと訂正
