diff options
| -rw-r--r-- | examples/08-pong.lisp | 75 | ||||
| -rw-r--r-- | wheelwork-examples.asd | 3 | ||||
| -rw-r--r-- | wheelwork.asd | 1 |
3 files changed, 62 insertions, 17 deletions
diff --git a/examples/08-pong.lisp b/examples/08-pong.lisp index 1eed260..c9b4edb 100644 --- a/examples/08-pong.lisp +++ b/examples/08-pong.lisp @@ -25,38 +25,83 @@ (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))) - + (incf r dr) + (setf dr (decay dr)))) ;; rotation diminishes every round, just aesthetic. + +(defun decay (val &optional (amount 0.01)) + (cond + ((zerop val) + val) + ((plusp val) + (- val amount)) + ((minusp val) + (+ val amount)))) + +(defun avg (&rest args) + (loop for x in args + sum x into total + sum 1 into count + finally (return (/ total count)))) + +(defun sqrt+ (val) + (if (plusp val) (sqrt val) + (* -1 (sqrt (abs val))))) (ww::defhandler pong-perframe (ww::on-perframe (app) (with-slots (paddle ball game-over) app - (when (ww::units-intersect-p paddle ball) - (setf (dy ball) (* -1 (dy ball)) - (dr ball) (* -1 (dr ball))) - (incf (ww::x ball) (dx ball)) - (incf (ww::y ball) (dy ball))) - - (with-accessors ((dx dx) (dy dy) (bx ww::x) (by ww::y) (w ww::width) (h ww::height)) ball + (setf + ;; dy just reverses direction + (dy ball) (* -1 (dy ball)) + ;; average dx of the two + (dx ball) (avg (dx ball) (dx paddle)) + ;; no logic to it dr change, just aesthetic + (dr ball) (avg (sqrt+ (sqrt+ (dx paddle))) (dr ball))) + + ;; its a good idea to advance the ball position after every collision + ;; this prevents the ball from "getting stuck" contstantly colliding + ;; with an object / wall. + (advance-pos ball)) + + ;; since the dx of the paddle only changes when the paddle + ;; moves we should have it decay if its just been sitting + ;; still. Mostly for aesthetics. It looks funny if a + ;; stationary paddle speeds up the ball. + (setf (dx paddle) (decay (dx paddle) 1)) + + ;; here we just check the bounds, bounce when the ball hits the top left or right + ;; and signal game over if it hits the bottom. + (with-accessors + ((dx dx) (dy dy) (bx ww::x) (by ww::y) (w ww::width) (h ww::height)) ball (cond ((<= 600 (+ by h)) - (setf dy (* -1 dy)) + (setf dy (* -1 dy) + by (- 600 h)) (advance-pos ball)) - ((or (<= 800 (+ bx w)) (<= bx 0)) - (setf dx (* -1 dx)) + ((<= 800 (+ bx w)) + (setf dx (* -1 dx) + bx (- 800 w)) (advance-pos ball)) + ((<= bx 0) + (setf dx (* -1 dx) + x 0)) + ((<= by 0) (setf (ww::unit-visiblep game-over) t))) + ;; and whatever else happens, advance the ball position. (advance-pos ball))))) (ww::defhandler pong-mousemove - (ww::on-mousemotion (app x) + (ww::on-mousemotion (app) (setf (ww::x (paddle app)) - (- x (* 0.5 (ww::width (paddle app))))))) + (- x (* 0.5 (ww::width (paddle app)))) + ;; using dx to store some motion informaton + ;; used to chagne dx and dr in the ball + (dx (paddle app)) xrel))) ; xrel is supplied by default by on-mousedown (defmethod ww::boot ((app solo-pong)) (let* ((ball @@ -66,7 +111,7 @@ :x 400 :y 300 :dr (random-velocity) :dx (random-velocity 10) - :dy (random-velocity 10))) + :dy 8)) (paddle (make-instance 'paddle diff --git a/wheelwork-examples.asd b/wheelwork-examples.asd index a5a5498..952c36a 100644 --- a/wheelwork-examples.asd +++ b/wheelwork-examples.asd @@ -12,4 +12,5 @@ (:file "04-a-button") (:file "05-frameset-animation") (:file "06-sprite") - (:file "07-renderarea"))) + (:file "07-renderarea") + (:file "08-pong"))) diff --git a/wheelwork.asd b/wheelwork.asd index 5de81de..095c949 100644 --- a/wheelwork.asd +++ b/wheelwork.asd @@ -30,7 +30,6 @@ (:module "core" :components ((:file "unit") (:file "container") - (:file "clipped") (:file "affine"))) (:module "events" :components ((:file "event-handler") |