Skip to content
Browse files

Don't clobber polygon edge-lists.

  • Loading branch information...
1 parent aa69b65 commit 9db5359e3db7217cf51142bb108eba8cdb86c910 @Ramarren committed
Showing with 10 additions and 5 deletions.
  1. +3 −0 basic-line.lisp
  2. +7 −5 polygon-binary.lisp
View
3 basic-line.lisp
@@ -19,6 +19,9 @@
"Create a new line segment."
(make-instance line-segment-type :start start :end end))
+(defun copy-line-segment (line-segment)
+ (make-instance (type-of line-segment) :start (start line-segment) :end (end line-segment)))
+
(defclass line ()
((A :accessor A :initarg :A)
(B :accessor B :initarg :B)
View
12 polygon-binary.lisp
@@ -18,8 +18,7 @@
t)
nil))
-(defun sanitize-edges (edge-list acc)
- "Drop zero length edges and merge all segment intersecting edges."
+(defun recurse-sanitize-edges (edge-list acc)
(if (null edge-list)
(nreverse acc)
(let ((head (car edge-list))
@@ -33,11 +32,14 @@
(push tk racc)))
(sanitize-edges racc (cons head acc)))))))
+(defun sanitize-edges (edge-list)
+ "Drop zero length edges and merge all segment intersecting edges."
+ (recurse-sanitize-edges (mapcar #'copy-line-segment edge-list) nil))
+
(defun polygon-binary (polygon1 polygon2 triangle-test)
"Return all triangles fulfilling triangle-test from triangulation of all edges of two polygons."
(let ((edge-list (sanitize-edges (append (edge-list polygon1)
- (edge-list polygon2))
- nil)))
+ (edge-list polygon2)))))
(let ((trapez (trapezoidize-edges edge-list)))
(let ((triangles (trapezoids-to-triangles trapez)))
(remove-if-not triangle-test triangles)))))
@@ -76,7 +78,7 @@
(typecase poly
(polygon t)
(t nil)))
- holes)))) nil)))
+ holes)))))))
(let ((trapez (trapezoidize-edges edge-list)))
(let ((triangles (trapezoids-to-triangles trapez)))
(remove-if-not #'(lambda (x)

0 comments on commit 9db5359

Please sign in to comment.
Something went wrong with that request. Please try again.