Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-11 23:31:21 -05:00
Code Issues Activity

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

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

1
CHANGES.md
View file

@ -7,6 +7,7 @@
- Add integration with gitpod.io (an online IDE) [#807](https://github.com/penpot/penpot/pull/807)
- Allow to group assets (components and graphics) [Taiga #1289](https://tree.taiga.io/project/penpot/us/1289)
- Internal: refactor of http client, replace internal xhr usage with more modern Fetch API.
- New features for paths: snap points on edition, add/remove nodes, merge/join/split nodes. [Taiga #907](https://tree.taiga.io/project/penpot/us/907)
### :bug: Bugs fixed

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

@ -220,7 +220,9 @@
v2-unit
(point scalar-projection scalar-projection))))
(defn center-points [points]
(defn center-points
"Centroid of a group of points"
[points]
(let [k (point (count points))]
(reduce #(add %1 (divide %2 k)) (point) points)))
@ -253,7 +255,16 @@
(and (mth/almost-zero? x)
(mth/almost-zero? y)))
(defn line-val
"Given a line with two points p1-p2 and a 'percent'. Returns the point in the vector
generated by these two points. For example: for p1=(0,0) p2=(1,1) and v=0.25 will return
the point (0.25, 0.25)"
[p1 p2 v]
(let [v (-> (to-vec p1 p2)
(scale v))]
(add p1 v)))
;; --- Debug
(defmethod pp/simple-dispatch Point [obj] (pr obj))

1
common/app/common/geom/shapes.cljc
View file

@ -253,3 +253,4 @@
;; Intersection
(d/export gin/overlaps?)
(d/export gin/has-point?)
(d/export gin/has-point-rect?)

5
common/app/common/geom/shapes/intersect.cljc
View file

@ -285,6 +285,11 @@
(or (not path?) (overlaps-path? shape rect))
(or (not circle?) (overlaps-ellipse? shape rect))))))
(defn has-point-rect?
[rect point]
(let [lines (gpr/rect->lines rect)]
(is-point-inside-evenodd? point lines)))
(defn has-point?
"Check if the shape contains a point"
[shape point]

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

@ -41,6 +41,20 @@
(gpt/point (coord-v :x) (coord-v :y))))
(defn curve-split
"Splits a curve into two at the given parametric value `t`.
Calculates the Casteljau's algorithm intermediate points"
[start end h1 h2 t]
(let [p1 (gpt/line-val start h1 t)
p2 (gpt/line-val h1 h2 t)
p3 (gpt/line-val h2 end t)
p4 (gpt/line-val p1 p2 t)
p5 (gpt/line-val p2 p3 t)
sp (gpt/line-val p4 p5 t)]
[[start sp p1 p4]
[sp end p5 p3]]))
;; https://pomax.github.io/bezierinfo/#extremities
(defn curve-extremities
"Given a cubic bezier cube finds its roots in t. This are the extremities
@ -211,3 +225,92 @@
point))
(conj result [prev-point last-start]))))
(defonce path-closest-point-accuracy 0.01)
(defn curve-closest-point
[position start end h1 h2]
(let [d (memoize (fn [t] (gpt/distance position (curve-values start end h1 h2 t))))]
(loop [t1 0
t2 1]
(if (<= (mth/abs (- t1 t2)) path-closest-point-accuracy)
(curve-values start end h1 h2 t1)
(let [ht (+ t1 (/ (- t2 t1) 2))
ht1 (+ t1 (/ (- t2 t1) 4))
ht2 (+ t1 (/ (* 3 (- t2 t1)) 4))
[t1 t2] (cond
(< (d ht1) (d ht2))
[t1 ht]
(< (d ht2) (d ht1))
[ht t2]
(and (< (d ht) (d t1)) (< (d ht) (d t2)))
[ht1 ht2]
(< (d t1) (d t2))
[t1 ht]
:else
[ht t2])]
(recur t1 t2))))))
(defn line-closest-point
"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))
len2 (+ (mth/sq (:x e1)) (mth/sq (:y e1)))
val-dp (/ (gpt/dot e1 e2) len2)]
(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))
from-p
to-p))))
(defn path-closest-point
"Given a path and a position"
[shape position]
(let [point+distance (fn [[cur-cmd prev-cmd]]
(let [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])))
nil)]
(when point
[point (gpt/distance point position)])))
find-min-point (fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]]
(if (and (some? acc) (or (not cur) (<= min-dist cur-dist)))
[min-p min-dist]
[cur-p cur-dist]))]
(->> (:content shape)
(d/with-prev)
(map point+distance)
(reduce find-min-point)
(first))))

6
common/app/common/geom/shapes/rect.cljc
View file

@ -19,6 +19,12 @@
(gpt/point (+ x width) (+ y height))
(gpt/point x (+ y height))])
(defn rect->lines [{:keys [x y width height]}]
[[(gpt/point x y) (gpt/point (+ x width) y)]
[(gpt/point (+ x width) y) (gpt/point (+ x width) (+ y height))]
[(gpt/point (+ x width) (+ y height)) (gpt/point x (+ y height))]
[(gpt/point x (+ y height)) (gpt/point x y)]])
(defn points->rect
[points]
(let [minx (transduce gco/map-x-xf min ##Inf points)

2
frontend/deps.edn
View file

@ -11,7 +11,7 @@
danlentz/clj-uuid {:mvn/version "0.1.9"}
frankiesardo/linked {:mvn/version "1.3.0"}
funcool/beicon {:mvn/version "2021.04.09-1"}
funcool/beicon {:mvn/version "2021.04.12-1"}
funcool/cuerdas {:mvn/version "2020.03.26-3"}
funcool/okulary {:mvn/version "2020.04.14-0"}
funcool/potok {:mvn/version "3.2.0"}

2
frontend/src/app/main/data/workspace.cljs
View file

@ -24,7 +24,7 @@
[app.main.data.messages :as dm]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.drawing :as dwd]
[app.main.data.workspace.drawing.path :as dwdp]
[app.main.data.workspace.path :as dwdp]
[app.main.data.workspace.groups :as dwg]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.notifications :as dwn]

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

@ -360,25 +360,30 @@
(ptk/reify ::undo
ptk/WatchEvent
(watch [_ state stream]
(let [undo (:workspace-undo state)
items (:items undo)
index (or (:index undo) (dec (count items)))]
(when-not (or (empty? items) (= index -1))
(let [changes (get-in items [index :undo-changes])]
(rx/of (materialize-undo changes (dec index))
(commit-changes changes [] {:save-undo? false}))))))))
(let [edition (get-in state [:workspace-local :edition])]
;; Editors handle their own undo's
(when-not (some? edition)
(let [undo (:workspace-undo state)
items (:items undo)
index (or (:index undo) (dec (count items)))]
(when-not (or (empty? items) (= index -1))
(let [changes (get-in items [index :undo-changes])]
(rx/of (materialize-undo changes (dec index))
(commit-changes changes [] {:save-undo? false}))))))))))
(def redo
(ptk/reify ::redo
ptk/WatchEvent
(watch [_ state stream]
(let [undo (:workspace-undo state)
items (:items undo)
index (or (:index undo) (dec (count items)))]
(when-not (or (empty? items) (= index (dec (count items))))
(let [changes (get-in items [(inc index) :redo-changes])]
(rx/of (materialize-undo changes (inc index))
(commit-changes changes [] {:save-undo? false}))))))))
(let [edition (get-in state [:workspace-local :edition])]
(when-not (some? edition)
(let [undo (:workspace-undo state)
items (:items undo)
index (or (:index undo) (dec (count items)))]
(when-not (or (empty? items) (= index (dec (count items))))
(let [changes (get-in items [(inc index) :redo-changes])]
(rx/of (materialize-undo changes (inc index))
(commit-changes changes [] {:save-undo? false}))))))))))
(def reinitialize-undo
(ptk/reify ::reset-undo

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

@ -14,8 +14,8 @@
[app.common.uuid :as uuid]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.path :as path]
[app.main.data.workspace.drawing.common :as common]
[app.main.data.workspace.drawing.path :as path]
[app.main.data.workspace.drawing.curve :as curve]
[app.main.data.workspace.drawing.box :as box]))

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

