# HG changeset patch # User Steve Losh # Date 1462235825 0 # Node ID 43ee81d9eec08377ba6624db19578cbb9247ea2c # Parent b87c87014e086f8985c1a1bb8308b8492c9ddfb9 Application 4: Ballistics Part 4 diff -r b87c87014e08 -r 43ee81d9eec0 src/ballistics.lisp --- a/src/ballistics.lisp Sun May 01 23:29:26 2016 +0000 +++ b/src/ballistics.lisp Tue May 03 00:37:05 2016 +0000 @@ -12,8 +12,10 @@ (defparameter *gun-pen* (make-pen :stroke (gray 0.0) :fill (gray 0.0))) (defparameter *ball-pen* (make-pen :stroke (gray 0.1) :fill (gray 0.6))) (defparameter *force-bg-pen* (make-pen :fill (gray 0.6))) +(defparameter *target-pen* (make-pen :stroke (rgb 0.6 0 0) :weight 2 :fill (rgb 1.0 0 0))) (defparameter *force-fg-pen* (make-pen :fill (rgb 1.000 0.478 0.749))) + (defun draw-gun (gun) (in-context (translate (getf gun 'x) (getf gun 'y)) @@ -34,6 +36,13 @@ (- *height* 50) (map-range -1.0 1.0 0 15 force)))) +(defun draw-target (target) + (when target + (with-pen *target-pen* + (circle (getf target :x) + (getf target :y) + (getf target :radius))))) + ;;;; Game (defun aim (gun x y) @@ -62,6 +71,18 @@ *height*) (setf firedp nil)))) +(defun check-target (game) + (when (and (target game) + (circles-collide-p (cannonball game) + (target game))) + (setf (win game) t))) + +(defun random-target () + (list :x (random-range 200 *width*) + :y *height* + :radius (random-range 10 40))) + + (defsketch game (:width *width* :height *height* :debug :scancode-d) @@ -73,6 +94,8 @@ (force-speed 0.05) (force-angle 0.0) (raw-force) + (target) + (win) ) (with-fps (background (gray 1)) @@ -81,11 +104,19 @@ (incf force-angle force-speed) (setf raw-force (sin force-angle))) + (when (not target) + (setf target (random-target))) + (draw-ball cannonball) (draw-gun gun) (draw-force raw-force) + (draw-target target) + (when firedp - (update-ball sketch::sketch-window)) + (update-ball sketch::sketch-window) + (check-target sketch::sketch-window)) + (when win + (text "You win!" *center-x* *center-y*)) ;; )) diff -r b87c87014e08 -r 43ee81d9eec0 src/math.lisp --- a/src/math.lisp Sun May 01 23:29:26 2016 +0000 +++ b/src/math.lisp Tue May 03 00:37:05 2016 +0000 @@ -107,6 +107,10 @@ (defgeneric hitbox-radius (object)) +(defgeneric hitbox-width (object)) + +(defgeneric hitbox-height (object)) + (defmethod hitbox-x ((object list)) (getf object :x)) diff -r b87c87014e08 -r 43ee81d9eec0 src/particles.lisp --- a/src/particles.lisp Sun May 01 23:29:26 2016 +0000 +++ b/src/particles.lisp Tue May 03 00:37:05 2016 +0000 @@ -1,9 +1,7 @@ (in-package #:coding-math.particles) (defstruct (particle - (:constructor make-particle%) - (:type vector) - :named) + (:constructor make-particle%)) (pos (make-vec) :type vec) (vel (make-vec) :type vec) (grv (make-vec) :type vec) diff -r b87c87014e08 -r 43ee81d9eec0 src/vectors.lisp --- a/src/vectors.lisp Sun May 01 23:29:26 2016 +0000 +++ b/src/vectors.lisp Tue May 03 00:37:05 2016 +0000 @@ -1,7 +1,7 @@ (in-package #:coding-math.vectors) -(declaim (inline vec-x vec-y)) +(declaim (inline vec-x vec-y make-vec)) (defstruct (vec (:constructor make-vec