3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-07-11 23:47:17 +02:00
Code Issues Projects Releases Packages Wiki Activity

♻️ Refactor path into modules

Browse source
This commit is contained in:
alonso.torres 2021-03-31 20:14:51 +02:00 • committed by Andrés Moya
parent c22b4a1de2
commit 2e6dacf539
18 changed files with 1213 additions and 1001 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -24,7 +24,7 @@
[app.main.data.messages :as dm] [app.main.data.messages :as dm]
[app.main.data.workspace.common :as dwc] [app.main.data.workspace.common :as dwc]
[app.main.data.workspace.drawing :as dwd] [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.groups :as dwg]
[app.main.data.workspace.libraries :as dwl] [app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.notifications :as dwn] [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/reify ::undo
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [undo (:workspace-undo state) (let [edition (get-in state [:workspace-local :edition])]
items (:items undo) ;; Editors handle their own undo's
index (or (:index undo) (dec (count items)))] (when-not (some? edition)
(when-not (or (empty? items) (= index -1)) (let [undo (:workspace-undo state)
(let [changes (get-in items [index :undo-changes])] items (:items undo)
(rx/of (materialize-undo changes (dec index)) index (or (:index undo) (dec (count items)))]
(commit-changes changes [] {:save-undo? false})))))))) (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 (def redo
(ptk/reify ::redo (ptk/reify ::redo
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [undo (:workspace-undo state) (let [edition (get-in state [:workspace-local :edition])]
items (:items undo) (when-not (some? edition)
index (or (:index undo) (dec (count items)))] (let [undo (:workspace-undo state)
(when-not (or (empty? items) (= index (dec (count items)))) items (:items undo)
(let [changes (get-in items [(inc index) :redo-changes])] index (or (:index undo) (dec (count items)))]
(rx/of (materialize-undo changes (inc index)) (when-not (or (empty? items) (= index (dec (count items))))
(commit-changes changes [] {:save-undo? false})))))))) (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 (def reinitialize-undo
(ptk/reify ::reset-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.common.uuid :as uuid]
[app.main.data.workspace.common :as dwc] [app.main.data.workspace.common :as dwc]
[app.main.data.workspace.selection :as dws] [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.common :as common]
[app.main.data.workspace.drawing.path :as path]
[app.main.data.workspace.drawing.curve :as curve] [app.main.data.workspace.drawing.curve :as curve]
[app.main.data.workspace.drawing.box :as box])) [app.main.data.workspace.drawing.box :as box]))

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

@ -1,926 +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-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 (get-path-id state)
content (get-in state (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 {}))]
(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-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 (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-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 (get-path state :content))
selected-point? (fn [point]
(gsh/has-point-rect? selrect point))
positions (into #{}
(comp (map (comp gpt/point :params))
(filter selected-point?))
content)]
(-> state
(assoc-in [:workspace-local :edit-path id :selected-points] positions))))))
(defn select-node [position shift?]
(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 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 (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))))))))
(defn update-area-selection
[selrect]
(ptk/reify ::update-area-selection
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :selrect] selrect))))
(defn clear-area-selection
[]
(ptk/reify ::clear-area-selection
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local dissoc :selrect))))
(defn handle-selection
[shift?]
(letfn [(data->selrect [data]
(let [start (:start data)
stop (:stop data)
start-x (min (:x start) (:x stop))
start-y (min (:y start) (:y stop))
end-x (max (:x start) (:x stop))
end-y (max (:y start) (:y stop))]
{:x start-x
:y start-y
:width (mth/abs (- end-x start-x))
:height (mth/abs (- end-y start-y))}))]
(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?))]
(rx/concat
#_(when-not preserve?
(rx/of (deselect-all)))
(->> ms/mouse-position
(rx/scan (fn [data pos]
(if data
(assoc data :stop pos)
{:start pos :stop pos}))
nil)
(rx/map data->selrect)
(rx/filter #(or (> (:width %) 10)
(> (:height %) 10)))
(rx/map update-area-selection)
(rx/take-until stoper))
(rx/of (select-node-area shift?)
(clear-area-selection))
#_(rx/of (select-shapes-by-current-selrect preserve?))))))))

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

@ -0,0 +1,39 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 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/select-handler)
(d/export selection/handle-selection)
(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)

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

@ -0,0 +1,71 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 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))))))

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

@ -0,0 +1,28 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 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))))))

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

