;; 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) KALEIDOS INC (ns app.main.data.workspace.path.drawing (:require [app.common.geom.point :as gpt] [app.common.geom.shapes.flex-layout :as gsl] [app.common.geom.shapes.path :as upg] [app.common.path.commands :as upc] [app.common.path.shapes-to-path :as upsp] [app.common.spec :as us] [app.common.types.shape-tree :as ctst] [app.common.types.shape.layout :as ctl] [app.main.data.workspace.changes :as dch] [app.main.data.workspace.drawing.common :as dwdc] [app.main.data.workspace.edition :as dwe] [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.undo :as undo] [app.main.data.workspace.state-helpers :as wsh] [app.main.streams :as ms] [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 (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-location state) helpers/append-node position last-point prev-handler)) state))))) (defn drag-handler ([position] (drag-handler nil nil :c1 position)) ([position index prefix {:keys [x y alt? shift?]}] (ptk/reify ::drag-handler ptk/UpdateEvent (update [_ state] (let [id (st/get-path-id state) content (st/get-path state :content) index (or index (count content)) prefix (or prefix :c1) position (or position (upc/command->point (nth content (dec index)))) old-handler (upc/handler->point content index prefix) handler-position (cond-> (gpt/point x y) shift? (helpers/position-fixed-angle position)) {dx :x dy :y} (if (some? old-handler) (gpt/add (gpt/to-vec old-handler position) (gpt/to-vec position handler-position)) (gpt/to-vec position handler-position)) match-opposite? (not alt?) modifiers (helpers/move-handler-modifiers content index prefix match-opposite? match-opposite? dx dy)] (-> state (update-in [:workspace-local :edit-path id :content-modifiers] merge modifiers) (assoc-in [:workspace-local :edit-path id :drag-handler] handler-position))))))) (defn finish-drag [] (ptk/reify ::finish-drag ptk/UpdateEvent (update [_ state] (let [id (st/get-path-id state) modifiers (get-in state [:workspace-local :edit-path id :content-modifiers]) content (-> (st/get-path state :content) (upc/apply-content-modifiers modifiers)) handler (get-in state [:workspace-local :edit-path id :drag-handler])] (-> state (st/set-content content) (update-in [:workspace-local :edit-path id] dissoc :drag-handler) (update-in [:workspace-local :edit-path id] dissoc :content-modifiers) (assoc-in [:workspace-local :edit-path id :prev-handler] handler) (update-in (st/get-path-location state) helpers/update-selrect)))) ptk/WatchEvent (watch [_ state _] (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) (undo/merge-head)))))) (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) stop-stream (->> stream (rx/filter #(or (helpers/end-path-event? %) (ms/mouse-up? %)))) content (st/get-path state :content) snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled]) points (upg/content->points content) handlers (-> (upc/content->handlers content) (get position)) [idx prefix] (when (= (count handlers) 1) (first handlers)) drag-events-stream (->> (streams/position-stream snap-toggled points) (rx/take-until stop-stream) (rx/map #(drag-handler position idx prefix %)))] (rx/concat (rx/of (add-node position)) (streams/drag-stream (rx/concat 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 [mouse-up (->> stream (rx/filter #(or (helpers/end-path-event? %) (ms/mouse-up? %)))) content (st/get-path state :content) points (upg/content->points content) id (st/get-path-id state) snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled]) drag-events (->> (streams/position-stream snap-toggled points) (rx/take-until mouse-up) (rx/map #(drag-handler %)))] (rx/concat (rx/of (add-node position)) (streams/drag-stream (rx/concat drag-events (rx/of (finish-drag))))))))) (defn make-node-events-stream [stream] (->> stream (rx/filter (ptk/type? ::close-path-drag-start)) (rx/take 1) (rx/merge-map #(rx/empty)))) (defn make-drag-stream [stream snap-toggled _zoom points down-event] (let [mouse-up (->> stream (rx/filter #(or (helpers/end-path-event? %) (ms/mouse-up? %)))) drag-events (->> (streams/position-stream snap-toggled points) (rx/take-until mouse-up) (rx/map #(drag-handler %)))] (rx/concat (rx/of (add-node down-event)) (streams/drag-stream (rx/concat drag-events (rx/of (finish-drag))))))) (defn handle-drawing-path [_id] (ptk/reify ::handle-drawing-path ptk/UpdateEvent (update [_ state] (let [id (st/get-path-id state)] (-> state (assoc-in [:workspace-local :edit-path id :edit-mode] :draw)))) ptk/WatchEvent (watch [_ state stream] (let [zoom (get-in state [:workspace-local :zoom]) mouse-down (->> stream (rx/filter ms/mouse-down?)) end-path-events (->> stream (rx/filter helpers/end-path-event?)) content (st/get-path state :content) points (upg/content->points content) id (st/get-path-id state) snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled]) ;; Mouse move preview mousemove-events (->> (streams/position-stream snap-toggled points) (rx/take-until end-path-events) (rx/map #(preview-next-point %))) ;; From mouse down we can have: click, drag and double click mousedown-events (->> mouse-down (rx/take-until end-path-events) (rx/with-latest merge (streams/position-stream snap-toggled points)) ;; We change to the stream that emits the first event (rx/switch-map #(rx/race (make-node-events-stream stream) (make-drag-stream stream snap-toggled zoom points %))))] (rx/concat (rx/of (undo/start-path-undo)) (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 (wsh/lookup-page-objects state) content (get-in state [:workspace-drawing :object :content] []) position (gpt/point (get-in content [0 :params] nil)) frame-id (ctst/top-nested-frame objects position) layout? (ctl/layout? objects frame-id) drop-index (when layout? (gsl/get-drop-index frame-id objects position))] (-> state (assoc-in [:workspace-drawing :object :frame-id] frame-id) (cond-> (some? drop-index) (update-in [:workspace-drawing :object] with-meta {:index drop-index}))))))) (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 _] (let [content (get-in state [:workspace-drawing :object :content] [])] (if (seq content) (rx/of (setup-frame-path) (dwdc/handle-finish-drawing) (dwe/start-edition-mode shape-id) (change-edit-mode :draw)) (rx/of (dwdc/handle-finish-drawing))))))) (defn handle-new-shape "Creates a new path shape" [] (ptk/reify ::handle-new-shape ptk/UpdateEvent (update [_ state] (let [id (st/get-path-id state)] (-> state (assoc-in [:workspace-local :edit-path id :snap-toggled] false)))) 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 (dch/update-shapes [id] upsp/convert-to-path)) (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 _] (let [id (st/get-path-id state) content (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 _] (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)))))) (defn reset-last-handler [] (ptk/reify ::reset-last-handler ptk/UpdateEvent (update [_ state] (let [id (st/get-path-id state)] (-> state (assoc-in [:workspace-local :edit-path id :prev-handler] nil))))))