✨ Export/Import and edgecases fixing

common/src/app/common/file_builder.cljc

@@ -278,6 +278,48 @@
     (-> file
         (update :parent-stack pop))))
 
+(defn add-bool [file data]
+  (let [frame-id (:current-frame-id file)
+        name (:name data)
+        obj (-> {:id (uuid/next)
+                 :type :bool
+                 :name name
+                 :shapes []
+                 :frame-id frame-id}
+                (merge data)
+                (check-name file :bool)
+                (d/without-nils))]
+    (-> file
+        (commit-shape obj)
+        (assoc :last-id (:id obj))
+        (add-name (:name obj))
+        (update :parent-stack conjv (:id obj)))))
+
+(defn close-bool [file]
+  (let [bool-id (-> file :parent-stack peek)
+        bool    (lookup-shape file bool-id)
+        children (->> bool :shapes (mapv #(lookup-shape file %)))
+
+        file
+        (let [objects (lookup-objects file)
+              bool' (gsh/update-bool-selrect bool children objects)]
+          (commit-change
+           file
+           {:type :mod-obj
+            :id bool-id
+            :operations
+            [{:type :set :attr :selrect :val (:selrect bool')}
+             {:type :set :attr :points  :val (:points bool')}
+             {:type :set :attr :x       :val (-> bool' :selrect :x)}
+             {:type :set :attr :y       :val (-> bool' :selrect :y)}
+             {:type :set :attr :width   :val (-> bool' :selrect :width)}
+             {:type :set :attr :height  :val (-> bool' :selrect :height)}]}
+
+           {:add-container? true}))]
+
+    (-> file
+        (update :parent-stack pop))))
+
 (defn create-shape [file type data]
   (let [frame-id (:current-frame-id file)
         frame (when-not (= frame-id root-frame)

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

@@ -17,6 +17,9 @@
 (def ^:const curve-curve-precision 0.1)
 (def ^:const curve-range-precision 2)
 
+(defn s= [a b]
+  (mth/almost-zero? (- (mth/abs a) b)))
+
 (defn calculate-opposite-handler
   "Given a point and its handler, gives the symetric handler"
   [point handler]
@@ -567,6 +570,34 @@
                       (mapv #(curve-values curve %)))]
     (gpr/points->rect (into [from-p to-p] extremes))))
 
+(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]]
+  (let [{x1 :x y1 :y} from-p
+        {x2 :x y2 :y} to-p
+        {px :x py :y} point
+
+        m (/ (- y2 y1) (- x2 x1))
+        vy (+ (* m px) (* (- m) x1) y1)
+
+        t (get-line-tval line point)]
+
+    ;; 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))
+             (s= py vy))
+         ;; This will check if is between both segments
+         (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
+  )
 
 (defn line-line-crossing
   [[from-p1 to-p1 :as l1] [from-p2 to-p2 :as l2]]
@@ -613,26 +644,30 @@
 
     (curve-roots c2' :y)))
 
-(defn ray-line-intersect
-  [point [from-p to-p :as line]]
 
-  (let [ray-line-angle (gpt/angle (gpt/to-vec from-p to-p) (gpt/point 1 0))]
+
+(defn ray-line-intersect
+  [point line]
+
   ;; If the ray is paralell to the line there will be no crossings
-    (when (and (> (mth/abs (- ray-line-angle 180)) 0.01)
-               (> (mth/abs (- ray-line-angle 0)) 0.01))
   (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) (> ray-t 0) (>= line-t 0) (<= line-t 1))
+    (when (and (some? line-t)
+               (> ray-t 0)
+               (or (> line-t 0) (s= line-t 0))
+               (or (< line-t 1) (s= line-t 1)))
       [[(line-values line line-t)
-            (line-windup line line-t)]])))))
+        (line-windup line line-t)]])))
 
 (defn line-line-intersect
   [l1 l2]
 
   (let [[l1-t l2-t] (line-line-crossing l1 l2)]
     (when (and (some? l1-t) (some? l2-t)
-               (>= l1-t 0) (<= l1-t 1)
+               (or (> l1-t 0) (s= l1-t 0))
-               (>= l2-t 0) (<= l2-t 1))
+               (or (< l1-t 1) (s= l1-t 1))
+               (or (> l2-t 0) (s= l2-t 0))
+               (or (< l2-t 1) (s= l2-t 1)))
       [[l1-t] [l2-t]])))
 
 (defn ray-curve-intersect
@@ -675,26 +710,7 @@
 (defn curve-curve-intersect
   [c1 c2]
 
-  (letfn [(remove-close-ts [ts]
+  (letfn [(check-range [c1-from c1-to c2-from c2-to]
-            (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)]
 
@@ -760,14 +776,22 @@
               (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   [])))]
+                #_:else   [])))
 
-    ;; non-zero windup rule
+          (inside-border? [[cmd prev]]
-    (->> (d/with-prev content)
+            (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))))
+               (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

@@ -7,7 +7,8 @@
 (ns app.common.geom.shapes.rect
   (:require
    [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.common :as gco]))
+   [app.common.geom.shapes.common :as gco]
+   [app.common.math :as mth]))
 
 (defn rect->points [{:keys [x y width height]}]
   ;; (assert (number? x))
@@ -71,6 +72,10 @@
    :width width
    :height height})
 
+(defn s=
+  [a b]
+  (mth/almost-zero? (- a b)))
+
 (defn overlaps-rects?
   "Check for two rects to overlap. Rects won't overlap only if
    one of them is fully to the left or the top"
@@ -86,7 +91,7 @@
         x2b (+ (:x rect-b) (:width rect-b))
         y2b (+ (:y rect-b) (:height rect-b))]
 
-    (and (> x2a x1b)
+    (and (or (> x2a x1b)  (s= x2a x1b))
-         (> x2b x1a)
+         (or (>= x2b x1a) (s= x2b x1a))
-         (> y2a y1b)
+         (or (<= y1b y2a) (s= y1b y2a))
-         (> y2b y1a))))
+         (or (<= y1a y2b) (s= y1a y2b)))))

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

@@ -151,7 +151,6 @@
                        (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)]
 
@@ -180,7 +179,8 @@
   (d/concat
    []
    (->> content-a-split (filter #(not (contains-segment? % content-b))))
-   (->> content-b-split (filter #(not (contains-segment? % content-a))))))
+   (->> content-b-split (filter #(or (not (contains-segment? % content-a))
+                                     (overlap-segment? % content-a-split))))))
 
 (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
@@ -194,8 +194,8 @@
    (->> content-b-split
         (reverse)
         (mapv reverse-command)
-        (filter #(contains-segment? % content-a))
+        (filter #(and (contains-segment? % content-a)
-        (filter #(not (overlap-segment? % content-a-split))))))
+                      (not (overlap-segment? % content-a-split)))))))
 
 (defn create-intersection [content-a content-a-split content-b content-b-split]
   ;; Pick all segments in content-a that are inside content-b

frontend/src/app/main/ui/shapes/bool.cljs

@@ -8,12 +8,71 @@
   (:require
    [app.common.data :as d]
    [app.common.geom.shapes :as gsh]
+   [app.common.geom.shapes.path :as gsp]
    [app.common.path.bool :as pb]
    [app.common.path.shapes-to-path :as stp]
    [app.main.ui.hooks :refer [use-equal-memo]]
+   [app.main.ui.shapes.export :as use]
+   [app.main.ui.shapes.path :refer [path-shape]]
    [app.util.object :as obj]
    [rumext.alpha :as mf]))
 
+(mf/defc debug-bool
+  {::mf/wrap-props false}
+  [props]
+
+  (let [frame  (obj/get props "frame")
+        shape  (obj/get props "shape")
+        childs (obj/get props "childs")
+
+        [content-a content-b]
+        (mf/use-memo
+         (mf/deps shape childs)
+         (fn []
+           (let [childs (d/mapm #(-> %2 (gsh/translate-to-frame frame) gsh/transform-shape) childs)
+                 [content-a content-b]
+                 (->> (:shapes shape)
+                      (map #(get childs %))
+                      (filter #(not (:hidden %)))
+                      (map #(stp/convert-to-path % childs))
+                      (mapv :content)
+                      (mapv pb/add-previous))]
+             (pb/content-intersect-split content-a content-b))))]
+    [:g.debug-bool
+     [:g.shape-a
+      [:& path-shape {:shape (-> shape
+                                 (assoc :type :path)
+                                 (assoc :stroke-color "blue")
+                                 (assoc :stroke-opacity 1)
+                                 (assoc :stroke-width 0.5)
+                                 (assoc :stroke-style :solid)
+                                 (dissoc :fill-color :fill-opacity)
+                                 (assoc :content content-b))
+                      :frame frame}]
+      (for [{:keys [x y]} (gsp/content->points content-b)]
+        [:circle {:cx x
+                  :cy y
+                  :r 2.5
+                  :style {:fill "blue"}}])]
+
+     [:g.shape-b
+      [:& path-shape {:shape (-> shape
+                                 (assoc :type :path)
+                                 (assoc :stroke-color "red")
+                                 (assoc :stroke-opacity 1)
+                                 (assoc :stroke-width 0.5)
+                                 (assoc :stroke-style :solid)
+                                 (dissoc :fill-color :fill-opacity)
+                                 (assoc :content content-a))
+                      :frame frame}]
+      (for [{:keys [x y]} (gsp/content->points content-a)]
+        [:circle {:cx x
+                  :cy y
+                  :r 1.25
+                  :style {:fill "red"}}])]])
+  )
+
+
 (defn bool-shape
   [shape-wrapper]
   (mf/fnc bool-shape
@@ -25,72 +84,30 @@
 
                 childs (use-equal-memo childs)
 
-          ;;[content-a content-b]
+                include-metadata? (mf/use-ctx use/include-metadata-ctx)
-          ;;(mf/use-memo
-          ;; (mf/deps shape childs)
-          ;; (fn []
-          ;;   (let [childs (d/mapm #(gsh/transform-shape %2) childs)
-          ;;         [content-a content-b]
-          ;;         (->> (:shapes shape)
-          ;;              (map #(get childs %))
-          ;;              (filter #(not (:hidden %)))
-          ;;              (map #(stp/convert-to-path % childs))
-          ;;              (mapv :content)
-          ;;              (mapv pb/add-previous))]
-          ;;     (pb/content-intersect-split content-a content-b))))
-
-          ;;_ (.log js/console "content-a" (clj->js content-a))
-          ;;_ (.log js/console "content-b" (clj->js content-b))
 
                 bool-content
                 (mf/use-memo
                  (mf/deps shape childs)
                  (fn []
-             (let [childs (d/mapm #(gsh/transform-shape %2) childs)]
+                   (let [childs (d/mapm #(-> %2 (gsh/translate-to-frame frame) gsh/transform-shape) childs)]
                      (->> (:shapes shape)
                           (map #(get childs %))
                           (filter #(not (:hidden %)))
                           (map #(stp/convert-to-path % childs))
                           (mapv :content)
-                    (pb/content-bool (:bool-type shape))))))
+                          (pb/content-bool (:bool-type shape))))))]
-          ]
 
             [:*
-       [:& shape-wrapper {:shape (-> shape
+             [:& path-shape {:shape (assoc shape :content bool-content)}]
-                                     (assoc :type :path)
-                                     (assoc :content bool-content))
-                          :frame frame}]
 
+             (when include-metadata?
+               [:> "penpot:bool" {}
+                (for [item (->> (:shapes shape) (mapv #(get childs %)))]
+                  [:& shape-wrapper {:frame frame
+                                     :shape item
+                                     :key (:id item)}])])
 
-       #_[:*
+             #_[:& debug-bool {:frame frame
-        [:g
+                             :shape shape
-         [:& shape-wrapper {:shape (-> shape
+                             :childs childs}]])))
-                                       (assoc :type :path)
-                                       (assoc :stroke-color "blue")
-                                       (assoc :stroke-opacity 1)
-                                       (assoc :stroke-width 0.5)
-                                       (assoc :stroke-style :solid)
-                                       (dissoc :fill-color :fill-opacity)
-                                       (assoc :content content-b))
-                            :frame frame}]
-         (for [{:keys [x y]} (app.common.geom.shapes.path/content->points content-b)]
-           [:circle {:cx x
-                     :cy y
-                     :r 2.5
-                     :style {:fill "blue"}}])]
-        
-        [:g
-         [:& shape-wrapper {:shape (-> shape
-                                       (assoc :type :path)
-                                       (assoc :stroke-color "red")
-                                       (assoc :stroke-opacity 1)
-                                       (assoc :stroke-width 0.5)
-                                       (assoc :stroke-style :solid)
-                                       (dissoc :fill-color :fill-opacity)
-                                       (assoc :content content-a))
-                            :frame frame}]
-         (for [{:keys [x y]} (app.common.geom.shapes.path/content->points content-a)]
-           [:circle {:cx x
-                     :cy y
-                     :r 1.25
-                     :style {:fill "red"}}])]]])))

frontend/src/app/main/ui/shapes/export.cljs

@@ -64,6 +64,7 @@
         text?  (= :text (:type shape))
         path?  (= :path (:type shape))
         mask?  (and group? (:masked-group? shape))
+        bool?  (= :bool (:type shape))
         center (gsh/center-shape shape)]
     (-> props
         (add! :name)
@@ -102,7 +103,10 @@
               (add! :content (comp json/encode uuid->string))))
 
         (cond-> mask?
-          (obj/set! "penpot:masked-group" "true")))))
+          (obj/set! "penpot:masked-group" "true"))
+
+        (cond-> bool?
+          (add! :bool-type)))))
 
 
 (defn add-library-refs [props shape]

frontend/src/app/main/ui/shapes/shape.cljs

@@ -72,6 +72,7 @@
      [:> wrapper-tag wrapper-props
       (when include-metadata?
         [:& ed/export-data {:shape shape}])
+
       [:defs
        [:& defs/svg-defs          {:shape shape :render-id render-id}]
        [:& filters/filters        {:shape shape :filter-id filter-id}]

frontend/src/app/main/ui/workspace/viewport.cljs

@@ -201,11 +201,12 @@
 
       [:& use/export-page {:options options}]
 
+      [:& (mf/provider use/include-metadata-ctx) {:value true}
        [:& (mf/provider embed/context) {:value true}
         ;; Render root shape
         [:& shapes/root-shape {:key page-id
                                :objects objects
-                              :active-frames @active-frames}]]]
+                               :active-frames @active-frames}]]]]
 
      [:svg.viewport-controls
       {:xmlns "http://www.w3.org/2000/svg"

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

@@ -209,6 +209,13 @@
                        (->> node :content last))]
         (merge (add-attrs {} (:attrs svg-node)) node-attrs))
 
+      (= type :bool)
+      (->> node
+           (:content)
+           (filter #(= :path (:tag %)))
+           (map #(:attrs %))
+           (reduce add-attrs node-attrs))
+
       :else
       node-attrs)))
 
@@ -443,6 +450,11 @@
       mask?
       (assoc :masked-group? true))))
 