@ -1,860 +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.main.data.workspace.drawing.path
(:require
[app.common.data :as d]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.path :as gsp]
[app.common.math :as mth]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.drawing.common :as common]
[app.main.store :as st]
[app.main.streams :as ms]
[app.util.geom.path :as ugp]
[beicon.core :as rx]
[clojure.spec.alpha :as s]
[potok.core :as ptk]))
;; SCHEMAS
(s/def ::command #{:move-to
:line-to
:line-to-horizontal
:line-to-vertical
:curve-to
:smooth-curve-to
:quadratic-bezier-curve-to
:smooth-quadratic-bezier-curve-to
:elliptical-arc
:close-path})
(s/def :paths.params/x number?)
(s/def :paths.params/y number?)
(s/def :paths.params/c1x number?)
(s/def :paths.params/c1y number?)
(s/def :paths.params/c2x number?)
(s/def :paths.params/c2y number?)
(s/def ::relative? boolean?)
(s/def ::params
(s/keys :req-un [:path.params/x
:path.params/y]
:opt-un [:path.params/c1x
:path.params/c1y
:path.params/c2x
:path.params/c2y]))
(s/def ::content-entry
(s/keys :req-un [::command]
:req-opt [::params
::relative?]))
(s/def ::content
(s/coll-of ::content-entry :kind vector?))
;; CONSTANTS
(defonce enter-keycode 13)
(defonce drag-threshold 5)
;; PRIVATE METHODS
(defn get-path-id
"Retrieves the currently editing path id"
[state]
(or (get-in state [:workspace-local :edition])
(get-in state [:workspace-drawing :object :id])))
(defn get-path
"Retrieves the location of the path object and additionaly can pass
the arguments. This location can be used in get-in, assoc-in... functions"
[state & path]
(let [edit-id (get-in state [:workspace-local :edition])
page-id (:current-page-id state)]
(d/concat
(if edit-id
[:workspace-data :pages-index page-id :objects edit-id]
[:workspace-drawing :object])
path)))
(defn- points->components [shape content]
(let [transform (:transform shape (gmt/matrix))
transform-inverse (:transform-inverse shape (gmt/matrix))
center (gsh/center-shape shape)
base-content (gsh/transform-content
content
(gmt/transform-in center transform-inverse))
;; Calculates the new selrect with points given the old center
points (-> (gsh/content->selrect base-content)
(gsh/rect->points)
(gsh/transform-points center (:transform shape (gmt/matrix))))
points-center (gsh/center-points points)
;; Points is now the selrect but the center is different so we can create the selrect
;; through points
selrect (-> points
(gsh/transform-points points-center (:transform-inverse shape (gmt/matrix)))
(gsh/points->selrect))]
[points selrect]))
(defn update-selrect
"Updates the selrect and points for a path"
[shape]
(if (= (:rotation shape 0) 0)
(let [content (:content shape)
selrect (gsh/content->selrect content)
points (gsh/rect->points selrect)]
(assoc shape :points points :selrect selrect))
(let [content (:content shape)
[points selrect] (points->components shape content)]
(assoc shape :points points :selrect selrect))))
(defn closest-angle [angle]
(cond
(or (> angle 337.5) (<= angle 22.5)) 0
(and (> angle 22.5) (<= angle 67.5)) 45
(and (> angle 67.5) (<= angle 112.5)) 90
(and (> angle 112.5) (<= angle 157.5)) 135
(and (> angle 157.5) (<= angle 202.5)) 180
(and (> angle 202.5) (<= angle 247.5)) 225
(and (> angle 247.5) (<= angle 292.5)) 270
(and (> angle 292.5) (<= angle 337.5)) 315))
(defn position-fixed-angle [point from-point]
(if (and from-point point)
(let [angle (mod (+ 360 (- (gpt/angle point from-point))) 360)
to-angle (closest-angle angle)
distance (gpt/distance point from-point)]
(gpt/angle->point from-point (mth/radians to-angle) distance))
point))
(defn next-node
"Calculates the next-node to be inserted."
[shape position prev-point prev-handler]
(let [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)}
:else {:command :move-to
:params position})))
(defn append-node
"Creates a new node in the path. Usualy used when drawing."
[shape position prev-point prev-handler]
(let [command (next-node shape position prev-point prev-handler)]
(-> shape
(update :content (fnil conj []) command)
(update-selrect))))
(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)]
(cond-> {}
:always
(update index assoc cx dx cy dy)
(and match-opposite? opposite-index)
(update opposite-index assoc ocx (- dx) ocy (- dy)))))
(defn end-path-event? [{:keys [type shift] :as event}]
(or (= (ptk/type event) ::finish-path)
(= (ptk/type event) :esc-pressed)
(= event :interrupt) ;; ESC
(and (ms/mouse-double-click? event))))
(defn generate-path-changes [page-id shape old-content new-content]
(us/verify ::content old-content)
(us/verify ::content new-content)
(let [shape-id (:id shape)
[old-points old-selrect] (points->components shape old-content)
[new-points new-selrect] (points->components shape new-content)
rch [{:type :mod-obj
:id shape-id
:page-id page-id
:operations [{:type :set :attr :content :val new-content}
{:type :set :attr :selrect :val new-selrect}
{:type :set :attr :points :val new-points}]}
{:type :reg-objects
:page-id page-id
:shapes [shape-id]}]
uch [{:type :mod-obj
:id shape-id
:page-id page-id
:operations [{:type :set :attr :content :val old-content}
{:type :set :attr :selrect :val old-selrect}
{:type :set :attr :points :val old-points}]}
{:type :reg-objects
:page-id page-id
:shapes [shape-id]}]]
[rch uch]))
(defn clean-edit-state
[state]
(dissoc state :last-point :prev-handler :drag-handler :preview))
(defn dragging? [start zoom]
(fn [current]
(>= (gpt/distance start current) (/ drag-threshold zoom))))
(defn drag-stream [to-stream]
(let [start @ms/mouse-position
zoom (get-in @st/state [:workspace-local :zoom] 1)
mouse-up (->> st/stream (rx/filter #(ms/mouse-up? %)))]
(->> ms/mouse-position
(rx/take-until mouse-up)
(rx/filter (dragging? start zoom))
(rx/take 1)
(rx/merge-map (fn [] to-stream)))))
(defn position-stream []
(->> 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? %))))))
;; EVENTS
(defn init-path []
(ptk/reify ::init-path))
(defn finish-path [source]
(ptk/reify ::finish-path
ptk/UpdateEvent
(update [_ state]
(let [id (get-path-id state)]
(-> state
(update-in [:workspace-local :edit-path id] clean-edit-state))))))
(defn preview-next-point [{:keys [x y shift?]}]
(ptk/reify ::preview-next-point
ptk/UpdateEvent
(update [_ state]
(let [id (get-path-id state)
fix-angle? shift?
last-point (get-in state [:workspace-local :edit-path id :last-point])
position (cond-> (gpt/point x y)
fix-angle? (position-fixed-angle last-point))
shape (get-in state (get-path state))
{:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id])
command (next-node shape position last-point prev-handler)]
(assoc-in state [:workspace-local :edit-path id :preview] command)))))
(defn add-node [{:keys [x y shift?]}]
(ptk/reify ::add-node
ptk/UpdateEvent
(update [_ state]
(let [id (get-path-id state)
fix-angle? shift?
{:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id])
position (cond-> (gpt/point x y)
fix-angle? (position-fixed-angle last-point))]
(if-not (= last-point position)
(-> state
(assoc-in [:workspace-local :edit-path id :last-point] position)
(update-in [:workspace-local :edit-path id] dissoc :prev-handler)
(update-in [:workspace-local :edit-path id] dissoc :preview)
(update-in (get-path state) 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 (get-path state :content))
index (dec (count content))
command (get-in state (get-path state :content index :command))
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))))]
(cond-> state
(= command :line-to)
(update-in (get-path state :content index) make-curve))))))
(defn drag-handler [{:keys [x y alt? shift?]}]
(ptk/reify ::drag-handler
ptk/UpdateEvent
(update [_ state]
(let [id (get-path-id state)
shape (get-in state (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? (position-fixed-angle node-position))
{dx :x dy :y} (gpt/subtract handler-position node-position)
match-opposite? (not alt?)
modifiers (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))))))
(defn finish-drag []
(ptk/reify ::finish-drag
ptk/UpdateEvent
(update [_ state]
(let [id (get-path-id state)
modifiers (get-in state [:workspace-local :edit-path id :content-modifiers])
handler (get-in state [:workspace-local :edit-path id :drag-handler])]
(-> state
(update-in (get-path state :content) ugp/apply-content-modifiers modifiers)
(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)
(update-in (get-path state) update-selrect))))
ptk/WatchEvent
(watch [_ state stream]
(let [id (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))))))
(declare close-path-drag-end)
(defn close-path-drag-start [position]
(ptk/reify ::close-path-drag-start
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-path-id state)
zoom (get-in state [:workspace-local :zoom])
start-position @ms/mouse-position
stop-stream
(->> stream (rx/filter #(or (end-path-event? %)
(ms/mouse-up? %))))
drag-events-stream
(->> (position-stream)
(rx/take-until stop-stream)
(rx/map #(drag-handler %)))]
(rx/concat
(rx/of (add-node position))
(drag-stream
(rx/concat
(rx/of (start-drag-handler))
drag-events-stream
(rx/of (finish-drag))
(rx/of (close-path-drag-end))))
(rx/of (finish-path "close-path")))))))
(defn close-path-drag-end []
(ptk/reify ::close-path-drag-end
ptk/UpdateEvent
(update [_ state]
(let [id (get-path-id state)]
(update-in state [:workspace-local :edit-path id] dissoc :prev-handler)))))
(defn path-pointer-enter [position]
(ptk/reify ::path-pointer-enter
ptk/UpdateEvent
(update [_ state]
(let [id (get-path-id state)]
(update-in state [:workspace-local :edit-path id :hover-points] (fnil conj #{}) position)))))
(defn path-pointer-leave [position]
(ptk/reify ::path-pointer-leave
ptk/UpdateEvent
(update [_ state]
(let [id (get-path-id state)]
(update-in state [:workspace-local :edit-path id :hover-points] disj position)))))
(defn start-path-from-point [position]
(ptk/reify ::start-path-from-point
ptk/WatchEvent
(watch [_ state stream]
(let [start-point @ms/mouse-position
zoom (get-in state [:workspace-local :zoom])
mouse-up (->> stream (rx/filter #(or (end-path-event? %)
(ms/mouse-up? %))))
drag-events (->> ms/mouse-position
(rx/take-until mouse-up)
(rx/map #(drag-handler %)))]
(rx/concat
(rx/of (add-node position))
(drag-stream
(rx/concat
(rx/of (start-drag-handler))
drag-events
(rx/of (finish-drag)))))))))
(defn make-corner []
(ptk/reify ::make-corner
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-path-id state)
page-id (:current-page-id state)
shape (get-in state (get-path state))
selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
new-content (reduce ugp/make-corner-point (:content shape) selected-points)
[rch uch] (generate-path-changes page-id shape (:content shape) new-content)]
(rx/of (dwc/commit-changes rch uch {:commit-local? true}))))))
(defn make-curve []
(ptk/reify ::make-curve
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-path-id state)
page-id (:current-page-id state)
shape (get-in state (get-path state))
selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
new-content (reduce ugp/make-curve-point (:content shape) selected-points)
[rch uch] (generate-path-changes page-id shape (:content shape) new-content)]
(rx/of (dwc/commit-changes rch uch {:commit-local? true}))))))
(defn path-handler-enter [index prefix]
(ptk/reify ::path-handler-enter
ptk/UpdateEvent
(update [_ state]
(let [id (get-path-id state)]
(update-in state [:workspace-local :edit-path id :hover-handlers] (fnil conj #{}) [index prefix])))))
(defn path-handler-leave [index prefix]
(ptk/reify ::path-handler-leave
ptk/UpdateEvent
(update [_ state]
(let [id (get-path-id state)]
(update-in state [:workspace-local :edit-path id :hover-handlers] disj [index prefix])))))
;; EVENT STREAMS
(defn make-drag-stream
[stream down-event zoom]
(let [mouse-up (->> stream (rx/filter #(or (end-path-event? %)
(ms/mouse-up? %))))
drag-events (->> (position-stream)
(rx/take-until mouse-up)
(rx/map #(drag-handler %)))]
(rx/concat
(rx/of (add-node down-event))
(drag-stream
(rx/concat
(rx/of (start-drag-handler))
drag-events
(rx/of (finish-drag)))))))
(defn make-node-events-stream
[stream]
(->> stream
(rx/filter (ptk/type? ::close-path-drag-start))
(rx/take 1)
(rx/merge-map #(rx/empty))))
;; MAIN ENTRIES
(defn handle-drawing-path
[id]
(ptk/reify ::handle-drawing-path
ptk/UpdateEvent
(update [_ state]
(let [id (get-path-id state)]
(-> state
(assoc-in [:workspace-local :edit-path id :edit-mode] :draw))))
ptk/WatchEvent
(watch [_ state stream]
(let [zoom (get-in state [:workspace-local :zoom])
mouse-down (->> stream (rx/filter ms/mouse-down?))
end-path-events (->> stream (rx/filter end-path-event?))
;; Mouse move preview
mousemove-events
(->> (position-stream)
(rx/take-until end-path-events)
(rx/map #(preview-next-point %)))
;; From mouse down we can have: click, drag and double click
mousedown-events
(->> mouse-down
(rx/take-until end-path-events)
(rx/with-latest merge (position-stream))
;; We change to the stream that emits the first event
(rx/switch-map
#(rx/race (make-node-events-stream stream)
(make-drag-stream stream % zoom))))]
(rx/concat
(rx/of (init-path))
(rx/merge mousemove-events
mousedown-events)
(rx/of (finish-path "after-events")))))))
(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-point
ptk/UpdateEvent
(update [_ state]
(let [content (get-in state (get-path state :content))
[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)]
(cond-> state
:always
(update-in [:workspace-local :edit-path id :content-modifiers index] assoc
cx dx cy dy)
(and match-opposite? opposite-index)
(update-in [:workspace-local :edit-path id :content-modifiers opposite-index] assoc
ocx (- dx) ocy (- dy)))))))
(defn apply-content-modifiers []
(ptk/reify ::apply-content-modifiers
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-path-id state)
page-id (:current-page-id state)
shape (get-in state (get-path state))
content-modifiers (get-in state [:workspace-local :edit-path id :content-modifiers])
new-content (ugp/apply-content-modifiers (:content shape) content-modifiers)
[rch uch] (generate-path-changes page-id shape (:content shape) new-content)]
(rx/of (dwc/commit-changes rch uch {:commit-local? true})
(fn [state] (update-in state [:workspace-local :edit-path id] dissoc :content-modifiers)))))))
(defn save-path-content []
(ptk/reify ::save-path-content
ptk/UpdateEvent
(update [_ state]
(let [content (get-in state (get-path state :content))
content (if (= (-> content last :command) :move-to)
(into [] (take (dec (count content)) content))
content)]
(assoc-in state (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 (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))))))
(declare start-draw-mode)
(defn check-changed-content []
(ptk/reify ::check-changed-content
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-path-id state)
content (get-in state (get-path state :content))
old-content (get-in state [:workspace-local :edit-path id :old-content])
mode (get-in state [:workspace-local :edit-path id :edit-mode])]
(cond
(not= content old-content) (rx/of (save-path-content)
(start-draw-mode))
(= mode :draw) (rx/of :interrupt)
:else (rx/of (finish-path "changed-content")))))))
(defn move-path-point [start-point end-point]
(ptk/reify ::move-point
ptk/UpdateEvent
(update [_ state]
(let [id (get-path-id state)
content (get-in state (get-path state :content))
{dx :x dy :y} (gpt/subtract end-point start-point)
handler-indices (-> (ugp/content->handlers content)
(get start-point))
command-for-point (fn [[index command]]
(let [point (ugp/command->point command)]
(= point start-point)))
point-indices (->> (d/enumerate content)
(filter command-for-point)
(map first))
point-reducer (fn [modifiers index]
(-> modifiers
(assoc-in [index :x] dx)
(assoc-in [index :y] dy)))
handler-reducer (fn [modifiers [index prefix]]
(let [cx (d/prefix-keyword prefix :x)
cy (d/prefix-keyword prefix :y)]
(-> modifiers
(assoc-in [index cx] dx)
(assoc-in [index cy] dy))))
modifiers (as-> (get-in state [:workspace-local :edit-path id :content-modifiers] {}) $
(reduce point-reducer $ point-indices)
(reduce handler-reducer $ handler-indices))]
(assoc-in state [:workspace-local :edit-path id :content-modifiers] modifiers)))))
(defn start-move-path-point
[position]
(ptk/reify ::start-move-path-point
ptk/WatchEvent
(watch [_ state stream]
(let [start-position @ms/mouse-position
stopper (->> stream (rx/filter ms/mouse-up?))
zoom (get-in state [:workspace-local :zoom])]
(drag-stream
(rx/concat
(->> ms/mouse-position
(rx/take-until stopper)
(rx/map #(move-path-point position %)))
(rx/of (apply-content-modifiers))))))))
(defn start-move-handler
[index prefix]
(ptk/reify ::start-move-handler
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-in state [:workspace-local :edition])
cx (d/prefix-keyword prefix :x)
cy (d/prefix-keyword prefix :y)
start-point @ms/mouse-position
modifiers (get-in state [:workspace-local :edit-path id :content-modifiers])
start-delta-x (get-in modifiers [index cx] 0)
start-delta-y (get-in modifiers [index cy] 0)
content (get-in state (get-path state :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)) (ugp/command->point))
handler (-> content (get index) (ugp/get-handler 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))]
(drag-stream
(rx/concat
(->> (position-stream)
(rx/take-until (->> stream (rx/filter ms/mouse-up?)))
(rx/map
(fn [{:keys [x y alt? shift?]}]
(let [pos (cond-> (gpt/point x y)
shift? (position-fixed-angle point))]
(modify-handler
id
index
prefix
(+ start-delta-x (- (:x pos) (:x start-point)))
(+ start-delta-y (- (:y pos) (:y start-point)))
(and (not alt?) match-opposite?))))))
(rx/concat (rx/of (apply-content-modifiers)))))))))
(defn start-draw-mode []
(ptk/reify ::start-draw-mode
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])
page-id (:current-page-id state)
old-content (get-in state [:workspace-data :pages-index page-id :objects id :content])]
(-> state
(assoc-in [:workspace-local :edit-path id :old-content] old-content))))
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-in state [:workspace-local :edition])
edit-mode (get-in state [:workspace-local :edit-path id :edit-mode])]
(if (= :draw edit-mode)
(rx/concat
(rx/of (handle-drawing-path id))
(->> stream
(rx/filter (ptk/type? ::finish-path))
(rx/take 1)
(rx/merge-map #(rx/of (check-changed-content)))))
(rx/empty))))))
(defn change-edit-mode [mode]
(ptk/reify ::change-edit-mode
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])]
(cond-> state
id (assoc-in [:workspace-local :edit-path id :edit-mode] mode))))
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-path-id state)]
(cond
(and id (= :move mode)) (rx/of (finish-path "change-edit-mode"))
(and id (= :draw mode)) (rx/of (start-draw-mode))
:else (rx/empty))))))
(defn select-handler [index type]
(ptk/reify ::select-handler
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])]
(-> state
(update-in [:workspace-local :edit-path id :selected-handlers] (fnil conj #{}) [index type]))))))
(defn select-node [position]
(ptk/reify ::select-node
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])]
(-> state
(assoc-in [:workspace-local :edit-path id :selected-points] #{position}))))))
(defn deselect-node [position]
(ptk/reify ::deselect-node
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])]
(-> state
(update-in [:workspace-local :edit-path id :selected-points] (fnil disj #{}) position))))))
(defn add-to-selection-handler [index type]
(ptk/reify ::add-to-selection-handler
ptk/UpdateEvent
(update [_ state]
state)))
(defn add-to-selection-node [index]
(ptk/reify ::add-to-selection-node
ptk/UpdateEvent
(update [_ state]
state)))
(defn remove-from-selection-handler [index]
(ptk/reify ::remove-from-selection-handler
ptk/UpdateEvent
(update [_ state]
state)))
(defn remove-from-selection-node [index]
(ptk/reify ::remove-from-selection-handler
ptk/UpdateEvent
(update [_ state]
state)))
(defn deselect-all []
(ptk/reify ::deselect-all
ptk/UpdateEvent
(update [_ state]
(let [id (get-path-id state)]
(-> state
(assoc-in [:workspace-local :edit-path id :selected-handlers] #{})
(assoc-in [:workspace-local :edit-path id :selected-points] #{}))))))
(defn setup-frame-path []
(ptk/reify ::setup-frame-path
ptk/UpdateEvent
(update [_ state]
(let [objects (dwc/lookup-page-objects state)
content (get-in state [:workspace-drawing :object :content] [])
position (get-in content [0 :params] nil)
frame-id (cp/frame-id-by-position objects position)]
(-> state
(assoc-in [:workspace-drawing :object :frame-id] frame-id))))))
(defn handle-new-shape-result [shape-id]
(ptk/reify ::handle-new-shape-result
ptk/UpdateEvent
(update [_ state]
(let [content (get-in state [:workspace-drawing :object :content] [])]
(us/verify ::content content)
(if (> (count content) 1)
(assoc-in state [:workspace-drawing :object :initialized?] true)
state)))
ptk/WatchEvent
(watch [_ state stream]
(->> (rx/of (setup-frame-path)
common/handle-finish-drawing
(dwc/start-edition-mode shape-id)
(change-edit-mode :draw))))))
(defn handle-new-shape
"Creates a new path shape"
[]
(ptk/reify ::handle-new-shape
ptk/WatchEvent
(watch [_ state stream]
(let [shape-id (get-in state [:workspace-drawing :object :id])]
(rx/concat
(rx/of (handle-drawing-path shape-id))
(->> stream
(rx/filter (ptk/type? ::finish-path))
(rx/take 1)
(rx/observe-on :async)
(rx/map #(handle-new-shape-result shape-id))))))))
(defn stop-path-edit []
(ptk/reify ::stop-path-edit
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])]
(update state :workspace-local dissoc :edit-path id)))))
(defn start-path-edit
[id]
(ptk/reify ::start-path-edit
ptk/UpdateEvent
(update [_ state]
(let [edit-path (get-in state [:workspace-local :edit-path id])]
(cond-> state
(or (not edit-path) (= :draw (:edit-mode edit-path)))
(assoc-in [:workspace-local :edit-path id] {:edit-mode :move
:selected #{}
:snap-toggled true})
(and (some? edit-path) (= :move (:edit-mode edit-path)))
(assoc-in [:workspace-local :edit-path id :edit-mode] :draw))))
ptk/WatchEvent
(watch [_ state stream]
(let [mode (get-in state [:workspace-local :edit-path id :edit-mode])]
(rx/concat
(rx/of (change-edit-mode mode))
(->> stream
(rx/take-until (->> stream (rx/filter (ptk/type? ::start-path-edit))))
(rx/filter #(= % :interrupt))
(rx/take 1)
(rx/map #(stop-path-edit))))))))

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

@ -0,0 +1,43 @@
;; 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
(:require
[app.common.data :as d]
[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]))
;; Drawing
(d/export drawing/handle-new-shape)
(d/export drawing/start-path-from-point)
(d/export drawing/close-path-drag-start)
(d/export drawing/change-edit-mode)
;; Edition
(d/export edition/start-move-handler)
(d/export edition/start-move-path-point)
(d/export edition/start-path-edit)
;; Selection
(d/export selection/handle-selection)
(d/export selection/select-node)
(d/export selection/path-handler-enter)
(d/export selection/path-handler-leave)
(d/export selection/path-pointer-enter)
(d/export selection/path-pointer-leave)
;; Path tools
(d/export tools/make-curve)
(d/export tools/make-corner)
(d/export tools/add-node)
(d/export tools/remove-node)
(d/export tools/merge-nodes)
(d/export tools/join-nodes)
(d/export tools/separate-nodes)
(d/export tools/toggle-snap)

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

@ -0,0 +1,68 @@
;; 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.changes
(:require
[app.common.spec :as us]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.path.helpers :as helpers]
[app.main.data.workspace.path.spec :as spec]
[app.main.data.workspace.path.state :as st]
[beicon.core :as rx]
[potok.core :as ptk]))
(defn generate-path-changes
"Generates content changes and the undos for the content given"
[page-id shape old-content new-content]
(us/verify ::spec/content old-content)
(us/verify ::spec/content new-content)
(let [shape-id (:id shape)
[old-points old-selrect] (helpers/content->points+selrect shape old-content)
[new-points new-selrect] (helpers/content->points+selrect shape new-content)
rch [{:type :mod-obj
:id shape-id
:page-id page-id
:operations [{:type :set :attr :content :val new-content}
{:type :set :attr :selrect :val new-selrect}
{:type :set :attr :points :val new-points}]}
{:type :reg-objects
:page-id page-id
:shapes [shape-id]}]
uch [{:type :mod-obj
:id shape-id
:page-id page-id
:operations [{:type :set :attr :content :val old-content}
{:type :set :attr :selrect :val old-selrect}
{:type :set :attr :points :val old-points}]}
{:type :reg-objects
:page-id page-id
: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)))
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))))))

25
frontend/src/app/main/data/workspace/path/common.cljs Normal file
View file

@ -0,0 +1,25 @@
;; 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.common
(:require
[app.main.data.workspace.path.state :as st]
[potok.core :as ptk]))
(defn init-path []
(ptk/reify ::init-path))
(defn clean-edit-state
[state]
(dissoc state :last-point :prev-handler :drag-handler :preview))
(defn finish-path [source]
(ptk/reify ::finish-path
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
(-> state
(update-in [:workspace-local :edit-path id] clean-edit-state))))))

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

@ -0,0 +1,357 @@
;; 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.drawing
(:require
[app.common.geom.point :as gpt]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.drawing.common :as dwdc]
[app.main.data.workspace.path.changes :as changes]
[app.main.data.workspace.path.common :as common]
[app.main.data.workspace.path.helpers :as helpers]
[app.main.data.workspace.path.spec :as spec]
[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.streams :as ms]
[app.util.geom.path :as ugp]
[beicon.core :as rx]
[potok.core :as ptk]))
(declare change-edit-mode)
(defn preview-next-point [{:keys [x y shift?]}]
(ptk/reify ::preview-next-point
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)
fix-angle? shift?
last-point (get-in state [:workspace-local :edit-path id :last-point])
position (cond-> (gpt/point x y)
fix-angle? (helpers/position-fixed-angle last-point))
shape (get-in state (st/get-path state))
{:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id])
command (helpers/next-node shape position last-point prev-handler)]
(assoc-in state [:workspace-local :edit-path id :preview] command)))))
(defn add-node [{:keys [x y shift?]}]
(ptk/reify ::add-node
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)
fix-angle? shift?
{:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id])
position (cond-> (gpt/point x y)
fix-angle? (helpers/position-fixed-angle last-point))]
(if-not (= last-point position)
(-> state
(assoc-in [:workspace-local :edit-path id :last-point] position)
(update-in [:workspace-local :edit-path id] dissoc :prev-handler)
(update-in [:workspace-local :edit-path id] dissoc :preview)
(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))
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))))]
(cond-> state
(= command :line-to)
(update-in (st/get-path state :content index) make-curve))))))
(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))))))
(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])
handler (get-in state [:workspace-local :edit-path id :drag-handler])]
(-> state
(update-in (st/get-path state :content) ugp/apply-content-modifiers modifiers)
(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)
(update-in (st/get-path state) helpers/update-selrect))))
ptk/WatchEvent
(watch [_ state stream]
(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))))))
(declare close-path-drag-end)
(defn close-path-drag-start [position]
(ptk/reify ::close-path-drag-start
ptk/WatchEvent
(watch [_ state stream]
(let [id (st/get-path-id state)
zoom (get-in state [:workspace-local :zoom])
start-position @ms/mouse-position
stop-stream
(->> stream (rx/filter #(or (helpers/end-path-event? %)
(ms/mouse-up? %))))
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)
drag-events-stream
(->> (streams/position-stream snap-toggled points)
(rx/take-until stop-stream)
(rx/map #(drag-handler %)))]
(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))))
(rx/of (common/finish-path "close-path")))))))
(defn close-path-drag-end []
(ptk/reify ::close-path-drag-end
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
(update-in state [:workspace-local :edit-path id] dissoc :prev-handler)))))
(defn start-path-from-point [position]
(ptk/reify ::start-path-from-point
ptk/WatchEvent
(watch [_ state stream]
(let [start-point @ms/mouse-position
zoom (get-in state [:workspace-local :zoom])
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)
id (st/get-path-id state)
snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled])
drag-events (->> (streams/position-stream snap-toggled points)
(rx/take-until mouse-up)
(rx/map #(drag-handler %)))]
(rx/concat
(rx/of (add-node position))
(streams/drag-stream
(rx/concat
(rx/of (start-drag-handler))
drag-events
(rx/of (finish-drag)))))))))
(defn make-node-events-stream
[stream]
(->> stream
(rx/filter (ptk/type? ::close-path-drag-start))
(rx/take 1)
(rx/merge-map #(rx/empty))))
(defn make-drag-stream
[stream snap-toggled zoom points down-event]
(let [mouse-up (->> stream (rx/filter #(or (helpers/end-path-event? %)
(ms/mouse-up? %))))
drag-events (->> (streams/position-stream snap-toggled points)
(rx/take-until mouse-up)
(rx/map #(drag-handler %)))]
(rx/concat
(rx/of (add-node down-event))
(streams/drag-stream
(rx/concat
(rx/of (start-drag-handler))
drag-events
(rx/of (finish-drag)))))))
(defn handle-drawing-path
[id]
(ptk/reify ::handle-drawing-path
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
(-> state
(assoc-in [:workspace-local :edit-path id :edit-mode] :draw))))
ptk/WatchEvent
(watch [_ state stream]
(let [zoom (get-in state [:workspace-local :zoom])
mouse-down (->> stream (rx/filter ms/mouse-down?))
end-path-events (->> stream (rx/filter helpers/end-path-event?))
content (get-in state (st/get-path state :content))
points (ugp/content->points content)
id (st/get-path-id state)
snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled])
;; Mouse move preview
mousemove-events
(->> (streams/position-stream snap-toggled points)
(rx/take-until end-path-events)
(rx/map #(preview-next-point %)))
;; From mouse down we can have: click, drag and double click
mousedown-events
(->> mouse-down
(rx/take-until end-path-events)
(rx/with-latest merge (streams/position-stream snap-toggled points))
;; We change to the stream that emits the first event
(rx/switch-map
#(rx/race (make-node-events-stream stream)
(make-drag-stream stream snap-toggled zoom points %))))]
(rx/concat
(rx/of (common/init-path))
(rx/merge mousemove-events
mousedown-events)
(rx/of (common/finish-path "after-events")))))))
(defn setup-frame-path []
(ptk/reify ::setup-frame-path
ptk/UpdateEvent
(update [_ state]
(let [objects (dwc/lookup-page-objects state)
content (get-in state [:workspace-drawing :object :content] [])
position (get-in content [0 :params] nil)
frame-id (cp/frame-id-by-position objects position)]
(-> state
(assoc-in [:workspace-drawing :object :frame-id] frame-id))))))
(defn handle-new-shape-result [shape-id]
(ptk/reify ::handle-new-shape-result
ptk/UpdateEvent
(update [_ state]
(let [content (get-in state [:workspace-drawing :object :content] [])]
(us/verify ::spec/content content)
(if (> (count content) 1)
(assoc-in state [:workspace-drawing :object :initialized?] true)
state)))
ptk/WatchEvent
(watch [_ state stream]
(->> (rx/of (setup-frame-path)
dwdc/handle-finish-drawing
(dwc/start-edition-mode shape-id)
(change-edit-mode :draw))))))
(defn handle-new-shape
"Creates a new path shape"
[]
(ptk/reify ::handle-new-shape
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
(-> state
(assoc-in [:workspace-local :edit-path id :snap-toggled] true))))
ptk/WatchEvent
(watch [_ state stream]
(let [shape-id (get-in state [:workspace-drawing :object :id])]
(rx/concat
(rx/of (handle-drawing-path shape-id))
(->> stream
(rx/filter (ptk/type? ::common/finish-path))
(rx/take 1)
(rx/observe-on :async)
(rx/map #(handle-new-shape-result shape-id))))))))
(declare check-changed-content)
(defn start-draw-mode []
(ptk/reify ::start-draw-mode
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])
page-id (:current-page-id state)
old-content (get-in state [:workspace-data :pages-index page-id :objects id :content])]
(-> state
(assoc-in [:workspace-local :edit-path id :old-content] old-content))))
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-in state [:workspace-local :edition])
edit-mode (get-in state [:workspace-local :edit-path id :edit-mode])]
(if (= :draw edit-mode)
(rx/concat
(rx/of (handle-drawing-path id))
(->> stream
(rx/filter (ptk/type? ::common/finish-path))
(rx/take 1)
(rx/merge-map #(rx/of (check-changed-content)))))
(rx/empty))))))
(defn check-changed-content []
(ptk/reify ::check-changed-content
ptk/WatchEvent
(watch [_ state stream]
(let [id (st/get-path-id state)
content (get-in state (st/get-path state :content))
old-content (get-in state [:workspace-local :edit-path id :old-content])
mode (get-in state [:workspace-local :edit-path id :edit-mode])]
(cond
(not= content old-content) (rx/of (changes/save-path-content)
(start-draw-mode))
(= mode :draw) (rx/of :interrupt)
:else (rx/of (common/finish-path "changed-content")))))))
(defn change-edit-mode [mode]
(ptk/reify ::change-edit-mode
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])]
(cond-> state
id (assoc-in [:workspace-local :edit-path id :edit-mode] mode))))
ptk/WatchEvent
(watch [_ state stream]
(let [id (st/get-path-id state)]
(cond
(and id (= :move mode)) (rx/of (common/finish-path "change-edit-mode"))
(and id (= :draw mode)) (rx/of (start-draw-mode))
:else (rx/empty))))))

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

