12c6ece1710f

Episode 32: Line Intersections Part 1
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 02 Jul 2016 18:57:31 +0000
parents a5c7bfeb34c3
children 4f1e6a70e5ad
branches/tags (none)
files coding-math.asd package.lisp src/2d/demo.lisp src/2d/lines.lisp src/utils.lisp

Changes

--- a/coding-math.asd	Fri Jul 01 14:41:43 2016 +0000
+++ b/coding-math.asd	Sat Jul 02 18:57:31 2016 +0000
@@ -32,6 +32,7 @@
                                (:file "hitboxes")
                                (:file "particles")
                                (:file "points")
+                               (:file "lines")
                                (:file "demo")
                                (:file "ballistics")))
                  (:module "3d"
--- a/package.lisp	Fri Jul 01 14:41:43 2016 +0000
+++ b/package.lisp	Sat Jul 02 18:57:31 2016 +0000
@@ -189,6 +189,26 @@
     #:multicurve
     ))
 
+(defpackage #:coding-math.2d.lines
+  (:use
+    #:cl
+    #:sketch
+    #:coding-math.math
+    #:coding-math.2d.vectors
+    #:coding-math.quickutils
+    #:coding-math.utils)
+  (:export
+    #:std-intersection-point
+    #:mxb-intersection-point
+    #:xys-intersection-point
+    #:xys-to-mxb
+    #:xys-to-std
+    #:std-to-xys
+    #:std-to-mxb
+    #:mxb-to-xys
+    #:mxb-to-std
+    ))
+
 
 (defpackage #:coding-math.2d.demo
   (:use
@@ -201,6 +221,7 @@
     #:coding-math.tween
     #:coding-math.2d.vectors
     #:coding-math.2d.points
+    #:coding-math.2d.lines
     #:coding-math.2d.hitboxes
     #:coding-math.2d.particles))
 
--- a/src/2d/demo.lisp	Fri Jul 01 14:41:43 2016 +0000
+++ b/src/2d/demo.lisp	Sat Jul 02 18:57:31 2016 +0000
@@ -48,57 +48,78 @@
       (outsidep (- 0 r) (+ *height* r) (vec-y p))))
 
 
-(defmacro map-static (function-symbol &rest arguments)
-  `(progn
-     ,@(loop :for arg :in arguments :collect `(,function-symbol ,arg))))
-
-(defun graph-tween (tweening-function)
-  (graph-function (curry tweening-function 0.0 1.0 1.0)
-                  :fn-start 0.0 :fn-end 1.0
-                  :fn-min 0.0 :fn-max 1.0
-                  :graph-start 0 :graph-end *width*
-                  :graph-min *height* :graph-max 0))
-
 (defsketch cm
     ((width *width*) (height *height*) (y-axis :down) (title "Coding Math 2D")
      (mouse (make-vec 0 0))
      ;; Data
-     (current (make-vec 100 100))
+     (m1 (random-range -5 5))
+     (m2 (random-range -5 5))
+     (b1 (random-range -5 5))
+     (b2 (random-range -5 5))
+     (x11 (random-range -5 5))
+     (y11 (random-range -5 5))
+     (x12 (random-range -5 5))
+     (y12 (random-range -5 5))
+     (x21 (random-range -5 5))
+     (y21 (random-range -5 5))
+     (x22 (random-range -5 5))
+     (y22 (random-range -5 5))
      ;; Pens
      (particle-pen (make-pen :fill (gray 0.9) :stroke (gray 0.4)))
-     (line-pen (make-pen :curve-steps 40 :stroke (gray 0.7)))
-     (black-function-pen (make-pen :curve-steps 20 :stroke (rgb 0 0 0) :weight 1))
-     (red-function-pen (make-pen :curve-steps 40 :stroke (rgb 0.8 0 0) :weight 1))
-     (green-function-pen (make-pen :curve-steps 40 :stroke (rgb 0 0.8 0) :weight 1))
-     (blue-function-pen (make-pen :curve-steps 40 :stroke (rgb 0 0 0.8) :weight 1))
+     (black-pen (make-pen :stroke (rgb 0 0 0) :fill (rgb 0.4 0.4 0.4) :weight 1 :curve-steps 50))
+     (red-pen (make-pen :stroke (rgb 0.6 0 0) :fill (rgb 0.9 0 0) :weight 1 :curve-steps 50))
+     (green-pen (make-pen :stroke (rgb 0 0.6 0) :fill (rgb 0 0.9 0) :weight 1 :curve-steps 50))
+     (blue-pen (make-pen :stroke (rgb 0 0 0.6) :fill (rgb 0 0 0.9) :weight 1 :curve-steps 50))
      )
   (with-setup
     ;;
     (in-context
+      (translate *center-x* *center-y*)
       (draw-axes *width* *height*)
-      (with-pen black-function-pen
-        (graph-tween #'tween-linear))
-      (with-pen red-function-pen
-        (map-static graph-tween
-                    #'tween-quadratic-in
-                    #'tween-cubic-in
-                    #'tween-quartic-in
-                    #'tween-quintic-in))
-      (with-pen green-function-pen
-        (map-static graph-tween
-                    #'tween-quadratic-out
-                    #'tween-cubic-out
-                    #'tween-quartic-out
-                    #'tween-quintic-out))
-      (with-pen blue-function-pen
-        (map-static graph-tween
-                    #'tween-quadratic-inout
-                    #'tween-cubic-inout
-                    #'tween-quartic-inout
-                    #'tween-quintic-inout))
-      (update-tweens!)
-      (with-pen particle-pen
-        (draw-circle current)))
+      (flet ((map-to-screen (x y)
+               (values (map-range -10.0 10.0 (- *center-x*) *center-x* x)
+                       (map-range -10.0 10.0 (- *center-y*) *center-y* y)))
+             (valid-line-p (x1 y1 x2 y2)
+               (not (and (= x1 x2)
+                         (= y1 y2))))
+             (g (fn)
+               (graph-function
+                 fn
+                 :fn-start -10 :fn-end 10
+                 :fn-min -10 :fn-max 10
+                 :graph-start (- *center-x*) :graph-end *center-x*
+                 :graph-min (- *center-y*) :graph-max *center-y*)))
+        (with-pen green-pen
+          (g (lambda (x) (+ (* m1 x) b1)))
+          (g (lambda (x) (+ (* m2 x) b2)))
+          (multiple-value-bind (x y)
+              (mxb-intersection-point m1 b1 m2 b2)
+            (when x
+              (draw-circle (multiple-value-call #'make-vec
+                             (map-to-screen x y))
+                           6))))
+        (when (and (valid-line-p x11 y11 x12 y12)
+                   (valid-line-p x21 y21 x22 y22))
+          (with-pen red-pen
+            (multiple-value-call #'line
+              (map-to-screen x11 y11)
+              (map-to-screen x12 y12))
+            (multiple-value-call #'line
+              (map-to-screen x21 y21)
+              (map-to-screen x22 y22))
+            (draw-circle (multiple-value-call #'make-vec (map-to-screen x11 y11)) 3)
+            (draw-circle (multiple-value-call #'make-vec (map-to-screen x12 y12)) 3)
+            (draw-circle (multiple-value-call #'make-vec (map-to-screen x21 y21)) 3)
+            (draw-circle (multiple-value-call #'make-vec (map-to-screen x22 y22)) 3)
+            (multiple-value-bind (x y)
+                (xys-intersection-point x11 y11 x12 y12 x21 y21 x22 y22)
+              (when x
+                (draw-circle (multiple-value-call #'make-vec
+                               (map-to-screen x y))
+                             6)))
+            ))
+        )
+      )
     ;;
     )
   )
@@ -118,13 +139,7 @@
         300 300))
 
 (defun mousedown-left (instance x y)
-  (declare (ignorable instance x y))
-  (with-slots (current) instance
-    (tween-places!
-        (#'tween-quadratic-inout 10.0
-         :callback-progress #'draw-time)
-      (vec-x current) x
-      (vec-y current) y)))
+  (declare (ignorable instance x y)))
 
 (defun mousedown-right (instance x y)
   (declare (ignorable instance x y))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2d/lines.lisp	Sat Jul 02 18:57:31 2016 +0000
@@ -0,0 +1,82 @@
+(in-package #:coding-math.2d.lines)
+
+;;;; Conversions
+;;; We have three ways to represent a line:
+;;;
+;;; * Two points (x1, y1) and (x2, y2)
+;;; * Slope/intercept form (y = mx + b)
+;;; * "Standard" form (Ax + By = C)
+
+(defun xys-to-mxb (x1 y1 x2 y2)
+  (if (= x1 x2)
+    (values)
+    (let ((slope (/ (- y2 y1)
+                    (- x2 x1))))
+      (values slope
+              (- y1 (* slope x1))))))
+
+(defun xys-to-std (x1 y1 x2 y2)
+  (let* ((a (- y2 y1))
+         (b (- x1 x2))
+         (c (+ (* a x1) (* b y1))))
+    (values a b c)))
+
+
+(defun mxb-to-std (slope intercept)
+  ;; y = mx + b
+  ;; -mx + y = b
+  ;; Ax + By = C
+  (let* ((a (- slope))
+         (b 1)
+         (c intercept))
+    (values a b c)))
+
+(defun mxb-to-xys (slope intercept)
+  ;; y = mx + b
+  ;;
+  ;; y = 0x + b
+  ;; y = 1x + b
+  (let ((x1 0)
+        (y1 intercept)
+        (x2 1)
+        (y2 (+ intercept slope)))
+    (values x1 y1 x2 y2)))
+
+
+(defun std-to-mxb (a b c)
+  ;; Ax + By = C
+  ;; By = -Ax + C
+  ;; y = -(A/B)x + (C/B)
+  (if (zerop b)
+    (values)
+    (values (- (/ a b))
+            (/ c b))))
+
+(defun std-to-xys (a b c)
+  ;; Ax + By = C
+  ;;
+  ;; A0 + By = C  ->  By = C      ->  y = C / B
+  ;; A1 + By = C  ->  By = C - A  ->  y = (C - A) / B
+  (let ((x1 0)
+        (y1 (/ c b))
+        (x2 1)
+        (y2 (/ (- c a) b)))
+    (values x1 y1 x2 y2)))
+
+
+(defun std-intersection-point (a1 b1 c1 a2 b2 c2)
+  (let ((denominator (- (* a1 b2) (* a2 b1))))
+    (if (zerop denominator)
+      (values)
+      (values (/ (- (* b2 c1) (* b1 c2)) denominator) ; x
+              (/ (- (* a1 c2) (* a2 c1)) denominator))))) ; y
+
+(defun xys-intersection-point (x11 y11 x12 y12 x21 y21 x22 y22)
+  (multiple-value-call #'std-intersection-point
+                       (xys-to-std x11 y11 x12 y12)
+                       (xys-to-std x21 y21 x22 y22)))
+
+(defun mxb-intersection-point (slope1 intercept1 slope2 intercept2)
+  (multiple-value-call #'std-intersection-point
+                       (mxb-to-std slope1 intercept1)
+                       (mxb-to-std slope2 intercept2)))
--- a/src/utils.lisp	Fri Jul 01 14:41:43 2016 +0000
+++ b/src/utils.lisp	Sat Jul 02 18:57:31 2016 +0000
@@ -67,7 +67,7 @@
 
 
 ;;;; Handy drawing functions
-(defparameter axis-pen (make-pen :stroke (gray 0.7)))
+(defparameter axis-pen (make-pen :stroke (gray 0.7) :weight 2))
 
 (defun draw-axes (width height)
   (with-pen axis-pen