diff options
Diffstat (limited to 'examples/08-pong.lisp')
-rw-r--r-- | examples/08-pong.lisp | 30 |
1 files changed, 25 insertions, 5 deletions
diff --git a/examples/08-pong.lisp b/examples/08-pong.lisp index 00577c9..bf80e32 100644 --- a/examples/08-pong.lisp +++ b/examples/08-pong.lisp @@ -7,6 +7,8 @@ (in-package #:ww.examples/8) +;;; CLASSES + (defclass/std solo-pong (ww::application) ((paddle ball game-over intro-text))) @@ -16,12 +18,18 @@ (defclass/std paddle (ww::bitmap mobile) ()) (defclass/std ball (ww::bitmap mobile) ()) +;;; UTILITY FUNCTIONS + (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) + "THING is expected to have the affine protocol implemented on it, +and to be an instance of MOBILE. + +In this game, this will only ever be called on the ball." (with-accessors ((dr dr) (dx dx) (dy dy) (x ww::x) (y ww::y) (r ww::rotation)) thing (incf x dx) (incf y dy) @@ -29,6 +37,8 @@ (setf dr (decay dr)))) ;; rotation diminishes every round, just aesthetic. (defun decay (val &optional (amount 0.01)) + "Returns a value that is VAL reduced in magnitude by AMOUNT, or zero +of VAL is already zero." (cond ((zerop val) val) @@ -38,20 +48,28 @@ (+ val amount)))) (defun avg (&rest args) + "Just averages values" (loop for x in args sum x into total sum 1 into count finally (return (/ total count)))) (defun sqrt+ (val) + "Returns a value with the same sign as VAL, but whose magnitude is +the sqrt of the magintude of VAL." (if (plusp val) (sqrt val) (* -1 (sqrt (abs val))))) (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 pong-perframe (ww::on-perframe (app) + "Called on the app once per frame. Responsible for checking + collisions and adjusting the ball's properties. And for + checking for and handling gameover conditions." (with-slots (paddle ball game-over) app (when (ww::units-intersect-p paddle ball) (setf @@ -84,17 +102,17 @@ (advance-pos ball)) ((<= 800 (+ bx w)) - (setf dx (* -1 dx) - bx (- 800 w)) + (setf dx (* -1 dx)) (advance-pos ball)) ((<= bx 0) - (setf dx (* -1 dx) - bx 0)) - + (setf dx (* -1 dx))) + + ;; game over ((<= by 0) (setf (ww::unit-visiblep game-over) t))) + ;; just to be safe, dx can get pretty fast (setf bx (clamp 0.0 bx (- 800 w))) ;; and whatever else happens, advance the ball position. @@ -102,6 +120,7 @@ (ww::defhandler pong-mousemove (ww::on-mousemotion (app) + "Just sets the position of the paddle, and updates the paddles dx" (setf (ww::x (paddle app)) (- x (* 0.5 (ww::width (paddle app)))) ;; using dx to store some motion informaton @@ -152,6 +171,7 @@ (defmethod ww::boot ((app solo-pong)) + "Adds the intro text and sets up the start button handler." (ww::add-unit app (setf (intro-text app) |