@ -0,0 +1,236 @@
;; 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.edition
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.math :as mth]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.path.changes :as changes]
[app.main.data.workspace.path.common :as common]
[app.main.data.workspace.path.helpers :as helpers]
[app.main.data.workspace.path.selection :as selection]
[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.streams :as ms]
[app.util.geom.path :as ugp]
[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))
[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)))))))
(defn apply-content-modifiers []
(ptk/reify ::apply-content-modifiers
ptk/WatchEvent
(watch [_ state stream]
(let [id (st/get-path-id state)
page-id (:current-page-id state)
shape (get-in state (st/get-path state))
content-modifiers (get-in state [:workspace-local :edit-path id :content-modifiers])
content (:content shape)
new-content (ugp/apply-content-modifiers content content-modifiers)
old-points (->> content ugp/content->points)
new-points (->> new-content ugp/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)]
(rx/of (dwc/commit-changes rch uch {:commit-local? true})
(selection/update-selection point-change)
(fn [state] (update-in state [:workspace-local :edit-path id] dissoc :content-modifiers :moving-nodes :moving-handler)))))))
(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]]
modify-point
(fn [modifiers index]
(-> modifiers
(update index assoc :x dx :y dy)))
modify-handler
(fn [modifiers [index prefix]]
(let [cx (d/prefix-keyword prefix :x)
cy (d/prefix-keyword prefix :y)]
(-> modifiers
(update index assoc cx dx cy dy))))]
(as-> modifiers $
(reduce modify-point $ point-indices)
(reduce modify-handler $ handler-indices))))]
(ptk/reify ::move-point
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)
content (get-in state (st/get-path state :content))
delta (gpt/subtract to-point from-point)
modifiers-reducer (partial modify-content-point content delta)
points (get-in state [:workspace-local :edit-path id :selected-points] #{})
modifiers (get-in state [:workspace-local :edit-path id :content-modifiers] {})
modifiers (->> points
(reduce modifiers-reducer {}))]
(-> state
(assoc-in [:workspace-local :edit-path id :moving-nodes] true)
(assoc-in [:workspace-local :edit-path id :content-modifiers] modifiers)))))))
(declare drag-selected-points)
(defn start-move-path-point
[position shift?]
(ptk/reify ::start-move-path-point
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-in state [:workspace-local :edition])
selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
selected? (contains? selected-points position)]
(streams/drag-stream
(rx/of
(when-not selected? (selection/select-node position shift? "drag"))
(drag-selected-points @ms/mouse-position))
(rx/of (selection/select-node position shift? "click")))))))
(defn drag-selected-points
[start-position]
(ptk/reify ::drag-selected-points
ptk/WatchEvent
(watch [_ state stream]
(let [stopper (->> stream (rx/filter ms/mouse-up?))
zoom (get-in state [:workspace-local :zoom])
id (get-in state [:workspace-local :edition])
snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled])
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)]
(rx/concat
;; This stream checks the consecutive mouse positions to do the draging
(->> points
(streams/move-points-stream snap-toggled start-position selected-points)
(rx/take-until stopper)
(rx/map #(move-selected-path-point start-position %)))
(rx/of (apply-content-modifiers)))))))
(defn start-move-handler
[index prefix]
(ptk/reify ::start-move-handler
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-in state [:workspace-local :edition])
cx (d/prefix-keyword prefix :x)
cy (d/prefix-keyword prefix :y)
start-point @ms/mouse-position
modifiers (get-in state [:workspace-local :edit-path id :content-modifiers])
start-delta-x (get-in modifiers [index cx] 0)
start-delta-y (get-in modifiers [index cy] 0)
content (get-in state (st/get-path state :content))
points (ugp/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)) (ugp/command->point))
handler (-> content (get index) (ugp/get-handler 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)
(rx/take-until (->> stream (rx/filter ms/mouse-up?)))
(rx/map
(fn [{:keys [x y alt? shift?]}]
(let [pos (cond-> (gpt/point x y)
shift? (helpers/position-fixed-angle point))]
(modify-handler
id
index
prefix
(+ start-delta-x (- (:x pos) (:x start-point)))
(+ start-delta-y (- (:y pos) (:y start-point)))
(and (not alt?) match-opposite?))))))
(rx/concat (rx/of (apply-content-modifiers)))))))))
(declare stop-path-edit)
(defn start-path-edit
[id]
(ptk/reify ::start-path-edit
ptk/UpdateEvent
(update [_ state]
(let [edit-path (get-in state [:workspace-local :edit-path id])]
(cond-> state
(or (not edit-path) (= :draw (:edit-mode edit-path)))
(assoc-in [:workspace-local :edit-path id] {:edit-mode :move
:selected #{}
:snap-toggled true})
(and (some? edit-path) (= :move (:edit-mode edit-path)))
(assoc-in [:workspace-local :edit-path id :edit-mode] :draw))))
ptk/WatchEvent
(watch [_ state stream]
(let [mode (get-in state [:workspace-local :edit-path id :edit-mode])]
(rx/concat
(rx/of (drawing/change-edit-mode mode))
(->> stream
(rx/take-until (->> stream (rx/filter (ptk/type? ::start-path-edit))))
(rx/filter #(= % :interrupt))
(rx/take 1)
(rx/map #(stop-path-edit))))))))
(defn stop-path-edit []
(ptk/reify ::stop-path-edit
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])]
(update state :workspace-local dissoc :edit-path id)))))

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

@ -0,0 +1,120 @@
;; 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.helpers
(:require
[app.common.data :as d]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[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]
[potok.core :as ptk]))
;; CONSTANTS
(defonce enter-keycode 13)
(defn end-path-event? [{:keys [type shift] :as event}]
(or (= (ptk/type event) ::common/finish-path)
(= (ptk/type event) :esc-pressed)
(= event :interrupt) ;; ESC
(and (ms/mouse-double-click? event))))
(defn content->points+selrect
"Given the content of a shape, calculate its points and selrect"
[shape content]
(let [transform (:transform shape (gmt/matrix))
transform-inverse (:transform-inverse shape (gmt/matrix))
center (gsh/center-shape shape)
base-content (gsh/transform-content
content
(gmt/transform-in center transform-inverse))
;; Calculates the new selrect with points given the old center
points (-> (gsh/content->selrect base-content)
(gsh/rect->points)
(gsh/transform-points center (:transform shape (gmt/matrix))))
points-center (gsh/center-points points)
;; Points is now the selrect but the center is different so we can create the selrect
;; through points
selrect (-> points
(gsh/transform-points points-center (:transform-inverse shape (gmt/matrix)))
(gsh/points->selrect))]
[points selrect]))
(defn update-selrect
"Updates the selrect and points for a path"
[shape]
(if (= (:rotation shape 0) 0)
(let [content (:content shape)
selrect (gsh/content->selrect content)
points (gsh/rect->points selrect)]
(assoc shape :points points :selrect selrect))
(let [content (:content shape)
[points selrect] (content->points+selrect shape content)]
(assoc shape :points points :selrect selrect))))
(defn closest-angle
[angle]
(cond
(or (> angle 337.5) (<= angle 22.5)) 0
(and (> angle 22.5) (<= angle 67.5)) 45
(and (> angle 67.5) (<= angle 112.5)) 90
(and (> angle 112.5) (<= angle 157.5)) 135
(and (> angle 157.5) (<= angle 202.5)) 180
(and (> angle 202.5) (<= angle 247.5)) 225
(and (> angle 247.5) (<= angle 292.5)) 270
(and (> angle 292.5) (<= angle 337.5)) 315))
(defn position-fixed-angle [point from-point]
(if (and from-point point)
(let [angle (mod (+ 360 (- (gpt/angle point from-point))) 360)
to-angle (closest-angle angle)
distance (gpt/distance point from-point)]
(gpt/angle->point from-point (mth/radians to-angle) distance))
point))
(defn next-node
"Calculates the next-node to be inserted."
[shape position prev-point prev-handler]
(let [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)}
:else {:command :move-to
:params position})))
(defn append-node
"Creates a new node in the path. Usualy used when drawing."
[shape position prev-point prev-handler]
(let [command (next-node shape position prev-point prev-handler)]
(-> shape
(update :content (fnil conj []) command)
(update-selrect))))
(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)]
(cond-> {}
:always
(update index assoc cx dx cy dy)
(and match-opposite? opposite-index)
(update opposite-index assoc ocx (- dx) ocy (- dy)))))

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

