✨ Boolean shapes enhancements

common/src/app/common/geom/shapes/path.cljc

@@ -18,7 +18,7 @@
 (def ^:const curve-range-precision 2)
 
 (defn s= [a b]
-  (mth/almost-zero? (- (mth/abs a) b)))
+  (mth/almost-zero? (- a b)))
 
 (defn calculate-opposite-handler
   "Given a point and its handler, gives the symetric handler"
@@ -285,7 +285,8 @@
          ykey (keyword (str prefix "y"))
          x (get params xkey)
          y (get params ykey)]
-     (gpt/point x y))))
+     (when (and (some? x) (some? y))
+       (gpt/point x y)))))
 
 (defn command->line
   ([cmd]
@@ -582,32 +583,42 @@
 (defn line-has-point?
   "Using the line equation we put the x value and check if matches with
   the given Y. If it does the point is inside the line"
-  [point [from-p to-p :as line]]
+  [point [from-p to-p]]
   (let [{x1 :x y1 :y} from-p
         {x2 :x y2 :y} to-p
         {px :x py :y} point
 
         m  (when-not (s= x1 x2) (/ (- y2 y1) (- x2 x1)))
-        vy (when (some? m) (+ (* m px) (* (- m) x1) y1))
-
-        t (get-line-tval line point)]
-
+        vy (when (some? m) (+ (* m px) (* (- m) x1) y1))]
 
     ;; If x1 = x2 there is no slope, to see if the point is in the line
     ;; only needs to check the x is the same
-    (and (or (and (s= x1 x2) (s= px x1))
-             (and (some? vy) (s= py vy)))
-         ;; This will check if is between both segments
-         (or (> t 0) (s= t 0))
-         (or (< t 1) (s= t 1)))))
+    (or (and (s= x1 x2) (s= px x1))
+        (and (some? vy) (s= py vy)))))
+
+(defn segment-has-point?
+  "Using the line equation we put the x value and check if matches with
+  the given Y. If it does the point is inside the line"
+  [point line]
+
+  (and (line-has-point? point line)
+       (let [t (get-line-tval line point)]
+         (and (or (> t 0) (s= t 0))
+              (or (< t 1) (s= t 1))))))
 
 (defn curve-has-point?
-  [_point _curve]
-  ;; TODO
-  #_(or (< (gpt/distance point from-p) 0.01)
-        (< (gpt/distance point to-p) 0.01))
-  false
-  )
+  [point curve]
+  (letfn [(check-range [from-t to-t]
+            (let [r (curve-range->rect curve from-t to-t)]
+              (when (gpr/contains-point? r point)
+                (if (s= from-t to-t)
+                  (< (gpt/distance (curve-values curve from-t) point) 0.1)
+
+                  (let [half-t (+ from-t (/ (- to-t from-t) 2.0))]
+                    (or (check-range from-t half-t)
+                        (check-range half-t to-t)))))))]
+
+    (check-range 0 1)))
 
 (defn line-line-crossing
   [[from-p1 to-p1 :as l1] [from-p2 to-p2 :as l2]]
@@ -627,13 +638,23 @@
         d  (- (* (- x1 x2) (- y3 y4))
               (* (- y1 y2) (- x3 x4)))]
 
