diff options
author | Colin Okay <colin@cicadas.surf> | 2022-07-08 08:44:23 -0500 |
---|---|---|
committer | Colin Okay <colin@cicadas.surf> | 2022-07-08 08:44:23 -0500 |
commit | a8690d41f892331fe7cb57c1b543273d41dca96e (patch) | |
tree | 26142f769a61ee73b15d757dec8104a206a81cab /examples/08-pong.lisp | |
parent | 5122fcd280a8ba098e0e4c680c8058db526cc6ac (diff) |
[example] [bugfix] [add] intro text and start command
Diffstat (limited to 'examples/08-pong.lisp')
-rw-r--r-- | examples/08-pong.lisp | 102 |
1 files changed, 64 insertions, 38 deletions
diff --git a/examples/08-pong.lisp b/examples/08-pong.lisp index c9b4edb..00577c9 100644 --- a/examples/08-pong.lisp +++ b/examples/08-pong.lisp @@ -8,7 +8,7 @@ (in-package #:ww.examples/8) (defclass/std solo-pong (ww::application) - ((paddle ball game-over))) + ((paddle ball game-over intro-text))) (defclass/std mobile () ((dx dy dr :std 0))) @@ -47,6 +47,9 @@ (if (plusp val) (sqrt val) (* -1 (sqrt (abs val))))) +(defun clamp (lo val hi) + (max lo (min val hi))) + (ww::defhandler pong-perframe (ww::on-perframe (app) (with-slots (paddle ball game-over) app @@ -87,11 +90,13 @@ ((<= bx 0) (setf dx (* -1 dx) - x 0)) + bx 0)) ((<= by 0) (setf (ww::unit-visiblep game-over) t))) + (setf bx (clamp 0.0 bx (- 800 w))) + ;; and whatever else happens, advance the ball position. (advance-pos ball))))) @@ -101,44 +106,65 @@ (- 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 + (dx (paddle app)) xrel))) ; xrel is supplied by default by on-mousemotion + +(ww::defhandler press-to-start + (ww::on-keydown (app) + "Sets up the ball, paddle, and game over text." + ;; first remove the intro text and keydown handler. + (ww::drop-unit (intro-text app)) + (ww::remove-handler app #'press-to-start) + (let* ((ball + (make-instance + 'ball + :texture (ww::get-asset "Fezghoul.png") + :x 400 :y 300 + :dr (random-velocity) + :dx (random-velocity 10) + :dy 8)) + (paddle + (make-instance + 'paddle + :texture (ww::get-asset "GelatinousCube.png") + :x 400 + :y 0)) + (game-over + (make-instance + 'ww::text + :font (ww::get-asset "Ticketing.ttf") + :content "Game Over" + :visiblep nil + :x 300 + :y 300 + :scale-x 3.0 + :scale-y 3.0))) + (setf (ww::width paddle) 120 + (ww::height paddle) 20 + (paddle app) paddle + (ball app) ball + (game-over app) game-over) + + (ww::add-unit app ball) + (ww::add-unit app paddle) + (ww::add-unit app game-over) + (ww::add-handler app #'pong-mousemove) + (ww::add-handler app #'pong-perframe)))) + (defmethod ww::boot ((app solo-pong)) - (let* ((ball - (make-instance - 'ball - :texture (ww::get-asset "Fezghoul.png") - :x 400 :y 300 - :dr (random-velocity) - :dx (random-velocity 10) - :dy 8)) - (paddle - (make-instance - 'paddle - :texture (ww::get-asset "GelatinousCube.png") - :x 400 - :y 0)) - (game-over - (make-instance - 'ww::text - :font (ww::get-asset "Ticketing.ttf") - :content "Game Over" - :visiblep nil - :x 300 - :y 300 - :scale-x 3.0 - :scale-y 3.0))) - (setf (ww::width paddle) 120 - (ww::height paddle) 20 - (paddle app) paddle - (ball app) ball - (game-over app) game-over) - - (ww::add-unit app ball) - (ww::add-unit app paddle) - (ww::add-unit app game-over) - (ww::add-handler app #'pong-mousemove) - (ww::add-handler app #'pong-perframe ))) + (ww::add-unit + app + (setf (intro-text app) + (make-instance + 'ww::text + :content "Press any key to start" + :font (ww::get-asset "Ticketing.ttf") + :x 160 + :y 300 + :scale-x 3.0 + :scale-y 3.0))) + + (ww::add-handler app #'press-to-start)) (defun start () (ww::start |