@ -0,0 +1,167 @@
;; 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.selection
(:require
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.path.state :as st]
[app.main.streams :as ms]
[beicon.core :as rx]
[potok.core :as ptk]))
(defn path-pointer-enter [position]
(ptk/reify ::path-pointer-enter
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
(update-in state [:workspace-local :edit-path id :hover-points] (fnil conj #{}) position)))))
(defn path-pointer-leave [position]
(ptk/reify ::path-pointer-leave
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
(update-in state [:workspace-local :edit-path id :hover-points] disj position)))))
(defn path-handler-enter [index prefix]
(ptk/reify ::path-handler-enter
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
(update-in state [:workspace-local :edit-path id :hover-handlers] (fnil conj #{}) [index prefix])))))
(defn path-handler-leave [index prefix]
(ptk/reify ::path-handler-leave
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
(update-in state [:workspace-local :edit-path id :hover-handlers] disj [index prefix])))))
(defn select-node-area [shift?]
(ptk/reify ::select-node-area
ptk/UpdateEvent
(update [_ state]
(let [selrect (get-in state [:workspace-local :selrect])
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 #{})
(comp (map (comp gpt/point :params))
(filter selected-point?))
content)]
(cond-> state
(some? id)
(assoc-in [:workspace-local :edit-path id :selected-points] positions))))))
(defn select-node [position shift? kk]
(ptk/reify ::select-node
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])
selected-points (or (get-in state [:workspace-local :edit-path id :selected-points]) #{})
selected-points (cond
(and shift? (contains? selected-points position))
(disj selected-points position)
shift?
(conj selected-points position)
:else
#{position})]
(cond-> state
(some? id)
(assoc-in [:workspace-local :edit-path id :selected-points] selected-points))))))
(defn deselect-node [position shift?]
(ptk/reify ::deselect-node
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])]
(-> state
(update-in [:workspace-local :edit-path id :selected-points] (fnil disj #{}) position))))))
(defn add-to-selection-handler [index type]
(ptk/reify ::add-to-selection-handler
ptk/UpdateEvent
(update [_ state]
state)))
(defn add-to-selection-node [index]
(ptk/reify ::add-to-selection-node
ptk/UpdateEvent
(update [_ state]
state)))
(defn remove-from-selection-handler [index]
(ptk/reify ::remove-from-selection-handler
ptk/UpdateEvent
(update [_ state]
state)))
(defn remove-from-selection-node [index]
(ptk/reify ::remove-from-selection-handler
ptk/UpdateEvent
(update [_ state]
state)))
(defn deselect-all []
(ptk/reify ::deselect-all
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
(-> state
(assoc-in [:workspace-local :edit-path id :selected-points] #{}))))))
(defn update-area-selection
[rect]
(ptk/reify ::update-area-selection
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :selrect] rect))))
(defn clear-area-selection
[]
(ptk/reify ::clear-area-selection
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local dissoc :selrect))))
(defn handle-selection
[shift?]
(letfn [(valid-rect? [{width :width height :height}]
(or (> width 10) (> height 10)))]
(ptk/reify ::handle-selection
ptk/WatchEvent
(watch [_ state stream]
(let [stop? (fn [event] (or (dwc/interrupt? event) (ms/mouse-up? event)))
stoper (->> stream (rx/filter stop?))
from-p @ms/mouse-position]
(rx/concat
(->> ms/mouse-position
(rx/take-until stoper)
(rx/map #(gsh/points->rect [from-p %]))
(rx/filter valid-rect?)
(rx/map update-area-selection))
(rx/of (select-node-area shift?)
(clear-area-selection))))))))
(defn update-selection
[point-change]
(ptk/reify ::update-selection
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)
selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
selected-points (into #{} (map point-change) selected-points)]
(-> state
(assoc-in [:workspace-local :edit-path id :selected-points] selected-points))))))

49
frontend/src/app/main/data/workspace/path/spec.cljs Normal file
View file

@ -0,0 +1,49 @@
;; 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.spec
(:require
[clojure.spec.alpha :as s]))
;; SCHEMAS
(s/def ::command #{:move-to
:line-to
:line-to-horizontal
:line-to-vertical
:curve-to
:smooth-curve-to
:quadratic-bezier-curve-to
:smooth-quadratic-bezier-curve-to
:elliptical-arc
:close-path})
(s/def :paths.params/x number?)
(s/def :paths.params/y number?)
(s/def :paths.params/c1x number?)
(s/def :paths.params/c1y number?)
(s/def :paths.params/c2x number?)
(s/def :paths.params/c2y number?)
(s/def ::relative? boolean?)
(s/def ::params
(s/keys :req-un [:path.params/x
:path.params/y]
:opt-un [:path.params/c1x
:path.params/c1y
:path.params/c2x
:path.params/c2y]))
(s/def ::content-entry
(s/keys :req-un [::command]
:req-opt [::params
::relative?]))
(s/def ::content
(s/coll-of ::content-entry :kind vector?))

