diff options
Diffstat (limited to 'examples/09-ghoulspree.lisp')
| -rw-r--r-- | examples/09-ghoulspree.lisp | 63 |
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 |