# HG changeset patch # User Steve Losh # Date 1467485851 0 # Node ID 12c6ece1710f5c179be59697bfc4a0a3c1bf5a4b # Parent a5c7bfeb34c33879b811cf7f5618a13552cf788e Episode 32: Line Intersections Part 1 diff -r a5c7bfeb34c3 -r 12c6ece1710f coding-math.asd --- 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" diff -r a5c7bfeb34c3 -r 12c6ece1710f package.lisp --- 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)) diff -r a5c7bfeb34c3 -r 12c6ece1710f src/2d/demo.lisp --- 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)) diff -r a5c7bfeb34c3 -r 12c6ece1710f src/2d/lines.lisp --- /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))) diff -r a5c7bfeb34c3 -r 12c6ece1710f src/utils.lisp --- 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