✨ Add utilities to calculate boolean shapes

frontend/src/app/util/path/bool.cljs

@@ -0,0 +1,270 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) UXBOX Labs SL
+
+(ns app.util.path.bool
+  (:require
+   [app.common.data :as d]
+   [app.common.geom.matrix :as gmt]
+   [app.common.geom.point :as gpt]
+   [app.common.geom.shapes.intersect :as gsi]
+   [app.common.geom.shapes.path :as gpp]
+   [app.common.geom.shapes.rect :as gpr]
+   [app.common.math :as mth]
+   [app.util.path.geom :as upg]
+   [cuerdas.core :as str]))
+
+(def ^:const curve-curve-precision 0.001)
+
+(defn curve->rect
+  [[from-p to-p :as curve]]
+  (let [extremes (->> (gpp/curve-extremities curve)
+                      (mapv #(gpp/curve-values curve %)))]
+    (gpr/points->rect (into [from-p to-p] extremes))))
+
+(defn curve-range->rect
+  [curve from-t to-t]
+
+  (let [[from-p to-p :as curve] (gpp/subcurve-range curve from-t to-t)
+        extremes (->> (gpp/curve-extremities curve)
+                      (mapv #(gpp/curve-values curve %)))]
+    (gpr/points->rect (into [from-p to-p] extremes))))
+
+(defn line+point->tvalue
+  [[{x1 :x y1 :y} {x2 :x y2 :y}] {:keys [x y]}]
+  (if (mth/almost-zero? (- x2 x1))
+    (/ (- y y1) (- y2 y1))
+    (/ (- x x1) (- x2 x1))))
+
+(defn line-line-intersect
+  [[from-p1 to-p1] [from-p2 to-p2]]
+
+  (let [{x1 :x y1 :y} from-p1
+        {x2 :x y2 :y} to-p1
+
+        {x3 :x y3 :y} from-p2
+        {x4 :x y4 :y} to-p2
+
+        nx (- (* (- x3 x4) (- (* x1 y2) (* y1 x2)))
+              (* (- x1 x2) (- (* x3 y4) (* y3 x4))))
+
+        ny (- (* (- y3 y4) (- (* x1 y2) (* y1 x2)))
+              (* (- y1 y2) (- (* x3 y4) (* y3 x4))))
+
+        d  (- (* (- x1 x2) (- y3 y4))
+              (* (- y1 y2) (- x3 x4)))]
+
+    (when-not (mth/almost-zero? d)
+      ;; ix,iy are the coordinates in the line. We calculate the
+      ;; tvalue that will return 0-1 as a percentage in the segment
+      
+      (let [ix (/ nx d)
+            iy (/ ny d)
+            t1 (if (mth/almost-zero? (- x2 x1))
+                 (/ (- iy y1) (- y2 y1))
+                 (/ (- ix x1) (- x2 x1)))
+            t2 (if (mth/almost-zero? (- x4 x3))
+                 (/ (- iy y3) (- y4 y3))
+                 (/ (- ix x3) (- x4 x3)))]
+
+        (when (and (> t1 0) (< t1 1)
+                   (> t2 0) (< t2 1))
+          [[t1] [t2]])))))
+
+(defn line-curve-intersect
+  [[from-p1 to-p1 :as l1]
+   [from-p2 to-p2 h1-p2 h2-p2 :as c2]]
+
+
+  (let [theta (-> (mth/atan2 (- (:y to-p1) (:y from-p1))
+                             (- (:x to-p1) (:x from-p1)))
+                  (mth/degrees))
+
+        transform (-> (gmt/matrix)
+                      (gmt/rotate (- theta))
+                      (gmt/translate (gpt/negate from-p1)))
+
+        c2' [(gpt/transform from-p2 transform)
+             (gpt/transform to-p2 transform)
+             (gpt/transform h1-p2 transform)
+             (gpt/transform h2-p2 transform)]
+
+        ;; Curve intersections as t-values
+        curve-ts (->> (gpp/curve-roots c2' :y)
+                      (filterv #(let [curve-v (gpp/curve-values c2 %)
+                                      line-t (line+point->tvalue l1 curve-v)]
+                                  (and (> line-t 0.001) (< line-t 0.999)))))
+
+        ;; Intersection line-curve points
+        intersect-ps (->> curve-ts
+                          (mapv #(gpp/curve-values c2 %)))
+        
+        line-ts (->> intersect-ps
+                     (mapv #(line+point->tvalue l1 %)))]
+
+    [line-ts curve-ts]))
+
+(defn curve-curve-intersect
+  [c1 c2]
+
+  (letfn [(remove-close-ts [ts]
+            (loop [current (first ts)
+                   pending (rest ts)
+                   acc     nil
+                   result  []]
+              (if (nil? current)
+                result
+                (if (and (some? acc)
+                         (< (mth/abs (- current acc)) 0.01))
+                  (recur (first pending)
+                         (rest pending)
+                         acc
+                         result)
+
+                  (recur (first pending)
+                         (rest pending)
+                         current
+                         (conj result current))))))
+
+          (check-range [c1-from c1-to c2-from c2-to]
+            (let [r1 (curve-range->rect c1 c1-from c1-to)
+                  r2 (curve-range->rect c2 c2-from c2-to)]
+
+              (when (gsi/overlaps-rects? r1 r2)
+
+                (if (and (< (mth/abs (- c1-from c1-to)) curve-curve-precision)
+                         (< (mth/abs (- c2-from c2-to)) curve-curve-precision))
+
+                  [(sorted-set (mth/precision c1-from 4))
+                   (sorted-set (mth/precision c2-from 4))]
+
+                  (let [c1-half (+ c1-from (/ (- c1-to c1-from) 2))
+                        c2-half (+ c2-from (/ (- c2-to c2-from) 2))
+
+                        [c1-ts-1 c2-ts-1] (check-range c1-from c1-half c2-from c2-half)
+                        [c1-ts-2 c2-ts-2] (check-range c1-from c1-half c2-half c2-to)
+                        [c1-ts-3 c2-ts-3] (check-range c1-half c1-to c2-from c2-half)
+                        [c1-ts-4 c2-ts-4] (check-range c1-half c1-to c2-half c2-to)]
+
+                    [(into (sorted-set) (d/concat [] c1-ts-1 c1-ts-2 c1-ts-3 c1-ts-4))
+                     (into (sorted-set) (d/concat [] c2-ts-1 c2-ts-2 c2-ts-3 c2-ts-4))])))))]
+
+    (let [[c1-ts c2-ts] (check-range 0.005 0.995 0.005 0.995)
+          c1-ts (remove-close-ts c1-ts)
+          c2-ts (remove-close-ts c2-ts)]
+      [c1-ts c2-ts])))
+
+(defn- line-to->line
+  [cmd]
+  [(:prev cmd) (gpp/command->point cmd)])
+
+(defn- curve-to->bezier
+  [cmd]
+  [(:prev cmd)
+   (gpp/command->point cmd)
+   (gpt/point (-> cmd :params :c1x) (-> cmd :params :c1y))
+   (gpt/point (-> cmd :params :c2x) (-> cmd :params :c2y))])
+
+(defn- split-command
+  [cmd values]
+  (case (:command cmd)
+    :line-to  (upg/split-line-to-ranges (:prev cmd) cmd values)
+    :curve-to (upg/split-curve-to-ranges (:prev cmd) cmd values)
+    [cmd]))
+
+(defn split [seg-1 seg-2]
+  (let [[ts-seg-1 ts-seg-2]
+        (cond
+          (and (= :line-to (:command seg-1))
+               (= :line-to (:command seg-2)))
+          (line-line-intersect (line-to->line seg-1) (line-to->line seg-2))
+
+          (and (= :line-to (:command seg-1))
+               (= :curve-to (:command seg-2)))
+          (line-curve-intersect (line-to->line seg-1) (curve-to->bezier seg-2))
+          
+          (and (= :curve-to (:command seg-1))
+               (= :line-to (:command seg-2)))
+          (let [[seg-2' seg-1']
+                (line-curve-intersect (line-to->line seg-2) (curve-to->bezier seg-1))]
+            ;; Need to reverse because we send the arguments reversed
+            [seg-1' seg-2'])
+          
+          (and (= :curve-to (:command seg-1))
+               (= :curve-to (:command seg-2)))
+          (curve-curve-intersect (curve-to->bezier seg-1) (curve-to->bezier seg-2))
+
+          :else
+          [[] []])]
+    
+    [(split-command seg-1 ts-seg-1)
+     (split-command seg-2 ts-seg-2)]))
+
+(defn add-previous
+  ([content]
+   (add-previous content nil))
+  ([content first]
+   (->> (d/with-prev content)
+        (mapv (fn [[cmd prev]]
+                (cond-> cmd
+                  (and (nil? prev) (some? first))
+                  (assoc :prev first)
+
+                  (some? prev)
+                  (assoc :prev (gpp/command->point prev))))))))
+
+(defn content-intersect-split
+  "Given two path contents will return the intersect between them"
+  [content-a content-b]
+
+  (let [content-a (add-previous content-a)
+        content-b (add-previous content-b)]
+    (if (or (empty? content-a) (empty? content-b))
+      [content-a content-b]
+
+      (loop [current       (first content-a)
+             pending       (rest content-a)
+             content-b     content-b
+             new-content-a []]
+
+        (if (not (some? current))
+          [new-content-a content-b]
+
+          (let [[new-current new-pending new-content-b]
+
+                (loop [current      current
+                       pending      pending
+                       other        (first content-b)
+                       head-content []
+                       tail-content (rest content-b)]
+
+                  (if (not (some? other))
+                    ;; Finished recorring second content
+                    [current pending head-content]
+
+                    ;; We split the current
+                    (let [[new-as new-bs] (split current other)
+                          new-as (add-previous new-as (:prev current))
+                          new-bs (add-previous new-bs (:prev other))]
+                      
+                      (if (> (count new-as) 1)
+                        ;; We add the new-a's to the stack and change the b then we iterate to the top
+                        (recur (first new-as)
+                               (d/concat [] (rest new-as) pending)
+                               (first tail-content)
+                               (d/concat [] head-content new-bs)
+                               (rest tail-content))
+
+                        ;; No current segment-segment split we continue searching
+                        (recur current
+                               pending
+                               (first tail-content)
+                               (conj head-content other)
+                               (rest tail-content))))))]
+
+            (recur (first new-pending)
+                   (rest new-pending)
+                   new-content-b
+                   (conj new-content-a new-current))))))))

frontend/src/app/util/path/geom.cljs

@@ -6,6 +6,7 @@
 
 (ns app.util.path.geom
   (:require
+   [app.common.data :as d]
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes.path :as gshp]
    [app.util.path.commands :as upc]))
@@ -16,21 +17,54 @@
   (let [handler-vector (gpt/to-vec point handler)]
     (gpt/add point (gpt/negate handler-vector))))
 
-(defn split-line-to [from-p cmd val]
+(defn split-line-to
+  "Given a point and a line-to command will create a two new line-to commands
+  that will split the original line into two given a value between 0-1"
+  [from-p cmd t-val]
   (let [to-p (upc/command->point cmd)
-        sp (gpt/line-val from-p to-p val)]
+        sp (gpt/lerp from-p to-p t-val)]
     [(upc/make-line-to sp) cmd]))
 
-(defn split-curve-to [from-p cmd val]
+(defn split-curve-to
+  "Given the point and a curve-to command will split the curve into two new
+  curve-to commands given a value between 0-1"
+  [from-p cmd t-val]
   (let [params (:params cmd)
         end (gpt/point (:x params) (:y params))
         h1 (gpt/point (:c1x params) (:c1y params))
         h2 (gpt/point (:c2x params) (:c2y params))
         [[_ to1 h11 h21]
-         [_ to2 h12 h22]] (gshp/curve-split from-p end h1 h2 val)]
+         [_ to2 h12 h22]] (gshp/curve-split from-p end h1 h2 t-val)]
     [(upc/make-curve-to to1 h11 h21)
      (upc/make-curve-to to2 h12 h22)]))
 
+(defn split-line-to-ranges
+  "Splits a line into several lines given the points in `values`
+  for example (split-line-to-ranges p c [0 0.25 0.5 0.75 1] will split
+  the line into 4 lines"
+  [from-p cmd values]
+  (let [to-p (upc/command->point cmd)]
+    (->> (conj values 1)
+         (mapv (fn [val]
+                 (upc/make-line-to (gpt/lerp from-p to-p val)))))))
+
+(defn split-curve-to-ranges
+  "Splits a curve into several curves given the points in `values`
+  for example (split-curve-to-ranges p c [0 0.25 0.5 0.75 1] will split
+  the curve into 4 curves that draw the same curve"
+  [from-p cmd values]
+  (let [to-p (upc/command->point cmd)
+        params (:params cmd)
+        h1 (gpt/point (:c1x params) (:c1y params))
+        h2 (gpt/point (:c2x params) (:c2y params))]
+
+    (->> (d/with-prev (conj values 1))
+         (mapv
+          (fn [[t1 t0]]
+            (let [t0 (if (nil? t0) 0 t0)
+                  [_ to-p h1' h2'] (gshp/subcurve-range from-p to-p h1 h2 t0 t1)]
+              (upc/make-curve-to to-p h1' h2')))))))
+
 (defn opposite-handler
   "Calculates the coordinates of the opposite handler"
   [point handler]
@@ -47,9 +81,12 @@
               (gpt/point old-distance))]
     (gpt/add point phv2)))
 
-(defn content->points [content]
+(defn content->points
+  "Returns the points in the given content"
+  [content]
   (->> content
-       (map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y))))
+       (map #(when (-> % :params :x)
+               (gpt/point (-> % :params :x) (-> % :params :y))))
        (remove nil?)
        (into [])))
 

frontend/src/app/util/path/tools.cljs

@@ -210,7 +210,7 @@
           (case (:command cmd)
             :line-to [index (upg/split-line-to start cmd value)]
             :curve-to [index (upg/split-curve-to start cmd value)]
-            :close-path [index [(upc/make-line-to (gpt/line-val start end value)) cmd]]
+            :close-path [index [(upc/make-line-to (gpt/lerp start end value)) cmd]]
             nil))
 
         cmd-changes