29
frontend/src/app/main/data/workspace/path/state.cljs Normal file
View file

@ -0,0 +1,29 @@
;; 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.state
(:require
[app.common.data :as d]))
(defn get-path-id
"Retrieves the currently editing path id"
[state]
(or (get-in state [:workspace-local :edition])
(get-in state [:workspace-drawing :object :id])))
(defn get-path
"Retrieves the location of the path object and additionaly can pass
the arguments. This location can be used in get-in, assoc-in... functions"
[state & path]
(let [edit-id (get-in state [:workspace-local :edition])
page-id (:current-page-id state)]
(d/concat
(if edit-id
[:workspace-data :pages-index page-id :objects edit-id]
[:workspace-drawing :object])
path)))

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

@ -0,0 +1,118 @@
;; 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.streams
(:require
[app.main.data.workspace.path.helpers :as helpers]
[app.main.data.workspace.path.state :as state]
[app.common.geom.point :as gpt]
[app.main.store :as st]
[app.main.streams :as ms]
[beicon.core :as rx]
[potok.core :as ptk]
[app.common.math :as mth]
[app.main.snap :as snap]
[okulary.core :as l]
[app.util.geom.path :as ugp]))
(defonce drag-threshold 5)
(defn dragging? [start zoom]
(fn [current]
(>= (gpt/distance start current) (/ drag-threshold zoom))))
(defn drag-stream
([to-stream]
(drag-stream to-stream (rx/empty)))
([to-stream not-drag-stream]
(let [start @ms/mouse-position
zoom (get-in @st/state [:workspace-local :zoom] 1)
mouse-up (->> st/stream (rx/filter #(ms/mouse-up? %)))
position-stream
(->> ms/mouse-position
(rx/take-until mouse-up)
(rx/filter (dragging? start zoom))
(rx/take 1))]
(rx/merge
(->> position-stream
(rx/if-empty ::empty)
(rx/merge-map (fn [value]
(if (= value ::empty)
not-drag-stream
(rx/empty)))))
(->> position-stream
(rx/merge-map (fn [] to-stream)))))))
(defn to-dec [num]
(let [k 50]
(* (mth/floor (/ num k)) k)))
(defn move-points-stream
[snap-toggled start-point selected-points points]
(let [zoom (get-in @st/state [:workspace-local :zoom] 1)
ranges (snap/create-ranges points selected-points)
d-pos (/ snap/snap-path-accuracy zoom)
check-path-snap
(fn [position]
(if snap-toggled
(let [delta (gpt/subtract position start-point)
moved-points (->> selected-points (mapv #(gpt/add % delta)))
snap (snap/get-snap-delta moved-points ranges d-pos)]
(gpt/add position snap))
position))]
(->> ms/mouse-position
(rx/map check-path-snap))))
(defn move-handler-stream
[snap-toggled start-point handler points]
(let [zoom (get-in @st/state [:workspace-local :zoom] 1)
ranges (snap/create-ranges points)
d-pos (/ snap/snap-path-accuracy zoom)
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))
position))]
(->> ms/mouse-position
(rx/map check-path-snap))))
(defn position-stream
[snap-toggled points]
(let [zoom (get-in @st/state [:workspace-local :zoom] 1)
;; ranges (snap/create-ranges points)
d-pos (/ snap/snap-path-accuracy zoom)
get-content (fn [state] (get-in state (state/get-path state :content)))
content-stream
(-> (l/derived get-content st/state)
(rx/from-atom {:emit-current-value? true}))
ranges-stream
(->> content-stream
(rx/map ugp/content->points)
(rx/map snap/create-ranges))]
(->> ms/mouse-position
(rx/with-latest vector ranges-stream)
(rx/map (fn [[position ranges]]
(if snap-toggled
(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? %)))))))

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

