From c7683dfd80165f6f80f7ab3def8fbb9d65adf6c6 Mon Sep 17 00:00:00 2001 From: "alonso.torres" Date: Tue, 20 Apr 2021 21:22:15 +0200 Subject: [PATCH] :sparkles: Improved make curve options --- common/app/common/geom/point.cljc | 37 ++++- .../app/main/data/workspace/path/drawing.cljs | 79 +++++----- .../app/main/data/workspace/path/edition.cljs | 38 ++--- .../app/main/data/workspace/path/helpers.cljs | 91 +++++++++-- .../app/main/data/workspace/path/streams.cljs | 4 +- frontend/src/app/main/ui/shapes/path.cljs | 1 - frontend/src/app/util/path/commands.cljs | 54 +++++-- frontend/src/app/util/path/tools.cljs | 142 ++++++++++++------ 8 files changed, 305 insertions(+), 141 deletions(-) diff --git a/common/app/common/geom/point.cljc b/common/app/common/geom/point.cljc index 6e656d888..9752f32be 100644 --- a/common/app/common/geom/point.cljc +++ b/common/app/common/geom/point.cljc @@ -213,12 +213,12 @@ (let [v-length (length v)] (divide v (point v-length v-length)))) -(defn project [v1 v2] +(defn project + "V1 perpendicular projection on vector V2" + [v1 v2] (let [v2-unit (unit v2) - scalar-projection (dot v1 (unit v2))] - (multiply - v2-unit - (point scalar-projection scalar-projection)))) + scalar-proj (dot v1 v2-unit)] + (scale v2-unit scalar-proj))) (defn center-points "Centroid of a group of points" @@ -264,7 +264,34 @@ (scale v))] (add p1 v))) + +(defn rotate + "Rotates the point around center with an angle" + [{px :x py :y} {cx :x cy :y} angle] + (let [angle (mth/radians angle) + + x (+ (* (mth/cos angle) (- px cx)) + (* (mth/sin angle) (- py cy) -1) + cx) + + y (+ (* (mth/sin angle) (- px cx)) + (* (mth/cos angle) (- py cy)) + cy)] + (point x y))) + + +(defn scale-from + "Moves a point in the vector that creates with center with a scale + value" + [point center value] + (add point + (-> (to-vec center point) + (unit) + (scale value)))) + + ;; --- Debug (defmethod pp/simple-dispatch Point [obj] (pr obj)) + diff --git a/frontend/src/app/main/data/workspace/path/drawing.cljs b/frontend/src/app/main/data/workspace/path/drawing.cljs index 9f359c3af..08de690f7 100644 --- a/frontend/src/app/main/data/workspace/path/drawing.cljs +++ b/frontend/src/app/main/data/workspace/path/drawing.cljs @@ -58,54 +58,51 @@ (update-in (st/get-path state) helpers/append-node position last-point prev-handler)) state))))) -(defn start-drag-handler [] - (ptk/reify ::start-drag-handler - ptk/UpdateEvent - (update [_ state] - (let [content (get-in state (st/get-path state :content)) - index (dec (count content)) - command (get-in state (st/get-path state :content index :command)) +(defn drag-handler + ([{:keys [x y alt? shift?] :as position}] + (drag-handler nil nil :c1 position)) - make-curve - (fn [command] - (let [params (upc/make-curve-params - (get-in content [index :params]) - (get-in content [(dec index) :params]))] - (-> command - (assoc :command :curve-to :params params))))] + ([position index prefix {:keys [x y alt? shift?]}] + (ptk/reify ::drag-handler + ptk/UpdateEvent + (update [_ state] + (let [id (st/get-path-id state) + content (get-in state (st/get-path state :content)) - (cond-> state - (= command :line-to) - (update-in (st/get-path state :content index) make-curve)))))) + index (or index (count content)) + prefix (or prefix :c1) + position (or position (upc/command->point (nth content (dec index)))) -(defn drag-handler [{:keys [x y alt? shift?]}] - (ptk/reify ::drag-handler - ptk/UpdateEvent - (update [_ state] - (let [id (st/get-path-id state) - shape (get-in state (st/get-path state)) - content (:content shape) - index (dec (count content)) - node-position (upc/command->point (nth content index)) - handler-position (cond-> (gpt/point x y) - shift? (helpers/position-fixed-angle node-position)) - {dx :x dy :y} (gpt/subtract handler-position node-position) - match-opposite? (not alt?) - modifiers (helpers/move-handler-modifiers content (inc index) :c1 match-opposite? dx dy)] - (-> state - (update-in [:workspace-local :edit-path id :content-modifiers] merge modifiers) - (assoc-in [:workspace-local :edit-path id :prev-handler] handler-position) - (assoc-in [:workspace-local :edit-path id :drag-handler] handler-position)))))) + old-handler (helpers/handler->point content index prefix) + + handler-position (cond-> (gpt/point x y) + shift? (helpers/position-fixed-angle position)) + + {dx :x dy :y} (if (some? old-handler) + (gpt/add (gpt/to-vec old-handler position) + (gpt/to-vec position handler-position)) + (gpt/to-vec position handler-position)) + + match-opposite? (not alt?) + + modifiers (helpers/move-handler-modifiers content index prefix match-opposite? match-opposite? dx dy)] + (-> state + (update-in [:workspace-local :edit-path id :content-modifiers] merge modifiers) + (assoc-in [:workspace-local :edit-path id :drag-handler] handler-position))))))) (defn finish-drag [] (ptk/reify ::finish-drag ptk/UpdateEvent (update [_ state] (let [id (st/get-path-id state) + modifiers (get-in state [:workspace-local :edit-path id :content-modifiers]) + content (-> (get-in state (st/get-path state :content)) + (upc/apply-content-modifiers modifiers)) + handler (get-in state [:workspace-local :edit-path id :drag-handler])] (-> state - (update-in (st/get-path state :content) upc/apply-content-modifiers modifiers) + (assoc-in (st/get-path state :content) content) (update-in [:workspace-local :edit-path id] dissoc :drag-handler) (update-in [:workspace-local :edit-path id] dissoc :content-modifiers) (assoc-in [:workspace-local :edit-path id :prev-handler] handler) @@ -135,17 +132,21 @@ content (get-in state (st/get-path state :content)) snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled]) points (upg/content->points content) + + handlers (-> (upc/content->handlers content) + (get position)) + + [idx prefix] (when (= (count handlers) 1) (first handlers)) drag-events-stream (->> (streams/position-stream snap-toggled points) (rx/take-until stop-stream) - (rx/map #(drag-handler %)))] + (rx/map #(drag-handler position idx prefix %)))] (rx/concat (rx/of (add-node position)) (streams/drag-stream (rx/concat - (rx/of (start-drag-handler)) drag-events-stream (rx/of (finish-drag)) (rx/of (close-path-drag-end)))) @@ -180,7 +181,6 @@ (rx/of (add-node position)) (streams/drag-stream (rx/concat - (rx/of (start-drag-handler)) drag-events (rx/of (finish-drag))))))))) @@ -204,7 +204,6 @@ (rx/of (add-node down-event)) (streams/drag-stream (rx/concat - (rx/of (start-drag-handler)) drag-events (rx/of (finish-drag))))))) diff --git a/frontend/src/app/main/data/workspace/path/edition.cljs b/frontend/src/app/main/data/workspace/path/edition.cljs index 57162153f..eb6a63eb2 100644 --- a/frontend/src/app/main/data/workspace/path/edition.cljs +++ b/frontend/src/app/main/data/workspace/path/edition.cljs @@ -25,37 +25,23 @@ [beicon.core :as rx] [potok.core :as ptk])) -(defn modify-point [index prefix dx dy] - (ptk/reify ::modify-point - ptk/UpdateEvent - (update [_ state] - (let [id (get-in state [:workspace-local :edition]) - [cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])] - (-> state - (update-in [:workspace-local :edit-path id :content-modifiers (inc index)] assoc - :c1x dx :c1y dy) - (update-in [:workspace-local :edit-path id :content-modifiers index] assoc - :x dx :y dy :c2x dx :c2y dy)))))) - (defn modify-handler [id index prefix dx dy match-opposite?] (ptk/reify ::modify-handler ptk/UpdateEvent (update [_ state] + (let [content (get-in state (st/get-path state :content)) + + modifiers (helpers/move-handler-modifiers content index prefix false match-opposite? dx dy) [cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y]) - [ocx ocy] (if (= prefix :c1) [:c2x :c2y] [:c1x :c1y]) point (gpt/point (+ (get-in content [index :params cx]) dx) (+ (get-in content [index :params cy]) dy)) - opposite-index (upc/opposite-index content index prefix)] - (cond-> state - :always - (-> (update-in [:workspace-local :edit-path id :content-modifiers index] assoc - cx dx cy dy) - (assoc-in [:workspace-local :edit-path id :moving-handler] point)) - (and match-opposite? opposite-index) - (update-in [:workspace-local :edit-path id :content-modifiers opposite-index] assoc - ocx (- dx) ocy (- dy))))))) + ] + + (-> state + (update-in [:workspace-local :edit-path id :content-modifiers] merge modifiers) + (assoc-in [:workspace-local :edit-path id :moving-handler] point)))))) (defn apply-content-modifiers [] (ptk/reify ::apply-content-modifiers @@ -174,15 +160,9 @@ content (get-in state (st/get-path state :content)) points (upg/content->points content) - opposite-index (upc/opposite-index content index prefix) - opposite-prefix (if (= prefix :c1) :c2 :c1) - opposite-handler (-> content (get opposite-index) (upc/get-handler opposite-prefix)) - point (-> content (get (if (= prefix :c1) (dec index) index)) (upc/command->point)) handler (-> content (get index) (upc/get-handler prefix)) - current-distance (when opposite-handler (gpt/distance (upg/opposite-handler point handler) opposite-handler)) - match-opposite? (and opposite-handler (mth/almost-zero? current-distance)) snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled])] (streams/drag-stream @@ -199,7 +179,7 @@ prefix (+ start-delta-x (- (:x pos) (:x start-point))) (+ start-delta-y (- (:y pos) (:y start-point))) - (and (not alt?) match-opposite?)))))) + (not alt?)))))) (rx/concat (rx/of (apply-content-modifiers))))))))) (declare stop-path-edit) diff --git a/frontend/src/app/main/data/workspace/path/helpers.cljs b/frontend/src/app/main/data/workspace/path/helpers.cljs index 57b31b908..a1f81e51d 100644 --- a/frontend/src/app/main/data/workspace/path/helpers.cljs +++ b/frontend/src/app/main/data/workspace/path/helpers.cljs @@ -106,15 +106,88 @@ (update :content (fnil conj []) command) (update-selrect)))) +(defn prefix->coords [prefix] + (case prefix + :c1 [:c1x :c1y] + :c2 [:c2x :c2y] + nil)) + +(defn handler->point [content index prefix] + (when (and (some? index) + (some? prefix) + (contains? content index)) + (let [[cx cy :as coords] (prefix->coords prefix)] + (if (= :curve-to (get-in content [index :command])) + (gpt/point (get-in content [index :params cx]) + (get-in content [index :params cy])) + + (gpt/point (get-in content [index :params :x]) + (get-in content [index :params :y])))))) + +(defn handler->node [content index prefix] + (if (= prefix :c1) + (upc/command->point (get content (dec index))) + (upc/command->point (get content index)))) + +(defn angle-points [common p1 p2] + (mth/abs + (gpt/angle-with-other + (gpt/to-vec common p1) + (gpt/to-vec common p2)))) + +(defn calculate-opposite-delta [node handler opposite match-angle? match-distance? dx dy] + (when (and (some? handler) (some? opposite)) + (let [;; To match the angle, the angle should be matching (angle between points 180deg) + angle-handlers (angle-points node handler opposite) + + match-angle? (and match-angle? (<= (mth/abs (- 180 angle-handlers) ) 0.1)) + + ;; To match distance the distance should be matching + match-distance? (and match-distance? (mth/almost-zero? (- (gpt/distance node handler) + (gpt/distance node opposite)))) + + new-handler (-> handler (update :x + dx) (update :y + dy)) + + v1 (gpt/to-vec node handler) + v2 (gpt/to-vec node new-handler) + + delta-angle (gpt/angle-with-other v1 v2) + delta-sign (if (> (* (:y v1) (:x v2)) (* (:x v1) (:y v2))) -1 1) + + distance-scale (/ (gpt/distance node handler) + (gpt/distance node new-handler)) + + new-opposite (cond-> opposite + match-angle? + (gpt/rotate node (* delta-sign delta-angle)) + + match-distance? + (gpt/scale-from node distance-scale))] + [(- (:x new-opposite) (:x opposite)) + (- (:y new-opposite) (:y opposite))]))) + (defn move-handler-modifiers - [content index prefix match-opposite? dx dy] - (let [[cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y]) - [ocx ocy] (if (= prefix :c1) [:c2x :c2y] [:c1x :c1y]) - opposite-index (upc/opposite-index content index prefix)] + [content index prefix match-distance? match-angle? dx dy] - (cond-> {} - :always - (update index assoc cx dx cy dy) + (let [[cx cy] (prefix->coords prefix) + [op-idx op-prefix] (upc/opposite-index content index prefix) - (and match-opposite? opposite-index) - (update opposite-index assoc ocx (- dx) ocy (- dy))))) + node (handler->node content index prefix) + handler (handler->point content index prefix) + opposite (handler->point content op-idx op-prefix) + + [ocx ocy] (prefix->coords op-prefix) + [odx ody] (calculate-opposite-delta node handler opposite match-angle? match-distance? dx dy) + + hnv (if (some? handler) + (gpt/to-vec node (-> handler (update :x + dx) (update :y + dy))) + (gpt/point dx dy))] + + (-> {} + (update index assoc cx dx cy dy) + + (cond-> (and (some? op-idx) (not= opposite node)) + (update op-idx assoc ocx odx ocy ody) + + (and (some? op-idx) (= opposite node) match-distance? match-angle?) + (update op-idx assoc ocx (- (:x hnv)) ocy (- (:y hnv))))))) diff --git a/frontend/src/app/main/data/workspace/path/streams.cljs b/frontend/src/app/main/data/workspace/path/streams.cljs index d61d1a82a..8912a1141 100644 --- a/frontend/src/app/main/data/workspace/path/streams.cljs +++ b/frontend/src/app/main/data/workspace/path/streams.cljs @@ -88,7 +88,9 @@ (gpt/add position snap)) position))] (->> ms/mouse-position - (rx/map check-path-snap)))) + (rx/map check-path-snap) + (rx/with-latest merge (->> ms/mouse-position-shift (rx/map #(hash-map :shift? %)))) + (rx/with-latest merge (->> ms/mouse-position-alt (rx/map #(hash-map :alt? %))))))) (defn position-stream [snap-toggled points] diff --git a/frontend/src/app/main/ui/shapes/path.cljs b/frontend/src/app/main/ui/shapes/path.cljs index c5de929e1..08b716e15 100644 --- a/frontend/src/app/main/ui/shapes/path.cljs +++ b/frontend/src/app/main/ui/shapes/path.cljs @@ -39,4 +39,3 @@ :base-props props :elem-name "path"}]))) - diff --git a/frontend/src/app/util/path/commands.cljs b/frontend/src/app/util/path/commands.cljs index 7d933991a..e899cf85e 100644 --- a/frontend/src/app/util/path/commands.cljs +++ b/frontend/src/app/util/path/commands.cljs @@ -53,22 +53,43 @@ :c2x (:x h2) :c2y (:y h2)})) -(defn make-curve-to [to h1 h2] +(defn update-curve-to + [command h1 h2] + (-> command + (assoc :command :curve-to) + (assoc-in [:params :c1x] (:x h1)) + (assoc-in [:params :c1y] (:y h1)) + (assoc-in [:params :c2x] (:x h2)) + (assoc-in [:params :c2y] (:y h2)))) + +(defn make-curve-to + [to h1 h2] {:command :curve-to :relative false :params (make-curve-params to h1 h2)}) -(defn apply-content-modifiers [content modifiers] +(defn update-handler + [command prefix point] + (let [[cox coy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])] + (-> command + (assoc-in [:params cox] (:x point)) + (assoc-in [:params coy] (:y point))))) + +(defn apply-content-modifiers + "Apply to content a map with point translations" + [content modifiers] (letfn [(apply-to-index [content [index params]] (if (contains? content index) (cond-> content (and (or (:c1x params) (:c1y params) (:c2x params) (:c2y params)) - (= :line-to (get-in content [index :params :command]))) + (= :line-to (get-in content [index :command]))) + (-> (assoc-in [index :command] :curve-to) - (assoc-in [index :params] :curve-to) (make-curve-params - (get-in content [index :params]) - (get-in content [(dec index) :params]))) + (assoc-in [index :params] + (make-curve-params + (get-in content [index :params]) + (get-in content [(dec index) :params])))) (:x params) (update-in [index :params :x] + (:x params)) (:y params) (update-in [index :params :y] + (:y params)) @@ -117,6 +138,7 @@ (mapv (fn [[index _]] index)))) (defn handler-indices + "Return an index where the key is the positions and the values the handlers" [content point] (->> (d/with-prev content) (d/enumerate) @@ -132,16 +154,24 @@ (defn opposite-index "Calculate sthe opposite index given a prefix and an index" [content index prefix] + (let [point (if (= prefix :c2) (command->point (nth content index)) (command->point (nth content (dec index)))) - handlers (-> (content->handlers content) - (get point)) + point->handlers (content->handlers content) - opposite-prefix (if (= prefix :c1) :c2 :c1)] - (when (<= (count handlers) 2) + handlers (->> point + (point->handlers ) + (filter (fn [[ci cp]] (and (not= index ci) (not= prefix cp)) )))] + + (when (= (count handlers) 1) (->> handlers - (d/seek (fn [[index prefix]] (= prefix opposite-prefix))) - (first))))) + first)))) + +(defn get-commands + "Returns the commands involving a point with its indices" + [content point] + (->> (d/enumerate content) + (filterv (fn [[idx cmd]] (= (command->point cmd) point))))) diff --git a/frontend/src/app/util/path/tools.cljs b/frontend/src/app/util/path/tools.cljs index 8224d4c9c..ff8196027 100644 --- a/frontend/src/app/util/path/tools.cljs +++ b/frontend/src/app/util/path/tools.cljs @@ -54,59 +54,113 @@ (reduce change-content $ handlers) (remove-line-curves $)))) +(defn line->curve + [from-p cmd] + + (let [to-p (upc/command->point cmd) + + v (gpt/to-vec from-p to-p) + d (gpt/distance from-p to-p) + + dv1 (-> (gpt/normal-left v) + (gpt/scale (/ d 3))) + + h1 (gpt/add from-p dv1) + + dv2 (-> (gpt/to-vec to-p h1) + (gpt/unit) + (gpt/scale (/ d 3))) + + h2 (gpt/add to-p dv2)] + (-> cmd + (assoc :command :curve-to) + (assoc-in [:params :c1x] (:x h1)) + (assoc-in [:params :c1y] (:y h1)) + (assoc-in [:params :c2x] (:x h2)) + (assoc-in [:params :c2y] (:y h2))))) + (defn make-curve-point "Changes the content to make the point a 'curve'. The handlers will be positioned in the same vector that results from te previous->next points but with fixed length." [content point] - (let [content-next (d/enumerate (d/with-prev-next content)) - make-curve - (fn [command previous] - (if (= :line-to (:command command)) - (let [cur-point (upc/command->point command) - pre-point (upc/command->point previous)] - (-> command - (assoc :command :curve-to) - (assoc :params (upc/make-curve-params cur-point pre-point)))) - command)) + (let [make-curve-cmd (fn [cmd h1 h2] + (-> cmd + (update :params assoc + :c1x (:x h1) :c1y (:y h1) + :c2x (:x h2) :c2y (:y h2)))) - update-handler - (fn [command prefix handler] - (if (= :curve-to (:command command)) - (let [cx (d/prefix-keyword prefix :x) - cy (d/prefix-keyword prefix :y)] - (-> command - (assoc-in [:params cx] (:x handler)) - (assoc-in [:params cy] (:y handler)))) - command)) + indices (upc/point-indices content point) + vectors (->> indices (mapv (fn [index] + (let [cmd (nth content index) + prev-i (dec index) + prev (when (not (= :move-to (:command cmd))) + (get content prev-i)) + next-i (inc index) + next (get content next-i) - calculate-vector - (fn [point next prev] - (let [base-vector (if (or (nil? next) (nil? prev) (= next prev)) - (-> (gpt/to-vec point (or next prev)) - (gpt/normal-left)) - (gpt/to-vec next prev))] - (-> base-vector - (gpt/unit) - (gpt/multiply (gpt/point 100))))) + next (when (not (= :move-to (:command next))) + next)] + (hash-map :index index + :prev-i (when (some? prev) prev-i) + :prev-c prev + :prev-p (upc/command->point prev) + :next-i (when (some? next) next-i) + :next-c next + :next-p (upc/command->point next) + :command cmd))))) - redfn (fn [content [index [command prev next]]] - (if (= point (upc/command->point command)) - (let [prev-point (if (= :move-to (:command command)) nil (upc/command->point prev)) - next-point (if (= :move-to (:command next)) nil (upc/command->point next)) - handler-vector (calculate-vector point next-point prev-point) - handler (gpt/add point handler-vector) - handler-opposite (gpt/add point (gpt/negate handler-vector))] - (-> content - (d/update-when index make-curve prev) - (d/update-when index update-handler :c2 handler) - (d/update-when (inc index) make-curve command) - (d/update-when (inc index) update-handler :c1 handler-opposite))) - content))] - (as-> content $ - (reduce redfn $ content-next) - (remove-line-curves $)))) + points (->> vectors (mapcat #(vector (:next-p %) (:prev-p %))) (remove nil?) (into #{}))] + + (cond + (= (count points) 2) + ;; + (let [v1 (gpt/to-vec (first points) point) + v2 (gpt/to-vec (first points) (second points)) + vp (gpt/project v1 v2) + vh (gpt/subtract v1 vp) + + add-curve + (fn [content {:keys [index prev-p next-p next-i]}] + (let [cur-cmd (get content index) + next-cmd (get content next-i) + + ;; New handlers for prev-point and next-point + prev-h (when (some? prev-p) (gpt/add prev-p vh)) + next-h (when (some? next-p) (gpt/add next-p vh)) + + ;; Correct 1/3 to the point improves the curve + prev-correction (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3))) + next-correction (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3))) + + prev-h (when (some? prev-h) (gpt/add prev-h prev-correction)) + next-h (when (some? next-h) (gpt/add next-h next-correction)) + ] + (cond-> content + (and (= :line-to (:command cur-cmd)) (some? prev-p)) + (update index upc/update-curve-to prev-p prev-h) + + (and (= :line-to (:command next-cmd)) (some? next-p)) + (update next-i upc/update-curve-to next-h next-p) + + (and (= :curve-to (:command cur-cmd)) (some? prev-p)) + (update index upc/update-handler :c2 prev-h) + + (and (= :curve-to (:command next-cmd)) (some? next-p)) + (update next-i upc/update-handler :c1 next-h))))] + (->> vectors (reduce add-curve content))) + + :else + (let [add-curve + (fn [content {:keys [index command prev-p next-c next-i]}] + (cond-> content + (and (= :line-to (:command command))) + (update index #(line->curve prev-p %)) + + (and (= :line-to (:command next-c))) + (update next-i #(line->curve point %))))] + (->> vectors (reduce add-curve content)))))) (defn get-segments "Given a content and a set of points return all the segments in the path