aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--examples/09-ghoulspree.lisp63
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