Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-13 16:21:57 -05:00
Code Issues Activity

Merge pull request #851 from penpot/advanced-path-options

Browse source 
Advanced path options
This commit is contained in:
Andrés Moya 2021-04-22 16:02:09 +02:00 • committed by GitHub
commit 43f7750658
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
41 changed files with 2023 additions and 1238 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

60
common/app/common/data/undo_stack.cljc Normal file
View file

@ -0,0 +1,60 @@
;; 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.common.data.undo-stack
(:refer-clojure :exclude [peek])
(:require
#?(:cljs [cljs.core :as core]
:clj [clojure.core :as core])))
(defonce MAX-UNDO-SIZE 100)
(defn make-stack
[]
{:index -1
:items []})
(defn peek
[{index :index items :items :as stack}]
(when (and (>= index 0) (< index (count items)))
(nth items index)))
(defn append
[{index :index items :items :as stack} value]
(if (and (some? stack) (not= value (peek stack)))
(let [items (cond-> items
(> index 0)
(subvec 0 (inc index))
(> (+ index 2) MAX-UNDO-SIZE)
(subvec 1 (inc index))
:always
(conj value))
index (min (dec MAX-UNDO-SIZE) (inc index))]
{:index index
:items items})
stack))
(defn fixup
[{index :index :as stack} value]
(assoc-in stack [:items index] value))
(defn undo
[{index :index items :items :as stack}]
(update stack :index dec))
(defn redo
[{index :index items :items :as stack}]
(cond-> stack
(< index (dec (count items)))
(update :index inc)))
(defn size
[{index :index items :items :as stack}]
(inc index))

41
common/app/common/geom/point.cljc
View file

@ -38,7 +38,7 @@
([v]
(cond
(point? v)
v
(Point. (:x v) (:y v))
(number? v)
(point v v)
@ -162,6 +162,8 @@
(mth/precision 6))]
(if (mth/nan? d) 0 d)))))
(defn angle-sign [v1 v2]
(if (> (* (:y v1) (:x v2)) (* (:x v1) (:y v2))) -1 1))
(defn update-angle
"Update the angle of the point."
@ -213,12 +215,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 +266,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))

51
common/app/common/geom/shapes/path.cljc
View file

@ -233,7 +233,9 @@
(loop [t1 0
t2 1]
(if (<= (mth/abs (- t1 t2)) path-closest-point-accuracy)
(curve-values start end h1 h2 t1)
(-> (curve-values start end h1 h2 t1)
;; store the segment info
(with-meta {:t t1 :from-p start :to-p end}))
(let [ht (+ t1 (/ (- t2 t1) 2))
ht1 (+ t1 (/ (- t2 t1) 4))
@ -260,21 +262,18 @@
"Point on line"
[position from-p to-p]
(let [{v1x :x v1y :y} from-p
{v2x :x v2y :y} to-p
{px :x py :y} position
e1 (gpt/point (- v2x v1x) (- v2y v1y))
e2 (gpt/point (- px v1x) (- py v1y))
(let [e1 (gpt/to-vec from-p to-p )
e2 (gpt/to-vec from-p position)
len2 (+ (mth/sq (:x e1)) (mth/sq (:y e1)))
val-dp (/ (gpt/dot e1 e2) len2)]
t (/ (gpt/dot e1 e2) len2)]
(if (and (>= t 0) (<= t 1) (not (mth/almost-zero? len2)))
(-> (gpt/add from-p (gpt/scale e1 t))
(with-meta {:t t
:from-p from-p
:to-p to-p}))
(if (and (>= val-dp 0)
(<= val-dp 1)
(not (mth/almost-zero? len2)))
(gpt/point (+ v1x (* val-dp (:x e1)))
(+ v1y (* val-dp (:y e1))))
;; There is no perpendicular projection in the line so the closest
;; point will be one of the extremes
(if (<= (gpt/distance position from-p) (gpt/distance position to-p))
@ -286,20 +285,20 @@
[shape position]
(let [point+distance (fn [[cur-cmd prev-cmd]]
(let [point
(let [from-p (command->point prev-cmd)
to-p (command->point cur-cmd)
h1 (gpt/point (get-in cur-cmd [:params :c1x])
(get-in cur-cmd [:params :c1y]))
h2 (gpt/point (get-in cur-cmd [:params :c2x])
(get-in cur-cmd [:params :c2y]))
point
(case (:command cur-cmd)
:line-to (line-closest-point
position
(command->point prev-cmd)
(command->point cur-cmd))
:curve-to (curve-closest-point
position
(command->point prev-cmd)
(command->point cur-cmd)
(gpt/point (get-in cur-cmd [:params :c1x])
(get-in cur-cmd [:params :c1y]))
(gpt/point (get-in cur-cmd [:params :c2x])
(get-in cur-cmd [:params :c2y])))
:line-to
(line-closest-point position from-p to-p)
:curve-to
(curve-closest-point position from-p to-p h1 h2)
nil)]
(when point
[point (gpt/distance point position)])))

2
common/app/common/geom/shapes/transforms.cljc
View file

@ -161,7 +161,7 @@
v2 (gpt/to-vec center p2)
rot-angle (gpt/angle-with-other v1 v2)
rot-sign (if (> (* (:y v1) (:x v2)) (* (:x v1) (:y v2))) -1 1)]
rot-sign (gpt/angle-sign v1 v2)]
(* rot-sign rot-angle)))
(defn- calculate-dimensions

7
frontend/resources/styles/main/partials/workspace.scss
View file

@ -305,10 +305,9 @@
}
&.is-disabled {
opacity: 0.3;
&:hover svg {
fill: initial;
cursor: initial;
svg {
fill: $color-gray-20;
}
}

57
frontend/src/app/main/data/shortcuts.cljs
View file

@ -6,15 +6,13 @@
(ns app.main.data.shortcuts
(:require
[app.main.data.workspace.colors :as mdc]
[app.main.data.workspace.transforms :as dwt]
[app.main.store :as st]
[app.util.dom :as dom]
[potok.core :as ptk]
[beicon.core :as rx]
[app.config :as cfg])
["mousetrap" :as mousetrap]
[app.config :as cfg]
[app.util.logging :as log])
(:refer-clojure :exclude [meta]))
(log/set-level! :warn)
(def mac-command "\u2318")
(def mac-option "\u2325")
(def mac-delete "\u232B")
@ -46,20 +44,41 @@
[shortcut]
(c-mod (a-mod shortcut)))
(defn bind-shortcuts [shortcuts bind-fn cb-fn]
(doseq [[key {:keys [command disabled fn type]}] shortcuts]
(when-not disabled
(if (vector? command)
(doseq [cmd (seq command)]
(bind-fn cmd (cb-fn key fn) type))
(bind-fn command (cb-fn key fn) type)))))
(defn bind-shortcuts
([shortcuts-config]
(bind-shortcuts
shortcuts-config
mousetrap/bind
(fn [key cb]
(fn [event]
(log/debug :msg (str "Shortcut" key))
(.preventDefault event)
(cb event)))))
([shortcuts-config bind-fn cb-fn]
(doseq [[key {:keys [command disabled fn type]}] shortcuts-config]
(when-not disabled
(if (vector? command)
(doseq [cmd (seq command)]
(bind-fn cmd (cb-fn key fn) type))
(bind-fn command (cb-fn key fn) type))))))
(defn remove-shortcuts
[]
(mousetrap/reset))
(defn meta [key]
(str
(if (cfg/check-platform? :macos)
mac-command
"Ctrl+")
key))
;; If the key is "+" we need to surround with quotes
;; otherwise will not be very readable
(let [key (if (and (not (cfg/check-platform? :macos))
(= key "+"))
"\"+\""
key)]
(str
(if (cfg/check-platform? :macos)
mac-command
"Ctrl+")
key)))
(defn shift [key]
(str

12
frontend/src/app/main/data/workspace/common.cljs
View file

@ -356,13 +356,15 @@
(>= index 0) (accumulate-undo-entry (get-in state [:workspace-undo :items index]))
(>= index 0) (update-in [:workspace-undo :index] dec))))))
;; If these functions change modules review /src/app/main/data/workspace/path/undo.cljs
(def undo
(ptk/reify ::undo
ptk/WatchEvent
(watch [_ state stream]
(let [edition (get-in state [:workspace-local :edition])]
(let [edition (get-in state [:workspace-local :edition])
drawing (get state :workspace-drawing)]
;; Editors handle their own undo's
(when-not (some? edition)
(when-not (or (some? edition) (not-empty drawing))
(let [undo (:workspace-undo state)
items (:items undo)
index (or (:index undo) (dec (count items)))]
@ -375,8 +377,9 @@
(ptk/reify ::redo
ptk/WatchEvent
(watch [_ state stream]
(let [edition (get-in state [:workspace-local :edition])]
(when-not (some? edition)
(let [edition (get-in state [:workspace-local :edition])
drawing (get state :workspace-drawing)]
(when-not (or (some? edition) (not-empty drawing))
(let [undo (:workspace-undo state)
items (:items undo)
index (or (:index undo) (dec (count items)))]
@ -543,6 +546,7 @@
(rx/take 1)
(rx/map (constantly clear-edition-mode)))))))
;; If these event change modules review /src/app/main/data/workspace/path/undo.cljs
(def clear-edition-mode
(ptk/reify ::clear-edition-mode
ptk/UpdateEvent

5
frontend/src/app/main/data/workspace/drawing/curve.cljs
View file

@ -12,7 +12,7 @@
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.path :as gsp]
[app.main.streams :as ms]
[app.util.geom.path :as path]
[app.util.path.simplify-curve :as ups]
[app.main.data.workspace.drawing.common :as common]
[app.main.data.workspace.common :as dwc]
[app.common.pages :as cp]))
@ -67,7 +67,7 @@
state [:workspace-drawing :object]
(fn [shape]
(-> shape
(update :segments #(path/simplify % simplify-tolerance))
(update :segments #(ups/simplify % simplify-tolerance))
(curve-to-path)))))
(defn handle-drawing-curve []
@ -85,3 +85,4 @@
(rx/of (setup-frame-curve)
finish-drawing-curve
common/handle-finish-drawing))))))

8
frontend/src/app/main/data/workspace/path.cljs
View file

@ -10,7 +10,8 @@
[app.main.data.workspace.path.drawing :as drawing]
[app.main.data.workspace.path.edition :as edition]
[app.main.data.workspace.path.selection :as selection]
[app.main.data.workspace.path.tools :as tools]))
[app.main.data.workspace.path.tools :as tools]
[app.main.data.workspace.path.undo :as undo]))
;; Drawing
(d/export drawing/handle-new-shape)
@ -22,6 +23,7 @@
(d/export edition/start-move-handler)
(d/export edition/start-move-path-point)
(d/export edition/start-path-edit)
(d/export edition/create-node-at-position)
;; Selection
(d/export selection/handle-selection)
@ -41,3 +43,7 @@
(d/export tools/separate-nodes)
(d/export tools/toggle-snap)
;; Undo/redo
(d/export undo/undo-path)
(d/export undo/redo-path)
(d/export undo/merge-head)

43
frontend/src/app/main/data/workspace/path/changes.cljs
View file

@ -44,25 +44,30 @@
:shapes [shape-id]}]]
[rch uch]))
(defn save-path-content []
(ptk/reify ::save-path-content
ptk/UpdateEvent
(update [_ state]
(let [content (get-in state (st/get-path state :content))
content (if (= (-> content last :command) :move-to)
(into [] (take (dec (count content)) content))
content)]
(assoc-in state (st/get-path state :content) content)))
(defn save-path-content
([]
(save-path-content {}))
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-in state [:workspace-local :edition])
old-content (get-in state [:workspace-local :edit-path id :old-content])]
(if (some? old-content)
(let [shape (get-in state (st/get-path state))
page-id (:current-page-id state)
[rch uch] (generate-path-changes page-id shape old-content (:content shape))]
(rx/of (dwc/commit-changes rch uch {:commit-local? true})))
(rx/empty))))))
([{:keys [preserve-move-to] :or {preserve-move-to false}}]
(ptk/reify ::save-path-content
ptk/UpdateEvent
(update [_ state]
(let [content (get-in state (st/get-path state :content))
content (if (and (not preserve-move-to)
(= (-> content last :command) :move-to))
(into [] (take (dec (count content)) content))
content)]
(assoc-in state (st/get-path state :content) content)))
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-in state [:workspace-local :edition])
old-content (get-in state [:workspace-local :edit-path id :old-content])]
(if (some? old-content)
(let [shape (get-in state (st/get-path state))
page-id (:current-page-id state)
[rch uch] (generate-path-changes page-id shape old-content (:content shape))]
(rx/of (dwc/commit-changes rch uch {:commit-local? true})))
(rx/empty)))))))

96
frontend/src/app/main/data/workspace/path/drawing.cljs
View file

