diff --git a/common/src/app/common/geom/shapes/path.cljc b/common/src/app/common/geom/shapes/path.cljc index fc3deb045..a4be29985 100644 --- a/common/src/app/common/geom/shapes/path.cljc +++ b/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 diff --git a/common/src/app/common/geom/shapes/rect.cljc b/common/src/app/common/geom/shapes/rect.cljc index fe1541f23..f4a0bd043 100644 --- a/common/src/app/common/geom/shapes/rect.cljc +++ b/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))))) diff --git a/common/src/app/common/pages/changes_builder.cljc b/common/src/app/common/pages/changes_builder.cljc index d9567242c..45fcebd23 100644 --- a/common/src/app/common/pages/changes_builder.cljc +++ b/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)))))) diff --git a/common/src/app/common/path/bool.cljc b/common/src/app/common/path/bool.cljc index 649e17282..ddb388091 100644 --- a/common/src/app/common/path/bool.cljc +++ b/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 diff --git a/common/src/app/common/path/shapes_to_path.cljc b/common/src/app/common/path/shapes_to_path.cljc index 24cbd1892..7a41c60e7 100644 --- a/common/src/app/common/path/shapes_to_path.cljc +++ 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))) diff --git a/frontend/src/app/util/path/parser.cljs b/frontend/src/app/util/path/parser.cljs index 9e6023600..99e6435a5 100644 --- a/frontend/src/app/util/path/parser.cljs +++ b/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)