@ -0,0 +1,337 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 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? %))))
drag-events-stream
(->> (streams/position-stream)
(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? %))))
drag-events (->> ms/mouse-position
(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 down-event zoom]
(let [mouse-up (->> stream (rx/filter #(or (helpers/end-path-event? %)
(ms/mouse-up? %))))
drag-events (->> (streams/position-stream)
(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?))
;; Mouse move preview
mousemove-events
(->> (streams/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 (streams/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 (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/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))))))

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

@ -0,0 +1,216 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 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-point
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])
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 (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])
new-content (ugp/apply-content-modifiers (:content shape) content-modifiers)
[rch uch] (changes/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 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 {}))]
(assoc-in state [:workspace-local :edit-path id :content-modifiers] modifiers))))))
(defn start-move-path-point
[position shift?]
(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])
id (get-in state [:workspace-local :edition])
selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
selected? (contains? selected-points position)
mouse-drag-stream
(rx/concat
;; If we're dragging a selected item we don't change the selection
(if selected?
(rx/empty)
(rx/of (selection/select-node position shift?)))
;; This stream checks the consecutive mouse positions to do the draging
(->> ms/mouse-position
(rx/take-until stopper)
(rx/map #(move-selected-path-point start-position %)))
(rx/of (apply-content-modifiers)))
;; When there is not drag we select the node
mouse-click-stream
(rx/of (selection/select-node position shift?))]
(streams/drag-stream mouse-drag-stream
mouse-click-stream)))))
(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))
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))]
(streams/drag-stream
(rx/concat
(->> (streams/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? (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)))))

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

@ -0,0 +1,123 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 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)))))

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

@ -0,0 +1,157 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 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 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 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? (fn [point]
(gsh/has-point-rect? selrect point))
positions (into #{}
(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?]
(ptk/reify ::select-node
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])]
(cond-> state
(some? id)
(assoc-in [:workspace-local :edit-path id :selected-points] #{position}))))))
(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-handlers] #{})
(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))))))))

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

@ -0,0 +1,52 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 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?))

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

@ -0,0 +1,32 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 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)))

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

@ -0,0 +1,54 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.main.data.workspace.path.streams
(:require
[app.main.data.workspace.path.helpers :as helpers]
[app.common.geom.point :as gpt]
[app.main.store :as st]
[app.main.streams :as ms]
[beicon.core :as rx]
[potok.core :as ptk]))
(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 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? %))))))

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

@ -0,0 +1,42 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 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]
[beicon.core :as rx]
[potok.core :as ptk]))
(defn make-corner []
(ptk/reify ::make-corner
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 (reduce ugp/make-corner-point (: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-curve []
(ptk/reify ::make-curve
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 (reduce ugp/make-curve-point (: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}))))))

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