-    (when-not (mth/almost-zero? d)
+    (cond
+      (not (mth/almost-zero? d))
       ;; Coordinates in the line. We calculate the tvalue that will
       ;; return 0-1 as a percentage in the segment
       (let [cross-p (gpt/point (/ nx d) (/ ny d))
             t1 (get-line-tval l1 cross-p)
             t2 (get-line-tval l2 cross-p)]
-        [t1 t2]))))
+        [t1 t2])
+
+      ;; If they are parallels they could define the same line
+      (line-has-point? from-p2 l1) [(get-line-tval l1 from-p2) 0]
+      (line-has-point? to-p2   l1) [(get-line-tval l1 to-p2)   1]
+      (line-has-point? to-p1   l2) [1 (get-line-tval l2 to-p1)]
+      (line-has-point? from-p1 l2) [0 (get-line-tval l2 from-p1)]
+
+      :else
+      nil)))
 
 (defn line-curve-crossing
   [[from-p1 to-p1]
@@ -657,12 +678,17 @@
 
 
 (defn ray-line-intersect
-  [point line]
+  [point [a b :as line]]
 
   ;; If the ray is paralell to the line there will be no crossings
   (let [ray-line [point (gpt/point (inc (:x point)) (:y point))]
-        [ray-t line-t] (line-line-crossing ray-line line)]
-    (when (and (some? line-t)
+        ;; Rays fail when fall just in a vertex so we move a bit upward
+        ;; because only want to use this for insideness
+        a (if (and (some? a) (s= (:y a) (:y point))) (update a :y + 10) a)
+        b (if (and (some? b) (s= (:y b) (:y point))) (update b :y + 10) b)
+        [ray-t line-t] (line-line-crossing ray-line [a b])]
+
+    (when (and (some? line-t) (some? ray-t)
                (> ray-t 0)
                (or (> line-t 0) (s= line-t 0))
                (or (< line-t 1) (s= line-t 1)))
@@ -778,30 +804,33 @@
     (gpr/points->rect (into [from-p to-p] extremes))))
 
 
+(defn is-point-in-border?
+  [point content]
+
+  (letfn [(inside-border? [cmd]
+            (case (:command cmd)
+              :line-to  (segment-has-point?  point (command->line cmd))
+              :curve-to (curve-has-point? point (command->bezier cmd))
+              #_:else   false))]
+
+    (->> content
+         (some inside-border?))))
+
 (defn is-point-in-content?
   [point content]
 
-  (letfn [(cast-ray [[cmd prev]]
+  (letfn [(cast-ray [cmd]
             (let [ray-line [point (gpt/point (inc (:x point)) (:y point))]]
               (case (:command cmd)
-                :line-to  (ray-line-intersect  point (command->line cmd (command->point prev)))
-                :curve-to (ray-curve-intersect ray-line (command->bezier cmd (command->point prev)))
-                #_:else   [])))
+                :line-to  (ray-line-intersect  point (command->line cmd))
+                :curve-to (ray-curve-intersect ray-line (command->bezier cmd))
+                #_:else   [])))]
 
-          (inside-border? [[cmd prev]]
-            (case (:command cmd)
-              :line-to  (line-has-point?  point (command->line cmd (command->point prev)))
-              :curve-to (curve-has-point? point (command->bezier cmd (command->point prev)))
-              #_:else   false)
-            )]
-    (let [content-with-prev (d/with-prev content)]
-      (or (->> content-with-prev
-               (some inside-border?))
-          (->> content-with-prev
-               (mapcat cast-ray)
-               (map second)
-               (reduce +)
-               (not= 0))))))
+    (->> content
+         (mapcat cast-ray)
+         (map second)
+         (reduce +)
+         (not= 0))))
 
 (defn split-line-to
   "Given a point and a line-to command will create a two new line-to commands

common/src/app/common/geom/shapes/rect.cljc

@@ -95,3 +95,19 @@
          (or (>= x2b x1a) (s= x2b x1a))
          (or (<= y1b y2a) (s= y1b y2a))
          (or (<= y1a y2b) (s= y1a y2b)))))
+
+(defn contains-point?
+  [rect point]
+  (assert (gpt/point? point))
+  (let [x1 (:x rect)
+        y1 (:y rect)
+        x2 (+ (:x rect) (:width rect))
+        y2 (+ (:y rect) (:height rect))
+
+        px (:x point)
+        py (:y point)]
+
+    (and (or (> px x1) (s= px x1))
+         (or (< px x2) (s= px x2))
+         (or (> py y1) (s= py y1))
+         (or (< py y2) (s= py y2)))))

common/src/app/common/pages/changes_builder.cljc

@@ -134,22 +134,34 @@
                  :page-id page-id
                  :id id}))
 
-        add-undo-change
+        add-undo-change-shape
         (fn [change-set id]
           (let [shape (get objects id)]
             (d/preconj
              change-set
              {:type :add-obj
               :page-id page-id
-              :parent-id (:parent-id shape)
+              :parent-id (:frame-id shape)
               :frame-id (:frame-id shape)
               :id id
               :obj (cond-> shape
                      (contains? shape :shapes)
-                     (assoc :shapes []))
-              :index (h/position-on-parent id objects)})))]
+                     (assoc :shapes []))})))
 
+        add-undo-change-parent
+        (fn [change-set id]
+          (let [shape (get objects id)]
+            (d/preconj
+             change-set
+             {:type :mov-objects
+              :page-id page-id
+              :parent-id (:parent-id shape)
+              :shapes [id]
+              :index (h/position-on-parent id objects)
+              :ignore-touched true})))]
 
     (-> changes
         (update :redo-changes #(reduce add-redo-change % ids))
-        (update :undo-changes #(reduce add-undo-change % ids)))))
+        (update :undo-changes #(as-> % $
+                                 (reduce add-undo-change-parent $ ids)
+                                 (reduce add-undo-change-shape $ ids))))))

