aboutsummaryrefslogtreecommitdiffhomepage
path: root/examples/08-pong.lisp
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-07-08 08:22:09 -0500
committerColin Okay <colin@cicadas.surf>2022-07-08 08:22:09 -0500
commit50035adb08e82c240209ab6b53ba70e741ea58b0 (patch)
tree4537bb50027b179e1880df74320c3ff649dc651a /examples/08-pong.lisp
parent49d2a25cd4910be8ad1e32938a6537e0adcf6450 (diff)
[example] [modify] pong, made it a bit more dynamic
Diffstat (limited to 'examples/08-pong.lisp')
-rw-r--r--examples/08-pong.lisp75
1 files changed, 60 insertions, 15 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