@ -0,0 +1,62 @@
;; 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.tools
(:require
[app.main.data.workspace.common :as dwc]
[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.common.geom.point :as gpt]
[beicon.core :as rx]
[potok.core :as ptk]))
(defn process-path-tool
"Generic function that executes path transformations with the content and selected nodes"
[tool-fn]
(ptk/reify ::process-path-tool
ptk/WatchEvent
(watch [_ state stream]
(let [id (st/get-path-id state)
page-id (:current-page-id state)
shape (get-in state (st/get-path state))
selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
new-content (tool-fn (:content shape) selected-points)
[rch uch] (changes/generate-path-changes page-id shape (:content shape) new-content)]
(rx/of (dwc/commit-changes rch uch {:commit-local? true}))))))
(defn make-corner []
(process-path-tool
(fn [content points]
(reduce ugp/make-corner-point content points))))
(defn make-curve []
(process-path-tool
(fn [content points]
(reduce ugp/make-curve-point content points))))
(defn add-node []
(process-path-tool (fn [content points] (ugp/split-segments content points 0.5))))
(defn remove-node []
(process-path-tool ugp/remove-nodes))
(defn merge-nodes []
(process-path-tool ugp/merge-nodes))
(defn join-nodes []
(process-path-tool ugp/join-nodes))
(defn separate-nodes []
(process-path-tool ugp/separate-nodes))
(defn toggle-snap []
(ptk/reify ::toggle-snap
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
(update-in state [:workspace-local :edit-path id :snap-toggled] not)))))

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

