# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1467552934 0
# Node ID 4f1e6a70e5adb5235408717af4fd88999b414176
# Parent  12c6ece1710f5c179be59697bfc4a0a3c1bf5a4b
Episode 33: Line Intersections Part 2

diff -r 12c6ece1710f -r 4f1e6a70e5ad package.lisp
--- a/package.lisp	Sat Jul 02 18:57:31 2016 +0000
+++ b/package.lisp	Sun Jul 03 13:35:34 2016 +0000
@@ -201,6 +201,7 @@
     #:std-intersection-point
     #:mxb-intersection-point
     #:xys-intersection-point
+    #:xys-segments-intersection-point
     #:xys-to-mxb
     #:xys-to-std
     #:std-to-xys
diff -r 12c6ece1710f -r 4f1e6a70e5ad src/2d/demo.lisp
--- a/src/2d/demo.lisp	Sat Jul 02 18:57:31 2016 +0000
+++ b/src/2d/demo.lisp	Sun Jul 03 13:35:34 2016 +0000
@@ -116,8 +116,14 @@
               (when x
                 (draw-circle (multiple-value-call #'make-vec
                                (map-to-screen x y))
-                             6)))
-            ))
+                             6))))
+          (with-pen blue-pen
+            (multiple-value-bind (x y)
+                (xys-segments-intersection-point x11 y11 x12 y12 x21 y21 x22 y22)
+              (when x
+                (draw-circle (multiple-value-call #'make-vec
+                               (map-to-screen x y))
+                             3)))))
         )
       )
     ;;
diff -r 12c6ece1710f -r 4f1e6a70e5ad src/2d/lines.lisp
--- a/src/2d/lines.lisp	Sat Jul 02 18:57:31 2016 +0000
+++ b/src/2d/lines.lisp	Sun Jul 03 13:35:34 2016 +0000
@@ -80,3 +80,16 @@
   (multiple-value-call #'std-intersection-point
                        (mxb-to-std slope1 intercept1)
                        (mxb-to-std slope2 intercept2)))
+
+(defun xys-segments-intersection-point (x11 y11 x12 y12 x21 y21 x22 y22)
+  (multiple-value-bind (x y)
+      (xys-intersection-point x11 y11 x12 y12 x21 y21 x22 y22)
+    (cond
+      ((null x)
+       (values)) ; parallel/colinear
+      ((or (outsidep x11 x12 x)
+           (outsidep x21 x22 x)
+           (outsidep y11 y12 y)
+           (outsidep y21 y22 y))
+       (values)) ; intersection outside segment(s)
+      (t (values x y)))))
diff -r 12c6ece1710f -r 4f1e6a70e5ad src/utils.lisp
--- a/src/utils.lisp	Sat Jul 02 18:57:31 2016 +0000
+++ b/src/utils.lisp	Sun Jul 03 13:35:34 2016 +0000
@@ -1,5 +1,6 @@
 (in-package #:coding-math.utils)
 
+
 (defmacro zap% (place function &rest arguments &environment env)
   "Update `place` by applying `function` to its current value and `arguments`.
 
@@ -15,8 +16,8 @@
   "
   ;; original idea/name from http://malisper.me/2015/09/29/zap/
   (assert (find '% arguments)
-          ()
-          "Placeholder % not included in zap macro form.")
+      ()
+    "Placeholder % not included in zap macro form.")
   (multiple-value-bind (temps exprs stores store-expr access-expr)
       (get-setf-expansion place env)
     `(let* (,@(mapcar #'list temps exprs)