add game state machine
This commit is contained in:
parent
d946b38235
commit
ba69ed8d03
2 changed files with 48 additions and 15 deletions
4
TODO.org
4
TODO.org
|
@ -4,7 +4,7 @@
|
|||
A flappy bird clone to get experience with Common Lisp and game development.
|
||||
|
||||
|
||||
* Game Plan [10/15]
|
||||
* Game Plan [11/15]
|
||||
- [X] Create bird, well, ball
|
||||
- [X] Add physics for ball movement
|
||||
- [X] Add inputs on key and mouse clicks
|
||||
|
@ -15,7 +15,7 @@ A flappy bird clone to get experience with Common Lisp and game development.
|
|||
- [X] Add background
|
||||
- [X] Create random pipes
|
||||
- [X] Add goal after last pipe
|
||||
- [ ] Create state machine to manage start/play/finish
|
||||
- [X] Create state machine to manage start/play/finish
|
||||
- [ ] Add scores
|
||||
- [ ] Add high scores
|
||||
- [ ] Package for Mac/Linux/(Windows?)
|
||||
|
|
|
@ -7,7 +7,6 @@
|
|||
(in-package :flappy-ball)
|
||||
|
||||
|
||||
|
||||
;; Create a new ball entity
|
||||
;; (make-ball 10 20 -5.6)
|
||||
(defun make-ball (x y velocity size)
|
||||
|
@ -91,6 +90,7 @@
|
|||
(and (<= (- x bs) bx (+ x w bs))
|
||||
(not (<= (+ h bs) by (- (+ h gap) bs))))))
|
||||
|
||||
|
||||
;; -------------------------------------------------------------
|
||||
|
||||
(defun draw-image-layer(resource scroll-x)
|
||||
|
@ -119,6 +119,8 @@
|
|||
collect (make-pipe x (+ padding (random (- max-height gap padding padding))) gap width)))
|
||||
)
|
||||
|
||||
;; -------------------------------------------------------------
|
||||
|
||||
|
||||
(defsketch flappy-ball
|
||||
((title "Flappy Ball")
|
||||
|
@ -132,35 +134,66 @@
|
|||
(ball-pen (make-pen :stroke (gray 0.5) :fill sketch:+yellow+ :weight 1))
|
||||
(collision-pen (make-pen :stroke (gray 0.5) :fill sketch:+red+ :weight 1))
|
||||
(pipe-pen (make-pen :stroke (gray 0.5) :fill sketch:+green+ :weight 1))
|
||||
(pipes-amount 5)
|
||||
(pipes-amount 1)
|
||||
(pipes-spacing 200)
|
||||
(pipes (random-pipes pipes-amount pipes-spacing ground-level 100 20))
|
||||
(pipes-width 20)
|
||||
(pipes (random-pipes pipes-amount pipes-spacing ground-level 100 pipes-width))
|
||||
(scroll-x 0.0)
|
||||
(scroll-speed 0.2)
|
||||
(target-x (- (* pipes-amount pipes-spacing) 720)))
|
||||
(target-x (- (* pipes-amount pipes-spacing) 720))
|
||||
(state 'new))
|
||||
|
||||
(draw-background scroll-x)
|
||||
(draw-foreground pipes scroll-x pipe-pen height)
|
||||
|
||||
(ball-draw ball
|
||||
(if (some (lambda (pipe) (pipe-collides pipe ball scroll-x)) pipes)
|
||||
collision-pen
|
||||
(progn
|
||||
(when (eq state 'running)
|
||||
(setf state 'died))
|
||||
collision-pen)
|
||||
ball-pen))
|
||||
|
||||
(when (eq state 'new)
|
||||
(setf scroll-x 0.0)
|
||||
(text "Click to Start" 350 250 200 40))
|
||||
(when (eq state 'won)
|
||||
(text "You Won" 400 100 120 40))
|
||||
(when (eq state 'died)
|
||||
(text "You Died" 400 250 120 40))
|
||||
|
||||
(if (>= scroll-x target-x)
|
||||
(let ((pic (load-resource "assets/level1/prize.png")))
|
||||
(draw pic :x (- (+ 960 target-x) scroll-x) :y 0 )))
|
||||
|
||||
(when (eq state 'running)
|
||||
(setf scroll-x (+ scroll-x scroll-speed))
|
||||
(setf ball (ball-move ball gravity ground-level)))
|
||||
(setf ball (ball-move ball gravity ground-level))
|
||||
(when (> scroll-x (+ (* pipes-amount pipes-spacing) pipes-width))
|
||||
(setf state 'won)))
|
||||
)
|
||||
|
||||
(defmethod on-click ((instance flappy-ball) x y)
|
||||
(with-slots (ball flap-speed) instance
|
||||
(setf ball (ball-flap ball flap-speed))))
|
||||
(with-slots (ball flap-speed state) instance
|
||||
(setf ball (ball-flap ball flap-speed))
|
||||
(when (eq state 'new)
|
||||
(setf state 'running))
|
||||
(when (eq state 'died)
|
||||
(setf state 'new))
|
||||
(when (eq state 'won)
|
||||
(setf state 'new))
|
||||
))
|
||||
|
||||
(defmethod on-key ((instance flappy-ball) key state)
|
||||
(with-slots (ball flap-speed) instance
|
||||
(setf ball (ball-flap ball flap-speed))))
|
||||
(with-slots (ball flap-speed state) instance
|
||||
(setf ball (ball-flap ball flap-speed))
|
||||
(when (eq state 'new)
|
||||
(setf state 'running))
|
||||
(when (eq state 'died)
|
||||
(setf state 'new))
|
||||
(when (eq state 'won)
|
||||
(setf state 'new))
|
||||
))
|
||||
|
||||
(defmethod setup ((instance flappy-ball) &key &allow-other-keys)
|
||||
(background (gray 1)))
|
||||
|
|
Loading…
Reference in a new issue