@ -18,8 +18,10 @@
[app.main.data.workspace.path.state :as st]
[app.main.data.workspace.path.streams :as streams]
[app.main.data.workspace.path.tools :as tools]
[app.main.data.workspace.path.undo :as undo]
[app.main.streams :as ms]
[app.util.geom.path :as ugp]
[app.util.path.commands :as upc]
[app.util.path.geom :as upg]
[beicon.core :as rx]
[potok.core :as ptk]))
@ -56,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 (ugp/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 (ugp/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 (upc/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) ugp/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)
@ -114,7 +113,8 @@
(let [id (st/get-path-id state)
handler (get-in state [:workspace-local :edit-path id :prev-handler])]
;; Update the preview because can be outdated after the dragging
(rx/of (preview-next-point handler))))))
(rx/of (preview-next-point handler)
(undo/merge-head))))))
(declare close-path-drag-end)
@ -132,18 +132,23 @@
content (get-in state (st/get-path state :content))
snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled])
points (ugp/content->points content)
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))))
@ -165,7 +170,7 @@
mouse-up (->> stream (rx/filter #(or (helpers/end-path-event? %)
(ms/mouse-up? %))))
content (get-in state (st/get-path state :content))
points (ugp/content->points content)
points (upg/content->points content)
id (st/get-path-id state)
snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled])
@ -178,7 +183,6 @@
(rx/of (add-node position))
(streams/drag-stream
(rx/concat
(rx/of (start-drag-handler))
drag-events
(rx/of (finish-drag)))))))))
@ -202,7 +206,6 @@
(rx/of (add-node down-event))
(streams/drag-stream
(rx/concat
(rx/of (start-drag-handler))
drag-events
(rx/of (finish-drag)))))))
@ -222,7 +225,7 @@
end-path-events (->> stream (rx/filter helpers/end-path-event?))
content (get-in state (st/get-path state :content))
points (ugp/content->points content)
points (upg/content->points content)
id (st/get-path-id state)
snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled])
@ -245,6 +248,7 @@
(make-drag-stream stream snap-toggled zoom points %))))]
(rx/concat
(rx/of (undo/start-path-undo))
(rx/of (common/init-path))
(rx/merge mousemove-events
mousedown-events)

80
frontend/src/app/main/data/workspace/path/edition.cljs
View file

@ -17,42 +17,31 @@
[app.main.data.workspace.path.state :as st]
[app.main.data.workspace.path.streams :as streams]
[app.main.data.workspace.path.drawing :as drawing]
[app.main.data.workspace.path.undo :as undo]
[app.main.streams :as ms]
[app.util.geom.path :as ugp]
[app.util.path.commands :as upc]
[app.util.path.geom :as upg]
[app.util.path.tools :as upt]
[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 (ugp/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
@ -64,10 +53,10 @@
content-modifiers (get-in state [:workspace-local :edit-path id :content-modifiers])
content (:content shape)
new-content (ugp/apply-content-modifiers content content-modifiers)
new-content (upc/apply-content-modifiers content content-modifiers)
old-points (->> content ugp/content->points)
new-points (->> new-content ugp/content->points)
old-points (->> content upg/content->points)
new-points (->> new-content upg/content->points)
point-change (->> (map hash-map old-points new-points) (reduce merge))
[rch uch] (changes/generate-path-changes page-id shape (:content shape) new-content)]
@ -78,8 +67,8 @@
(defn move-selected-path-point [from-point to-point]
(letfn [(modify-content-point [content {dx :x dy :y} modifiers point]
(let [point-indices (ugp/point-indices content point) ;; [indices]
handler-indices (ugp/handler-indices content point) ;; [[index prefix]]
(let [point-indices (upc/point-indices content point) ;; [indices]
handler-indices (upc/handler-indices content point) ;; [[index prefix]]
modify-point
(fn [modifiers index]
@ -145,7 +134,7 @@
selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
content (get-in state (st/get-path state :content))
points (ugp/content->points content)]
points (upg/content->points content)]
(rx/concat
;; This stream checks the consecutive mouse positions to do the draging
@ -169,22 +158,19 @@
start-delta-y (get-in modifiers [index cy] 0)
content (get-in state (st/get-path state :content))
points (ugp/content->points content)
points (upg/content->points content)
opposite-index (ugp/opposite-index content index prefix)
opposite-prefix (if (= prefix :c1) :c2 :c1)
opposite-handler (-> content (get opposite-index) (ugp/get-handler opposite-prefix))
point (-> content (get (if (= prefix :c1) (dec index) index)) (upc/command->point))
handler (-> content (get index) (upc/get-handler prefix))
point (-> content (get (if (= prefix :c1) (dec index) index)) (ugp/command->point))
handler (-> content (get index) (ugp/get-handler prefix))
[op-idx op-prefix] (upc/opposite-index content index prefix)
opposite (upc/handler->point content op-idx op-prefix)
current-distance (when opposite-handler (gpt/distance (ugp/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
(rx/concat
(->> (streams/move-handler-stream snap-toggled start-point handler points)
(->> (streams/move-handler-stream snap-toggled start-point point handler opposite points)
(rx/take-until (->> stream (rx/filter ms/mouse-up?)))
(rx/map
(fn [{:keys [x y alt? shift?]}]
@ -196,7 +182,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)
@ -221,6 +207,7 @@
(watch [_ state stream]
(let [mode (get-in state [:workspace-local :edit-path id :edit-mode])]
(rx/concat
(rx/of (undo/start-path-undo))
(rx/of (drawing/change-edit-mode mode))
(->> stream
(rx/take-until (->> stream (rx/filter (ptk/type? ::start-path-edit))))
@ -234,3 +221,18 @@
(update [_ state]
(let [id (get-in state [:workspace-local :edition])]
(update state :workspace-local dissoc :edit-path id)))))
(defn create-node-at-position
[{:keys [from-p to-p t]}]
(ptk/reify ::create-node-at-position
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)
old-content (get-in state (st/get-path state :content))]
(-> state
(assoc-in [:workspace-local :edit-path id :old-content] old-content)
(update-in (st/get-path state :content) upt/split-segments #{from-p to-p} t))))
ptk/WatchEvent
(watch [_ state stream]
(rx/of (changes/save-path-content {:preserve-move-to true})))))

75
frontend/src/app/main/data/workspace/path/helpers.cljs
View file

@ -14,7 +14,7 @@
[app.main.data.workspace.path.state :refer [get-path]]
[app.main.data.workspace.path.common :as common]
[app.main.streams :as ms]
[app.util.geom.path :as ugp]
[app.util.path.commands :as upc]
[potok.core :as ptk]))
;; CONSTANTS
@ -87,14 +87,15 @@
(defn next-node
"Calculates the next-node to be inserted."
[shape position prev-point prev-handler]
(let [last-command (-> shape :content last :command)
(let [position (select-keys position [:x :y])
last-command (-> shape :content last :command)
add-line? (and prev-point (not prev-handler) (not= last-command :close-path))
add-curve? (and prev-point prev-handler (not= last-command :close-path))]
(cond
add-line? {:command :line-to
:params position}
add-curve? {:command :curve-to
:params (ugp/make-curve-params position prev-handler)}
:params (upc/make-curve-params position prev-handler)}
:else {:command :move-to
:params position})))
@ -106,15 +107,65 @@
(update :content (fnil conj []) command)
(update-selrect))))
(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 (gpt/angle-sign v1 v2)
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 (ugp/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] (upc/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 (upc/handler->node content index prefix)
handler (upc/handler->point content index prefix)
opposite (upc/handler->point content op-idx op-prefix)
[ocx ocy] (upc/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)))))))

1
frontend/src/app/main/data/workspace/path/selection.cljs
View file

@ -50,7 +50,6 @@
id (get-in state [:workspace-local :edition])
content (get-in state (st/get-path state :content))
selected-point? #(gsh/has-point-rect? selrect %)
selected-points (get-in state [:workspace-local :edit-path id :selected-points])
positions (into (if shift? selected-points #{})

94
frontend/src/app/main/data/workspace/path/shortcuts.cljs Normal file
View file

@ -0,0 +1,94 @@
;; 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.main.data.workspace.path.shortcuts
(:require
[app.main.data.shortcuts :as ds]
[app.main.data.workspace :as dw]
[app.main.data.workspace.path :as drp]
[app.main.store :as st]
[beicon.core :as rx]
[potok.core :as ptk]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Shortcuts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Shortcuts format https://github.com/ccampbell/mousetrap
(defn esc-pressed []
(ptk/reify :esc-pressed
ptk/WatchEvent
(watch [_ state stream]
;; Not interrupt when we're editing a path
(let [edition-id (or (get-in state [:workspace-drawing :object :id])
(get-in state [:workspace-local :edition]))
path-edit-mode (get-in state [:workspace-local :edit-path edition-id :edit-mode])]
(if-not (= :draw path-edit-mode)
(rx/of :interrupt (dw/deselect-all true))
(rx/empty))))))
(def shortcuts
{:move-nodes {:tooltip "V"
:command "v"
:fn #(st/emit! (drp/change-edit-mode :move))}
:draw-nodes {:tooltip "P"
:command "p"
:fn #(st/emit! (drp/change-edit-mode :draw))}
:add-node {:tooltip (ds/meta "+")
:command (ds/c-mod "+")
:fn #(st/emit! (drp/add-node))}
:delete-node {:tooltip (ds/supr)
:command ["del" "backspace"]
:fn #(st/emit! (drp/remove-node))}
:merge-nodes {:tooltip (ds/meta "J")
:command (ds/c-mod "j")
:fn #(st/emit! (drp/merge-nodes))}
:join-nodes {:tooltip (ds/meta-shift "J")
:command (ds/c-mod "shift+j")
:fn #(st/emit! (drp/join-nodes))}
:separate-nodes {:tooltip (ds/meta "K")
:command (ds/c-mod "k")
:fn #(st/emit! (drp/separate-nodes))}
:make-corner {:tooltip (ds/meta "B")
:command (ds/c-mod "b")
:fn #(st/emit! (drp/make-corner))}
:make-curve {:tooltip (ds/meta-shift "B")
:command (ds/c-mod "shift+b")
:fn #(st/emit! (drp/make-curve))}
:snap-nodes {:tooltip (ds/meta "'")
:command (ds/c-mod "'")
:fn #(st/emit! (drp/toggle-snap))}
:escape {:tooltip (ds/esc)
:command "escape"
:fn #(st/emit! (esc-pressed))}
:start-editing {:tooltip (ds/enter)
:command "enter"
:fn #(st/emit! (dw/start-editing-selected))}
:undo {:tooltip (ds/meta "Z")
:command (ds/c-mod "z")
:fn #(st/emit! (drp/undo-path))}
:redo {:tooltip (ds/meta "Y")
:command [(ds/c-mod "shift+z") (ds/c-mod "y")]
:fn #(st/emit! (drp/redo-path))}
})
(defn get-tooltip [shortcut]
(assert (contains? shortcuts shortcut) (str shortcut))
(get-in shortcuts [shortcut :tooltip]))

40
frontend/src/app/main/data/workspace/path/streams.cljs
View file

@ -16,7 +16,7 @@
[app.common.math :as mth]
[app.main.snap :as snap]
[okulary.core :as l]
[app.util.geom.path :as ugp]))
[app.util.path.geom :as upg]))
(defonce drag-threshold 5)
@ -72,22 +72,49 @@
(->> ms/mouse-position
(rx/map check-path-snap))))
(defn get-angle [node handler opposite]
(when (and (some? node) (some? handler) (some? opposite))
(let [v1 (gpt/to-vec node opposite)
v2 (gpt/to-vec node handler)
rot-angle (gpt/angle-with-other v1 v2)
rot-sign (gpt/angle-sign v1 v2)]
[rot-angle rot-sign])))
(defn move-handler-stream
[snap-toggled start-point handler points]
[snap-toggled start-point node handler opposite points]
(let [zoom (get-in @st/state [:workspace-local :zoom] 1)
ranges (snap/create-ranges points)
d-pos (/ snap/snap-path-accuracy zoom)
[initial-angle] (get-angle node handler opposite)
check-path-snap
(fn [position]
(if snap-toggled
(let [delta (gpt/subtract position start-point)
handler-position (gpt/add handler delta)
snap (snap/get-snap-delta [handler-position] ranges d-pos)]
(gpt/add position snap))
handler (gpt/add handler delta)
[rot-angle rot-sign] (get-angle node handler opposite)
snap-opposite-angle?
(and (some? rot-angle)
(or (:alt? position) (> (- 180 initial-angle) 0.1))
(<= (- 180 rot-angle) 5))]
(cond
snap-opposite-angle?
(let [rot-handler (gpt/rotate handler node (- 180 (* rot-sign rot-angle)))
snap (gpt/to-vec handler rot-handler)]
(merge position (gpt/add position snap)))
:else
(let [snap (snap/get-snap-delta [handler] ranges d-pos)]
(merge position (gpt/add position snap)))))
position))]
(->> ms/mouse-position
(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? %))))
(rx/map check-path-snap))))
(defn position-stream
@ -103,7 +130,7 @@
ranges-stream
(->> content-stream
(rx/map ugp/content->points)
(rx/map upg/content->points)
(rx/map snap/create-ranges))]
(->> ms/mouse-position
@ -113,6 +140,5 @@
(let [snap (snap/get-snap-delta [position] ranges d-pos)]
(gpt/add position snap))
position)))
(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? %)))))))

16
frontend/src/app/main/data/workspace/path/tools.cljs
View file

@ -10,7 +10,7 @@
[app.main.data.workspace.path.changes :as changes]
[app.main.data.workspace.path.common :as common]
[app.main.data.workspace.path.state :as st]
[app.util.geom.path :as ugp]
[app.util.path.tools :as upt]
[app.common.geom.point :as gpt]
[beicon.core :as rx]
[potok.core :as ptk]))
@ -32,27 +32,27 @@
(defn make-corner []
(process-path-tool
(fn [content points]
(reduce ugp/make-corner-point content points))))
(reduce upt/make-corner-point content points))))
(defn make-curve []
(process-path-tool
(fn [content points]
(reduce ugp/make-curve-point content points))))
(reduce upt/make-curve-point content points))))
(defn add-node []
(process-path-tool (fn [content points] (ugp/split-segments content points 0.5))))
(process-path-tool (fn [content points] (upt/split-segments content points 0.5))))
(defn remove-node []
(process-path-tool ugp/remove-nodes))
(process-path-tool upt/remove-nodes))
(defn merge-nodes []
(process-path-tool ugp/merge-nodes))
(process-path-tool upt/merge-nodes))
(defn join-nodes []
(process-path-tool ugp/join-nodes))
(process-path-tool upt/join-nodes))
(defn separate-nodes []
(process-path-tool ugp/separate-nodes))
(process-path-tool upt/separate-nodes))
(defn toggle-snap []
(ptk/reify ::toggle-snap

162
frontend/src/app/main/data/workspace/path/undo.cljs Normal file
View file

@ -0,0 +1,162 @@
;; 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.main.data.workspace.path.undo
(:require
[app.common.data :as d]
[app.common.data.undo-stack :as u]
[app.common.uuid :as uuid]
[app.main.data.workspace.path.state :as st]
[app.main.data.workspace.path.changes :as changes]
[app.main.store :as store]
[beicon.core :as rx]
[okulary.core :as l]
[potok.core :as ptk]))
(defn undo-event?
[event]
(= :app.main.data.workspace.common/undo (ptk/type event)))
(defn redo-event?
[event]
(= :app.main.data.workspace.common/redo (ptk/type event)))
(defn- make-entry [state]
(let [id (st/get-path-id state)]
{:content (get-in state (st/get-path state :content))
:selrect (get-in state (st/get-path state :selrect))
:points (get-in state (st/get-path state :points))
:preview (get-in state [:workspace-local :edit-path id :preview])
:last-point (get-in state [:workspace-local :edit-path id :last-point])
:prev-handler (get-in state [:workspace-local :edit-path id :prev-handler])}))
(defn- load-entry [state {:keys [content selrect points preview last-point prev-handler]}]
(let [id (st/get-path-id state)
old-content (get-in state (st/get-path state :content))]
(-> state
(d/assoc-in-when (st/get-path state :content) content)
(d/assoc-in-when (st/get-path state :selrect) selrect)
(d/assoc-in-when (st/get-path state :points) points)
(d/update-in-when
[:workspace-local :edit-path id]
assoc
:preview preview
:last-point last-point
:prev-handler prev-handler
:old-content old-content))))
(defn undo-path []
(ptk/reify ::undo-path
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)
undo-stack (-> (get-in state [:workspace-local :edit-path id :undo-stack])
(u/undo))
entry (u/peek undo-stack)]
(cond-> state
(some? entry)
(-> (load-entry entry)
(d/assoc-in-when
[:workspace-local :edit-path id :undo-stack]
undo-stack)))))
ptk/WatchEvent
(watch [_ state stream]
(rx/of (changes/save-path-content {:preserve-move-to true})))))
(defn redo-path []
(ptk/reify ::redo-path
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)
undo-stack (-> (get-in state [:workspace-local :edit-path id :undo-stack])
(u/redo))
entry (u/peek undo-stack)]
(-> state
(load-entry entry)
(d/assoc-in-when
[:workspace-local :edit-path id :undo-stack]
undo-stack))))
ptk/WatchEvent
(watch [_ state stream]
(rx/of (changes/save-path-content)))))
(defn merge-head
"Joins the head with the previous undo in one. This is done so when the user changes a
node handlers after adding it the undo merges both in one operation only"
[]
(ptk/reify ::add-undo-entry
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)
entry (make-entry state)
stack (get-in state [:workspace-local :edit-path id :undo-stack])
head (u/peek stack)
stack (-> stack (u/undo) (u/fixup head))]
(-> state
(d/assoc-in-when
[:workspace-local :edit-path id :undo-stack]
stack))))))
(defn add-undo-entry []
(ptk/reify ::add-undo-entry
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)
entry (make-entry state)]
(-> state
(d/update-in-when
[:workspace-local :edit-path id :undo-stack]
u/append entry))))))
(defn end-path-undo
[]
(ptk/reify ::end-path-undo
ptk/UpdateEvent
(update [_ state]
(-> state
(d/update-in-when
[:workspace-local :edit-path (st/get-path-id state)]
dissoc :undo-lock :undo-stack)))))
(defn- stop-undo? [event]
(= :app.main.data.workspace.common/clear-edition-mode (ptk/type event)))
(def path-content-ref
(letfn [(selector [state]
(get-in state (st/get-path state :content)))]
(l/derived selector store/state)))
(defn start-path-undo
[]
(let [lock (uuid/next)]
(ptk/reify ::start-path-undo
ptk/UpdateEvent
(update [_ state]
(let [undo-lock (get-in state [:workspace-local :edit-path (st/get-path-id state) :undo-lock])]
(cond-> state
(not undo-lock)
(update-in [:workspace-local :edit-path (st/get-path-id state)]
assoc
:undo-lock lock
:undo-stack (u/make-stack)))))
ptk/WatchEvent
(watch [_ state stream]
(let [undo-lock (get-in state [:workspace-local :edit-path (st/get-path-id state) :undo-lock])]
(when (= undo-lock lock)
(let [stop-undo-stream (->> stream
(rx/filter stop-undo?)
(rx/take 1))]
(rx/concat
(->> (rx/from-atom path-content-ref {:emit-current-value? true})
(rx/take-until stop-undo-stream)
(rx/filter (comp not nil?))
(rx/map #(add-undo-entry)))
(rx/of (end-path-undo))))))))))

22
frontend/src/app/main/data/workspace/shortcuts.cljs
View file

@ -6,10 +6,9 @@
(ns app.main.data.workspace.shortcuts
(:require
[app.config :as cfg]
[app.main.data.workspace.colors :as mdc]
[app.main.data.shortcuts :as ds]
[app.main.data.workspace :as dw]
[app.main.data.workspace.colors :as mdc]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.drawing :as dwd]
[app.main.data.workspace.libraries :as dwl]
@ -17,28 +16,13 @@
[app.main.data.workspace.transforms :as dwt]
[app.main.store :as st]
[app.util.dom :as dom]
[beicon.core :as rx]
[potok.core :as ptk]))
;; \u2318P
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Shortcuts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Shortcuts impl https://github.com/ccampbell/mousetrap
(defn esc-pressed []
(ptk/reify :esc-pressed
ptk/WatchEvent
(watch [_ state stream]
;; Not interrupt when we're editing a path
(let [edition-id (or (get-in state [:workspace-drawing :object :id])
(get-in state [:workspace-local :edition]))
path-edit-mode (get-in state [:workspace-local :edit-path edition-id :edit-mode])]
(if-not (= :draw path-edit-mode)
(rx/of :interrupt (dw/deselect-all true))
(rx/empty))))))
;; Shortcuts format https://github.com/ccampbell/mousetrap
(def shortcuts
{:toggle-layers {:tooltip (ds/alt "L")
@ -252,7 +236,7 @@
:escape {:tooltip (ds/esc)
:command "escape"
:fn #(st/emit! (esc-pressed))}
:fn #(st/emit! :interrupt (dw/deselect-all true))}
:start-editing {:tooltip (ds/enter)
:command "enter"

4
frontend/src/app/main/data/workspace/svg_upload.cljs
View file

@ -16,7 +16,7 @@
[app.main.data.workspace.common :as dwc]
[app.main.repo :as rp]
[app.util.color :as uc]
[app.util.geom.path :as ugp]
[app.util.path.parser :as upp]
[app.util.object :as obj]
[app.util.svg :as usvg]
[app.util.uri :as uu]
@ -163,7 +163,7 @@
(defn create-path-shape [name frame-id svg-data {:keys [attrs] :as data}]
(when (and (contains? attrs :d) (not (empty? (:d attrs)) ))
(let [svg-transform (usvg/parse-transform (:transform attrs))
path-content (ugp/path->content (:d attrs))
path-content (upp/parse-path (:d attrs))
content (cond-> path-content
svg-transform
(gsh/transform-content svg-transform))

15
frontend/src/app/main/ui/hooks.cljs
View file

@ -7,9 +7,8 @@
(ns app.main.ui.hooks
"A collection of general purpose react hooks."
(:require
["mousetrap" :as mousetrap]
[app.common.spec :as us]
[app.main.data.shortcuts :refer [bind-shortcuts]]
[app.main.data.shortcuts :as dsc]
[app.util.dom :as dom]
[app.util.object :as obj]
[app.util.dom.dnd :as dnd]
@ -39,16 +38,8 @@
[shortcuts]
(mf/use-effect
(fn []
(bind-shortcuts
shortcuts
mousetrap/bind
(fn [key cb]
(fn [event]
(log/debug :msg (str "Shortcut" key))
(.preventDefault event)
(cb event))))
(fn [] (mousetrap/reset))))
nil)
(dsc/bind-shortcuts shortcuts)
(fn [] (dsc/remove-shortcuts)))))
(defn invisible-image
[]

4
frontend/src/app/main/ui/shapes/path.cljs
View file

@ -11,7 +11,7 @@
[app.main.ui.shapes.attrs :as attrs]
[app.main.ui.shapes.custom-stroke :refer [shape-custom-stroke]]
[app.util.object :as obj]
[app.util.geom.path :as ugp]))
[app.util.path.format :as upf]))
;; --- Path Shape
@ -22,7 +22,7 @@
background? (unchecked-get props "background?")
{:keys [id x y width height]} (:selrect shape)
content (:content shape)
pdata (mf/use-memo (mf/deps content) #(ugp/content->path content))
pdata (mf/use-memo (mf/deps content) #(upf/format-path content))
props (-> (attrs/extract-style-attrs shape)
(obj/merge!
#js {:d pdata}))]

38
frontend/src/app/main/ui/workspace.cljs
View file

@ -11,7 +11,6 @@
[app.main.data.history :as udh]
[app.main.data.messages :as dm]
[app.main.data.workspace :as dw]
[app.main.data.workspace.shortcuts :as sc]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.streams :as ms]
@ -21,13 +20,13 @@
[app.main.ui.workspace.colorpalette :refer [colorpalette]]
[app.main.ui.workspace.colorpicker]
[app.main.ui.workspace.context-menu :refer [context-menu]]
[app.main.ui.workspace.coordinates :as coordinates]
[app.main.ui.workspace.header :refer [header]]
[app.main.ui.workspace.left-toolbar :refer [left-toolbar]]
[app.main.ui.workspace.libraries]
[app.main.ui.workspace.rules :refer [horizontal-rule vertical-rule]]
[app.main.ui.workspace.sidebar :refer [left-sidebar right-sidebar]]
[app.main.ui.workspace.viewport :refer [viewport]]
[app.main.ui.workspace.coordinates :as coordinates]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[app.util.keyboard :as kbd]
@ -114,30 +113,29 @@
(mf/defc workspace
{::mf/wrap [mf/memo]}
[{:keys [project-id file-id page-id layout-name] :as props}]
(mf/use-effect
(mf/deps layout-name)
#(st/emit! (dw/initialize-layout layout-name)))
(mf/use-effect
(mf/deps project-id file-id)
(fn []
(st/emit! (dw/initialize-file project-id file-id))
(st/emitf (dw/finalize-file project-id file-id))))
(mf/use-effect
(fn []
;; Close any non-modal dialog that may be still open
(st/emitf dm/hide)))
(hooks/use-shortcuts sc/shortcuts)
(let [file (mf/deref refs/workspace-file)
project (mf/deref refs/workspace-project)
layout (mf/deref refs/workspace-layout)]
(mf/use-effect
(mf/deps file)
#(dom/set-html-title (tr "title.workspace" (:name file))))
(mf/deps layout-name)
#(st/emit! (dw/initialize-layout layout-name)))
(mf/use-effect
(mf/deps project-id file-id)
(fn []
(st/emit! (dw/initialize-file project-id file-id))
(st/emitf (dw/finalize-file project-id file-id))))
(mf/use-effect
(fn []
;; Close any non-modal dialog that may be still open
(st/emitf dm/hide)))
(mf/use-effect
(mf/deps file)
#(dom/set-html-title (tr "title.workspace" (:name file))))
[:& (mf/provider ctx/current-file-id) {:value (:id file)}
[:& (mf/provider ctx/current-team-id) {:value (:team-id project)}

4
frontend/src/app/main/ui/workspace/shapes/path.cljs
View file

@ -13,7 +13,7 @@
[app.main.ui.shapes.shape :refer [shape-container]]
[app.main.ui.workspace.shapes.path.common :as pc]
[app.util.dom :as dom]
[app.util.geom.path :as ugp]
[app.util.path.commands :as upc]
[rumext.alpha :as mf]))
(mf/defc path-wrapper
@ -24,7 +24,7 @@
content-modifiers (mf/deref content-modifiers-ref)
editing-id (mf/deref refs/selected-edition)
editing? (= editing-id (:id shape))
shape (update shape :content ugp/apply-content-modifiers content-modifiers)]
shape (update shape :content upc/apply-content-modifiers content-modifiers)]
[:> shape-container {:shape shape
:pointer-events (when editing? "none")}

110
frontend/src/app/main/ui/workspace/shapes/path/editor.cljs
View file

@ -17,14 +17,16 @@
[app.main.ui.hooks :as hooks]
[app.main.ui.workspace.shapes.path.common :as pc]
[app.util.dom :as dom]
[app.util.geom.path :as ugp]
[app.util.path.geom :as upg]
[app.util.path.commands :as upc]
[app.util.path.format :as upf]
[app.util.keyboard :as kbd]
[clojure.set :refer [map-invert]]
[goog.events :as events]
[rumext.alpha :as mf])
(:import goog.events.EventType))
(mf/defc path-point [{:keys [position zoom edit-mode hover? selected? preview? start-path? last-p?]}]
(mf/defc path-point [{:keys [position zoom edit-mode hover? selected? preview? start-path? last-p? new-point?]}]
(let [{:keys [x y]} position
on-enter
@ -40,6 +42,9 @@
(dom/stop-propagation event)
(dom/prevent-default event)
(when (and new-point? (some? (meta position)))
(st/emit! (drp/create-node-at-position (meta position))))
(let [shift? (kbd/shift? event)]
(cond
(= edit-mode :move)
@ -75,7 +80,7 @@
(= edit-mode :move) cur/pointer-node)
:fill "transparent"}}]]))
(mf/defc path-handler [{:keys [index prefix point handler zoom selected? hover? edit-mode]}]
(mf/defc path-handler [{:keys [index prefix point handler zoom selected? hover? edit-mode snap-angle?]}]
(when (and point handler)
(let [{:keys [x y]} handler
on-enter
@ -103,6 +108,16 @@
:y2 y
:style {:stroke (if hover? pc/black-color pc/gray-color)
:stroke-width (/ 1 zoom)}}]
(when snap-angle?
[:line
{:x1 (:x point)
:y1 (:y point)
:x2 x
:y2 y
:style {:stroke pc/secondary-color
:stroke-width (/ 1 zoom)}}])
[:rect
{:x (- x (/ 3 zoom))
:y (- y (/ 3 zoom))
@ -130,10 +145,10 @@
:stroke pc/black-color
:stroke-width (/ 1 zoom)
:stroke-dasharray (/ 4 zoom)}
:d (ugp/content->path [{:command :move-to
:params {:x (:x from)
:y (:y from)}}
command])}])
:d (upf/format-path [{:command :move-to
:params {:x (:x from)
:y (:y from)}}
command])}])
[:& path-point {:position (:params command)
:preview? true
:zoom zoom}]])
@ -152,6 +167,18 @@
:style {:stroke pc/secondary-color
:stroke-width (/ 1 zoom)}}])]))
(defn matching-handler? [content node handlers]
(when (= 2 (count handlers))
(let [[[i1 p1] [i2 p2]] handlers
p1 (upc/handler->point content i1 p1)
p2 (upc/handler->point content i2 p2)
v1 (gpt/to-vec node p1)
v2 (gpt/to-vec node p2)
angle (gpt/angle-with-other v1 v2)]
(<= (- 180 angle) 0.1))))
(mf/defc path-editor
[{:keys [shape zoom]}]
@ -176,10 +203,10 @@
selected-points (or selected-points #{})
base-content (:content shape)
base-points (mf/use-memo (mf/deps base-content) #(->> base-content ugp/content->points))
base-points (mf/use-memo (mf/deps base-content) #(->> base-content upg/content->points))
content (ugp/apply-content-modifiers base-content content-modifiers)
content-points (mf/use-memo (mf/deps content) #(->> content ugp/content->points))
content (upc/apply-content-modifiers base-content content-modifiers)
content-points (mf/use-memo (mf/deps content) #(->> content upg/content->points))
point->base (->> (map hash-map content-points base-points) (reduce merge))
base->point (map-invert point->base)
@ -187,19 +214,25 @@
points (into #{} content-points)
last-command (last content)
last-p (->> content last ugp/command->point)
handlers (ugp/content->handlers content)
last-p (->> content last upc/command->point)
handlers (upc/content->handlers content)
start-p? (not (some? last-point))
[snap-selected snap-points]
(cond
(some? drag-handler) [#{drag-handler} points]
(some? preview) [#{(ugp/command->point preview)} points]
(some? preview) [#{(upc/command->point preview)} points]
(some? moving-handler) [#{moving-handler} points]
:else
[(->> selected-points (map base->point) (into #{}))
(->> points (remove selected-points) (into #{}))])
show-snap? (and snap-toggled (or (some? drag-handler) (some? preview) (some? moving-handler) moving-nodes))
show-snap? (and snap-toggled
(or (some? drag-handler)
(some? preview)
(some? moving-handler)
moving-nodes))
handle-double-click-outside
(fn [event]
@ -213,6 +246,13 @@
#(doseq [key keys]
(events/unlistenByKey key)))))
(hooks/use-stream
ms/mouse-position
(mf/deps shape zoom)
(fn [position]
(when-let [point (gshp/path-closest-point shape position)]
(reset! hover-point (when (< (gpt/distance position point) (/ 10 zoom)) point)))))
[:g.path-editor {:ref editor-ref}
(when (and preview (not drag-handler))
[:& path-preview {:command preview
@ -228,30 +268,36 @@
(when @hover-point
[:g.hover-point
[:& path-point {:position @hover-point
:edit-mode edit-mode
:new-point? true
:start-path? start-p?
:zoom zoom}]])
(for [position points]
(let [point-selected? (contains? selected-points (get point->base position))
point-hover? (contains? hover-points (get point->base position))
last-p? (= last-point (get point->base position))
start-p? (not (some? last-point))]
last-p? (= last-point (get point->base position))]
[:g.path-node
[:g.point-handlers {:pointer-events (when (= edit-mode :draw) "none")}
(for [[index prefix] (get handlers position)]
(let [command (get content index)
x (get-in command [:params (d/prefix-keyword prefix :x)])
y (get-in command [:params (d/prefix-keyword prefix :y)])
handler-position (gpt/point x y)
handler-hover? (contains? hover-handlers [index prefix])]
(when (not= position handler-position)
[:& path-handler {:point position
:handler handler-position
:index index
:prefix prefix
:zoom zoom
:hover? handler-hover?
:edit-mode edit-mode}])))]
(let [pos-handlers (get handlers position)]
(for [[index prefix] pos-handlers]
(let [command (get content index)
x (get-in command [:params (d/prefix-keyword prefix :x)])
y (get-in command [:params (d/prefix-keyword prefix :y)])
handler-position (gpt/point x y)
handler-hover? (contains? hover-handlers [index prefix])
moving-handler? (= handler-position moving-handler)
matching-handler? (matching-handler? content position pos-handlers)]
(when (not= position handler-position)
[:& path-handler {:point position
:handler handler-position
:index index
:prefix prefix
:zoom zoom
:hover? handler-hover?
:snap-angle? (and moving-handler? matching-handler?)
:edit-mode edit-mode}]))))]
[:& path-point {:position position
:zoom zoom
:edit-mode edit-mode
@ -269,6 +315,6 @@
(when show-snap?
[:g.path-snap {:pointer-events "none"}
[:& path-snap {:selected snap-selected
:points snap-points
:zoom zoom}]])]))
:points snap-points
:zoom zoom}]])]))

7
frontend/src/app/main/ui/workspace/viewport.cljs
View file

@ -98,6 +98,7 @@
drawing-path? (or (and edition (= :draw (get-in edit-path [edition :edit-mode])))
(and (some? drawing-obj) (= :path (:type drawing-obj))))
text-editing? (and edition (= :text (get-in objects [edition :type])))
path-editing? (and edition (= :path (get-in objects [edition :type])))
on-click (actions/on-click hover selected edition drawing-path? drawing-tool)
on-context-menu (actions/on-context-menu hover)
@ -132,15 +133,17 @@
show-snap-distance? (and (contains? layout :dynamic-alignment) (= transform :move) (not (empty? selected)))
show-snap-points? (and (contains? layout :dynamic-alignment) (or drawing-obj transform))
show-selrect? (and selrect (empty? drawing))
show-measures? (and (not transform) (not path-editing?) show-distances?)
]
(hooks/setup-dom-events viewport-ref zoom disable-paste in-viewport?)
(hooks/setup-viewport-size viewport-ref)
(hooks/setup-cursor cursor alt? panning drawing-tool drawing-path?)
(hooks/setup-cursor cursor alt? panning drawing-tool drawing-path? path-editing?)
(hooks/setup-resize layout viewport-ref)
(hooks/setup-keyboard alt? ctrl?)
(hooks/setup-hover-shapes page-id move-stream selected objects transform selected ctrl? hover hover-ids)
(hooks/setup-viewport-modifiers modifiers selected objects render-ref)
(hooks/setup-shortcuts path-editing? drawing-path?)
[:div.viewport
[:div.viewport-overlays
@ -224,7 +227,7 @@
:disable-handlers (or drawing-tool edition)
:on-move-selected on-move-selected}])
(when (and (not transform) show-distances?)
(when show-measures?
[:& msr/measurement
{:bounds vbox
:selected-shapes selected-shapes

39
frontend/src/app/main/ui/workspace/viewport/hooks.cljs
View file

@ -9,7 +9,10 @@
[app.common.data :as d]
[app.common.geom.shapes :as gsh]
[app.common.pages :as cp]
[app.main.data.shortcuts :as dsc]
[app.main.data.workspace :as dw]
[app.main.data.workspace.path.shortcuts :as psc]
[app.main.data.workspace.shortcuts :as wsc]
[app.main.store :as st]
[app.main.streams :as ms]
[app.main.ui.hooks :as hooks]
@ -58,23 +61,23 @@
;; We schedule the event so it fires after `initialize-page` event
(timers/schedule #(st/emit! (dw/initialize-viewport size)))))))
(defn setup-cursor [cursor alt? panning drawing-tool drawing-path?]
(defn setup-cursor [cursor alt? panning drawing-tool drawing-path? path-editing?]
(mf/use-effect
(mf/deps @cursor @alt? panning drawing-tool drawing-path?)
(mf/deps @cursor @alt? panning drawing-tool drawing-path? path-editing?)
(fn []
(let [new-cursor
(cond
panning (utils/get-cursor :hand)
(= drawing-tool :comments) (utils/get-cursor :comments)
(= drawing-tool :frame) (utils/get-cursor :create-artboard)
(= drawing-tool :rect) (utils/get-cursor :create-rectangle)
(= drawing-tool :circle) (utils/get-cursor :create-ellipse)
panning (utils/get-cursor :hand)
(= drawing-tool :comments) (utils/get-cursor :comments)
(= drawing-tool :frame) (utils/get-cursor :create-artboard)
(= drawing-tool :rect) (utils/get-cursor :create-rectangle)
(= drawing-tool :circle) (utils/get-cursor :create-ellipse)
(or (= drawing-tool :path)
drawing-path?) (utils/get-cursor :pen)
(= drawing-tool :curve) (utils/get-cursor :pencil)
drawing-tool (utils/get-cursor :create-shape)
@alt? (utils/get-cursor :duplicate)
:else (utils/get-cursor :pointer-inner))]
drawing-path?) (utils/get-cursor :pen)
(= drawing-tool :curve) (utils/get-cursor :pencil)
drawing-tool (utils/get-cursor :create-shape)
(and @alt? (not path-editing?)) (utils/get-cursor :duplicate)
:else (utils/get-cursor :pointer-inner))]
(when (not= @cursor new-cursor)
(reset! cursor new-cursor))))))
@ -148,3 +151,15 @@
(if modifiers
(utils/update-transform render-node roots modifiers)
(utils/remove-transform render-node roots))))))
(defn setup-shortcuts [path-editing? drawing-path?]
(mf/use-effect
(mf/deps path-editing? drawing-path?)
(fn []
(cond
(or drawing-path? path-editing?)
(dsc/bind-shortcuts psc/shortcuts)
:else
(dsc/bind-shortcuts wsc/shortcuts))
dsc/remove-shortcuts)))

4
frontend/src/app/main/ui/workspace/viewport/outline.cljs
View file

@ -9,7 +9,7 @@
[app.common.geom.shapes :as gsh]
[app.common.pages :as cp]
[app.main.refs :as refs]
[app.util.geom.path :as ugp]
[app.util.path.format :as upf]
[app.util.object :as obj]
[clojure.set :as set]
[rumext.alpha :as mf]
@ -27,7 +27,7 @@
path-data
(mf/use-memo
(mf/deps shape)
#(when path? (ugp/content->path (:content shape))))
#(when path? (upf/format-path (:content shape))))
{:keys [id x y width height]} shape

37
frontend/src/app/main/ui/workspace/viewport/path_actions.cljs
View file

@ -8,16 +8,17 @@
(:require
[app.main.data.workspace.path :as drp]
[app.main.data.workspace.path.helpers :as wph]
[app.main.data.workspace.path.shortcuts :as sc]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.icons :as i]
[app.main.ui.workspace.shapes.path.common :as pc]
[app.util.geom.path :as ugp]
[app.util.i18n :as i18n :refer [tr]]
[app.util.path.tools :as upt]
[rumext.alpha :as mf]))
(defn check-enabled [content selected-points]
(let [segments (ugp/get-segments content selected-points)
(let [segments (upt/get-segments content selected-points)
points-selected? (not (empty? selected-points))
segments-selected? (not (empty? segments))]
{:make-corner points-selected?
@ -107,65 +108,75 @@
[:div.viewport-actions-group
;; Draw Mode
[:div.viewport-actions-entry
[:div.viewport-actions-entry.tooltip.tooltip-bottom
{:class (when (= edit-mode :draw) "is-toggled")
:alt (tr "workspace.path.actions.move-nodes" (sc/get-tooltip :move-nodes))
:on-click on-select-draw-mode}
i/pen]
;; Edit mode
[:div.viewport-actions-entry
[:div.viewport-actions-entry.tooltip.tooltip-bottom
{:class (when (= edit-mode :move) "is-toggled")
:alt (tr "workspace.path.actions.draw-nodes" (sc/get-tooltip :draw-nodes))
:on-click on-select-edit-mode}
i/pointer-inner]]
[:div.viewport-actions-group
;; Add Node
[:div.viewport-actions-entry
[:div.viewport-actions-entry.tooltip.tooltip-bottom
{:class (when-not (:add-node enabled-buttons) "is-disabled")
:alt (tr "workspace.path.actions.add-node" (sc/get-tooltip :add-node))
:on-click on-add-node}
i/nodes-add]
;; Remove node
[:div.viewport-actions-entry
[:div.viewport-actions-entry.tooltip.tooltip-bottom
{:class (when-not (:remove-node enabled-buttons) "is-disabled")
:alt (tr "workspace.path.actions.delete-node" (sc/get-tooltip :delete-node))
:on-click on-remove-node}
i/nodes-remove]]
[:div.viewport-actions-group
;; Merge Nodes
[:div.viewport-actions-entry
[:div.viewport-actions-entry.tooltip.tooltip-bottom
{:class (when-not (:merge-nodes enabled-buttons) "is-disabled")
:alt (tr "workspace.path.actions.merge-nodes" (sc/get-tooltip :merge-nodes))
:on-click on-merge-nodes}
i/nodes-merge]
;; Join Nodes
[:div.viewport-actions-entry
[:div.viewport-actions-entry.tooltip.tooltip-bottom
{:class (when-not (:join-nodes enabled-buttons) "is-disabled")
:alt (tr "workspace.path.actions.join-nodes" (sc/get-tooltip :join-nodes))
:on-click on-join-nodes}
i/nodes-join]
;; Separate Nodes
[:div.viewport-actions-entry
[:div.viewport-actions-entry.tooltip.tooltip-bottom
{:class (when-not (:separate-nodes enabled-buttons) "is-disabled")
:alt (tr "workspace.path.actions.separate-nodes" (sc/get-tooltip :separate-nodes))
:on-click on-separate-nodes}
i/nodes-separate]]
;; Make Corner
[:div.viewport-actions-group
[:div.viewport-actions-entry
[:div.viewport-actions-entry.tooltip.tooltip-bottom
{:class (when-not (:make-corner enabled-buttons) "is-disabled")
:alt (tr "workspace.path.actions.make-corner" (sc/get-tooltip :make-corner))
:on-click on-make-corner}
i/nodes-corner]
;; Make Curve
[:div.viewport-actions-entry
[:div.viewport-actions-entry.tooltip.tooltip-bottom
{:class (when-not (:make-curve enabled-buttons) "is-disabled")
:alt (tr "workspace.path.actions.make-curve" (sc/get-tooltip :make-curve))
:on-click on-make-curve}
i/nodes-curve]]
;; Toggle snap
[:div.viewport-actions-group
[:div.viewport-actions-entry
[:div.viewport-actions-entry.tooltip.tooltip-bottom
{:class (when snap-toggled "is-toggled")
:alt (tr "workspace.path.actions.snap-nodes" (sc/get-tooltip :snap-nodes))
:on-click on-toggle-snap}
i/nodes-snap]]]))

2
frontend/src/app/util/debug.cljs
View file

@ -13,7 +13,7 @@
#{:app.main.data.workspace.notifications/handle-pointer-update
:app.main.data.workspace.selection/change-hover-state})
(defonce ^:dynamic *debug* (atom #{}))
(defonce ^:dynamic *debug* (atom #{#_:events}))
(defn debug-all! [] (reset! *debug* debug-options))
(defn debug-none! [] (reset! *debug* #{}))

917
frontend/src/app/util/geom/path.cljs
View file

@ -1,917 +0,0 @@
;; 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.geom.path
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as gshp]
[app.util.a2c :refer [a2c]]
[app.util.geom.path-impl-simplify :as impl-simplify]
[app.util.svg :as usvg]
[cuerdas.core :as str]
[clojure.set :as set]
[app.common.math :as mth]))
(defn calculate-opposite-handler
"Given a point and its handler, gives the symetric handler"
[point handler]
(let [handler-vector (gpt/to-vec point handler)]
(gpt/add point (gpt/negate handler-vector))))
(defn simplify
"Simplifies a drawing done with the pen tool"
([points]
(simplify points 0.1))
([points tolerance]
(let [points (into-array points)]
(into [] (impl-simplify/simplify points tolerance true)))))
;;
(def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*")
;; Matches numbers for path values allows values like... -.01, 10, +12.22
;; 0 and 1 are special because can refer to flags
(def num-regex #"[+-]?(\d+(\.\d+)?|\.\d+)(e[+-]?\d+)?")
(def flag-regex #"[01]")
(defn extract-params [cmd-str extract-commands]
(loop [result []
extract-idx 0
current {}
remain (-> cmd-str (subs 1) (str/trim))]
(let [[param type] (nth extract-commands extract-idx)
regex (case type
:flag flag-regex
#_:number num-regex)
match (re-find regex remain)]
(if match
(let [value (-> match first usvg/fix-dot-number d/read-string)
remain (str/replace-first remain regex "")
current (assoc current param value)
extract-idx (inc extract-idx)
[result current extract-idx]
(if (>= extract-idx (count extract-commands))
[(conj result current) {} 0]
[result current extract-idx])]
(recur result
extract-idx
current
remain))
(cond-> result
(not (empty? current)) (conj current))))))
(defn command->point [command]
(when-not (nil? command)
(let [{{:keys [x y]} :params} command]
(gpt/point x y))))
(defn command->param-list [command]
(let [params (:params command)]
(case (:command command)
(:move-to :line-to :smooth-quadratic-bezier-curve-to)
(str (:x params) ","
(:y params))
:close-path
""
(:line-to-horizontal :line-to-vertical)
(str (:value params))
:curve-to
(str (:c1x params) ","
(:c1y params) ","
(:c2x params) ","
(:c2y params) ","
(:x params) ","
(:y params))
(:smooth-curve-to :quadratic-bezier-curve-to)
(str (:cx params) ","
(:cy params) ","
(:x params) ","
(:y params))
:elliptical-arc
(str (:rx params) ","
(:ry params) ","
(:x-axis-rotation params) ","
(:large-arc-flag params) ","
(:sweep-flag params) ","
(:x params) ","
(:y params)))))
;; Path specification
;; https://www.w3.org/TR/SVG11/paths.html
(defmulti parse-command (comp str/upper first))
(defmethod parse-command "M" [cmd]
(let [relative (str/starts-with? cmd "m")
param-list (extract-params cmd [[:x :number]
[:y :number]])]
(d/concat [{:command :move-to
:relative relative
:params (first param-list)}]
(for [params (rest param-list)]
{:command :line-to
:relative relative
:params params}))))
(defmethod parse-command "Z" [cmd]
[{:command :close-path}])
(defmethod parse-command "L" [cmd]
(let [relative (str/starts-with? cmd "l")
param-list (extract-params cmd [[:x :number]
[:y :number]])]
(for [params param-list]
{:command :line-to
:relative relative
:params params})))
(defmethod parse-command "H" [cmd]
(let [relative (str/starts-with? cmd "h")
param-list (extract-params cmd [[:value :number]])]
(for [params param-list]
{:command :line-to-horizontal
:relative relative
:params params})))
(defmethod parse-command "V" [cmd]
(let [relative (str/starts-with? cmd "v")
param-list (extract-params cmd [[:value :number]])]
(for [params param-list]
{:command :line-to-vertical
:relative relative
:params params})))
(defmethod parse-command "C" [cmd]
(let [relative (str/starts-with? cmd "c")
param-list (extract-params cmd [[:c1x :number]
[:c1y :number]
[:c2x :number]
[:c2y :number]
[:x :number]
[:y :number]])
]
(for [params param-list]
{:command :curve-to
:relative relative
:params params})))
(defmethod parse-command "S" [cmd]
(let [relative (str/starts-with? cmd "s")
param-list (extract-params cmd [[:cx :number]
[:cy :number]
[:x :number]
[:y :number]])]
(for [params param-list]
{:command :smooth-curve-to
:relative relative
:params params})))
(defmethod parse-command "Q" [cmd]
(let [relative (str/starts-with? cmd "q")
param-list (extract-params cmd [[:cx :number]
[:cy :number]
[:x :number]
[:y :number]])]
(for [params param-list]
{:command :quadratic-bezier-curve-to
:relative relative
:params params})))
(defmethod parse-command "T" [cmd]
(let [relative (str/starts-with? cmd "t")
param-list (extract-params cmd [[:x :number]
[:y :number]])]
(for [params param-list]
{:command :smooth-quadratic-bezier-curve-to
:relative relative
:params params})))
(defmethod parse-command "A" [cmd]
(let [relative (str/starts-with? cmd "a")
param-list (extract-params cmd [[:rx :number]
[:ry :number]
[:x-axis-rotation :number]
[:large-arc-flag :flag]
[:sweep-flag :flag]
[:x :number]
[:y :number]])]
(for [params param-list]
{:command :elliptical-arc
:relative relative
:params params})))
(defn command->string [{:keys [command relative params] :as entry}]
(let [command-str (case command
:move-to "M"
:close-path "Z"
:line-to "L"
:line-to-horizontal "H"
:line-to-vertical "V"
:curve-to "C"
:smooth-curve-to "S"
:quadratic-bezier-curve-to "Q"
:smooth-quadratic-bezier-curve-to "T"
:elliptical-arc "A")
command-str (if relative (str/lower command-str) command-str)
param-list (command->param-list entry)]
(str command-str param-list)))
(defn cmd-pos [prev-pos {:keys [relative params]}]
(let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params]
(if relative
(-> prev-pos (update :x + x) (update :y + y))
(gpt/point x y))))
(defn arc->beziers [from-p command]
(let [to-command
(fn [[_ _ c1x c1y c2x c2y x y]]
{:command :curve-to
:relative (:relative command)
:params {:c1x c1x :c1y c1y
:c2x c2x :c2y c2y
:x x :y y}})
{from-x :x from-y :y} from-p
{:keys [rx ry x-axis-rotation large-arc-flag sweep-flag x y]} (:params command)
result (a2c from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation)]
(mapv to-command result)))
(defn smooth->curve
[{:keys [params]} pos handler]
(let [{c1x :x c1y :y} (calculate-opposite-handler pos handler)]
{:c1x c1x
:c1y c1y
:c2x (:cx params)
:c2y (:cy params)}))
(defn quadratic->curve
[sp ep cp]
(let [cp1 (-> (gpt/to-vec sp cp)
(gpt/scale (/ 2 3))
(gpt/add sp))
cp2 (-> (gpt/to-vec ep cp)
(gpt/scale (/ 2 3))
(gpt/add ep))]
{:c1x (:x cp1)
:c1y (:y cp1)
:c2x (:x cp2)
:c2y (:y cp2)}))
(defn simplify-commands
"Removes some commands and convert relative to absolute coordinates"
[commands]
(let [simplify-command
;; prev-pos : previous position for the current path. Necesary for relative commands
;; prev-start : previous move-to necesary for Z commands
;; prev-cc : previous command control point for cubic beziers
;; prev-qc : previous command control point for quadratic curves
(fn [[result prev-pos prev-start prev-cc prev-qc] [command prev]]
(let [command (assoc command :prev-pos prev-pos)
command
(cond-> command
(:relative command)
(-> (assoc :relative false)
(d/update-in-when [:params :c1x] + (:x prev-pos))
(d/update-in-when [:params :c1y] + (:y prev-pos))
(d/update-in-when [:params :c2x] + (:x prev-pos))
(d/update-in-when [:params :c2y] + (:y prev-pos))
(d/update-in-when [:params :cx] + (:x prev-pos))
(d/update-in-when [:params :cy] + (:y prev-pos))
(d/update-in-when [:params :x] + (:x prev-pos))
(d/update-in-when [:params :y] + (:y prev-pos))
(cond->
(= :line-to-horizontal (:command command))
(d/update-in-when [:params :value] + (:x prev-pos))
(= :line-to-vertical (:command command))
(d/update-in-when [:params :value] + (:y prev-pos)))))
params (:params command)
orig-command command
command
(cond-> command
(= :line-to-horizontal (:command command))
(-> (assoc :command :line-to)
(update :params dissoc :value)
(assoc-in [:params :x] (:value params))
(assoc-in [:params :y] (:y prev-pos)))
(= :line-to-vertical (:command command))
(-> (assoc :command :line-to)
(update :params dissoc :value)
(assoc-in [:params :y] (:value params))
(assoc-in [:params :x] (:x prev-pos)))
(= :smooth-curve-to (:command command))
(-> (assoc :command :curve-to)
(update :params dissoc :cx :cy)
(update :params merge (smooth->curve command prev-pos prev-cc)))
(= :quadratic-bezier-curve-to (:command command))
(-> (assoc :command :curve-to)
(update :params dissoc :cx :cy)
(update :params merge (quadratic->curve prev-pos (gpt/point params) (gpt/point (:cx params) (:cy params)))))
(= :smooth-quadratic-bezier-curve-to (:command command))
(-> (assoc :command :curve-to)
(update :params merge (quadratic->curve prev-pos (gpt/point params) (calculate-opposite-handler prev-pos prev-qc)))))
result (if (= :elliptical-arc (:command command))
(d/concat result (arc->beziers prev-pos command))
(conj result command))
next-cc (case (:command orig-command)
:smooth-curve-to
(gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
:curve-to
(gpt/point (get-in orig-command [:params :c2x]) (get-in orig-command [:params :c2y]))
(:line-to-horizontal :line-to-vertical)
(gpt/point (get-in command [:params :x]) (get-in command [:params :y]))
(gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
next-qc (case (:command orig-command)
:quadratic-bezier-curve-to
(gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
:smooth-quadratic-bezier-curve-to
(calculate-opposite-handler prev-pos prev-qc)
(gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
next-pos (if (= :close-path (:command command))
prev-start
(cmd-pos prev-pos command))
next-start (if (= :move-to (:command command)) next-pos prev-start)]
[result next-pos next-start next-cc next-qc]))
start (first commands)
start-pos (gpt/point (:params start))]
(->> (map vector (rest commands) commands)
(reduce simplify-command [[start] start-pos start-pos start-pos start-pos])
(first))))
(defn path->content [path-str]
(let [clean-path-str
(-> path-str
(str/trim)
;; Change "commas" for spaces
(str/replace #"," " ")
;; Remove all consecutive spaces
(str/replace #"\s+" " "))
commands (re-seq commands-regex clean-path-str)]
(-> (mapcat parse-command commands)
(simplify-commands))))
(defn content->path [content]
(->> content
(mapv command->string)
(str/join "")))
(defn make-move-to [to]
{:command :move-to
:relative false
:params {:x (:x to)
:y (:y to)}})
(defn make-line-to [to]
{:command :line-to
:relative false
:params {:x (:x to)
:y (:y to)}})
(defn make-curve-params
([point]
(make-curve-params point point point))
([point handler] (make-curve-params point handler point))
([point h1 h2]
{:x (:x point)
:y (:y point)
:c1x (:x h1)
:c1y (:y h1)
:c2x (:x h2)
:c2y (:y h2)}))
(defn make-curve-to [to h1 h2]
{:command :curve-to
:relative false
:params (make-curve-params to h1 h2)})
(defn split-line-to [from-p cmd val]
(let [to-p (command->point cmd)
sp (gpt/line-val from-p to-p val)]
[(make-line-to sp) cmd]))
(defn split-curve-to [from-p cmd 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)]
[(make-curve-to to1 h11 h21)
(make-curve-to to2 h12 h22)]))
(defn opposite-handler
"Calculates the coordinates of the opposite handler"
[point handler]
(let [phv (gpt/to-vec point handler)]
(gpt/add point (gpt/negate phv))))
(defn opposite-handler-keep-distance
"Calculates the coordinates of the opposite handler but keeping the old distance"
[point handler old-opposite]
(let [old-distance (gpt/distance point old-opposite)
phv (gpt/to-vec point handler)
phv2 (gpt/multiply
(gpt/unit (gpt/negate phv))
(gpt/point old-distance))]
(gpt/add point phv2)))
(defn apply-content-modifiers [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])))
(-> (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])))
(:x params) (update-in [index :params :x] + (:x params))
(:y params) (update-in [index :params :y] + (:y params))
(:c1x params) (update-in [index :params :c1x] + (:c1x params))
(:c1y params) (update-in [index :params :c1y] + (:c1y params))
(:c2x params) (update-in [index :params :c2x] + (:c2x params))
(:c2y params) (update-in [index :params :c2y] + (:c2y params)))
content))]
(let [content (if (vector? content) content (into [] content))]
(reduce apply-to-index content modifiers))))
(defn content->points [content]
(->> content
(map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y))))
(remove nil?)
(into [])))
(defn get-handler [{:keys [params] :as command} prefix]
(let [cx (d/prefix-keyword prefix :x)
cy (d/prefix-keyword prefix :y)]
(when (and command
(contains? params cx)
(contains? params cy))
(gpt/point (get params cx)
(get params cy)))))
(defn content->handlers
"Retrieve a map where for every point will retrieve a list of
the handlers that are associated with that point.
point -> [[index, prefix]]"
[content]
(->> (d/with-prev content)
(d/enumerate)
(mapcat (fn [[index [cur-cmd pre-cmd]]]
(if (and pre-cmd (= :curve-to (:command cur-cmd)))
(let [cur-pos (command->point cur-cmd)
pre-pos (command->point pre-cmd)]
(-> [[pre-pos [index :c1]]
[cur-pos [index :c2]]]))
[])))
(group-by first)
(d/mapm #(mapv second %2))))
(defn point-indices
[content point]
(->> (d/enumerate content)
(filter (fn [[_ cmd]] (= point (command->point cmd))))
(mapv (fn [[index _]] index))))
(defn handler-indices
[content point]
(->> (d/with-prev content)
(d/enumerate)
(mapcat (fn [[index [cur-cmd pre-cmd]]]
(if (and (some? pre-cmd) (= :curve-to (:command cur-cmd)))
(let [cur-pos (command->point cur-cmd)
pre-pos (command->point pre-cmd)]
(cond-> []
(= pre-pos point) (conj [index :c1])
(= cur-pos point) (conj [index :c2])))
[])))))
(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))
opposite-prefix (if (= prefix :c1) :c2 :c1)]
(when (<= (count handlers) 2)
(->> handlers
(d/seek (fn [[index prefix]] (= prefix opposite-prefix)))
(first)))))
(defn remove-line-curves
"Remove all curves that have both handlers in the same position that the
beggining and end points. This makes them really line-to commands"
[content]
(let [with-prev (d/enumerate (d/with-prev content))
process-command
(fn [content [index [command prev]]]
(let [cur-point (command->point command)
pre-point (command->point prev)
handler-c1 (get-handler command :c1)
handler-c2 (get-handler command :c2)]
(if (and (= :curve-to (:command command))
(= cur-point handler-c2)
(= pre-point handler-c1))
(assoc content index {:command :line-to
:params cur-point})
content)))]
(reduce process-command content with-prev)))
(defn make-corner-point
"Changes the content to make a point a 'corner'"
[content point]
(let [handlers (-> (content->handlers content)
(get point))
change-content
(fn [content [index prefix]]
(let [cx (d/prefix-keyword prefix :x)
cy (d/prefix-keyword prefix :y)]
(-> content
(assoc-in [index :params cx] (:x point))
(assoc-in [index :params cy] (:y point)))))]
(as-> content $
(reduce change-content $ handlers)
(remove-line-curves $))))
(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 (command->point command)
pre-point (command->point previous)]
(-> command
(assoc :command :curve-to)
(assoc :params (make-curve-params cur-point pre-point))))
command))
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))
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)))))
redfn (fn [content [index [command prev next]]]
(if (= point (command->point command))
(let [prev-point (if (= :move-to (:command command)) nil (command->point prev))
next-point (if (= :move-to (:command next)) nil (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 $))))
(defn get-segments
"Given a content and a set of points return all the segments in the path
that uses the points"
[content points]
(let [point-set (set points)]
(loop [segments []
prev-point nil
start-point nil
cur-cmd (first content)
content (rest content)]
(let [;; Close-path makes a segment from the last point to the initial path point
cur-point (if (= :close-path (:command cur-cmd))
start-point
(command->point cur-cmd))
;; If there is a move-to we don't have a segment
prev-point (if (= :move-to (:command cur-cmd))
nil
prev-point)
;; We update the start point
start-point (if (= :move-to (:command cur-cmd))
cur-point
start-point)
is-segment? (and (some? prev-point)
(contains? point-set prev-point)
(contains? point-set cur-point))
segments (cond-> segments
is-segment?
(conj [prev-point cur-point cur-cmd]))]
(if (some? cur-cmd)
(recur segments
cur-point
start-point
(first content)
(rest content))
segments)))))
(defn split-segments
"Given a content creates splits commands between points with new segments"
[content points value]
(let [split-command
(fn [[start end cmd]]
(case (:command cmd)
:line-to [cmd (split-line-to start cmd value)]
:curve-to [cmd (split-curve-to start cmd value)]
:close-path [cmd [(make-line-to (gpt/line-val start end value)) cmd]]
nil))
cmd-changes
(->> (get-segments content points)
(into {} (comp (map split-command)
(filter (comp not nil?)))))
process-segments
(fn [command]
(if (contains? cmd-changes command)
(get cmd-changes command)
[command]))]
(into [] (mapcat process-segments) content)))
(defn remove-nodes
"Removes from content the points given. Will try to reconstruct the paths
to keep everything consistent"
[content points]
(let [content (d/with-prev content)]
(loop [result []
last-handler nil
[cur-cmd prev-cmd] (first content)
content (rest content)]
(if (nil? cur-cmd)
;; The result with be an array of arrays were every entry is a subpath
(->> result
;; remove empty and only 1 node subpaths
(filter #(> (count %) 1))
;; flatten array-of-arrays plain array
(flatten)
(into []))
(let [move? (= :move-to (:command cur-cmd))
curve? (= :curve-to (:command cur-cmd))
;; When the old command was a move we start a subpath
result (if move? (conj result []) result)
subpath (peek result)
point (command->point cur-cmd)
old-prev-point (command->point prev-cmd)
new-prev-point (command->point (peek subpath))
remove? (contains? points point)
;; We store the first handler for the first curve to be removed to
;; use it for the first handler of the regenerated path
cur-handler (cond
(and (not last-handler) remove? curve?)
(select-keys (:params cur-cmd) [:c1x :c1y])
(not remove?)
nil
:else
last-handler)
cur-cmd (cond-> cur-cmd
;; If we're starting a subpath and it's not a move make it a move
(and (not move?) (empty? subpath))
(assoc :command :move-to
:params (select-keys (:params cur-cmd) [:x :y]))
;; If have a curve the first handler will be relative to the previous
;; point. We change the handler to the new previous point
(and curve? (not (empty? subpath)) (not= old-prev-point new-prev-point))
(update :params merge last-handler))
head-idx (dec (count result))
result (cond-> result
(not remove?)
(update head-idx conj cur-cmd))]
(recur result
cur-handler
(first content)
(rest content)))))))
(defn join-nodes
"Creates new segments between points that weren't previously"
[content points]
(let [segments-set (into #{}
(map (fn [[p1 p2 _]] [p1 p2]))
(get-segments content points))
create-line-command (fn [point other]
[(make-move-to point)
(make-line-to other)])
not-segment? (fn [point other] (and (not (contains? segments-set [point other]))
(not (contains? segments-set [other point]))))
new-content (->> (d/map-perm create-line-command not-segment? points)
(flatten)
(into []))]
(d/concat content new-content)))
(defn separate-nodes
"Removes the segments between the points given"
[content points]
(let [content (d/with-prev content)]
(loop [result []
[cur-cmd prev-cmd] (first content)
content (rest content)]
(if (nil? cur-cmd)
(->> result
(filter #(> (count %) 1))
(flatten)
(into []))
(let [prev-point (command->point prev-cmd)
cur-point (command->point cur-cmd)
cur-cmd (cond-> cur-cmd
(and (contains? points prev-point)
(contains? points cur-point))
(assoc :command :move-to
:params (select-keys (:params cur-cmd) [:x :y])))
move? (= :move-to (:command cur-cmd))
result (if move? (conj result []) result)
head-idx (dec (count result))
result (-> result
(update head-idx conj cur-cmd))]
(recur result
(first content)
(rest content)))))))
(defn- add-to-set
"Given a list of sets adds the value to the target set"
[set-list target value]
(->> set-list
(mapv (fn [it]
(cond-> it
(= it target) (conj value))))))
(defn- join-sets
"Given a list of sets join two sets in the list into a new one"
[set-list target other]
(conj (->> set-list
(filterv #(and (not= % target)
(not= % other))))
(set/union target other)))
(defn group-segments [segments]
(loop [result []
[point-a point-b :as segment] (first segments)
segments (rest segments)]
(if (nil? segment)
result
(let [set-a (d/seek #(contains? % point-a) result)
set-b (d/seek #(contains? % point-b) result)
result (cond-> result
(and (nil? set-a) (nil? set-b))
(conj #{point-a point-b})
(and (some? set-a) (nil? set-b))
(add-to-set set-a point-b)
(and (nil? set-a) (some? set-b))
(add-to-set set-b point-a)
(and (some? set-a) (some? set-b) (not= set-a set-b))
(join-sets set-a set-b))]
(recur result
(first segments)
(rest segments))))))
(defn calculate-merge-points [group-segments points]
(let [index-merge-point (fn [group] (vector group (-> (gpt/center-points group)
(update :x mth/round)
(update :y mth/round))))
index-group (fn [point] (vector point (d/seek #(contains? % point) group-segments)))
group->merge-point (into {} (map index-merge-point) group-segments)
point->group (into {} (map index-group) points)]
(d/mapm #(group->merge-point %2) point->group)))
;; TODO: Improve the replace for curves
(defn replace-points
"Replaces the points in a path for its merge-point"
[content point->merge-point]
(let [replace-command
(fn [cmd]
(let [point (command->point cmd)]
(if (contains? point->merge-point point)
(let [merge-point (get point->merge-point point)]
(-> cmd (update :params assoc :x (:x merge-point) :y (:y merge-point))))
cmd)))]
(->> content
(mapv replace-command))))
(defn merge-nodes
"Reduces the continguous segments in points to a single point"
[content points]
(let [point->merge-point (-> content
(get-segments points)
(group-segments)
(calculate-merge-points points))]
(-> content
(separate-nodes points)
(replace-points point->merge-point))))

4
frontend/src/app/util/a2c.js → frontend/src/app/util/path/arc_to_curve.js
View file

@ -10,11 +10,11 @@
"use strict";
goog.provide("app.util.a2c");
goog.provide("app.util.path.arc_to_curve");
// https://raw.githubusercontent.com/fontello/svgpath/master/lib/a2c.js
goog.scope(function() {
const self = app.util.a2c;
const self = app.util.path.arc_to_curve;
var TAU = Math.PI * 2;

206
frontend/src/app/util/path/commands.cljs Normal file
View file

@ -0,0 +1,206 @@
;; 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.commands
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as gshp]
[app.util.svg :as usvg]
[cuerdas.core :as str]
[clojure.set :as set]
[app.common.math :as mth]))
(defn command->point
([prev-pos {:keys [relative params] :as command}]
(let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params]
(if relative
(-> prev-pos (update :x + x) (update :y + y))
(command->point command))))
([command]
(when-not (nil? command)
(let [{{:keys [x y]} :params} command]
(gpt/point x y)))))
(defn make-move-to [to]
{:command :move-to
:relative false
:params {:x (:x to)
:y (:y to)}})
(defn make-line-to [to]
{:command :line-to
:relative false
:params {:x (:x to)
:y (:y to)}})
(defn make-curve-params
([point]
(make-curve-params point point point))
([point handler] (make-curve-params point handler point))
([point h1 h2]
{:x (:x point)
:y (:y point)
:c1x (:x h1)
:c1y (:y h1)
:c2x (:x h2)
:c2y (:y 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 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 :command])))
(-> (assoc-in [index :command] :curve-to)
(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))
(:c1x params) (update-in [index :params :c1x] + (:c1x params))
(:c1y params) (update-in [index :params :c1y] + (:c1y params))
(:c2x params) (update-in [index :params :c2x] + (:c2x params))
(:c2y params) (update-in [index :params :c2y] + (:c2y params)))
content))]
(let [content (if (vector? content) content (into [] content))]
(reduce apply-to-index content modifiers))))
(defn get-handler [{:keys [params] :as command} prefix]
(let [cx (d/prefix-keyword prefix :x)
cy (d/prefix-keyword prefix :y)]
(when (and command
(contains? params cx)
(contains? params cy))
(gpt/point (get params cx)
(get params cy)))))
(defn content->handlers
"Retrieve a map where for every point will retrieve a list of
the handlers that are associated with that point.
point -> [[index, prefix]]"
[content]
(->> (d/with-prev content)
(d/enumerate)
(mapcat (fn [[index [cur-cmd pre-cmd]]]
(if (and pre-cmd (= :curve-to (:command cur-cmd)))
(let [cur-pos (command->point cur-cmd)
pre-pos (command->point pre-cmd)]
(-> [[pre-pos [index :c1]]
[cur-pos [index :c2]]]))
[])))
(group-by first)
(d/mapm #(mapv second %2))))
(defn point-indices
[content point]
(->> (d/enumerate content)
(filter (fn [[_ cmd]] (= point (command->point cmd))))
(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)
(mapcat (fn [[index [cur-cmd pre-cmd]]]
(if (and (some? pre-cmd) (= :curve-to (:command cur-cmd)))
(let [cur-pos (command->point cur-cmd)
pre-pos (command->point pre-cmd)]
(cond-> []
(= pre-pos point) (conj [index :c1])
(= cur-pos point) (conj [index :c2])))
[])))))
(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))))
point->handlers (content->handlers content)
handlers (->> point
(point->handlers )
(filter (fn [[ci cp]] (and (not= index ci) (not= prefix cp)) )))]
(cond
(= (count handlers) 1)
(->> handlers first)
(and (= :c1 prefix) (= (count content) index))
[(dec index) :c2]
:else nil)))
(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)))))
(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)
(command->point (get content (dec index)))
(command->point (get content index))))

74
frontend/src/app/util/path/format.cljs Normal file
View file

@ -0,0 +1,74 @@
;; 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.format
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as gshp]
[app.util.svg :as usvg]
[cuerdas.core :as str]
[clojure.set :as set]
[app.common.math :as mth]
))
(defn command->param-list [command]
(let [params (:params command)]
(case (:command command)
(:move-to :line-to :smooth-quadratic-bezier-curve-to)
(str (:x params) ","
(:y params))
:close-path
""
(:line-to-horizontal :line-to-vertical)
(str (:value params))
:curve-to
(str (:c1x params) ","
(:c1y params) ","
(:c2x params) ","
(:c2y params) ","
(:x params) ","
(:y params))
(:smooth-curve-to :quadratic-bezier-curve-to)
(str (:cx params) ","
(:cy params) ","
(:x params) ","
(:y params))
:elliptical-arc
(str (:rx params) ","
(:ry params) ","
(:x-axis-rotation params) ","
(:large-arc-flag params) ","
(:sweep-flag params) ","
(:x params) ","
(:y params)))))
(defn command->string [{:keys [command relative params] :as entry}]
(let [command-str (case command
:move-to "M"
:close-path "Z"
:line-to "L"
:line-to-horizontal "H"
:line-to-vertical "V"
:curve-to "C"
:smooth-curve-to "S"
:quadratic-bezier-curve-to "Q"
:smooth-quadratic-bezier-curve-to "T"
:elliptical-arc "A")
command-str (if relative (str/lower command-str) command-str)
param-list (command->param-list entry)]
(str command-str param-list)))
(defn format-path [content]
(->> content
(mapv command->string)
(str/join "")))