@ -60,9 +60,8 @@
(ptk/reify ::handle-selection
ptk/WatchEvent
(watch [_ state stream]
(let [stoper (rx/filter #(or (dwc/interrupt? %)
(ms/mouse-up? %))
stream)]
(let [stop? (fn [event] (or (dwc/interrupt? event) (ms/mouse-up? event)))
stoper (->> stream (rx/filter stop?))]
(rx/concat
(when-not preserve?
(rx/of (deselect-all)))

91
frontend/src/app/main/snap.cljs
View file

@ -15,10 +15,12 @@
[app.main.refs :as refs]
[app.main.worker :as uw]
[app.util.geom.snap-points :as sp]
[app.util.range-tree :as rt]
[beicon.core :as rx]
[clojure.set :as set]))
(defonce ^:private snap-accuracy 5)
(defonce ^:private snap-path-accuracy 10)
(defonce ^:private snap-distance-accuracy 10)
(defn- remove-from-snap-points
@ -240,3 +242,92 @@
(rx/reduce gpt/min)
(rx/map #(or % (gpt/point 0 0))))))
;;; PATH SNAP
(defn create-ranges
([points]
(create-ranges points #{}))
([points selected-points]
(let [selected-points (or selected-points #{})
into-tree
(fn [coord]
(fn [tree point]
(rt/insert tree (get point coord) point)))
make-ranges
(fn [coord]
(->> points
(filter (comp not selected-points))
(reduce (into-tree coord) (rt/make-tree))))]
{:x (make-ranges :x)
:y (make-ranges :y)})))
(defn query-delta-point [ranges point precision]
(let [query-coord
(fn [point coord]
(let [pval (get point coord)]
(->> (rt/range-query (get ranges coord) (- pval precision) (+ pval precision))
;; We save the distance to the point and add the matching point to the points
(mapv (fn [[value points]]
[(- value pval)
(->> points (mapv #(vector point %)))])))))]
{:x (query-coord point :x)
:y (query-coord point :y)}))
(defn merge-matches
([] {:x nil :y nil})
([matches other]
(let [merge-coord
(fn [matches other]
(let [matches (into {} matches)
other (into {} other)
keys (set/union (keys matches) (keys other))]
(into {}
(map (fn [key]
[key
(d/concat [] (get matches key []) (get other key []))]))
keys)))]
(-> matches
(update :x merge-coord (:x other))
(update :y merge-coord (:y other))))))
(defn min-match
[default matches]
(let [get-min
(fn [[cur-val :as current] [other-val :as other]]
(if (< (mth/abs cur-val) (mth/abs other-val))
current
other))
min-match-coord
(fn [matches]
(if (and (seq matches) (not (empty? matches)))
(->> matches (reduce get-min))
default))]
(-> matches
(update :x min-match-coord)
(update :y min-match-coord))))
(defn get-snap-delta-match
[points ranges accuracy]
(assert vector? points)
(->> points
(mapv #(query-delta-point ranges % accuracy))
(reduce merge-matches)
(min-match [0 nil])))
(defn get-snap-delta
[points ranges accuracy]
(-> (get-snap-delta-match points ranges accuracy)
(update :x first)
(update :y first)
(gpt/point)))

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

@ -1,44 +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.main.ui.workspace.shapes.path.actions
(:require
[app.main.data.workspace.drawing.path :as drp]
[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]
[rumext.alpha :as mf]))
(mf/defc path-actions [{:keys [shape]}]
(let [id (mf/deref refs/selected-edition)
{:keys [edit-mode selected-points snap-toggled] :as all} (mf/deref pc/current-edit-path-ref)]
[:div.path-actions
[:div.viewport-actions-group
[:div.viewport-actions-entry {:class (when (= edit-mode :draw) "is-toggled")
:on-click #(st/emit! (drp/change-edit-mode :draw))} i/pen]
[:div.viewport-actions-entry {:class (when (= edit-mode :move) "is-toggled")
:on-click #(st/emit! (drp/change-edit-mode :move))} i/pointer-inner]]
#_[:div.viewport-actions-group
[:div.viewport-actions-entry {:class "is-disabled"} i/nodes-add]
[:div.viewport-actions-entry {:class "is-disabled"} i/nodes-remove]]
#_[:div.viewport-actions-group
[:div.viewport-actions-entry {:class "is-disabled"} i/nodes-merge]
[:div.viewport-actions-entry {:class "is-disabled"} i/nodes-join]
[:div.viewport-actions-entry {:class "is-disabled"} i/nodes-separate]]
[:div.viewport-actions-group
[:div.viewport-actions-entry {:class (when (empty? selected-points) "is-disabled")
:on-click #(when-not (empty? selected-points)
(st/emit! (drp/make-corner)))} i/nodes-corner]
[:div.viewport-actions-entry {:class (when (empty? selected-points) "is-disabled")
:on-click #(when-not (empty? selected-points)
(st/emit! (drp/make-curve)))} i/nodes-curve]]
#_[:div.viewport-actions-group
[:div.viewport-actions-entry {:class (when snap-toggled "is-toggled")} i/nodes-snap]]]))

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

@ -8,12 +8,18 @@
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.main.data.workspace.drawing.path :as drp]
[app.common.geom.shapes.path :as gshp]
[app.main.data.workspace.path :as drp]
[app.main.snap :as snap]
[app.main.store :as st]
[app.main.streams :as ms]
[app.main.ui.cursors :as cur]
[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.keyboard :as kbd]
[clojure.set :refer [map-invert]]
[goog.events :as events]
[rumext.alpha :as mf])
(:import goog.events.EventType))
@ -29,29 +35,16 @@
(fn [event]
(st/emit! (drp/path-pointer-leave position)))
on-click
(fn [event]
(when-not last-p?
(dom/stop-propagation event)
(dom/prevent-default event)
(cond
(and (= edit-mode :move) (not selected?))
(st/emit! (drp/select-node position))
(and (= edit-mode :move) selected?)
(st/emit! (drp/deselect-node position)))))
on-mouse-down
(fn [event]
(when-not last-p?
(dom/stop-propagation event)
(dom/prevent-default event)
(dom/stop-propagation event)
(dom/prevent-default event)
(let [shift? (kbd/shift? event)]
(cond
(= edit-mode :move)
(st/emit! (drp/start-move-path-point position))
;; If we're dragging a selected item we don't change the selection
(st/emit! (drp/start-move-path-point position shift?))
(and (= edit-mode :draw) start-path?)
(st/emit! (drp/start-path-from-point position))
@ -73,12 +66,12 @@
[:circle {:cx x
:cy y
:r (/ 10 zoom)
:on-click on-click
:on-mouse-down on-mouse-down
:on-mouse-enter on-enter
:on-mouse-leave on-leave
:style {:cursor (cond
(and (not last-p?) (= edit-mode :draw)) cur/pen-node
:style {:pointer-events (when last-p? "none")
:cursor (cond
(= edit-mode :draw) cur/pen-node
(= edit-mode :move) cur/pointer-node)
:fill "transparent"}}]]))
@ -93,14 +86,6 @@
(fn [event]
(st/emit! (drp/path-handler-leave index prefix)))
on-click
(fn [event]
(dom/stop-propagation event)
(dom/prevent-default event)
(cond
(= edit-mode :move)
(drp/select-handler index prefix)))
on-mouse-down
(fn [event]
(dom/stop-propagation event)
@ -132,7 +117,6 @@
[:circle {:cx x
:cy y
:r (/ 10 zoom)
:on-click on-click
:on-mouse-down on-mouse-down
:on-mouse-enter on-enter
:on-mouse-leave on-leave
@ -143,8 +127,9 @@
[:g.preview {:style {:pointer-events "none"}}
(when (not= :move-to (:command command))
[:path {:style {:fill "transparent"
:stroke pc/secondary-color
:stroke-width (/ 1 zoom)}
: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)}}
@ -153,37 +138,68 @@
:preview? true
:zoom zoom}]])
(mf/defc path-snap [{:keys [selected points zoom]}]
(let [ranges (mf/use-memo (mf/deps selected points) #(snap/create-ranges points selected))
snap-matches (snap/get-snap-delta-match selected ranges (/ 1 zoom))
matches (d/concat [] (second (:x snap-matches)) (second (:y snap-matches)))]
[:g.snap-paths
(for [[from to] matches]
[:line {:x1 (:x from)
:y1 (:y from)
:x2 (:x to)
:y2 (:y to)
:style {:stroke pc/secondary-color
:stroke-width (/ 1 zoom)}}])]))
(mf/defc path-editor
[{:keys [shape zoom]}]
(let [editor-ref (mf/use-ref nil)
edit-path-ref (pc/make-edit-path-ref (:id shape))
hover-point (mf/use-state nil)
{:keys [edit-mode
drag-handler
prev-handler
preview
content-modifiers
last-point
selected-handlers
selected-points
moving-nodes
moving-handler
hover-handlers
hover-points]
hover-points
snap-toggled]
:as edit-path} (mf/deref edit-path-ref)
{:keys [content]} shape
content (ugp/apply-content-modifiers content content-modifiers)
points (->> content ugp/content->points (into #{}))
selected-points (or selected-points #{})
base-content (:content shape)
base-points (mf/use-memo (mf/deps base-content) #(->> base-content ugp/content->points))
content (ugp/apply-content-modifiers base-content content-modifiers)
content-points (mf/use-memo (mf/deps content) #(->> content ugp/content->points))
point->base (->> (map hash-map content-points base-points) (reduce merge))
base->point (map-invert point->base)
points (into #{} content-points)
last-command (last content)
last-p (->> content last ugp/command->point)
handlers (ugp/content->handlers content)
handle-click-outside
(fn [event]
(let [current (dom/get-target event)
editor-dom (mf/ref-val editor-ref)]
(when-not (or (.contains editor-dom current)
(dom/class? current "viewport-actions-entry"))
(st/emit! (drp/deselect-all)))))
[snap-selected snap-points]
(cond
(some? drag-handler) [#{drag-handler} points]
(some? preview) [#{(ugp/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))
handle-double-click-outside
(fn [event]
@ -193,8 +209,7 @@
(mf/use-layout-effect
(mf/deps edit-mode)
(fn []
(let [keys [(events/listen (dom/get-root) EventType.CLICK handle-click-outside)
(events/listen (dom/get-root) EventType.DBLCLICK handle-double-click-outside)]]
(let [keys [(events/listen (dom/get-root) EventType.DBLCLICK handle-double-click-outside)]]
#(doseq [key keys]
(events/unlistenByKey key)))))
@ -204,30 +219,46 @@
:from last-p
:zoom zoom}])
(when drag-handler
[:g.drag-handler {:pointer-events "none"}
[:& path-handler {:point last-p
:handler drag-handler
:zoom zoom}]])
(when @hover-point
[:g.hover-point
[:& path-point {:position @hover-point
:zoom zoom}]])
(for [position points]
[: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)]
(when (not= position handler-position)
[:& path-handler {:point position
:handler handler-position
:index index
:prefix prefix
:zoom zoom
:selected? (contains? selected-handlers [index prefix])
:hover? (contains? hover-handlers [index prefix])
:edit-mode edit-mode}])))]
[:& path-point {:position position
:zoom zoom
:edit-mode edit-mode
:selected? (contains? selected-points position)
:hover? (contains? hover-points position)
:last-p? (= last-point position)
:start-path? (nil? last-point)}]])
(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))]
[: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}])))]
[:& path-point {:position position
:zoom zoom
:edit-mode edit-mode
:selected? point-selected?
:hover? point-hover?
:last-p? last-p?
:start-path? start-p?}]]))
(when prev-handler
[:g.prev-handler {:pointer-events "none"}
@ -235,9 +266,9 @@
:handler prev-handler
:zoom zoom}]])
(when drag-handler
[:g.drag-handler {:pointer-events "none"}
[:& path-handler {:point last-p
:handler drag-handler
:zoom zoom}]])]))
(when show-snap?
[:g.path-snap {:pointer-events "none"}
[:& path-snap {:selected snap-selected
:points snap-points
:zoom zoom}]])]))

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

@ -101,7 +101,7 @@
on-click (actions/on-click hover selected edition drawing-path? drawing-tool)
on-context-menu (actions/on-context-menu hover)
on-double-click (actions/on-double-click hover hover-ids drawing-path? objects)
on-double-click (actions/on-double-click hover hover-ids drawing-path? objects edition)
on-drag-enter (actions/on-drag-enter)
on-drag-over (actions/on-drag-over)
on-drop (actions/on-drop file viewport-ref zoom)
@ -170,7 +170,8 @@
:width (:width vport 0)
:height (:height vport 0)
:view-box (utils/format-viewbox vbox)
:style {:background-color (get options :background "#E8E9EA")}}
:style {:background-color (get options :background "#E8E9EA")
:pointer-events "none"}}
[:& (mf/provider muc/embed-ctx) {:value true}
;; Render root shape
@ -287,7 +288,6 @@
{:zoom zoom
:tooltip tooltip}])
(when show-presence?
[:& presence/active-cursors
{:page-id page-id}])

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