+(defn add-bool-data
+  [props node]
+  (-> props
+      (assoc :bool-type (get-meta node :bool-type keyword))))
+
 (defn parse-shadow [node]
   {:id       (uuid/next)
    :style    (get-meta node :shadow-type keyword)
@@ -706,7 +718,10 @@
             (add-image-data type node))
 
           (cond-> (= :text type)
-            (add-text-data node))))))
+            (add-text-data node))
+
+          (cond-> (= :bool type)
+            (add-bool-data node))))))
 
 (defn parse-page-data
   [node]

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

@@ -81,8 +81,8 @@
               last-move (if current-move? point last-move)]
 
           (if (and (not current-move?) (pt= last-move point))
-            (println (command->string (set-point current last-move)))
+            (print (command->string (set-point current last-move)))
-            (println (command->string current)))
+            (print (command->string current)))
 
           (when (and (not current-move?) (pt= last-move point))
             (print "Z"))

frontend/src/app/worker/import.cljs

@@ -202,6 +202,7 @@
       (case type
         :frame    (fb/close-artboard file)
         :group    (fb/close-group file)
+        :bool     (fb/close-bool file)
         :svg-raw  (fb/close-svg-raw file)
         #_default file)
 
@@ -218,6 +219,7 @@
             file (case type
                    :frame    (fb/add-artboard   file data)
                    :group    (fb/add-group      file data)
+                   :bool     (fb/add-bool       file data)
                    :rect     (fb/create-rect    file data)
                    :circle   (fb/create-circle  file data)
                    :path     (fb/create-path    file data)