;;;; examples/09-ghoulspree.lisp (defpackage #:ww.examples/9 (:use #:cl) (:export #:start) (:import-from #:defclass-std #:defclass/std)) (in-package #:ww.examples/9) ;;; CLASSES (defclass/std ghoulspree (ww::application) ((ghouls-per-click :std 20) (collision-on-p :std t) (gravity-on-p :std nil))) (defclass/std ghoul (ww:image) ((dx dy dr :std))) ;;; UTILITY FUNCTIONS (defun make-ghoul (x y) (make-instance 'ghoul :texture (ww:get-asset "Fezghoul.png") :x x :y y :dr (random-velocity 0.2) :dx (random-velocity 4) :dy (random-velocity 4))) (defun out-of-bounds-p (ghoul) (not (and (< -50 (ww:x ghoul) 850) (< -50 (ww:y ghoul) 650)))) (defun random-velocity (&optional (size 1.0)) (* size (if (zerop (random 2)) (random 1.0) (* -1 (random 1.0))))) (defun advance-pos (thing) (with-accessors ((dr dr) (dx dx) (dy dy) (x ww::x) (y ww::y) (r ww::rotation)) thing (incf x dx) (incf y dy) (incf r dr))) (defun clamp (lo val hi) "Returns VAL if (< LO VAL HI), otherwise returns LO or HI depending 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) vector &rest body) (alexandria:with-gensyms (idxa idxb vec) `(loop with ,vec = ,vector for ,idxa from 0 to (- (length ,vec) 2) for ,a = (aref ,vec ,idxa) do (loop for ,idxb from (1+ ,idxa) to (1- (length ,vec)) for ,b = (aref ,vec ,idxb) do (progn ,@body))))) (defun handle-collision (g1 g2 &optional (friction 0.99)) (with-slots ((dx1 dx) (dy1 dy) (dr1 dr)) g1 (with-slots ((dx2 dx) (dy2 dy) (dr2 dr)) g2 (let ((tdx (* friction dx1)) (tdy (* friction dy1)) (tdr (* friction dr1))) (setf dx1 (* friction dx2) dy1 (* friction dy2) dr1 (* friction dr2) dx2 tdx dy2 tdy dr2 tdr))))) (defun apply-gravity-to (thing acc) (with-slots (dx dy) thing (decf dy acc))) (ww:defhandler moveghouls (ww:on-perframe (app) ;; first handle collisions (when (collision-on-p app) (with-pairs (g1 g2) (ww::application-scene app) (when (ww:units-intersect-p g1 g2) (handle-collision g1 g2 1.0) ;; need a "bounce" (advance-pos g1) (advance-pos g1) (advance-pos g2) (advance-pos g2)))) ;; then update positions and remove the out of bounds (let ((gravity (gravity-on-p app)) (accelleration (/ 9.8 (ww:fps app)))) (loop for ghoul across (ww::application-scene app) do (advance-pos ghoul) when gravity do (apply-gravity-to ghoul accelleration) 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) 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 (make-ghoul rx ry))) (format t "~a ghouls on screen~%" (length (ww::application-scene app ))))) (ww:defhandler toggle-collision (ww:on-keydown (app scancode) (case scancode (:scancode-c (format t "collision: ~a~%" (setf (collision-on-p app) (not (collision-on-p app))))) (:scancode-g (format t "gravity: ~a~%" (setf (gravity-on-p app) (not (gravity-on-p app)))))))) (defmethod ww::boot ((app ghoulspree)) "Adds the intro text and sets up the start button handler." (format t "Click to add ~a ghouls to the screen.~%" (ghouls-per-click app)) (format t "Press c to toggle collision handling.~%") (format t "Press g to toggle gravity.~%") (ww:add-handler app #'add-ghouls) (ww:add-handler app #'moveghouls) (ww:add-handler app #'toggle-collision)) (defun start (&optional (scale 1.0)) (ww::start (make-instance 'ghoulspree :fps 60 :width (round (* 800 scale)) :height (round (* 600 scale)) :scale scale :refocus-on-mousedown-p nil :title "Click to add ghouls" :asset-root (merge-pathnames "examples/" (asdf:system-source-directory :wheelwork)))))