From 8a87b66ae9c4c884dbd866ebe5a8ef7331b16c90 Mon Sep 17 00:00:00 2001 From: Charles Comstock Date: Fri, 19 Jul 2024 10:22:25 -0500 Subject: [PATCH] extract impaled-circle? and intersected-segment? --- src/shimmers/sketches/ring_impressions.cljs | 23 +++++++++++++-------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/src/shimmers/sketches/ring_impressions.cljs b/src/shimmers/sketches/ring_impressions.cljs index b6eb4593..76f38878 100644 --- a/src/shimmers/sketches/ring_impressions.cljs +++ b/src/shimmers/sketches/ring_impressions.cljs @@ -27,17 +27,22 @@ (defn rv [x y] (gv/vec2 (* width x) (* height y))) +(defn intersected-segment? [segment] + (fn [line] + (when (isec/segment-intersect line segment) + segment))) + +(defn impaled-circle? [segment] + (let [[p q] segment] + (fn [circle] + (when-let [isec (isec/circle-ray (g/scale-size circle 1.1) p q)] + (when (= :impale (:type isec)) + circle))))) + (defn planar-pairs [circles pairs] (letfn [(planar? [circles xs segment] - (let [[p q] segment] - (and (not-any? (fn [line] (when (isec/segment-intersect line segment) - segment)) - xs) - (not-any? (fn [circle] - (when-let [isec (isec/circle-ray (g/scale-size circle 1.1) p q)] - (when (= :impale (:type isec)) - circle))) - circles))))] + (and (not-any? (intersected-segment? segment) xs) + (not-any? (impaled-circle? segment) circles)))] (reduce (fn [xs segment] (if (planar? circles xs segment) (conj xs segment)