diff options
Diffstat (limited to 'examples')
-rw-r--r-- | examples/09-ghoulspree.lisp | 79 |
1 files changed, 79 insertions, 0 deletions
diff --git a/examples/09-ghoulspree.lisp b/examples/09-ghoulspree.lisp new file mode 100644 index 0000000..744397d --- /dev/null +++ b/examples/09-ghoulspree.lisp @@ -0,0 +1,79 @@ +;;;; 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 50))) + +(defclass/std ghoul (ww:bitmap) + ((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) + :dx (random-velocity 5) + :dy (random-velocity 5))) + +(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 (< 0.5 (random 1.0)) + (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))) ;; rotation diminishes every round, just aesthetic. + +(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))) + +(ww:defhandler moveghouls + (ww:on-perframe (app) + (loop for ghoul in (ww:container-units app) + do (advance-pos ghoul) + when (out-of-bounds-p ghoul) + do (ww:drop-unit ghoul)))) + +(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))))) + + +(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)) + +(defun start () + (ww::start + (make-instance + 'ghoulspree + :fps 60 + :width 800 + :height 600 + :refocus-on-mousedown-p nil + :title "Click to add ghouls" + :asset-root + (merge-pathnames + "examples/" + (asdf:system-source-directory :wheelwork))))) |