60
frontend/src/app/util/path/geom.cljs Normal file
View file

@ -0,0 +1,60 @@
;; 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.geom
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as gshp]
[app.util.svg :as usvg]
[cuerdas.core :as str]
[clojure.set :as set]
[app.common.math :as mth]
[app.util.path.commands :as upc]))
(defn calculate-opposite-handler
"Given a point and its handler, gives the symetric handler"
[point handler]
(let [handler-vector (gpt/to-vec point handler)]
(gpt/add point (gpt/negate handler-vector))))
(defn split-line-to [from-p cmd val]
(let [to-p (upc/command->point cmd)
sp (gpt/line-val from-p to-p val)]
[(upc/make-line-to sp) cmd]))
(defn split-curve-to [from-p cmd 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)]
[(upc/make-curve-to to1 h11 h21)
(upc/make-curve-to to2 h12 h22)]))
(defn opposite-handler
"Calculates the coordinates of the opposite handler"
[point handler]
(let [phv (gpt/to-vec point handler)]
(gpt/add point (gpt/negate phv))))
(defn opposite-handler-keep-distance
"Calculates the coordinates of the opposite handler but keeping the old distance"
[point handler old-opposite]
(let [old-distance (gpt/distance point old-opposite)
phv (gpt/to-vec point handler)
phv2 (gpt/multiply
(gpt/unit (gpt/negate phv))
(gpt/point old-distance))]
(gpt/add point phv2)))
(defn content->points [content]
(->> content
(map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y))))
(remove nil?)
(into [])))

