Episode 32: Line Intersections Part 1
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