43ee81d9eec0

Application 4: Ballistics Part 4
[view raw] [browse files]
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