common/src/app/common/path/bool.cljc

@@ -34,14 +34,15 @@
   (loop [head (first content)
          content (rest content)
          result []
-         last-move nil]
+         last-move nil
+         last-p nil]
 
     (if (nil? head)
       result
       (let [head-p (gsp/command->point head)
             head (cond
                    (and (= :close-path (:command head))
-                        (< (gpt/distance head-p last-move) 0.01))
+                        (< (gpt/distance last-p last-move) 0.01))
                    nil
 
                    (= :close-path (:command head))
@@ -55,7 +56,8 @@
                (cond-> result (some? head) (conj head))
                (if (= :move-to (:command head))
                  head-p
-                 last-move))))))
+                 last-move)
+               head-p)))))
 
 (defn- split-command
   [cmd values]
@@ -152,6 +154,19 @@
 
                 :curve-to (-> (gsp/command->bezier segment)
                               (gsp/curve-values 0.5)))]
+
+    (or (gsp/is-point-in-content? point content)
+        (gsp/is-point-in-border? point content))))
+
+(defn inside-segment?
+  [segment content]
+  (let [point (case (:command segment)
+                :line-to  (-> (gsp/command->line segment)
+                              (gsp/line-values 0.5))
+
+                :curve-to (-> (gsp/command->bezier segment)
+                              (gsp/curve-values 0.5)))]
+
     (gsp/is-point-in-content? point content)))
 
 (defn overlap-segment?
@@ -159,42 +174,57 @@
   segment meaning they have the same coordinates"
   [segment content]
 
-  (letfn [(overlap-single?
-            [other]
-            (when (and (= (:command segment) (:command other))
-                       (contains? #{:line-to :curve-to} (:command segment)))
+  (let [overlap-single?
+        (fn [other]
+          (when (and (= (:command segment) (:command other))
+                     (contains? #{:line-to :curve-to} (:command segment)))
 
-              (case (:command segment)
-                :line-to (let [[p1 q1] (gsp/command->line segment)
-                               [p2 q2] (gsp/command->line other)]
+            (case (:command segment)
+              :line-to (let [[p1 q1] (gsp/command->line segment)
+                             [p2 q2] (gsp/command->line other)]
 
-                           (or (and (< (gpt/distance p1 p2) 0.1)
-                                    (< (gpt/distance q1 q2) 0.1))
-                               (and (< (gpt/distance p1 q2) 0.1)
-                                    (< (gpt/distance q1 p2) 0.1))))
+                         (when (or (and (< (gpt/distance p1 p2) 0.1)
+                                        (< (gpt/distance q1 q2) 0.1))
+                                   (and (< (gpt/distance p1 q2) 0.1)
+                                        (< (gpt/distance q1 p2) 0.1)))
+                           [segment other]))
 
-                :curve-to (let [[p1 q1 h11 h21] (gsp/command->bezier segment)
-                                [p2 q2 h12 h22] (gsp/command->bezier other)]
+              :curve-to (let [[p1 q1 h11 h21] (gsp/command->bezier segment)
+                              [p2 q2 h12 h22] (gsp/command->bezier other)]
 
-                            (or (and (< (gpt/distance p1 p2) 0.1)
-                                     (< (gpt/distance q1 q2) 0.1)
-                                     (< (gpt/distance h11 h12) 0.1)
-                                     (< (gpt/distance h21 h22) 0.1))
+                          (when (or (and (< (gpt/distance p1 p2) 0.1)
+                                         (< (gpt/distance q1 q2) 0.1)
+                                         (< (gpt/distance h11 h12) 0.1)
+                                         (< (gpt/distance h21 h22) 0.1))
 
-                                (and (< (gpt/distance p1 q2) 0.1)
-                                     (< (gpt/distance q1 p2) 0.1)
-                                     (< (gpt/distance h11 h22) 0.1)
-                                     (< (gpt/distance h21 h12) 0.1)))))))]
-    (some? (d/seek overlap-single? content))))
+                                    (and (< (gpt/distance p1 q2) 0.1)
+                                         (< (gpt/distance q1 p2) 0.1)
+                                         (< (gpt/distance h11 h22) 0.1)
+                                         (< (gpt/distance h21 h12) 0.1)))
+
+                            [segment other])))))]
+
+    (->> content
+         (d/seek overlap-single?)
+         (some?))))
 
 (defn create-union [content-a content-a-split content-b content-b-split]
   ;; Pick all segments in content-a that are not inside content-b
   ;; Pick all segments in content-b that are not inside content-a
-  (d/concat
-   []
-   (->> content-a-split (filter #(not (contains-segment? % content-b))))
-   (->> content-b-split (filter #(or (not (contains-segment? % content-a))
-                                     (overlap-segment? % content-a-split))))))
+  (let [content
+        (d/concat
+         []
+         (->> content-a-split (filter #(not (contains-segment? % content-b))))
+         (->> content-b-split (filter #(not (contains-segment? % content-a)))))
+
+        ;; Overlapping segments should be added when they are part of the border
+        border-content
+        (->> content-b-split
+             (filterv #(and (contains-segment? % content-a)
+                            (overlap-segment? % content-a-split)
+                            (not (inside-segment? % content)))))]
+
+    (d/concat content border-content)))
 
 (defn create-difference [content-a content-a-split content-b content-b-split]
   ;; Pick all segments in content-a that are not inside content-b

common/src/app/common/path/shapes_to_path.cljc

@@ -24,9 +24,7 @@
 (def allowed-transform-types
   #{:rect
     :circle
-    :image
-    :group
-    :bool})
+    :image})
 
 (def style-group-properties
   [:shadow
@@ -146,16 +144,26 @@
 
 (declare convert-to-path)
 
+(defn fix-first-relative
+  "Fix an issue with the simplify commands not changing the first relative"
+  [content]
+  (let [head (first content)]
+    (cond-> content
+      (and head (:relative head))
+      (update 0 assoc :relative false))))
+
 (defn group-to-path
   [group objects]
   (let [xform (comp (map #(get objects %))
                     (map #(-> (convert-to-path % objects))))
 
         child-as-paths (into [] xform (:shapes group))
-        head (first child-as-paths)
+        head (last child-as-paths)
         head-data (select-keys head style-properties)
-        content (into [] (mapcat :content) child-as-paths)]
-
+        content (into []
+                      (comp (filter #(= :path (:type %)))
+                            (mapcat #(fix-first-relative (:content %))))
+                      child-as-paths)]
     (-> group
         (assoc :type :path)
         (assoc :content content)
@@ -184,14 +192,14 @@
    (convert-to-path shape {}))
   ([{:keys [type x y width height r1 r2 r3 r4 rx metadata] :as shape} objects]
    (assert (map? objects))
-   (cond
-     (= (:type shape) :group)
+   (case (:type shape)
+     :group
      (group-to-path shape objects)
 
-     (= (:type shape) :bool)
+     :bool
      (bool-to-path shape objects)
 
-     (contains? allowed-transform-types type)
+     (:rect :circle :image :text)
      (let [new-content
            (case type
              :circle (circle->path x y width height)
@@ -209,6 +217,6 @@
            (cond-> (= :image type)
              (assoc :fill-image metadata))
            (d/without-keys dissoc-attrs)))
-     :else
-     ;; Do nothing if the shape is not of a correct type
+
+     ;; For the rest return the plain shape
      shape)))

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

@@ -292,6 +292,10 @@
             [result next-pos next-start next-cc next-qc]))
 
         start (first commands)
+        start (cond-> start
+                (:relative start)
+                (assoc :relative false))
+
         start-pos (gpt/point (:params start))]
 
     (->> (map vector (rest commands) commands)