[example] add collision detection to ghoulspree

1 files changed, 57 insertions, 6 deletions

diff --git a/examples/09-ghoulspree.lisp b/examples/09-ghoulspree.lisp
index 744397d..9b40605 100644
--- a/examples/09-ghoulspree.lisp
+++ b/examples/09-ghoulspree.lisp
@@ -10,7 +10,8 @@
 ;;; CLASSES
 
 (defclass/std  ghoulspree (ww::application)
-  ((ghouls-per-click :std 50)))
+  ((ghouls-per-click :std 10)
+   (collision-on-p :std t)))
 
 (defclass/std ghoul (ww:bitmap)
   ((dx dy dr :std)))
@@ -21,8 +22,8 @@
   (make-instance 'ghoul :texture (ww:get-asset "Fezghoul.png")
                         :x x :y y
                         :dr (random-velocity)
-                        :dx (random-velocity 5)
-                        :dy (random-velocity 5)))
+                        :dx (random-velocity 4)
+                        :dy (random-velocity 4)))
 
 (defun out-of-bounds-p (ghoul)
   (not
@@ -31,7 +32,7 @@
     (< -50 (ww:y ghoul) 650))))
 
 (defun random-velocity (&optional (size 1.0))
-  (* size (if (< 0.5 (random 1.0))
+  (* size (if (zerop (random 2))
               (random 1.0)
               (* -1 (random 1.0)))))
 
@@ -46,23 +47,73 @@
 on which boundary VAL is outside of."
   (max lo (min val hi)))
 
+(defun sign (x)
+  (if (zerop x) 0
+      (/ x (abs x))))
+
+(defmacro with-pairs ((a b) ls &rest body)
+  "run body with a and b bound to unique 2-sets of LS"
+  (let ((more-a (gensym)))
+    `(loop for (,a . ,more-a) on ,ls do
+      (loop for ,b in ,more-a do (progn ,@body)) )))
+
+(defun handle-collision (g1 g2 &optional (friction 0.99))
+  (with-slots ((dx1 dx) (dy1 dy)) g1
+    (with-slots ((dx2 dx) (dy2 dy)) g2
+      (let ((tdx (* friction dx1))
+            (tdy (* friction dy1)))
+        (setf dx1 (* friction dx2)
+              dy1 (* friction dy2)
+              dx2 tdx
+              dy2 tdy)))))
+
 (ww:defhandler moveghouls
     (ww:on-perframe (app)
+      ;; first handle collisions
+      (when (collision-on-p app)
+        (with-pairs
+            (g1 g2) (ww:container-units app)
+            (when (ww:units-intersect-p g1 g2)
+              (handle-collision g1 g2 0.99)
+              ;; need a "bounce" 
+              (advance-pos g1)
+              (advance-pos g1)
+              (advance-pos g2)
+              (advance-pos g2))))
+      
+      ;; then update positions and remove the out of bounds
       (loop for ghoul in (ww:container-units app)
             do (advance-pos ghoul)
             when (out-of-bounds-p ghoul)
               do (ww:drop-unit ghoul))))
 
+(defun random-sign ()
+  (if (zerop (random 2)) -1 1))
+
+(defun random-between (lo hi)
+  (+ lo (random (- hi lo))))
+
 (ww:defhandler add-ghouls
     (ww:on-mousedown (app x y)
       (loop repeat (ghouls-per-click app)
-            do (ww:add-unit app (make-ghoul x y)))))
+            for rx = (random 800); (+ x (* (random-sign) (random-between 30 60)))
+            for ry = (random 600); (+ y (* (random-sign) (random-between 30 60)))
+            do (ww:add-unit app (make-ghoul rx ry)))
+      (format t "~a ghouls on screen~%"
+              (length (ww:container-units app )))))
+
 
+(ww:defhandler toggle-collision
+    (ww:on-keydown ()
+      (format t "collision: ~a~%"
+              (setf (collision-on-p target)
+                    (not (collision-on-p target))))))
 
 (defmethod ww::boot ((app ghoulspree))
   "Adds the intro text and sets up the start button handler."
   (ww:add-handler app #'add-ghouls)
-  (ww:add-handler app #'moveghouls))
+  (ww:add-handler app #'moveghouls)
+  (ww:add-handler app #'toggle-collision))
 
 (defun start ()
   (ww::start