@ -15,6 +15,7 @@
[app.main.store :as st]
[app.main.streams :as ms]
[app.main.ui.workspace.viewport.utils :as utils]
[app.main.data.workspace.path :as dwdp]
[app.util.dom :as dom]
[app.util.dom.dnd :as dnd]
[app.util.keyboard :as kbd]
@ -44,7 +45,9 @@
middle-click? (= 2 (.-which event))
frame? (= :frame type)
selected? (contains? selected id)]
selected? (contains? selected id)
drawing-path? (= :draw (get-in edit-path [edition :edit-mode]))]
(when middle-click?
(dom/prevent-default bevent)
@ -56,14 +59,18 @@
(when (and (not= edition id) text-editing?)
(st/emit! dw/clear-edition-mode))
(when (and (or (not edition) (not= edition id)) (not blocked) (not hidden) (not (#{:comments :path} drawing-tool)))
(when (and (not text-editing?)
(not blocked)
(not hidden)
(not (#{:comments :path} drawing-tool))
(not drawing-path?))
(cond
drawing-tool
(st/emit! (dd/start-drawing drawing-tool))
(and edit-path (contains? edit-path edition))
;; Handle node select-drawing. NOP at the moment
nil
;; Handle path node area selection
(st/emit! (dwdp/handle-selection shift?))
(or (not id) (and frame? (not selected?)))
(st/emit! (dw/handle-selection shift?))
@ -142,9 +149,9 @@
(st/emit! (dw/select-shape (:id @hover)))))))))
(defn on-double-click
[hover hover-ids drawing-path? objects]
[hover hover-ids drawing-path? objects edition]
(mf/use-callback
(mf/deps @hover @hover-ids drawing-path?)
(mf/deps @hover @hover-ids drawing-path? edition)
(fn [event]
(dom/stop-propagation event)
(let [ctrl? (kbd/ctrl? event)
@ -170,7 +177,7 @@
(reset! hover-ids (into [] (rest @hover-ids)))
(st/emit! (dw/select-shape (:id selected))))
(or text? path?)
(and (not= id edition) (or text? path?))
(st/emit! (dw/select-shape id)
(dw/start-editing-selected))

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

@ -0,0 +1,171 @@
;; 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.ui.workspace.viewport.path-actions
(:require
[app.main.data.workspace.path :as drp]
[app.main.data.workspace.path.helpers :as wph]
[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]
[rumext.alpha :as mf]))
(defn check-enabled [content selected-points]
(let [segments (ugp/get-segments content selected-points)
points-selected? (not (empty? selected-points))
segments-selected? (not (empty? segments))]
{:make-corner points-selected?
:make-curve points-selected?
:add-node segments-selected?
:remove-node points-selected?
:merge-nodes segments-selected?
:join-nodes points-selected?
:separate-nodes segments-selected?}))
(mf/defc path-actions [{:keys [shape]}]
(let [id (mf/deref refs/selected-edition)
{:keys [edit-mode selected-points snap-toggled] :as all} (mf/deref pc/current-edit-path-ref)
content (:content shape)
enabled-buttons
(mf/use-memo
(mf/deps content selected-points)
#(check-enabled content selected-points))
on-select-draw-mode
(mf/use-callback
(fn [event]
(st/emit! (drp/change-edit-mode :draw))))
on-select-edit-mode
(mf/use-callback
(fn [event]
(st/emit! (drp/change-edit-mode :move))))
on-add-node
(mf/use-callback
(mf/deps (:add-node enabled-buttons))
(fn [event]
(when (:add-node enabled-buttons)
(st/emit! (drp/add-node)))))
on-remove-node
(mf/use-callback
(mf/deps (:remove-node enabled-buttons))
(fn [event]
(when (:remove-node enabled-buttons)
(st/emit! (drp/remove-node)))))
on-merge-nodes
(mf/use-callback
(mf/deps (:merge-nodes enabled-buttons))
(fn [event]
(when (:merge-nodes enabled-buttons)
(st/emit! (drp/merge-nodes)))))
on-join-nodes
(mf/use-callback
(mf/deps (:join-nodes enabled-buttons))
(fn [event]
(when (:join-nodes enabled-buttons)
(st/emit! (drp/join-nodes)))))
on-separate-nodes
(mf/use-callback
(mf/deps (:separate-nodes enabled-buttons))
(fn [event]
(when (:separate-nodes enabled-buttons)
(st/emit! (drp/separate-nodes)))))
on-make-corner
(mf/use-callback
(mf/deps (:make-corner enabled-buttons))
(fn [event]
(when (:make-corner enabled-buttons)
(st/emit! (drp/make-corner)))))
on-make-curve
(mf/use-callback
(mf/deps (:make-curve enabled-buttons))
(fn [event]
(when (:make-curve enabled-buttons)
(st/emit! (drp/make-curve)))))
on-toggle-snap
(mf/use-callback
(fn [event]
(st/emit! (drp/toggle-snap))))
]
[:div.path-actions
[:div.viewport-actions-group
;; Draw Mode
[:div.viewport-actions-entry
{:class (when (= edit-mode :draw) "is-toggled")
:on-click on-select-draw-mode}
i/pen]
;; Edit mode
[:div.viewport-actions-entry
{:class (when (= edit-mode :move) "is-toggled")
:on-click on-select-edit-mode}
i/pointer-inner]]
[:div.viewport-actions-group
;; Add Node
[:div.viewport-actions-entry
{:class (when-not (:add-node enabled-buttons) "is-disabled")
:on-click on-add-node}
i/nodes-add]
;; Remove node
[:div.viewport-actions-entry
{:class (when-not (:remove-node enabled-buttons) "is-disabled")
:on-click on-remove-node}
i/nodes-remove]]
[:div.viewport-actions-group
;; Merge Nodes
[:div.viewport-actions-entry
{:class (when-not (:merge-nodes enabled-buttons) "is-disabled")
:on-click on-merge-nodes}
i/nodes-merge]
;; Join Nodes
[:div.viewport-actions-entry
{:class (when-not (:join-nodes enabled-buttons) "is-disabled")
:on-click on-join-nodes}
i/nodes-join]
;; Separate Nodes
[:div.viewport-actions-entry
{:class (when-not (:separate-nodes enabled-buttons) "is-disabled")
:on-click on-separate-nodes}
i/nodes-separate]]
;; Make Corner
[:div.viewport-actions-group
[:div.viewport-actions-entry
{:class (when-not (:make-corner enabled-buttons) "is-disabled")
:on-click on-make-corner}
i/nodes-corner]
;; Make Curve
[:div.viewport-actions-entry
{:class (when-not (:make-curve enabled-buttons) "is-disabled")
:on-click on-make-curve}
i/nodes-curve]]
;; Toggle snap
[:div.viewport-actions-group
[:div.viewport-actions-entry
{:class (when snap-toggled "is-toggled")
:on-click on-toggle-snap}
i/nodes-snap]]]))

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

@ -14,7 +14,7 @@
[app.main.store :as st]
[app.main.streams :as ms]
[app.main.ui.hooks :as hooks]
[app.main.ui.workspace.shapes.path.actions :refer [path-actions]]
[app.main.ui.workspace.viewport.path-actions :refer [path-actions]]
[app.util.dom :as dom]
[app.util.object :as obj]
[rumext.alpha :as mf]))

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

@ -8,10 +8,13 @@
(: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]))
[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"
@ -64,6 +67,11 @@
(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)
@ -387,6 +395,18 @@
(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))
@ -401,6 +421,26 @@
: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]
@ -441,11 +481,6 @@
(let [content (if (vector? content) content (into [] content))]
(reduce apply-to-index content modifiers))))
(defn command->point [command]
(when-not (nil? command)
(let [{{:keys [x y]} :params} command]
(gpt/point x y))))
(defn content->points [content]
(->> content
(map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y))))
@ -468,7 +503,6 @@
[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)
@ -480,6 +514,25 @@
(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]
@ -586,3 +639,279 @@
(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))))