49 lines
1.4 KiB
Common Lisp
49 lines
1.4 KiB
Common Lisp
(defpackage :flappy-ball
|
|
(:use :cl :sketch)
|
|
(:export :flappy-ball :on-click :on-key :setup))
|
|
|
|
(in-package :flappy-ball)
|
|
|
|
(defsketch flappy-ball
|
|
((title "Flappy Ball")
|
|
(width 800)
|
|
(height 600)
|
|
(copy-pixels nil)
|
|
(ball (list (/ width 10) (/ height 3) 0))
|
|
(gravity 0.05)
|
|
(flap-speed -0.25)
|
|
(ball-pen (make-pen :stroke (gray 0.5) :fill sketch:+yellow+ :weight 1))
|
|
(pipe-pen (make-pen :stroke (gray 0.5) :fill sketch:+green+ :weight 1))
|
|
(pipes '((200 200 100) (400 300 100) (600 400 100)))
|
|
(scroll-x 0.0)
|
|
(scroll-speed 0.2))
|
|
|
|
(flet ((move (b)
|
|
(list
|
|
(car b)
|
|
(alexandria:clamp (+ (cadr b) (caddr b)) 10 (- height 10))
|
|
(+ (caddr b) gravity))))
|
|
(with-pen ball-pen
|
|
(circle (car ball) (cadr ball) 10))
|
|
(with-pen pipe-pen
|
|
(dolist (pipe pipes)
|
|
(let ((x (- (car pipe) scroll-x))
|
|
(h (cadr pipe))
|
|
(gap (caddr pipe)))
|
|
(rect x 0 20 h)
|
|
(rect x (+ h gap) 20 (- height h gap)))))
|
|
(setf scroll-x (+ scroll-x scroll-speed))
|
|
(setf ball (move ball)))
|
|
)
|
|
|
|
(defmethod on-click ((instance flappy-ball) x y)
|
|
(with-slots (ball flap-speed) instance
|
|
(setf (caddr ball) flap-speed)))
|
|
|
|
(defmethod on-key ((instance flappy-ball) key state)
|
|
(with-slots (ball flap-speed) instance
|
|
(setf (caddr ball) flap-speed)))
|
|
|
|
(defmethod setup ((instance flappy-ball) &key &allow-other-keys)
|
|
(background (gray 1)))
|
|
|