@ -6,7 +6,7 @@
(ns app.main.ui.workspace.shapes.path.actions (ns app.main.ui.workspace.shapes.path.actions
(:require (:require
[app.main.data.workspace.drawing.path :as drp] [app.main.data.workspace.path :as drp]
[app.main.refs :as refs] [app.main.refs :as refs]
[app.main.store :as st] [app.main.store :as st]
[app.main.ui.icons :as i] [app.main.ui.icons :as i]

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

@ -8,7 +8,7 @@
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.main.data.workspace.drawing.path :as drp] [app.main.data.workspace.path :as drp]
[app.main.store :as st] [app.main.store :as st]
[app.main.ui.cursors :as cur] [app.main.ui.cursors :as cur]
[app.main.ui.workspace.shapes.path.common :as pc] [app.main.ui.workspace.shapes.path.common :as pc]
@ -31,34 +31,21 @@
(fn [event] (fn [event]
(st/emit! (drp/path-pointer-leave position))) (st/emit! (drp/path-pointer-leave position)))
on-click on-mouse-down
(fn [event] (fn [event]
(dom/stop-propagation event) (dom/stop-propagation event)
(dom/prevent-default event) (dom/prevent-default event)
(let [shift? (kbd/shift? event)] (let [shift? (kbd/shift? event)]
(cond (cond
(and (= edit-mode :move) (not selected?)) (= edit-mode :move)
(st/emit! (drp/select-node position shift?)) (st/emit! (drp/start-move-path-point position shift?))
(and (= edit-mode :move) selected?) (and (= edit-mode :draw) start-path?)
(st/emit! (drp/deselect-node position shift?))))) (st/emit! (drp/start-path-from-point position))
(and (= edit-mode :draw) (not start-path?))
on-mouse-down (st/emit! (drp/close-path-drag-start position)))))]
(fn [event]
(dom/stop-propagation event)
(dom/prevent-default event)
(cond
(= edit-mode :move)
(st/emit! (drp/start-move-path-point position))
(and (= edit-mode :draw) start-path?)
(st/emit! (drp/start-path-from-point position))
(and (= edit-mode :draw) (not start-path?))
(st/emit! (drp/close-path-drag-start position))))]
[:g.path-point [:g.path-point
[:circle.path-point [:circle.path-point
@ -74,7 +61,6 @@
[:circle {:cx x [:circle {:cx x
:cy y :cy y
:r (/ 10 zoom) :r (/ 10 zoom)
:on-click on-click
:on-mouse-down on-mouse-down :on-mouse-down on-mouse-down
:on-mouse-enter on-enter :on-mouse-enter on-enter
:on-mouse-leave on-leave :on-mouse-leave on-leave
@ -179,25 +165,15 @@
last-p (->> content last ugp/command->point) last-p (->> content last ugp/command->point)
handlers (ugp/content->handlers content) 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)))))
handle-double-click-outside handle-double-click-outside
(fn [event] (fn [event]
(when (= edit-mode :move) (when (= edit-mode :move)
(st/emit! :interrupt))) (st/emit! :interrupt)))]
]
(mf/use-layout-effect (mf/use-layout-effect
(mf/deps edit-mode) (mf/deps edit-mode)
(fn [] (fn []
(let [keys [;;(events/listen (dom/get-root) EventType.CLICK handle-click-outside) (let [keys [(events/listen (dom/get-root) EventType.DBLCLICK handle-double-click-outside)]]
(events/listen (dom/get-root) EventType.DBLCLICK handle-double-click-outside)]]
#(doseq [key keys] #(doseq [key keys]
(events/unlistenByKey key))))) (events/unlistenByKey key)))))
@ -208,29 +184,35 @@
:zoom zoom}]) :zoom zoom}])
(for [position points] (for [position points]
[:g.path-node (let [point-selected? (contains? selected-points position)
[:g.point-handlers {:pointer-events (when (= edit-mode :draw) "none")} point-hover? (contains? hover-points position)
(for [[index prefix] (get handlers position)] last-p? (= last-point position)
(let [command (get content index) start-p? (some? last-point)]
x (get-in command [:params (d/prefix-keyword prefix :x)]) [:g.path-node
y (get-in command [:params (d/prefix-keyword prefix :y)]) [:g.point-handlers {:pointer-events (when (= edit-mode :draw) "none")}
handler-position (gpt/point x y)] (for [[index prefix] (get handlers position)]
(when (not= position handler-position) (let [command (get content index)
[:& path-handler {:point position x (get-in command [:params (d/prefix-keyword prefix :x)])
:handler handler-position y (get-in command [:params (d/prefix-keyword prefix :y)])
:index index handler-position (gpt/point x y)
:prefix prefix handler-selected? (contains? selected-handlers [index prefix])
:zoom zoom handler-hover? (contains? hover-handlers [index prefix])]
:selected? (contains? selected-handlers [index prefix]) (when (not= position handler-position)
:hover? (contains? hover-handlers [index prefix]) [:& path-handler {:point position
:edit-mode edit-mode}])))] :handler handler-position
[:& path-point {:position position :index index
:zoom zoom :prefix prefix
:edit-mode edit-mode :zoom zoom
:selected? (contains? selected-points position) :selected? handler-selected?
:hover? (contains? hover-points position) :hover? handler-hover?
:last-p? (= last-point position) :edit-mode edit-mode}])))]
:start-path? (nil? last-point)}]]) [:& 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 (when prev-handler
[:g.prev-handler {:pointer-events "none"} [:g.prev-handler {:pointer-events "none"}

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

@ -15,7 +15,7 @@
[app.main.store :as st] [app.main.store :as st]
[app.main.streams :as ms] [app.main.streams :as ms]
[app.main.ui.workspace.viewport.utils :as utils] [app.main.ui.workspace.viewport.utils :as utils]
[app.main.data.workspace.drawing.path :as dwdp] [app.main.data.workspace.path :as dwdp]
[app.util.dom :as dom] [app.util.dom :as dom]
[app.util.dom.dnd :as dnd] [app.util.dom.dnd :as dnd]
[app.util.keyboard :as kbd] [app.util.keyboard :as kbd]