add game state machine

This commit is contained in:
Peter Tillemans 2024-05-01 11:17:12 +02:00
parent d946b38235
commit ba69ed8d03
2 changed files with 48 additions and 15 deletions

View file

@ -4,7 +4,7 @@
A flappy bird clone to get experience with Common Lisp and game development. 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] Create bird, well, ball
- [X] Add physics for ball movement - [X] Add physics for ball movement
- [X] Add inputs on key and mouse clicks - [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] Add background
- [X] Create random pipes - [X] Create random pipes
- [X] Add goal after last pipe - [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 scores
- [ ] Add high scores - [ ] Add high scores
- [ ] Package for Mac/Linux/(Windows?) - [ ] Package for Mac/Linux/(Windows?)

View file

@ -7,7 +7,6 @@
(in-package :flappy-ball) (in-package :flappy-ball)
;; Create a new ball entity ;; Create a new ball entity
;; (make-ball 10 20 -5.6) ;; (make-ball 10 20 -5.6)
(defun make-ball (x y velocity size) (defun make-ball (x y velocity size)
@ -91,6 +90,7 @@
(and (<= (- x bs) bx (+ x w bs)) (and (<= (- x bs) bx (+ x w bs))
(not (<= (+ h bs) by (- (+ h gap) bs)))))) (not (<= (+ h bs) by (- (+ h gap) bs))))))
;; ------------------------------------------------------------- ;; -------------------------------------------------------------
(defun draw-image-layer(resource scroll-x) (defun draw-image-layer(resource scroll-x)
@ -119,6 +119,8 @@
collect (make-pipe x (+ padding (random (- max-height gap padding padding))) gap width))) collect (make-pipe x (+ padding (random (- max-height gap padding padding))) gap width)))
) )
;; -------------------------------------------------------------
(defsketch flappy-ball (defsketch flappy-ball
((title "Flappy Ball") ((title "Flappy Ball")
@ -132,36 +134,67 @@
(ball-pen (make-pen :stroke (gray 0.5) :fill sketch:+yellow+ :weight 1)) (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)) (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)) (pipe-pen (make-pen :stroke (gray 0.5) :fill sketch:+green+ :weight 1))
(pipes-amount 5) (pipes-amount 1)
(pipes-spacing 200) (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-x 0.0)
(scroll-speed 0.2) (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-background scroll-x)
(draw-foreground pipes scroll-x pipe-pen height) (draw-foreground pipes scroll-x pipe-pen height)
(ball-draw ball (ball-draw ball
(if (some (lambda (pipe) (pipe-collides pipe ball scroll-x)) pipes) (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)) 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) (if (>= scroll-x target-x)
(let ((pic (load-resource "assets/level1/prize.png"))) (let ((pic (load-resource "assets/level1/prize.png")))
(draw pic :x (- (+ 960 target-x) scroll-x) :y 0 ))) (draw pic :x (- (+ 960 target-x) scroll-x) :y 0 )))
(setf scroll-x (+ scroll-x scroll-speed)) (when (eq state 'running)
(setf ball (ball-move ball gravity ground-level))) (setf scroll-x (+ scroll-x scroll-speed))
(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) (defmethod on-click ((instance flappy-ball) x y)
(with-slots (ball flap-speed) instance (with-slots (ball flap-speed state) instance
(setf ball (ball-flap ball flap-speed)))) (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) (defmethod on-key ((instance flappy-ball) key state)
(with-slots (ball flap-speed) instance (with-slots (ball flap-speed state) instance
(setf ball (ball-flap ball flap-speed)))) (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) (defmethod setup ((instance flappy-ball) &key &allow-other-keys)
(background (gray 1))) (background (gray 1)))