Application 4: Ballistics Part 4
author |
Steve Losh <steve@stevelosh.com> |
date |
Tue, 03 May 2016 00:37:05 +0000 |
parents |
b87c87014e08
|
children |
7e868ce7595b
|
branches/tags |
(none) |
files |
src/ballistics.lisp src/math.lisp src/particles.lisp src/vectors.lisp |
Changes
--- 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*))
;;
))
--- 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))
--- 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)
--- 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