317
frontend/src/app/util/path/parser.cljs Normal file
View file

@ -0,0 +1,317 @@
;; 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.parser
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as gshp]
[app.util.path.arc-to-curve :refer [a2c]]
[app.util.path.commands :as upc]
[app.util.svg :as usvg]
[cuerdas.core :as str]
[clojure.set :as set]
[app.common.math :as mth]
[app.util.path.geom :as upg]
))
;;
(def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*")
;; Matches numbers for path values allows values like... -.01, 10, +12.22
;; 0 and 1 are special because can refer to flags
(def num-regex #"[+-]?(\d+(\.\d+)?|\.\d+)(e[+-]?\d+)?")
(def flag-regex #"[01]")
(defn extract-params [cmd-str extract-commands]
(loop [result []
extract-idx 0
current {}
remain (-> cmd-str (subs 1) (str/trim))]
(let [[param type] (nth extract-commands extract-idx)
regex (case type
:flag flag-regex
#_:number num-regex)
match (re-find regex remain)]
(if match
(let [value (-> match first usvg/fix-dot-number d/read-string)
remain (str/replace-first remain regex "")
current (assoc current param value)
extract-idx (inc extract-idx)
[result current extract-idx]
(if (>= extract-idx (count extract-commands))
[(conj result current) {} 0]
[result current extract-idx])]
(recur result
extract-idx
current
remain))
(cond-> result
(not (empty? current)) (conj current))))))
;; Path specification
;; https://www.w3.org/TR/SVG11/paths.html
(defmulti parse-command (comp str/upper first))
(defmethod parse-command "M" [cmd]
(let [relative (str/starts-with? cmd "m")
param-list (extract-params cmd [[:x :number]
[:y :number]])]
(d/concat [{:command :move-to
:relative relative
:params (first param-list)}]
(for [params (rest param-list)]
{:command :line-to
:relative relative
:params params}))))
(defmethod parse-command "Z" [cmd]
[{:command :close-path}])
(defmethod parse-command "L" [cmd]
(let [relative (str/starts-with? cmd "l")
param-list (extract-params cmd [[:x :number]
[:y :number]])]
(for [params param-list]
{:command :line-to
:relative relative
:params params})))
(defmethod parse-command "H" [cmd]
(let [relative (str/starts-with? cmd "h")
param-list (extract-params cmd [[:value :number]])]
(for [params param-list]
{:command :line-to-horizontal
:relative relative
:params params})))
(defmethod parse-command "V" [cmd]
(let [relative (str/starts-with? cmd "v")
param-list (extract-params cmd [[:value :number]])]
(for [params param-list]
{:command :line-to-vertical
:relative relative
:params params})))
(defmethod parse-command "C" [cmd]
(let [relative (str/starts-with? cmd "c")
param-list (extract-params cmd [[:c1x :number]
[:c1y :number]
[:c2x :number]
[:c2y :number]
[:x :number]
[:y :number]])
]
(for [params param-list]
{:command :curve-to
:relative relative
:params params})))
(defmethod parse-command "S" [cmd]
(let [relative (str/starts-with? cmd "s")
param-list (extract-params cmd [[:cx :number]
[:cy :number]
[:x :number]
[:y :number]])]
(for [params param-list]
{:command :smooth-curve-to
:relative relative
:params params})))
(defmethod parse-command "Q" [cmd]
(let [relative (str/starts-with? cmd "q")
param-list (extract-params cmd [[:cx :number]
[:cy :number]
[:x :number]
[:y :number]])]
(for [params param-list]
{:command :quadratic-bezier-curve-to
:relative relative
:params params})))
(defmethod parse-command "T" [cmd]
(let [relative (str/starts-with? cmd "t")
param-list (extract-params cmd [[:x :number]
[:y :number]])]
(for [params param-list]
{:command :smooth-quadratic-bezier-curve-to
:relative relative
:params params})))
(defmethod parse-command "A" [cmd]
(let [relative (str/starts-with? cmd "a")
param-list (extract-params cmd [[:rx :number]
[:ry :number]
[:x-axis-rotation :number]
[:large-arc-flag :flag]
[:sweep-flag :flag]
[:x :number]
[:y :number]])]
(for [params param-list]
{:command :elliptical-arc
:relative relative
:params params})))
(defn smooth->curve
[{:keys [params]} pos handler]
(let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)]
{:c1x c1x
:c1y c1y
:c2x (:cx params)
:c2y (:cy params)}))
(defn quadratic->curve
[sp ep cp]
(let [cp1 (-> (gpt/to-vec sp cp)
(gpt/scale (/ 2 3))
(gpt/add sp))
cp2 (-> (gpt/to-vec ep cp)
(gpt/scale (/ 2 3))
(gpt/add ep))]
{:c1x (:x cp1)
:c1y (:y cp1)
:c2x (:x cp2)
:c2y (:y cp2)}))
(defn arc->beziers [from-p command]
(let [to-command
(fn [[_ _ c1x c1y c2x c2y x y]]
{:command :curve-to
:relative (:relative command)
:params {:c1x c1x :c1y c1y
:c2x c2x :c2y c2y
:x x :y y}})
{from-x :x from-y :y} from-p
{:keys [rx ry x-axis-rotation large-arc-flag sweep-flag x y]} (:params command)
result (a2c from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation)]
(mapv to-command result)))
(defn simplify-commands
"Removes some commands and convert relative to absolute coordinates"
[commands]
(let [simplify-command
;; prev-pos : previous position for the current path. Necesary for relative commands
;; prev-start : previous move-to necesary for Z commands
;; prev-cc : previous command control point for cubic beziers
;; prev-qc : previous command control point for quadratic curves
(fn [[result prev-pos prev-start prev-cc prev-qc] [command prev]]
(let [command (assoc command :prev-pos prev-pos)
command
(cond-> command
(:relative command)
(-> (assoc :relative false)
(d/update-in-when [:params :c1x] + (:x prev-pos))
(d/update-in-when [:params :c1y] + (:y prev-pos))
(d/update-in-when [:params :c2x] + (:x prev-pos))
(d/update-in-when [:params :c2y] + (:y prev-pos))
(d/update-in-when [:params :cx] + (:x prev-pos))
(d/update-in-when [:params :cy] + (:y prev-pos))
(d/update-in-when [:params :x] + (:x prev-pos))
(d/update-in-when [:params :y] + (:y prev-pos))
(cond->
(= :line-to-horizontal (:command command))
(d/update-in-when [:params :value] + (:x prev-pos))
(= :line-to-vertical (:command command))
(d/update-in-when [:params :value] + (:y prev-pos)))))
params (:params command)
orig-command command
command
(cond-> command
(= :line-to-horizontal (:command command))
(-> (assoc :command :line-to)
(update :params dissoc :value)
(assoc-in [:params :x] (:value params))
(assoc-in [:params :y] (:y prev-pos)))
(= :line-to-vertical (:command command))
(-> (assoc :command :line-to)
(update :params dissoc :value)
(assoc-in [:params :y] (:value params))
(assoc-in [:params :x] (:x prev-pos)))
(= :smooth-curve-to (:command command))
(-> (assoc :command :curve-to)
(update :params dissoc :cx :cy)
(update :params merge (smooth->curve command prev-pos prev-cc)))
(= :quadratic-bezier-curve-to (:command command))
(-> (assoc :command :curve-to)
(update :params dissoc :cx :cy)
(update :params merge (quadratic->curve prev-pos (gpt/point params) (gpt/point (:cx params) (:cy params)))))
(= :smooth-quadratic-bezier-curve-to (:command command))
(-> (assoc :command :curve-to)
(update :params merge (quadratic->curve prev-pos (gpt/point params) (upg/calculate-opposite-handler prev-pos prev-qc)))))
result (if (= :elliptical-arc (:command command))
(d/concat result (arc->beziers prev-pos command))
(conj result command))
next-cc (case (:command orig-command)
:smooth-curve-to
(gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
:curve-to
(gpt/point (get-in orig-command [:params :c2x]) (get-in orig-command [:params :c2y]))
(:line-to-horizontal :line-to-vertical)
(gpt/point (get-in command [:params :x]) (get-in command [:params :y]))
(gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
next-qc (case (:command orig-command)
:quadratic-bezier-curve-to
(gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
:smooth-quadratic-bezier-curve-to
(upg/calculate-opposite-handler prev-pos prev-qc)
(gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
next-pos (if (= :close-path (:command command))
prev-start
(upc/command->point prev-pos command))
next-start (if (= :move-to (:command command)) next-pos prev-start)]
[result next-pos next-start next-cc next-qc]))
start (first commands)
start-pos (gpt/point (:params start))]
(->> (map vector (rest commands) commands)
(reduce simplify-command [[start] start-pos start-pos start-pos start-pos])
(first))))
(defn parse-path [path-str]
(let [clean-path-str
(-> path-str
(str/trim)
;; Change "commas" for spaces
(str/replace #"," " ")
;; Remove all consecutive spaces
(str/replace #"\s+" " "))
commands (re-seq commands-regex clean-path-str)]
(-> (mapcat parse-command commands)
(simplify-commands))))

4
frontend/src/app/util/geom/path_impl_simplify.js → frontend/src/app/util/path/path_impl_simplify.js
View file

@ -11,10 +11,10 @@
"use strict";
goog.provide("app.util.geom.path_impl_simplify");
goog.provide("app.util.path.path_impl_simplify");
goog.scope(function() {
const self = app.util.geom.path_impl_simplify;
const self = app.util.path.path_impl_simplify;
// square distance between 2 points
function getSqDist(p1, p2) {

24
frontend/src/app/util/path/simplify_curve.cljs Normal file
View file

@ -0,0 +1,24 @@
;; 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.simplify-curve
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as gshp]
[app.util.path.path-impl-simplify :as impl-simplify]
[app.util.svg :as usvg]
[cuerdas.core :as str]
[clojure.set :as set]
[app.common.math :as mth]))
(defn simplify
"Simplifies a drawing done with the pen tool"
([points]
(simplify points 0.1))
([points tolerance]
(let [points (into-array points)]
(into [] (impl-simplify/simplify points tolerance true)))))

439
frontend/src/app/util/path/tools.cljs Normal file
View file

@ -0,0 +1,439 @@
;; 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.tools
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as gshp]
[app.util.svg :as usvg]
[cuerdas.core :as str]
[clojure.set :as set]
[app.common.math :as mth]
[app.util.path.commands :as upc]
[app.util.path.geom :as upg]
))
(defn remove-line-curves
"Remove all curves that have both handlers in the same position that the
beggining and end points. This makes them really line-to commands"
[content]
(let [with-prev (d/enumerate (d/with-prev content))
process-command
(fn [content [index [command prev]]]
(let [cur-point (upc/command->point command)
pre-point (upc/command->point prev)
handler-c1 (upc/get-handler command :c1)
handler-c2 (upc/get-handler command :c2)]
(if (and (= :curve-to (:command command))
(= cur-point handler-c2)
(= pre-point handler-c1))
(assoc content index {:command :line-to
:params cur-point})
content)))]
(reduce process-command content with-prev)))
(defn make-corner-point
"Changes the content to make a point a 'corner'"
[content point]
(let [handlers (-> (upc/content->handlers content)
(get point))
change-content
(fn [content [index prefix]]
(let [cx (d/prefix-keyword prefix :x)
cy (d/prefix-keyword prefix :y)]
(-> content
(assoc-in [index :params cx] (:x point))
(assoc-in [index :params cy] (:y point)))))]
(as-> content $
(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 [make-curve-cmd (fn [cmd h1 h2]
(-> cmd
(update :params assoc
:c1x (:x h1) :c1y (:y h1)
:c2x (:x h2) :c2y (:y h2))))
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)
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)))))
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
that uses the points"
[content points]
(let [point-set (set points)]
(loop [segments []
prev-point nil
start-point nil
cur-cmd (first content)
content (rest content)]
(let [;; Close-path makes a segment from the last point to the initial path point
cur-point (if (= :close-path (:command cur-cmd))
start-point
(upc/command->point cur-cmd))
;; If there is a move-to we don't have a segment
prev-point (if (= :move-to (:command cur-cmd))
nil
prev-point)
;; We update the start point
start-point (if (= :move-to (:command cur-cmd))
cur-point
start-point)
is-segment? (and (some? prev-point)
(contains? point-set prev-point)
(contains? point-set cur-point))
segments (cond-> segments
is-segment?
(conj [prev-point cur-point cur-cmd]))]
(if (some? cur-cmd)
(recur segments
cur-point
start-point
(first content)
(rest content))
segments)))))
(defn split-segments
"Given a content creates splits commands between points with new segments"
[content points value]
(let [split-command
(fn [[start end cmd]]
(case (:command cmd)
:line-to [cmd (upg/split-line-to start cmd value)]
:curve-to [cmd (upg/split-curve-to start cmd value)]
:close-path [cmd [(upc/make-line-to (gpt/line-val start end value)) cmd]]
nil))
cmd-changes
(->> (get-segments content points)
(into {} (comp (map split-command)
(filter (comp not nil?)))))
process-segments
(fn [command]
(if (contains? cmd-changes command)
(get cmd-changes command)
[command]))]
(into [] (mapcat process-segments) content)))
(defn remove-nodes
"Removes from content the points given. Will try to reconstruct the paths
to keep everything consistent"
[content points]
(let [content (d/with-prev content)]
(loop [result []
last-handler nil
[cur-cmd prev-cmd] (first content)
content (rest content)]
(if (nil? cur-cmd)
;; The result with be an array of arrays were every entry is a subpath
(->> result
;; remove empty and only 1 node subpaths
(filter #(> (count %) 1))
;; flatten array-of-arrays plain array
(flatten)
(into []))
(let [move? (= :move-to (:command cur-cmd))
curve? (= :curve-to (:command cur-cmd))
;; When the old command was a move we start a subpath
result (if move? (conj result []) result)
subpath (peek result)
point (upc/command->point cur-cmd)
old-prev-point (upc/command->point prev-cmd)
new-prev-point (upc/command->point (peek subpath))
remove? (contains? points point)
;; We store the first handler for the first curve to be removed to
;; use it for the first handler of the regenerated path
cur-handler (cond
(and (not last-handler) remove? curve?)
(select-keys (:params cur-cmd) [:c1x :c1y])
(not remove?)
nil
:else
last-handler)
cur-cmd (cond-> cur-cmd
;; If we're starting a subpath and it's not a move make it a move
(and (not move?) (empty? subpath))
(assoc :command :move-to
:params (select-keys (:params cur-cmd) [:x :y]))
;; If have a curve the first handler will be relative to the previous
;; point. We change the handler to the new previous point
(and curve? (not (empty? subpath)) (not= old-prev-point new-prev-point))
(update :params merge last-handler))
head-idx (dec (count result))
result (cond-> result
(not remove?)
(update head-idx conj cur-cmd))]
(recur result
cur-handler
(first content)
(rest content)))))))
(defn join-nodes
"Creates new segments between points that weren't previously"
[content points]
(let [segments-set (into #{}
(map (fn [[p1 p2 _]] [p1 p2]))
(get-segments content points))
create-line-command (fn [point other]
[(upc/make-move-to point)
(upc/make-line-to other)])
not-segment? (fn [point other] (and (not (contains? segments-set [point other]))
(not (contains? segments-set [other point]))))
new-content (->> (d/map-perm create-line-command not-segment? points)
(flatten)
(into []))]
(d/concat content new-content)))
(defn separate-nodes
"Removes the segments between the points given"
[content points]
(let [content (d/with-prev content)]
(loop [result []
[cur-cmd prev-cmd] (first content)
content (rest content)]
(if (nil? cur-cmd)
(->> result
(filter #(> (count %) 1))
(flatten)
(into []))
(let [prev-point (upc/command->point prev-cmd)
cur-point (upc/command->point cur-cmd)
cur-cmd (cond-> cur-cmd
(and (contains? points prev-point)
(contains? points cur-point))
(assoc :command :move-to
:params (select-keys (:params cur-cmd) [:x :y])))
move? (= :move-to (:command cur-cmd))
result (if move? (conj result []) result)
head-idx (dec (count result))
result (-> result
(update head-idx conj cur-cmd))]
(recur result
(first content)
(rest content)))))))
(defn- add-to-set
"Given a list of sets adds the value to the target set"
[set-list target value]
(->> set-list
(mapv (fn [it]
(cond-> it
(= it target) (conj value))))))
(defn- join-sets
"Given a list of sets join two sets in the list into a new one"
[set-list target other]
(conj (->> set-list
(filterv #(and (not= % target)
(not= % other))))
(set/union target other)))
(defn group-segments [segments]
(loop [result []
[point-a point-b :as segment] (first segments)
segments (rest segments)]
(if (nil? segment)
result
(let [set-a (d/seek #(contains? % point-a) result)
set-b (d/seek #(contains? % point-b) result)
result (cond-> result
(and (nil? set-a) (nil? set-b))
(conj #{point-a point-b})
(and (some? set-a) (nil? set-b))
(add-to-set set-a point-b)
(and (nil? set-a) (some? set-b))
(add-to-set set-b point-a)
(and (some? set-a) (some? set-b) (not= set-a set-b))
(join-sets set-a set-b))]
(recur result
(first segments)
(rest segments))))))
(defn calculate-merge-points [group-segments points]
(let [index-merge-point (fn [group] (vector group (-> (gpt/center-points group)
(update :x mth/round)
(update :y mth/round))))
index-group (fn [point] (vector point (d/seek #(contains? % point) group-segments)))
group->merge-point (into {} (map index-merge-point) group-segments)
point->group (into {} (map index-group) points)]
(d/mapm #(group->merge-point %2) point->group)))
;; TODO: Improve the replace for curves
(defn replace-points
"Replaces the points in a path for its merge-point"
[content point->merge-point]
(let [replace-command
(fn [cmd]
(let [point (upc/command->point cmd)]
(if (contains? point->merge-point point)
(let [merge-point (get point->merge-point point)]
(-> cmd (update :params assoc :x (:x merge-point) :y (:y merge-point))))
cmd)))]
(->> content
(mapv replace-command))))
(defn merge-nodes
"Reduces the continguous segments in points to a single point"
[content points]
(let [point->merge-point (-> content
(get-segments points)
(group-segments)
(calculate-merge-points points))]
(-> content
(separate-nodes points)
(replace-points point->merge-point))))

50
frontend/translations/en.po
View file

@ -1,11 +1,25 @@
# SOME DESCRIPTIVE TITLE.
# Copyright (C) YEAR Free Software Foundation, Inc.
# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.
#
#, fuzzy
msgid ""
msgstr ""
"Language: en\n"
"Project-Id-Version: PACKAGE VERSION\n"
"PO-Revision-Date: 2021-04-22 13:43+0200\n"
"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
"Language-Team: LANGUAGE <LL@li.org>\n"
"MIME-Version: 1.0\n"
"Content-Type: text/plain; charset=utf-8\n"
"Content-Type: text/plain; charset=iso-8859-1\n"
"Content-Transfer-Encoding: 8bit\n"
"Plural-Forms: nplurals=2; plural=(n != 1);\n"
# ~ msgid ""
# ~ msgstr ""
# ~ "Language: en\n"
# ~ "MIME-Version: 1.0\n"
# ~ "Content-Type: text/plain; charset=utf-8\n"
# ~ "Content-Transfer-Encoding: 8bit\n"
# ~ "Plural-Forms: nplurals=2; plural=(n != 1);\n"
#: src/app/main/ui/auth/register.cljs
msgid "auth.already-have-account"
msgstr "Already have an account?"
@ -2169,6 +2183,36 @@ msgstr "Vertical align"
msgid "workspace.options.use-play-button"
msgstr "Use the play button at the header to run the prototype view."
msgid "workspace.path.actions.add-node"
msgstr "Add node (%s)"
msgid "workspace.path.actions.delete-node"
msgstr "Delete node (%s)"
msgid "workspace.path.actions.draw-nodes"
msgstr "Draw nodes (%s)"
msgid "workspace.path.actions.join-nodes"
msgstr "Join nodes (%s)"
msgid "workspace.path.actions.make-corner"
msgstr "To corner (%s)"
msgid "workspace.path.actions.make-curve"
msgstr "To curve (%s)"
msgid "workspace.path.actions.merge-nodes"
msgstr "Merge nodes (%s)"
msgid "workspace.path.actions.move-nodes"
msgstr "Move nodes (%s)"
msgid "workspace.path.actions.separate-nodes"
msgstr "Separate nodes (%s)"
msgid "workspace.path.actions.snap-nodes"
msgstr "Snap nodes (%s)"
#: src/app/main/ui/workspace/context_menu.cljs
msgid "workspace.shape.menu.back"
msgstr "Send to back"

30
frontend/translations/es.po
View file

@ -2153,6 +2153,36 @@ msgstr "Alineación vertical"
msgid "workspace.options.use-play-button"
msgstr "Usa el botón de play de la cabecera para arrancar la vista de prototipo."
msgid "workspace.path.actions.add-node"
msgstr "Añadir nodo (%s)"
msgid "workspace.path.actions.delete-node"
msgstr "Borrar nodos (%s)"
msgid "workspace.path.actions.draw-nodes"
msgstr "Dibujar nodos (%s)"
msgid "workspace.path.actions.join-nodes"
msgstr "Unir nodos (%s)"
msgid "workspace.path.actions.make-corner"
msgstr "Convertir en esquina (%s)"
msgid "workspace.path.actions.make-curve"
msgstr "Convertir en curva (%s)"
msgid "workspace.path.actions.merge-nodes"
msgstr "Fusionar nodos (%s)"
msgid "workspace.path.actions.move-nodes"
msgstr "Mover nodes (%s)"
msgid "workspace.path.actions.separate-nodes"
msgstr "Separar nodos (%s)"
msgid "workspace.path.actions.snap-nodes"
msgstr "Alinear nodos (%s)"
#: src/app/main/ui/workspace/context_menu.cljs
msgid "workspace.shape.menu.back"
msgstr "Enviar al fondo"