# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1461534382 0
# Node ID b4b4043dd88a5e2df91c5d92303c18a5d55e26ba
# Parent  67072984548b9e10ccd6e4decc07bcd4eeb65ffd
Episode 14: Collision Detection

diff -r 67072984548b -r b4b4043dd88a .lispwords
--- a/.lispwords	Sat Apr 23 15:18:20 2016 +0000
+++ b/.lispwords	Sun Apr 24 21:46:22 2016 +0000
@@ -1,2 +1,3 @@
 (1 scancode-case)
 (1 make-sketch)
+(2 with-vals)
diff -r 67072984548b -r b4b4043dd88a package.lisp
--- a/package.lisp	Sat Apr 23 15:18:20 2016 +0000
+++ b/package.lisp	Sun Apr 24 21:46:22 2016 +0000
@@ -1,115 +1,128 @@
 (defpackage #:coding-math.utils
   (:use
-   #:cl
-   #:sketch
-   #:coding-math.quickutils)
+    #:cl
+    #:sketch
+    #:coding-math.quickutils)
   (:export
-   #:in-context
-   #:make-sketch
-   #:scancode-case
-   #:mulf
-   #:dividesp
-   #:square))
+    #:in-context
+    #:make-sketch
+    #:scancode-case
+    #:with-vals
+    #:mulf
+    #:dividesp
+    #:square))
 
 (defpackage #:coding-math.math
   (:use
-   #:cl
-   #:coding-math.quickutils
-   #:coding-math.utils)
+    #:cl
+    #:coding-math.quickutils
+    #:coding-math.utils)
   (:export
-   #:tau
-   #:distance
-   #:random-range
-   #:random-around
-   #:norm
-   #:lerp
-   #:precise-lerp
-   #:map-range
-   #:clamp
-   #:wrap-zero
-   #:wrap-range
-   #:outside-p))
+    #:tau
+    #:distance
+    #:random-range
+    #:random-around
+    #:norm
+    #:lerp
+    #:precise-lerp
+    #:map-range
+    #:clamp
+    #:wrap-zero
+    #:wrap-range
+    #:outsidep
+    #:insidep
+    #:ranges-overlap-p
+    #:hitbox-x
+    #:hitbox-y
+    #:hitbox-radius
+    #:hitbox-width
+    #:hitbox-height
+    #:circles-collide-p
+    #:circle-point-collide-p
+    #:rect-point-collide-p
+    #:rects-collide-p
+    ))
 
 (defpackage #:coding-math.vectors
   (:use
-   #:cl
-   #:coding-math.math
-   #:coding-math.quickutils
-   #:coding-math.utils)
+    #:cl
+    #:coding-math.math
+    #:coding-math.quickutils
+    #:coding-math.utils)
   (:export
-   #:vec
-   #:vec-x
-   #:vec-y
-   #:make-vec
-   #:make-vec-md
-   #:make-vec-ma
-   #:vec-magnitude
-   #:vec-direction
-   #:vec-angle
-   #:vec-add
-   #:vec-sub
-   #:vec-mul
-   #:vec-div
-   #:vec-add!
-   #:vec-sub!
-   #:vec-mul!
-   #:vec-div!
-   #:vec-to-string))
+    #:vec
+    #:vec-x
+    #:vec-y
+    #:make-vec
+    #:make-vec-md
+    #:make-vec-ma
+    #:vec-magnitude
+    #:vec-direction
+    #:vec-angle
+    #:vec-add
+    #:vec-sub
+    #:vec-mul
+    #:vec-div
+    #:vec-add!
+    #:vec-sub!
+    #:vec-mul!
+    #:vec-div!
+    #:vec-to-string))
 
 (defpackage #:coding-math.particles
   (:use
-   #:cl
-   #:coding-math.math
-   #:coding-math.vectors
-   #:coding-math.quickutils
-   #:coding-math.utils)
+    #:cl
+    #:coding-math.math
+    #:coding-math.vectors
+    #:coding-math.quickutils
+    #:coding-math.utils)
   (:export
-   #:particle
-   #:particle-vel
-   #:particle-pos
-   #:particle-grv
-   #:particle-radius
-   #:particle-mass
-   #:particle-friction
-   #:particle-speed
-   #:particle-direction
-   #:make-particle
-   #:particle-x
-   #:particle-y
-   #:particle-wrap!
-   #:particle-update!
-   #:particle-accelerate!
-   #:particle-angle-to
-   #:particle-distance-to
-   #:particle-gravitate-to!))
+    #:particle
+    #:particle-vel
+    #:particle-pos
+    #:particle-grv
+    #:particle-radius
+    #:particle-mass
+    #:particle-friction
+    #:particle-speed
+    #:particle-direction
+    #:make-particle
+    #:particle-x
+    #:particle-y
+    #:particle-wrap!
+    #:particle-update!
+    #:particle-accelerate!
+    #:particle-angle-to
+    #:particle-distance-to
+    #:particle-gravitate-to!))
 
 (defpackage #:coding-math.fps
   (:use
-   #:cl
-   #:sketch
-   #:coding-math.quickutils
-   #:coding-math.utils)
+    #:cl
+    #:sketch
+    #:coding-math.quickutils
+    #:coding-math.utils)
   (:export
-   #:calc-fps
-   #:draw-fps))
+    #:calc-fps
+    #:draw-fps))
 
 (defpackage #:coding-math
   (:use
-   #:cl
-   #:sketch
-   #:coding-math.quickutils
-   #:coding-math.utils
-   #:coding-math.fps
-   #:coding-math.math
-   #:coding-math.vectors
-   #:coding-math.particles))
+    #:cl
+    #:sketch
+    #:coding-math.quickutils
+    #:coding-math.utils
+    #:coding-math.fps
+    #:coding-math.math
+    #:coding-math.vectors
+    #:coding-math.particles))
 
 (defpackage #:coding-math.ballistics
   (:use
-   #:cl
-   #:sketch
-   #:coding-math.quickutils
-   #:coding-math.particles
-   #:coding-math.utils
-   #:coding-math.math
-   #:coding-math.fps))
+    #:cl
+    #:sketch
+    #:coding-math.quickutils
+    #:coding-math.particles
+    #:coding-math.utils
+    #:coding-math.math
+    #:coding-math.fps))
diff -r 67072984548b -r b4b4043dd88a src/ballistics.lisp
--- a/src/ballistics.lisp	Sat Apr 23 15:18:20 2016 +0000
+++ b/src/ballistics.lisp	Sun Apr 24 21:46:22 2016 +0000
@@ -132,4 +132,4 @@
 
 
 ;;;; Run
-(defparameter *demo* (make-game))
+; (defparameter *demo* (make-game))
diff -r 67072984548b -r b4b4043dd88a src/main.lisp
--- a/src/main.lisp	Sat Apr 23 15:18:20 2016 +0000
+++ b/src/main.lisp	Sun Apr 24 21:46:22 2016 +0000
@@ -1,8 +1,8 @@
 (in-package #:coding-math)
 
-(declaim (optimize (speed 0)
-                   (safety 3)
-                   (debug 3)))
+(declaim (optimize (speed 1)
+                   (safety 1)
+                   (debug 1)))
 
 ;;;; Config
 (defparameter *width* 600)
@@ -15,15 +15,25 @@
 ;;;; Sketch
 (defun particle-oob-p (particle)
   (let ((r (particle-radius particle)))
-    (or (outside-p (- 0 r)
-                   (+ *width* r)
-                   (particle-x particle))
-        (outside-p (- 0 r)
-                   (+ *height* r)
-                   (particle-y particle)))))
+    (or (outsidep (- 0 r)
+                  (+ *width* r)
+                  (particle-x particle))
+        (outsidep (- 0 r)
+                  (+ *height* r)
+                  (particle-y particle)))))
 
 
-(declaim (inline draw-particle))
+(defun draw-rect (r)
+  (rect (getf r :x)
+        (getf r :y)
+        (getf r :width)
+        (getf r :height)))
+
+(defun draw-circle (c)
+  (circle (getf c :x)
+          (getf c :y)
+          (getf c :radius)))
+
 (defun draw-particle (particle)
   (circle (particle-x particle)
           (particle-y particle)
@@ -33,30 +43,46 @@
 (defsketch cm (:width *width*
                :height *height*
                :debug :scancode-d)
-    ((mx 0)
-     (my 0)
-     (frame 1)
-     (p nil))
+    ((mouse)
+     (frame)
+     (r)
+     (mr)
+     )
   (background (gray 1))
   (incf frame)
   ;;
-  (with-pen (make-pen :stroke (gray 0.3)
-                      :fill (if (> (distance mx my *center-x* *center-y*) 100)
-                              (gray 1)
-                              (gray 0.5)))
-    (circle *center-x* *center-y* 100))
+
+  (setf (getf mr :x) (getf mouse :x))
+  (setf (getf mr :y) (getf mouse :y))
+
+  (with-pen (make-pen :stroke (gray 0.5)
+                      :fill (cond
+                              ((rects-collide-p r mr)
+                               (rgb 0 0 0.7 0.5))
+                              (t (gray 0.9))))
+    (draw-rect r)
+    (draw-rect mr))
+
   ;;
   (when (zerop (mod frame 20))
     (calc-fps 20))
   (draw-fps))
 
+(defun make-cm ()
+  (make-sketch 'cm
+    (mouse (list :x 0 :y 0))
+    (frame 1)
+    (r (list :x 20 :y 50 :width (- *width* 40) :height 30))
+    (mr (list :x 300 :y 300 :width 90 :height 90))
+    ))
+
 
 ;;;; Mouse
 (defmethod kit.sdl2:mousemotion-event ((window cm) ts b x y xrel yrel)
   (declare (ignore ts b xrel yrel))
-  (with-slots (mx my rect-x rect-y rect-w rect-h cx cy cr) window
-    (setf mx x)
-    (setf my y)
+  (with-slots (mouse) window
+    (setf (getf mouse :x) x)
+    (setf (getf mouse :y) y)
     ;;
     ;;
     ))
@@ -74,6 +100,7 @@
                           :direction (random tau))))))
 
 (defun keyup (instance scancode)
+  (declare (ignore instance))
   (scancode-case scancode
     (:scancode-space
      nil)))
@@ -88,4 +115,4 @@
 
 
 ;;;; Run
-; (defparameter *demo* (make-instance 'cm))
+; (defparameter *demo* (make-cm))
diff -r 67072984548b -r b4b4043dd88a src/math.lisp
--- a/src/math.lisp	Sat Apr 23 15:18:20 2016 +0000
+++ b/src/math.lisp	Sun Apr 24 21:46:22 2016 +0000
@@ -1,15 +1,19 @@
 (in-package #:coding-math.math)
 
-;; Constants
+(declaim (inline outsidep insidep wrap-zero wrap-range))
+(declaim (inline norm lerp clamp distance))
+
+;;;; Constants
 (defparameter tau (* pi 2))
 
+
 ;; Geometry
 (defun distance (x0 y0 x1 y1)
   (sqrt (+ (square (- x0 x1))
            (square (- y0 y1)))))
 
 
-;; Random
+;;;; Random
 (defun random-range (min max)
   (+ min (random (- max min))))
 
@@ -18,7 +22,7 @@
                 (+ val range)))
 
 
-;; Number range mapping
+;;;; Number range mapping
 (defun norm (min max val)
   (/ (- val min)
      (- max min)))
@@ -48,14 +52,16 @@
   (lerp dest-from dest-to
         (norm source-from source-to source-val)))
 
-(defun clamp (min max n)
-  (cond
-    ((> n max) max)
-    ((< n min) min)
-    (t n)))
+(defun clamp (from to n)
+  (let ((max (max from to))
+        (min (min from to)))
+    (cond
+      ((> n max) max)
+      ((< n min) min)
+      (t n))))
 
 
-;; Wrapping
+;;;; Wrapping
 (defun wrap-zero (max val)
   "Wrap `val` around the range [0, max)."
   (mod val max))
@@ -66,6 +72,74 @@
      (mod (- val min)
           (- max min))))
 
-(defun outside-p (min max val)
-  (or (< val min)
-      (> val max)))
+
+(defun insidep (from to val)
+  (< (min from to) val (max from to)))
+
+(defun outsidep (from to val)
+  (not (insidep from to val)))
+
+(defun ranges-overlap-p (from0 to0 from1 to1)
+  (not (or (< (max from0 to0)
+              (min from1 to1))
+           (> (min from0 to0)
+              (max from1 to1)))))
+
+
+;;;; Collisions
+(defgeneric hitbox-x (object))
+
+(defgeneric hitbox-y (object))
+
+(defgeneric hitbox-radius (object))
+
+
+(defmethod hitbox-x ((object list))
+  (getf object :x))
+
+(defmethod hitbox-y ((object list))
+  (getf object :y))
+
+(defmethod hitbox-radius ((object list))
+  (getf object :radius))
+
+(defmethod hitbox-width ((object list))
+  (getf object :width))
+
+(defmethod hitbox-height ((object list))
+  (getf object :height))
+
+
+(defun circles-collide-p (c0 c1)
+  (let ((d (distance (hitbox-x c0) (hitbox-y c0)
+                     (hitbox-x c1) (hitbox-y c1))))
+    (< d (+ (hitbox-radius c0)
+            (hitbox-radius c1)))))
+
+(defun circle-point-collide-p (c p)
+  (let ((d (distance (hitbox-x c) (hitbox-y c)
+                     (hitbox-x p) (hitbox-y p))))
+    (< d (hitbox-radius c))))
+
+(defun rect-point-collide-p (r p)
+  (with-vals ((rx hitbox-x)
+              (ry hitbox-y)
+              (rw hitbox-width)
+              (rh hitbox-height))
+      r
+    (and (insidep rx (+ rx rw) (hitbox-x p))
+         (insidep ry (+ ry rh) (hitbox-y p)))))
+
+(defun rects-collide-p (r0 r1)
+  (with-vals ((r0x hitbox-x) ; lol
+              (r0y hitbox-y)
+              (r0w hitbox-width)
+              (r0h hitbox-height)) r0
+    (with-vals ((r1x hitbox-x)
+                (r1y hitbox-y)
+                (r1w hitbox-width)
+                (r1h hitbox-height)) r1
+      (and (ranges-overlap-p r0x (+ r0x r0w)
+                             r1x (+ r1x r1w))
+           (ranges-overlap-p r0y (+ r0y r0h)
+                             r1y (+ r1y r1h))))))
diff -r 67072984548b -r b4b4043dd88a src/particles.lisp
--- a/src/particles.lisp	Sat Apr 23 15:18:20 2016 +0000
+++ b/src/particles.lisp	Sun Apr 24 21:46:22 2016 +0000
@@ -115,3 +115,13 @@
           (vec-angle gravity)
           (particle-angle-to particle attractor-particle))
     (particle-accelerate! particle gravity)))
+
+
+(defmethod hitbox-x ((p particle))
+  (particle-x p))
+
+(defmethod hitbox-y ((p particle))
+  (particle-y p))
+
+(defmethod hitbox-radius ((p particle))
+  (particle-radius p))
diff -r 67072984548b -r b4b4043dd88a src/utils.lisp
--- a/src/utils.lisp	Sat Apr 23 15:18:20 2016 +0000
+++ b/src/utils.lisp	Sun Apr 24 21:46:22 2016 +0000
@@ -44,3 +44,10 @@
                       `((sdl2:scancode= ,scancode ,key-scancode)
                         ,@body)))
            pairs)))))
+
+(defmacro with-vals (bindings value-form &body body)
+  (with-gensyms (val)
+    `(let* ((,val ,value-form)
+            ,@(loop :for (s accessor) :in bindings
+                    :collect `(,s (,accessor ,val))))
+      ,@body)))