initial commit

flappy-ball-test.lisp

@@ -0,0 +1,6 @@
+(defpackage flappy-ball-test
+  (:use :cl :fiveam :flappy-ball)
+  (:export #:flappy-ball-test))
+
+(in-package :flappy-ball-test)
+

flappy-ball.asd

@@ -0,0 +1,15 @@
+(asdf:defsystem "flappy-ball"
+  :description "A lame flappy bird clone"
+  :version "0.1.0"
+  :serial t
+  :license "MIT"
+  :pathname "."
+  :depends-on ("sketch" "alexandria")
+  :components ((:file "flappy-ball"))
+  :in-order-to ((asdf:test-op (test-op "flappy-ball-test"))))
+
+(asdf:defsystem "flappy-ball/test"
+  :depends-on ("flappy-ball fiveam")
+  :components ((:file "flappy-ball-test"))
+  :perform (asdf:test-op (o c)
+                         (funcall (intern (format nil "RUN-~A" (symbol-name (asdf:component-name c)))))))

flappy-ball.lisp

@@ -0,0 +1,49 @@
+(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)))
+