da2ecd6070
refactored ball and pipes as separate entities. Added collision detection for the ball and pipes. Ball now turns red when colliding with pipes.
132 lines
3.3 KiB
Common Lisp
132 lines
3.3 KiB
Common Lisp
(defpackage :flappy-ball
|
|
(:use :cl :sketch)
|
|
(:export :flappy-ball :on-click :on-key :setup))
|
|
|
|
(in-package :flappy-ball)
|
|
|
|
|
|
|
|
;; Create a new ball entity
|
|
;; (make-ball 10 20 -5.6)
|
|
(defun make-ball (x y velocity size)
|
|
(list x y velocity size))
|
|
|
|
(defun ball-x (ball)
|
|
(car ball))
|
|
|
|
(defun ball-y (ball)
|
|
(cadr ball))
|
|
|
|
(defun ball-velocity (ball)
|
|
(caddr ball))
|
|
|
|
(defun ball-size (ball)
|
|
(cadddr ball))
|
|
|
|
|
|
(defun ball-move (ball gravity max-height)
|
|
(let ((size (ball-size ball))
|
|
(velocity (ball-velocity ball)))
|
|
(make-ball
|
|
(ball-x ball)
|
|
(alexandria:clamp (+ (ball-y ball) velocity) size (- max-height size))
|
|
(+ velocity gravity)
|
|
size)))
|
|
|
|
(defun ball-flap (ball flap-speed)
|
|
(list
|
|
(ball-x ball)
|
|
(ball-y ball)
|
|
flap-speed
|
|
(ball-size ball)))
|
|
|
|
(defun ball-draw (ball pen)
|
|
(with-pen pen
|
|
(circle (ball-x ball) (ball-y ball) (ball-size ball))))
|
|
|
|
;; -------------------------------------------------------------
|
|
|
|
;; Create a new pipe entity
|
|
;; (setf pipe (make-pipe 10 200 100 20))
|
|
(defun make-pipe (x height gap width)
|
|
(list x height gap width))
|
|
|
|
;; Accessors
|
|
|
|
;; (pipe-x pipe)
|
|
(defun pipe-x (pipe)
|
|
(car pipe))
|
|
|
|
;; (pipe-height pipe)
|
|
(defun pipe-height (pipe)
|
|
(cadr pipe))
|
|
|
|
;; (pipe-gap pipe)
|
|
(defun pipe-gap (pipe)
|
|
(caddr pipe))
|
|
|
|
;; (pipe-width pipe)
|
|
(defun pipe-width (pipe)
|
|
(cadddr pipe))
|
|
|
|
(defun pipe-draw (pipe pen scroll-x height)
|
|
(let ((x (- (pipe-x pipe) scroll-x))
|
|
(h (pipe-height pipe))
|
|
(gap (pipe-gap pipe))
|
|
(w (pipe-width pipe)))
|
|
(with-pen pen
|
|
(rect x 0 w h)
|
|
(rect x (+ h gap) w (- height h gap)))))
|
|
|
|
(defun pipe-collides (pipe ball scroll-x)
|
|
(let ((x (- (pipe-x pipe) scroll-x))
|
|
(h (pipe-height pipe))
|
|
(gap (pipe-gap pipe))
|
|
(w (pipe-width pipe))
|
|
(bx (ball-x ball))
|
|
(by (ball-y ball))
|
|
(bs (ball-size ball)))
|
|
(and (<= (- x bs) bx (+ x w bs))
|
|
(not (<= (+ h bs) by (- (+ h gap) bs))))))
|
|
|
|
;; -------------------------------------------------------------
|
|
|
|
(defsketch flappy-ball
|
|
((title "Flappy Ball")
|
|
(width 800)
|
|
(height 600)
|
|
(copy-pixels nil)
|
|
(ball (make-ball (/ width 10) (/ height 3) 0 10))
|
|
(gravity 0.05)
|
|
(flap-speed -2.5)
|
|
(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 (list
|
|
(make-pipe 200 200 100 20)
|
|
(make-pipe 400 300 100 20)
|
|
(make-pipe 600 400 100 20)))
|
|
(scroll-x 0.0)
|
|
(scroll-speed 0.2))
|
|
|
|
(dolist (pipe pipes)
|
|
(pipe-draw pipe pipe-pen scroll-x height))
|
|
(ball-draw ball
|
|
(if (some (lambda (pipe) (pipe-collides pipe ball scroll-x)) pipes)
|
|
collision-pen
|
|
ball-pen))
|
|
|
|
(setf scroll-x (+ scroll-x scroll-speed))
|
|
(setf ball (ball-move ball gravity height)))
|
|
|
|
(defmethod on-click ((instance flappy-ball) x y)
|
|
(with-slots (ball flap-speed) instance
|
|
(setf ball (ball-flap ball flap-speed))))
|
|
|
|
(defmethod on-key ((instance flappy-ball) key state)
|
|
(with-slots (ball flap-speed) instance
|
|
(setf ball (ball-flap ball flap-speed))))
|
|
|
|
(defmethod setup ((instance flappy-ball) &key &allow-other-keys)
|
|
(background (gray 1)))
|
|
|