diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs index b5ce81ae2..5b629986d 100644 --- a/frontend/src/app/main/data/workspace.cljs +++ b/frontend/src/app/main/data/workspace.cljs @@ -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] diff --git a/frontend/src/app/main/data/workspace/common.cljs b/frontend/src/app/main/data/workspace/common.cljs index afec9744c..e993573bf 100644 --- a/frontend/src/app/main/data/workspace/common.cljs +++ b/frontend/src/app/main/data/workspace/common.cljs @@ -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 diff --git a/frontend/src/app/main/data/workspace/drawing.cljs b/frontend/src/app/main/data/workspace/drawing.cljs index 9c011c373..553b31038 100644 --- a/frontend/src/app/main/data/workspace/drawing.cljs +++ b/frontend/src/app/main/data/workspace/drawing.cljs @@ -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])) diff --git a/frontend/src/app/main/data/workspace/drawing/path.cljs b/frontend/src/app/main/data/workspace/drawing/path.cljs deleted file mode 100644 index 94ff198d7..000000000 --- a/frontend/src/app/main/data/workspace/drawing/path.cljs +++ /dev/null @@ -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?)))))))) diff --git a/frontend/src/app/main/data/workspace/path.cljs b/frontend/src/app/main/data/workspace/path.cljs new file mode 100644 index 000000000..714775131 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path.cljs @@ -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) diff --git a/frontend/src/app/main/data/workspace/path/changes.cljs b/frontend/src/app/main/data/workspace/path/changes.cljs new file mode 100644 index 000000000..53fdb6c9f --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/changes.cljs @@ -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)))))) + + diff --git a/frontend/src/app/main/data/workspace/path/common.cljs b/frontend/src/app/main/data/workspace/path/common.cljs new file mode 100644 index 000000000..0d28bf984 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/common.cljs @@ -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)))))) diff --git a/frontend/src/app/main/data/workspace/path/drawing.cljs b/frontend/src/app/main/data/workspace/path/drawing.cljs new file mode 100644 index 000000000..6f9318ebf --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/drawing.cljs @@ -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)))))) diff --git a/frontend/src/app/main/data/workspace/path/edition.cljs b/frontend/src/app/main/data/workspace/path/edition.cljs new file mode 100644 index 000000000..df71229e6 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/edition.cljs @@ -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))))) diff --git a/frontend/src/app/main/data/workspace/path/helpers.cljs b/frontend/src/app/main/data/workspace/path/helpers.cljs new file mode 100644 index 000000000..f70e89ad9 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/helpers.cljs @@ -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))))) diff --git a/frontend/src/app/main/data/workspace/path/selection.cljs b/frontend/src/app/main/data/workspace/path/selection.cljs new file mode 100644 index 000000000..120845fc8 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/selection.cljs @@ -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)))))))) diff --git a/frontend/src/app/main/data/workspace/path/spec.cljs b/frontend/src/app/main/data/workspace/path/spec.cljs new file mode 100644 index 000000000..759f43dc0 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/spec.cljs @@ -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?)) + + + diff --git a/frontend/src/app/main/data/workspace/path/state.cljs b/frontend/src/app/main/data/workspace/path/state.cljs new file mode 100644 index 000000000..96c4c7221 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/state.cljs @@ -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))) + + diff --git a/frontend/src/app/main/data/workspace/path/streams.cljs b/frontend/src/app/main/data/workspace/path/streams.cljs new file mode 100644 index 000000000..5040b0c34 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/streams.cljs @@ -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? %)))))) diff --git a/frontend/src/app/main/data/workspace/path/tools.cljs b/frontend/src/app/main/data/workspace/path/tools.cljs new file mode 100644 index 000000000..2085ddf79 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/tools.cljs @@ -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})))))) diff --git a/frontend/src/app/main/ui/workspace/shapes/path/actions.cljs b/frontend/src/app/main/ui/workspace/shapes/path/actions.cljs index 9a030ddeb..e71df0316 100644 --- a/frontend/src/app/main/ui/workspace/shapes/path/actions.cljs +++ b/frontend/src/app/main/ui/workspace/shapes/path/actions.cljs @@ -6,7 +6,7 @@ (ns app.main.ui.workspace.shapes.path.actions (:require - [app.main.data.workspace.drawing.path :as drp] + [app.main.data.workspace.path :as drp] [app.main.refs :as refs] [app.main.store :as st] [app.main.ui.icons :as i] diff --git a/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs b/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs index a30d29f05..a459dc836 100644 --- a/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs +++ b/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs @@ -8,7 +8,7 @@ (:require [app.common.data :as d] [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.ui.cursors :as cur] [app.main.ui.workspace.shapes.path.common :as pc] @@ -31,34 +31,21 @@ (fn [event] (st/emit! (drp/path-pointer-leave position))) - on-click + on-mouse-down (fn [event] (dom/stop-propagation event) (dom/prevent-default event) (let [shift? (kbd/shift? event)] (cond - (and (= edit-mode :move) (not selected?)) - (st/emit! (drp/select-node position shift?)) + (= edit-mode :move) + (st/emit! (drp/start-move-path-point position shift?)) - (and (= edit-mode :move) selected?) - (st/emit! (drp/deselect-node position shift?))))) + (and (= edit-mode :draw) start-path?) + (st/emit! (drp/start-path-from-point position)) - - on-mouse-down - (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))))] + (and (= edit-mode :draw) (not start-path?)) + (st/emit! (drp/close-path-drag-start position)))))] [:g.path-point [:circle.path-point @@ -74,7 +61,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 @@ -179,25 +165,15 @@ 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))))) - handle-double-click-outside (fn [event] (when (= edit-mode :move) - (st/emit! :interrupt))) - ] + (st/emit! :interrupt)))] (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))))) @@ -208,29 +184,35 @@ :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 position) + point-hover? (contains? hover-points position) + last-p? (= last-point position) + start-p? (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-selected? (contains? selected-handlers [index prefix]) + 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 + :selected? handler-selected? + :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"} diff --git a/frontend/src/app/main/ui/workspace/viewport/actions.cljs b/frontend/src/app/main/ui/workspace/viewport/actions.cljs index f2d2d203b..82b427730 100644 --- a/frontend/src/app/main/ui/workspace/viewport/actions.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/actions.cljs @@ -15,7 +15,7 @@ [app.main.store :as st] [app.main.streams :as ms] [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.dnd :as dnd] [app.util.keyboard :as kbd]