mirror of https://github.com/penpot/penpot.git
1504 lines
51 KiB
Clojure
1504 lines
51 KiB
Clojure
;; 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) 2020 UXBOX Labs SL
|
|
|
|
(ns uxbox.main.data.workspace
|
|
(:require
|
|
[beicon.core :as rx]
|
|
[cljs.spec.alpha :as s]
|
|
[clojure.set :as set]
|
|
[potok.core :as ptk]
|
|
[uxbox.common.data :as d]
|
|
[uxbox.common.exceptions :as ex]
|
|
[uxbox.common.pages :as cp]
|
|
[uxbox.common.pages-helpers :as cph]
|
|
[uxbox.common.spec :as us]
|
|
[uxbox.common.uuid :as uuid]
|
|
[uxbox.config :as cfg]
|
|
[uxbox.main.constants :as c]
|
|
[uxbox.main.data.workspace.common :as dwc]
|
|
[uxbox.main.data.workspace.notifications :as dwn]
|
|
[uxbox.main.data.workspace.persistence :as dwp]
|
|
[uxbox.main.data.workspace.texts :as dwtxt]
|
|
[uxbox.main.data.workspace.transforms :as dwt]
|
|
[uxbox.main.data.workspace.selection :as dws]
|
|
[uxbox.main.repo :as rp]
|
|
[uxbox.main.store :as st]
|
|
[uxbox.main.streams :as ms]
|
|
[uxbox.main.worker :as uw]
|
|
[uxbox.common.geom.matrix :as gmt]
|
|
[uxbox.common.geom.point :as gpt]
|
|
[uxbox.common.geom.shapes :as geom]
|
|
[uxbox.common.math :as mth]
|
|
[uxbox.util.timers :as ts]
|
|
[uxbox.util.router :as rt]
|
|
[uxbox.util.transit :as t]
|
|
[uxbox.util.webapi :as wapi]))
|
|
|
|
;; --- Specs
|
|
|
|
(s/def ::shape-attrs ::cp/shape-attrs)
|
|
(s/def ::set-of-string
|
|
(s/every string? :kind set?))
|
|
|
|
;; --- Expose inner functions
|
|
|
|
(defn interrupt? [e] (= e :interrupt))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Workspace Initialization
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(declare file-initialized)
|
|
|
|
;; --- Initialize Workspace
|
|
|
|
(s/def ::layout-flag
|
|
#{:sitemap
|
|
:sitemap-pages
|
|
:layers
|
|
:assets
|
|
:document-history
|
|
:colorpalette
|
|
:element-options
|
|
:rules
|
|
:display-grid
|
|
:snap-grid
|
|
:dynamic-alignment})
|
|
|
|
(s/def ::layout-flags (s/coll-of ::layout-flag))
|
|
|
|
(def default-layout
|
|
#{:sitemap
|
|
:sitemap-pages
|
|
:layers
|
|
:element-options
|
|
:rules
|
|
:display-grid
|
|
:snap-grid
|
|
:dynamic-alignment})
|
|
|
|
(s/def ::options-mode #{:design :prototype})
|
|
|
|
(def workspace-local-default
|
|
{:zoom 1
|
|
:flags #{}
|
|
:selected (d/ordered-set)
|
|
:expanded {}
|
|
:drawing nil
|
|
:drawing-tool nil
|
|
:tooltip nil
|
|
:options-mode :design
|
|
:draw-interaction-to nil
|
|
:left-sidebar? true
|
|
:right-sidebar? true
|
|
:color-for-rename nil})
|
|
|
|
(def initialize-layout
|
|
(ptk/reify ::initialize-layout
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(assoc state :workspace-layout default-layout))))
|
|
|
|
(defn initialize-file
|
|
[project-id file-id]
|
|
(us/verify ::us/uuid project-id)
|
|
(us/verify ::us/uuid file-id)
|
|
|
|
(ptk/reify ::initialize-file
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(assoc state :workspace-presence {}))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(rx/merge
|
|
(rx/of (dwp/fetch-bundle project-id file-id))
|
|
|
|
(->> stream
|
|
(rx/filter (ptk/type? ::dwp/bundle-fetched))
|
|
(rx/mapcat (fn [_] (rx/of (dwn/initialize file-id))))
|
|
(rx/first))
|
|
|
|
(->> stream
|
|
(rx/filter (ptk/type? ::dwp/bundle-fetched))
|
|
(rx/map deref)
|
|
(rx/map dwc/setup-selection-index)
|
|
(rx/first))
|
|
|
|
(->> stream
|
|
(rx/filter #(= ::dwc/index-initialized %))
|
|
(rx/map (constantly
|
|
(file-initialized project-id file-id))))))))
|
|
|
|
(defn- file-initialized
|
|
[project-id file-id]
|
|
(ptk/reify ::initialized
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update state :workspace-file
|
|
(fn [file]
|
|
(if (= (:id file) file-id)
|
|
(assoc file :initialized true)
|
|
file))))))
|
|
|
|
(defn finalize-file
|
|
[project-id file-id]
|
|
(ptk/reify ::finalize
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(dissoc state :workspace-file :workspace-project))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(rx/of (dwn/finalize file-id)))))
|
|
|
|
|
|
(defn initialize-page
|
|
[page-id]
|
|
(ptk/reify ::initialize-page
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [page (get-in state [:workspace-pages page-id])
|
|
local (get-in state [:workspace-cache page-id] workspace-local-default)]
|
|
(-> state
|
|
(assoc :current-page-id page-id ; mainly used by events
|
|
:workspace-local local
|
|
:workspace-page (dissoc page :data))
|
|
(assoc-in [:workspace-data page-id] (:data page)))))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(rx/of (dwp/initialize-page-persistence page-id)))))
|
|
|
|
(defn finalize-page
|
|
[page-id]
|
|
(us/verify ::us/uuid page-id)
|
|
(ptk/reify ::finalize-page
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [local (:workspace-local state)]
|
|
(-> state
|
|
(assoc-in [:workspace-cache page-id] local)
|
|
(update :workspace-data dissoc page-id))))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(rx/of ::dwp/finalize))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Workspace State Manipulation
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; --- Viewport Sizing
|
|
|
|
(declare zoom-to-fit-all)
|
|
|
|
(defn initialize-viewport
|
|
[{:keys [width height] :as size}]
|
|
(letfn [(update* [{:keys [vbox vport] :as local}]
|
|
(let [wprop (/ (:width vport) width)
|
|
hprop (/ (:height vport) height)]
|
|
(-> local
|
|
(assoc :vport size)
|
|
(update :vbox (fn [vbox]
|
|
(-> vbox
|
|
(update :width #(/ % wprop))
|
|
(update :height #(/ % hprop))))))))
|
|
|
|
(initialize [state local]
|
|
(let [page-id (get-in state [:workspace-page :id])
|
|
objects (get-in state [:workspace-data page-id :objects])
|
|
shapes (cph/select-toplevel-shapes objects {:include-frames? true})
|
|
srect (geom/selection-rect shapes)
|
|
local (assoc local :vport size)]
|
|
(cond
|
|
(or (not (mth/finite? (:width srect)))
|
|
(not (mth/finite? (:height srect))))
|
|
(assoc local :vbox (assoc size :x 0 :y 0 :left-offset 0))
|
|
|
|
(or (> (:width srect) width)
|
|
(> (:height srect) height))
|
|
(let [srect (geom/adjust-to-viewport size srect {:padding 40})
|
|
zoom (/ (:width size) (:width srect))]
|
|
(-> local
|
|
(assoc :zoom zoom)
|
|
(update :vbox merge srect)))
|
|
|
|
:else
|
|
(assoc local :vbox (assoc size
|
|
:x (- (:x srect) 40)
|
|
:y (- (:y srect) 40))))))
|
|
|
|
(setup [state local]
|
|
(if (:vbox local)
|
|
(update* local)
|
|
(initialize state local)))]
|
|
|
|
(ptk/reify ::initialize-viewport
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update state :workspace-local
|
|
(fn [local]
|
|
(setup state local)))))))
|
|
|
|
(defn update-viewport-position
|
|
[{:keys [x y] :or {x identity y identity}}]
|
|
(us/assert fn? x)
|
|
(us/assert fn? y)
|
|
(ptk/reify ::update-viewport-position
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update-in state [:workspace-local :vbox]
|
|
(fn [vbox]
|
|
(-> vbox
|
|
(update :x x)
|
|
(update :y y)))))))
|
|
|
|
(defn update-viewport-size
|
|
[{:keys [width height] :as size}]
|
|
(ptk/reify ::update-viewport-size
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update state :workspace-local
|
|
(fn [{:keys [vbox vport left-sidebar? zoom] :as local}]
|
|
(let [wprop (/ (:width vport) width)
|
|
hprop (/ (:height vport) height)
|
|
left-offset (if left-sidebar? 0 (/ (* -1 15 16) zoom))]
|
|
(-> local ;; This matches $width-settings-bar
|
|
(assoc :vport size) ;; in frontend/resources/styles/main/partials/sidebar.scss
|
|
(update :vbox (fn [vbox]
|
|
(-> vbox
|
|
(update :width #(/ % wprop))
|
|
(update :height #(/ % hprop))
|
|
(assoc :left-offset left-offset)))))))))))
|
|
|
|
|
|
(defn start-pan [state]
|
|
(-> state
|
|
(assoc-in [:workspace-local :panning] true)))
|
|
|
|
(defn finish-pan [state]
|
|
(-> state
|
|
(update :workspace-local dissoc :panning)))
|
|
|
|
|
|
;; --- Toggle layout flag
|
|
|
|
(defn- toggle-layout-flag
|
|
[state flag]
|
|
(us/assert ::layout-flag flag)
|
|
(update state :workspace-layout
|
|
(fn [flags]
|
|
(if (contains? flags flag)
|
|
(disj flags flag)
|
|
(conj flags flag)))))
|
|
|
|
(defn- check-sidebars
|
|
[state]
|
|
(let [layout (:workspace-layout state)
|
|
left-sidebar? (not (empty? (keep layout [:layers
|
|
:sitemap
|
|
:document-history
|
|
:assets])))
|
|
right-sidebar? (not (empty? (keep layout [:element-options])))]
|
|
(update-in state [:workspace-local]
|
|
assoc :left-sidebar? left-sidebar?
|
|
:right-sidebar? right-sidebar?)))
|
|
|
|
(defn- check-auto-flags
|
|
[state flags-to-toggle]
|
|
(update state :workspace-layout
|
|
(fn [flags]
|
|
(cond
|
|
(contains? (set flags-to-toggle) :assets)
|
|
(disj flags :sitemap :layers)
|
|
|
|
(contains? (set flags-to-toggle) :sitemap)
|
|
(disj flags :assets)
|
|
|
|
:else
|
|
flags))))
|
|
|
|
(defn toggle-layout-flags
|
|
[& flags]
|
|
(us/assert ::layout-flags flags)
|
|
(ptk/reify ::toggle-layout-flags
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(-> (reduce toggle-layout-flag state flags)
|
|
(check-sidebars)
|
|
(check-auto-flags flags)))))
|
|
|
|
;; --- Set element options mode
|
|
|
|
(defn set-options-mode
|
|
[mode]
|
|
(us/assert ::options-mode mode)
|
|
(ptk/reify ::set-options-mode
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(assoc-in state [:workspace-local :options-mode] mode))))
|
|
|
|
;; --- Tooltip
|
|
|
|
(defn assign-cursor-tooltip
|
|
[content]
|
|
(ptk/reify ::assign-cursor-tooltip
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(if (string? content)
|
|
(assoc-in state [:workspace-local :tooltip] content)
|
|
(assoc-in state [:workspace-local :tooltip] nil)))))
|
|
|
|
;; --- Zoom Management
|
|
|
|
(defn- impl-update-zoom
|
|
[{:keys [vbox vport] :as local} center zoom]
|
|
(let [new-zoom (if (fn? zoom) (zoom (:zoom local)) zoom)
|
|
old-zoom (:zoom local)
|
|
center (if center center (geom/center vbox))
|
|
scale (/ old-zoom new-zoom)
|
|
mtx (gmt/scale-matrix (gpt/point scale) center)
|
|
vbox' (geom/transform vbox mtx)]
|
|
(-> local
|
|
(assoc :zoom new-zoom)
|
|
(update :vbox merge (select-keys vbox' [:x :y :width :height])))))
|
|
|
|
(defn increase-zoom
|
|
[center]
|
|
(ptk/reify ::increase-zoom
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update state :workspace-local
|
|
#(impl-update-zoom % center (fn [z] (min (* z 1.1) 200)))))))
|
|
|
|
(defn decrease-zoom
|
|
[center]
|
|
(ptk/reify ::decrease-zoom
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update state :workspace-local
|
|
#(impl-update-zoom % center (fn [z] (max (* z 0.9) 0.01)))))))
|
|
|
|
(def reset-zoom
|
|
(ptk/reify ::reset-zoom
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update state :workspace-local
|
|
#(impl-update-zoom % nil 1)))))
|
|
|
|
(def zoom-to-fit-all
|
|
(ptk/reify ::zoom-to-fit-all
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [page-id (get-in state [:workspace-page :id])
|
|
objects (get-in state [:workspace-data page-id :objects])
|
|
shapes (cph/select-toplevel-shapes objects {:include-frames? true})
|
|
srect (geom/selection-rect shapes)]
|
|
|
|
(if (or (mth/nan? (:width srect))
|
|
(mth/nan? (:height srect)))
|
|
state
|
|
(update state :workspace-local
|
|
(fn [{:keys [vbox vport] :as local}]
|
|
(let [srect (geom/adjust-to-viewport vport srect {:padding 40})
|
|
zoom (/ (:width vport) (:width srect))]
|
|
(-> local
|
|
(assoc :zoom zoom)
|
|
(update :vbox merge srect))))))))))
|
|
|
|
(def zoom-to-selected-shape
|
|
(ptk/reify ::zoom-to-selected-shape
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [selected (get-in state [:workspace-local :selected])]
|
|
(if (empty? selected)
|
|
state
|
|
(let [page-id (get-in state [:workspace-page :id])
|
|
objects (get-in state [:workspace-data page-id :objects])
|
|
srect (->> selected
|
|
(map #(get objects %))
|
|
(geom/selection-rect))]
|
|
(update state :workspace-local
|
|
(fn [{:keys [vbox vport] :as local}]
|
|
(let [srect (geom/adjust-to-viewport vport srect {:padding 40})
|
|
zoom (/ (:width vport) (:width srect))]
|
|
(-> local
|
|
(assoc :zoom zoom)
|
|
(update :vbox merge srect)))))))))))
|
|
|
|
|
|
;; --- Add shape to Workspace
|
|
|
|
(defn- retrieve-used-names
|
|
[objects]
|
|
(into #{} (map :name) (vals objects)))
|
|
|
|
(defn- extract-numeric-suffix
|
|
[basename]
|
|
(if-let [[match p1 p2] (re-find #"(.*)-([0-9]+)$" basename)]
|
|
[p1 (+ 1 (d/parse-integer p2))]
|
|
[basename 1]))
|
|
|
|
(defn- generate-unique-name
|
|
"A unique name generator"
|
|
[used basename]
|
|
(s/assert ::set-of-string used)
|
|
(s/assert ::us/string basename)
|
|
(let [[prefix initial] (extract-numeric-suffix basename)]
|
|
(loop [counter initial]
|
|
(let [candidate (str prefix "-" counter)]
|
|
(if (contains? used candidate)
|
|
(recur (inc counter))
|
|
candidate)))))
|
|
|
|
(declare start-edition-mode)
|
|
|
|
(defn add-shape
|
|
[attrs]
|
|
(us/verify ::shape-attrs attrs)
|
|
(ptk/reify ::add-shape
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
objects (get-in state [:workspace-data page-id :objects])
|
|
|
|
id (uuid/next)
|
|
shape (geom/setup-proportions attrs)
|
|
|
|
unames (retrieve-used-names objects)
|
|
name (generate-unique-name unames (:name shape))
|
|
|
|
frames (cph/select-frames objects)
|
|
|
|
frame-id (if (= :frame (:type shape))
|
|
uuid/zero
|
|
(dwc/calculate-frame-overlap frames shape))
|
|
|
|
shape (merge
|
|
(if (= :frame (:type shape))
|
|
cp/default-frame-attrs
|
|
cp/default-shape-attrs)
|
|
(assoc shape
|
|
:id id
|
|
:name name
|
|
:frame-id frame-id))
|
|
|
|
rchange {:type :add-obj
|
|
:id id
|
|
:frame-id frame-id
|
|
:obj shape}
|
|
uchange {:type :del-obj
|
|
:id id}]
|
|
|
|
(rx/concat
|
|
(rx/of (dwc/commit-changes [rchange] [uchange] {:commit-local? true})
|
|
(dws/select-shapes (d/ordered-set id)))
|
|
(when (= :text (:type attrs))
|
|
(->> (rx/of (start-edition-mode id))
|
|
(rx/observe-on :async))))))))
|
|
|
|
(defn- calculate-centered-box
|
|
[state aspect-ratio]
|
|
(if (>= aspect-ratio 1)
|
|
(let [vbox (get-in state [:workspace-local :vbox])
|
|
width (/ (:width vbox) 2)
|
|
height (/ width aspect-ratio)
|
|
|
|
x (+ (:x vbox) (/ width 2))
|
|
y (+ (:y vbox) (/ (- (:height vbox) height) 2))]
|
|
|
|
[width height x y])
|
|
|
|
(let [vbox (get-in state [:workspace-local :vbox])
|
|
height (/ (:height vbox) 2)
|
|
width (* height aspect-ratio)
|
|
|
|
y (+ (:y vbox) (/ height 2))
|
|
x (+ (:x vbox) (/ (- (:width vbox) width) 2))]
|
|
|
|
[width height x y])))
|
|
|
|
(defn create-and-add-shape
|
|
[type data aspect-ratio]
|
|
(ptk/reify ::create-and-add-shape
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [[width height x y] (calculate-centered-box state aspect-ratio)
|
|
shape (-> (cp/make-minimal-shape type)
|
|
(merge data)
|
|
(geom/resize width height)
|
|
(geom/absolute-move (gpt/point x y)))]
|
|
|
|
(rx/of (add-shape shape))))))
|
|
|
|
;; --- Update Shape Attrs
|
|
|
|
(defn update-shape
|
|
[id attrs]
|
|
(us/verify ::us/uuid id)
|
|
(us/verify ::shape-attrs attrs)
|
|
(ptk/reify ::update-shape
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(rx/of (dwc/update-shapes [id] #(merge % attrs))))))
|
|
|
|
;; --- Update Selected Shapes attrs
|
|
|
|
(defn update-selected-shapes
|
|
[attrs]
|
|
(us/verify ::shape-attrs attrs)
|
|
(ptk/reify ::update-selected-shapes
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [selected (get-in state [:workspace-local :selected])]
|
|
(rx/from (map #(update-shape % attrs) selected))))))
|
|
|
|
(defn update-color-on-selected-shapes
|
|
[{:keys [fill-color stroke-color] :as attrs}]
|
|
(us/verify ::shape-attrs attrs)
|
|
(ptk/reify ::update-color-on-selected-shapes
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [selected (get-in state [:workspace-local :selected])
|
|
update-fn
|
|
(fn [shape]
|
|
(cond-> (merge shape attrs)
|
|
(and (= :text (:type shape))
|
|
(string? (:fill-color attrs)))
|
|
(dwtxt/impl-update-shape-attrs {:fill (:fill-color attrs)})))]
|
|
(rx/of (dwc/update-shapes-recursive selected update-fn))))))
|
|
|
|
|
|
;; --- Shape Movement (using keyboard shorcuts)
|
|
|
|
(declare initial-selection-align)
|
|
|
|
(defn- get-displacement-with-grid
|
|
"Retrieve the correct displacement delta point for the
|
|
provided direction speed and distances thresholds."
|
|
[shape direction options]
|
|
(let [grid-x (:grid-x options 10)
|
|
grid-y (:grid-y options 10)
|
|
x-mod (mod (:x shape) grid-x)
|
|
y-mod (mod (:y shape) grid-y)]
|
|
(case direction
|
|
:up (gpt/point 0 (- (if (zero? y-mod) grid-y y-mod)))
|
|
:down (gpt/point 0 (- grid-y y-mod))
|
|
:left (gpt/point (- (if (zero? x-mod) grid-x x-mod)) 0)
|
|
:right (gpt/point (- grid-x x-mod) 0))))
|
|
|
|
(defn- get-displacement
|
|
"Retrieve the correct displacement delta point for the
|
|
provided direction speed and distances thresholds."
|
|
[shape direction]
|
|
(case direction
|
|
:up (gpt/point 0 (- 1))
|
|
:down (gpt/point 0 1)
|
|
:left (gpt/point (- 1) 0)
|
|
:right (gpt/point 1 0)))
|
|
|
|
;; --- Delete Selected
|
|
|
|
(defn- delete-shapes
|
|
[ids]
|
|
(us/assert (s/coll-of ::us/uuid) ids)
|
|
(ptk/reify ::delete-shapes
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
objects (get-in state [:workspace-data page-id :objects])
|
|
|
|
del-change #(array-map :type :del-obj :id %)
|
|
|
|
get-empty-parents
|
|
(fn get-empty-parents [parents]
|
|
(->> parents
|
|
(map (fn [id]
|
|
(let [obj (get objects id)]
|
|
(when (and (= :group (:type obj))
|
|
(= 1 (count (:shapes obj))))
|
|
obj))))
|
|
(take-while (complement nil?))
|
|
(map :id)))
|
|
|
|
rchanges
|
|
(reduce (fn [res id]
|
|
(let [children (cph/get-children id objects)
|
|
parents (cph/get-parents id objects)]
|
|
(d/concat res
|
|
(map del-change (reverse children))
|
|
[(del-change id)]
|
|
(map del-change (get-empty-parents parents))
|
|
[{:type :reg-objects :shapes (vec parents)}])))
|
|
[]
|
|
ids)
|
|
|
|
uchanges
|
|
(reduce (fn [res id]
|
|
(let [children (cph/get-children id objects)
|
|
parents (cph/get-parents id objects)
|
|
add-chg (fn [id]
|
|
(let [item (get objects id)]
|
|
{:type :add-obj
|
|
:id (:id item)
|
|
:index (cph/position-on-parent id objects)
|
|
:frame-id (:frame-id item)
|
|
:parent-id (:parent-id item)
|
|
:obj item}))]
|
|
(d/concat res
|
|
(map add-chg (reverse (get-empty-parents parents)))
|
|
[(add-chg id)]
|
|
(map add-chg children)
|
|
[{:type :reg-objects :shapes (vec parents)}])))
|
|
[]
|
|
ids)
|
|
]
|
|
|
|
;; (println "================ rchanges")
|
|
;; (cljs.pprint/pprint rchanges)
|
|
;; (println "================ uchanges")
|
|
;; (cljs.pprint/pprint uchanges)
|
|
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}))))))
|
|
|
|
(def delete-selected
|
|
"Deselect all and remove all selected shapes."
|
|
(ptk/reify ::delete-selected
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
lookup #(get-in state [:workspace-data page-id :objects %])
|
|
selected (get-in state [:workspace-local :selected])
|
|
|
|
shapes (map lookup selected)
|
|
shape? #(not= (:type %) :frame)]
|
|
(rx/of (delete-shapes selected)
|
|
dws/deselect-all)))))
|
|
|
|
|
|
;; --- Shape Vertical Ordering
|
|
|
|
(s/def ::loc #{:up :down :bottom :top})
|
|
|
|
(defn vertical-order-selected
|
|
[loc]
|
|
(us/verify ::loc loc)
|
|
(ptk/reify ::vertical-order-selected-shpes
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
objects (get-in state [:workspace-data page-id :objects])
|
|
selected (get-in state [:workspace-local :selected])
|
|
rchanges (mapv (fn [id]
|
|
(let [obj (get objects id)
|
|
parent (get objects (:parent-id obj))
|
|
shapes (:shapes parent)
|
|
cindex (d/index-of shapes id)
|
|
nindex (case loc
|
|
:top (count shapes)
|
|
:down (max 0 (- cindex 1))
|
|
:up (min (count shapes) (+ (inc cindex) 1))
|
|
:bottom 0)]
|
|
{:type :mov-objects
|
|
:parent-id (:parent-id obj)
|
|
:frame-id (:frame-id obj)
|
|
:index nindex
|
|
:shapes [id]}))
|
|
selected)
|
|
|
|
uchanges (mapv (fn [id]
|
|
(let [obj (get objects id)]
|
|
{:type :mov-objects
|
|
:parent-id (:parent-id obj)
|
|
:frame-id (:frame-id obj)
|
|
:shapes [id]
|
|
:index (cph/position-on-parent id objects)}))
|
|
selected)]
|
|
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}))))))
|
|
|
|
|
|
;; --- Change Shape Order (D&D Ordering)
|
|
|
|
(defn relocate-shapes
|
|
[ids parent-id to-index]
|
|
(us/verify (s/coll-of ::us/uuid) ids)
|
|
(us/verify ::us/uuid parent-id)
|
|
(us/verify number? to-index)
|
|
|
|
(ptk/reify ::relocate-shapes
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
objects (get-in state [:workspace-data page-id :objects])
|
|
|
|
parents (loop [res #{parent-id}
|
|
ids (seq ids)]
|
|
(if (nil? ids)
|
|
(vec res)
|
|
(recur
|
|
(conj res (cph/get-parent (first ids) objects))
|
|
(next ids))))
|
|
|
|
rchanges [{:type :mov-objects
|
|
:parent-id parent-id
|
|
:index to-index
|
|
:shapes (vec (reverse ids))}
|
|
{:type :reg-objects
|
|
:shapes parents}]
|
|
|
|
uchanges
|
|
(reduce (fn [res id]
|
|
(let [obj (get objects id)]
|
|
(conj res
|
|
{:type :mov-objects
|
|
:parent-id (:parent-id obj)
|
|
:index (cph/position-on-parent id objects)
|
|
:shapes [id]})))
|
|
[] (reverse ids))
|
|
uchanges (conj uchanges
|
|
{:type :reg-objects
|
|
:shapes parents})]
|
|
|
|
;; (println "================ rchanges")
|
|
;; (cljs.pprint/pprint rchanges)
|
|
;; (println "================ uchanges")
|
|
;; (cljs.pprint/pprint uchanges)
|
|
(rx/of (dwc/commit-changes rchanges uchanges
|
|
{:commit-local? true}))))))
|
|
|
|
(defn relocate-selected-shapes
|
|
[parent-id to-index]
|
|
(ptk/reify ::relocate-selected-shapes
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [selected (get-in state [:workspace-local :selected])]
|
|
(rx/of (relocate-shapes selected parent-id to-index))))))
|
|
|
|
|
|
;; --- Change Page Order (D&D Ordering)
|
|
|
|
(defn relocate-page
|
|
[id index]
|
|
(ptk/reify ::relocate-pages
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [pages (get-in state [:workspace-file :pages])
|
|
[before after] (split-at index pages)
|
|
p? (partial = id)
|
|
pages' (d/concat []
|
|
(remove p? before)
|
|
[id]
|
|
(remove p? after))]
|
|
(assoc-in state [:workspace-file :pages] pages')))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [file (:workspace-file state)]
|
|
(->> (rp/mutation! :reorder-pages {:page-ids (:pages file)
|
|
:file-id (:id file)})
|
|
(rx/ignore))))))
|
|
|
|
;; --- Shape / Selection Alignment and Distribution
|
|
|
|
(declare align-object-to-frame)
|
|
(declare align-objects-list)
|
|
|
|
(defn align-objects
|
|
[axis]
|
|
(us/verify ::geom/align-axis axis)
|
|
(ptk/reify :align-objects
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
objects (get-in state [:workspace-data page-id :objects])
|
|
selected (get-in state [:workspace-local :selected])
|
|
moved (if (= 1 (count selected))
|
|
(align-object-to-frame objects (first selected) axis)
|
|
(align-objects-list objects selected axis))]
|
|
(loop [moved (seq moved)
|
|
rchanges []
|
|
uchanges []]
|
|
(if (nil? moved)
|
|
(do
|
|
;; (println "================ rchanges")
|
|
;; (cljs.pprint/pprint rchanges)
|
|
;; (println "================ uchanges")
|
|
;; (cljs.pprint/pprint uchanges)
|
|
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})))
|
|
(let [curr (first moved)
|
|
prev (get objects (:id curr))
|
|
ops1 (dwc/generate-operations prev curr)
|
|
ops2 (dwc/generate-operations curr prev)]
|
|
(recur (next moved)
|
|
(conj rchanges {:type :mod-obj
|
|
:operations ops1
|
|
:id (:id curr)})
|
|
(conj uchanges {:type :mod-obj
|
|
:operations ops2
|
|
:id (:id curr)})))))))))
|
|
|
|
(defn align-object-to-frame
|
|
[objects object-id axis]
|
|
(let [object (get objects object-id)
|
|
frame (get objects (:frame-id object))]
|
|
(geom/align-to-rect object frame axis objects)))
|
|
|
|
(defn align-objects-list
|
|
[objects selected axis]
|
|
(let [selected-objs (map #(get objects %) selected)
|
|
rect (geom/selection-rect selected-objs)]
|
|
(mapcat #(geom/align-to-rect % rect axis objects) selected-objs)))
|
|
|
|
(defn distribute-objects
|
|
[axis]
|
|
(us/verify ::geom/dist-axis axis)
|
|
(ptk/reify :align-objects
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
objects (get-in state [:workspace-data page-id :objects])
|
|
selected (get-in state [:workspace-local :selected])
|
|
|
|
moved (-> (map #(get objects %) selected)
|
|
(geom/distribute-space axis objects))]
|
|
(loop [moved (seq moved)
|
|
rchanges []
|
|
uchanges []]
|
|
(if (nil? moved)
|
|
(do
|
|
;; (println "================ rchanges")
|
|
;; (cljs.pprint/pprint rchanges)
|
|
;; (println "================ uchanges")
|
|
;; (cljs.pprint/pprint uchanges)
|
|
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})))
|
|
(let [curr (first moved)
|
|
prev (get objects (:id curr))
|
|
ops1 (dwc/generate-operations prev curr)
|
|
ops2 (dwc/generate-operations curr prev)]
|
|
(recur (next moved)
|
|
(conj rchanges {:type :mod-obj
|
|
:operations ops1
|
|
:id (:id curr)})
|
|
(conj uchanges {:type :mod-obj
|
|
:operations ops2
|
|
:id (:id curr)})))))))))
|
|
|
|
;; --- Start shape "edition mode"
|
|
|
|
(declare clear-edition-mode)
|
|
|
|
(defn start-edition-mode
|
|
[id]
|
|
(us/assert ::us/uuid id)
|
|
(ptk/reify ::start-edition-mode
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(assoc-in state [:workspace-local :edition] id))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(->> stream
|
|
(rx/filter interrupt?)
|
|
(rx/take 1)
|
|
(rx/map (constantly clear-edition-mode))))))
|
|
|
|
(def clear-edition-mode
|
|
(ptk/reify ::clear-edition-mode
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update state :workspace-local dissoc :edition))))
|
|
|
|
;; --- Select for Drawing
|
|
|
|
(def clear-drawing
|
|
(ptk/reify ::clear-drawing
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update state :workspace-local dissoc :drawing-tool :drawing))))
|
|
|
|
(defn select-for-drawing
|
|
([tool] (select-for-drawing tool nil))
|
|
([tool data]
|
|
(ptk/reify ::select-for-drawing
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update state :workspace-local assoc :drawing-tool tool :drawing data))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [cancel-event? (fn [event]
|
|
(interrupt? event))
|
|
stoper (rx/filter (ptk/type? ::clear-drawing) stream)]
|
|
(->> (rx/filter cancel-event? stream)
|
|
(rx/take 1)
|
|
(rx/map (constantly clear-drawing))
|
|
(rx/take-until stoper)))))))
|
|
|
|
;; --- Update Dimensions
|
|
|
|
;; Event mainly used for handling user modification of the size of the
|
|
;; object from workspace sidebar options inputs.
|
|
|
|
;; TODO: maybe replace directly with dwc/update-shapes?
|
|
|
|
(defn update-dimensions
|
|
[ids attr value]
|
|
(us/verify (s/coll-of ::us/uuid) ids)
|
|
(us/verify #{:width :height} attr)
|
|
(us/verify ::us/number value)
|
|
(ptk/reify ::update-dimensions
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(rx/of (dwc/update-shapes ids #(geom/resize-rect % attr value))))))
|
|
|
|
|
|
;; --- Shape Proportions
|
|
|
|
(defn set-shape-proportion-lock
|
|
[id lock]
|
|
(ptk/reify ::set-shape-proportion-lock
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [page-id (:current-page-id state)
|
|
shape (get-in state [:workspace-data page-id :objects id])]
|
|
(if-not lock
|
|
(assoc-in state [:workspace-data page-id :objects id :proportion-lock] lock))
|
|
(->> (geom/assign-proportions (assoc shape :proportion-lock lock))
|
|
(assoc-in state [:workspace-data page-id :objects id]))))))
|
|
|
|
;; --- Update Shape Position
|
|
|
|
(s/def ::x number?)
|
|
(s/def ::y number?)
|
|
(s/def ::position
|
|
(s/keys :opt-un [::x ::y]))
|
|
|
|
(defn update-position
|
|
[id position]
|
|
(us/verify ::us/uuid id)
|
|
(us/verify ::position position)
|
|
(ptk/reify ::update-position
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
shape (get-in state [:workspace-data page-id :objects id])
|
|
current-position (gpt/point (:x shape) (:y shape))
|
|
position (gpt/point (or (:x position) (:x shape)) (or (:y position) (:y shape)))
|
|
displacement (gmt/translate-matrix (gpt/subtract position current-position))]
|
|
(rx/of (dwt/set-modifiers [id] {:displacement displacement})
|
|
(dwt/apply-modifiers [id]))))))
|
|
|
|
;; --- Path Modifications
|
|
|
|
(defn update-path
|
|
"Update a concrete point in the path shape."
|
|
[id index delta]
|
|
(us/verify ::us/uuid id)
|
|
(us/verify ::us/integer index)
|
|
(us/verify gpt/point? delta)
|
|
(ptk/reify ::update-path
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [page-id (:current-page-id state)]
|
|
(-> state
|
|
(update-in [:workspace-data page-id :objects id :segments index] gpt/add delta)
|
|
(update-in [:workspace-data page-id :objects id] geom/update-path-selrect))))))
|
|
|
|
;; --- Shape attrs (Layers Sidebar)
|
|
|
|
(defn toggle-collapse
|
|
[id]
|
|
(ptk/reify ::toggle-collapse
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update-in state [:workspace-local :expanded id] not))))
|
|
|
|
(def collapse-all
|
|
(ptk/reify ::collapse-all
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update state :workspace-local dissoc :expanded))))
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Navigation
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn navigate-to-project
|
|
[project-id]
|
|
(ptk/reify ::navigate-to-project
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-ids (get-in state [:projects project-id :pages])
|
|
params {:project project-id :page (first page-ids)}]
|
|
(rx/of (rt/nav :workspace/page params))))))
|
|
|
|
(defn go-to-page
|
|
[page-id]
|
|
(us/verify ::us/uuid page-id)
|
|
(ptk/reify ::go-to-page
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [project-id (get-in state [:workspace-project :id])
|
|
file-id (get-in state [:workspace-page :file-id])
|
|
path-params {:file-id file-id :project-id project-id}
|
|
query-params {:page-id page-id}]
|
|
(rx/of (rt/nav :workspace path-params query-params))))))
|
|
|
|
(def go-to-file
|
|
(ptk/reify ::go-to-file
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [file (:workspace-file state)
|
|
|
|
file-id (:id file)
|
|
project-id (:project-id file)
|
|
page-ids (:pages file)
|
|
|
|
path-params {:project-id project-id :file-id file-id}
|
|
query-params {:page-id (first page-ids)}]
|
|
(rx/of (rt/nav :workspace path-params query-params))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Context Menu
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(s/def ::point gpt/point?)
|
|
|
|
(defn show-context-menu
|
|
[{:keys [position] :as params}]
|
|
(us/verify ::point position)
|
|
(ptk/reify ::show-context-menu
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(assoc-in state [:workspace-local :context-menu] {:position position}))))
|
|
|
|
(defn show-shape-context-menu
|
|
[{:keys [position shape] :as params}]
|
|
(us/verify ::point position)
|
|
(us/verify ::cp/minimal-shape shape)
|
|
(ptk/reify ::show-context-menu
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [mdata {:position position
|
|
:shape shape
|
|
:selected (get-in state [:workspace-local :selected])}]
|
|
(-> state
|
|
(assoc-in [:workspace-local :context-menu] mdata))))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(rx/of (dws/select-shape (:id shape))))))
|
|
|
|
(def hide-context-menu
|
|
(ptk/reify ::hide-context-menu
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(assoc-in state [:workspace-local :context-menu] nil))))
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Clipboard
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(def copy-selected
|
|
(letfn [(prepare-selected [objects selected]
|
|
(let [data (reduce #(prepare %1 objects %2) {} selected)]
|
|
{:type :copied-shapes
|
|
:selected selected
|
|
:objects data}))
|
|
|
|
(prepare [result objects id]
|
|
(let [obj (get objects id)]
|
|
(as-> result $$
|
|
(assoc $$ id obj)
|
|
(reduce #(prepare %1 objects %2) $$ (:shapes obj)))))
|
|
|
|
(on-copy-error [error]
|
|
(js/console.error "Clipboard blocked:" error)
|
|
(rx/empty))]
|
|
|
|
(ptk/reify ::copy-selected
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
objects (get-in state [:workspace-data page-id :objects])
|
|
selected (get-in state [:workspace-local :selected])
|
|
cdata (prepare-selected objects selected)]
|
|
(->> (t/encode cdata)
|
|
(wapi/write-to-clipboard)
|
|
(rx/from)
|
|
(rx/catch on-copy-error)
|
|
(rx/ignore)))))))
|
|
|
|
(defn- paste-impl
|
|
[{:keys [selected objects] :as data}]
|
|
(ptk/reify ::paste-impl
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [selected-objs (map #(get objects %) selected)
|
|
wrapper (geom/selection-rect selected-objs)
|
|
orig-pos (gpt/point (:x1 wrapper) (:y1 wrapper))
|
|
mouse-pos @ms/mouse-position
|
|
delta (gpt/subtract mouse-pos orig-pos)
|
|
|
|
page-id (:current-page-id state)
|
|
unames (-> (get-in state [:workspace-data page-id :objects])
|
|
(retrieve-used-names))
|
|
|
|
rchanges (dws/prepare-duplicate-changes objects unames selected delta)
|
|
uchanges (mapv #(array-map :type :del-obj :id (:id %))
|
|
(reverse rchanges))
|
|
|
|
selected (->> rchanges
|
|
(filter #(selected (:old-id %)))
|
|
(map #(get-in % [:obj :id]))
|
|
(into (d/ordered-set)))]
|
|
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
|
|
(dws/select-shapes selected))))))
|
|
|
|
(defn- image-uploaded
|
|
[image]
|
|
(let [shape {:name (:name image)
|
|
:metadata {:width (:width image)
|
|
:height (:height image)
|
|
:uri (:uri image)}}
|
|
;; :thumb-width (:thumb-width image)
|
|
;; :thumb-height (:thumb-height image)
|
|
;; :thumb-uri (:thumb-uri image)}}
|
|
aspect-ratio (/ (:width image) (:height image))]
|
|
(st/emit! (create-and-add-shape :image shape aspect-ratio))))
|
|
|
|
(defn- paste-image-impl
|
|
[image]
|
|
(ptk/reify ::paste-bin-impl
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(rx/of (dwp/upload-media-object image image-uploaded)))))
|
|
|
|
(def paste
|
|
(ptk/reify ::paste
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(->> (wapi/read-from-clipboard)
|
|
(rx/map t/decode)
|
|
(rx/filter #(= :copied-shapes (:type %)))
|
|
(rx/map #(select-keys % [:selected :objects]))
|
|
(rx/map paste-impl)
|
|
(rx/catch (partial instance? js/SyntaxError)
|
|
(fn [_]
|
|
(->> (wapi/read-image-from-clipboard)
|
|
(rx/map paste-image-impl))))
|
|
(rx/catch (fn [err]
|
|
(js/console.error "Clipboard error:" err)
|
|
(rx/empty)))))))
|
|
|
|
|
|
;; --- Change Page Order (D&D Ordering)
|
|
|
|
(defn change-page-order
|
|
[{:keys [id index] :as params}]
|
|
{:pre [(uuid? id) (number? index)]}
|
|
(ptk/reify ::change-page-order
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [page (get-in state [:pages id])
|
|
pages (get-in state [:projects (:project-id page) :pages])
|
|
pages (into [] (remove #(= % id)) pages)
|
|
[before after] (split-at index pages)
|
|
pages (vec (concat before [id] after))]
|
|
(assoc-in state [:projects (:project-id page) :pages] pages)))))
|
|
|
|
(defn update-shape-flags
|
|
[id {:keys [blocked hidden] :as flags}]
|
|
(s/assert ::us/uuid id)
|
|
(s/assert ::shape-attrs flags)
|
|
(ptk/reify ::update-shape-flags
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(letfn [(update-fn [obj]
|
|
(cond-> obj
|
|
(boolean? blocked) (assoc :blocked blocked)
|
|
(boolean? hidden) (assoc :hidden hidden)))]
|
|
(rx/of (dwc/update-shapes-recursive [id] update-fn))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; GROUPS
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn group-shape
|
|
[id frame-id selected selection-rect]
|
|
{:id id
|
|
:type :group
|
|
:name (name (gensym "Group-"))
|
|
:shapes []
|
|
:frame-id frame-id
|
|
:x (:x selection-rect)
|
|
:y (:y selection-rect)
|
|
:width (:width selection-rect)
|
|
:height (:height selection-rect)})
|
|
|
|
(def group-selected
|
|
(ptk/reify ::group-selected
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [id (uuid/next)
|
|
page-id (get-in state [:workspace-page :id])
|
|
selected (get-in state [:workspace-local :selected])
|
|
objects (get-in state [:workspace-data page-id :objects])
|
|
items (->> selected
|
|
(map #(get objects %))
|
|
(filter #(not= :frame (:type %)))
|
|
(map #(assoc % ::index (cph/position-on-parent (:id %) objects)))
|
|
(sort-by ::index))]
|
|
|
|
(when (not-empty items)
|
|
(let [selrect (geom/selection-rect items)
|
|
frame-id (-> items first :frame-id)
|
|
parent-id (-> items first :parent-id)
|
|
group (-> (group-shape id frame-id selected selrect)
|
|
(geom/setup selrect))
|
|
|
|
index (::index (first items))
|
|
|
|
rchanges [{:type :add-obj
|
|
:id id
|
|
:frame-id frame-id
|
|
:parent-id parent-id
|
|
:obj group
|
|
:index index}
|
|
{:type :mov-objects
|
|
:parent-id id
|
|
:shapes (->> items
|
|
(map :id)
|
|
(into #{})
|
|
(vec))}]
|
|
|
|
uchanges
|
|
(reduce (fn [res obj]
|
|
(conj res {:type :mov-objects
|
|
:parent-id (:parent-id obj)
|
|
:index (::index obj)
|
|
:shapes [(:id obj)]}))
|
|
[]
|
|
items)
|
|
|
|
uchanges (conj uchanges {:type :del-obj :id id})]
|
|
|
|
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
|
|
(dws/select-shapes (d/ordered-set id)))))))))
|
|
|
|
(def ungroup-selected
|
|
(ptk/reify ::ungroup-selected
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [page-id (:current-page-id state)
|
|
objects (get-in state [:workspace-data page-id :objects])
|
|
selected (get-in state [:workspace-local :selected])
|
|
group-id (first selected)
|
|
group (get objects group-id)]
|
|
(when (and (= 1 (count selected))
|
|
(= (:type group) :group))
|
|
(let [shapes (:shapes group)
|
|
parent-id (cph/get-parent group-id objects)
|
|
parent (get objects parent-id)
|
|
index-in-parent (->> (:shapes parent)
|
|
(map-indexed vector)
|
|
(filter #(#{group-id} (second %)))
|
|
(ffirst))
|
|
rchanges [{:type :mov-objects
|
|
:parent-id parent-id
|
|
:shapes shapes
|
|
:index index-in-parent}]
|
|
uchanges [{:type :add-obj
|
|
:id group-id
|
|
:frame-id (:frame-id group)
|
|
:obj (assoc group :shapes [])}
|
|
{:type :mov-objects
|
|
:parent-id group-id
|
|
:shapes shapes}
|
|
{:type :mov-objects
|
|
:parent-id parent-id
|
|
:shapes [group-id]
|
|
:index index-in-parent}]]
|
|
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}))))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Interactions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(declare move-create-interaction)
|
|
(declare finish-create-interaction)
|
|
|
|
(defn start-create-interaction
|
|
[]
|
|
(ptk/reify ::start-create-interaction
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [initial-pos @ms/mouse-position
|
|
selected (get-in state [:workspace-local :selected])
|
|
stopper (rx/filter ms/mouse-up? stream)]
|
|
(when (= 1 (count selected))
|
|
(rx/concat
|
|
(->> ms/mouse-position
|
|
(rx/take-until stopper)
|
|
(rx/map #(move-create-interaction initial-pos %)))
|
|
(rx/of (finish-create-interaction initial-pos))))))))
|
|
|
|
(defn move-create-interaction
|
|
[initial-pos position]
|
|
(ptk/reify ::move-create-interaction
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [page-id (:current-page-id state)
|
|
objects (get-in state [:workspace-data page-id :objects])
|
|
selected-shape-id (-> state (get-in [:workspace-local :selected]) first)
|
|
selected-shape (get objects selected-shape-id)
|
|
selected-shape-frame-id (:frame-id selected-shape)
|
|
start-frame (get objects selected-shape-frame-id)
|
|
end-frame (dwc/get-frame-at-point objects position)]
|
|
(cond-> state
|
|
(not= position initial-pos) (assoc-in [:workspace-local :draw-interaction-to] position)
|
|
(not= start-frame end-frame) (assoc-in [:workspace-local :draw-interaction-to-frame] end-frame))))))
|
|
|
|
(defn finish-create-interaction
|
|
[initial-pos]
|
|
(ptk/reify ::finish-create-interaction
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(-> state
|
|
(assoc-in [:workspace-local :draw-interaction-to] nil)
|
|
(assoc-in [:workspace-local :draw-interaction-to-frame] nil)))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [position @ms/mouse-position
|
|
page-id (:current-page-id state)
|
|
objects (get-in state [:workspace-data page-id :objects])
|
|
frame (dwc/get-frame-at-point objects position)
|
|
|
|
shape-id (first (get-in state [:workspace-local :selected]))
|
|
shape (get objects shape-id)]
|
|
|
|
(when-not (= position initial-pos)
|
|
(if (and frame shape-id
|
|
(not= (:id frame) (:id shape))
|
|
(not= (:id frame) (:frame-id shape)))
|
|
(rx/of (update-shape shape-id
|
|
{:interactions [{:event-type :click
|
|
:action-type :navigate
|
|
:destination (:id frame)}]}))
|
|
(rx/of (update-shape shape-id
|
|
{:interactions []}))))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; CANVAS OPTIONS
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn change-canvas-color
|
|
[color]
|
|
(ptk/reify ::change-canvas-color
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [pid (get state :current-page-id)
|
|
current-color (get-in state [:workspace-data pid :options :background])]
|
|
(rx/of (dwc/commit-changes
|
|
[{:type :set-option
|
|
:option :background
|
|
:value color}]
|
|
[{:type :set-option
|
|
:option :background
|
|
:value current-color}]
|
|
{:commit-local? true}))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Exports
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; Transform
|
|
|
|
(def start-rotate dwt/start-rotate)
|
|
(def start-resize dwt/start-resize)
|
|
(def start-move-selected dwt/start-move-selected)
|
|
(def move-selected dwt/move-selected)
|
|
|
|
(def set-rotation dwt/set-rotation)
|
|
(def set-modifiers dwt/set-modifiers)
|
|
(def apply-modifiers dwt/apply-modifiers)
|
|
|
|
;; Persistence
|
|
|
|
(def set-file-shared dwp/set-file-shared)
|
|
(def fetch-media-objects dwp/fetch-media-objects)
|
|
(def add-media-object-from-url dwp/add-media-object-from-url)
|
|
(def upload-media-object dwp/upload-media-object)
|
|
(def delete-media-object dwp/delete-media-object)
|
|
(def fetch-colors dwp/fetch-colors)
|
|
(def rename-page dwp/rename-page)
|
|
(def delete-page dwp/delete-page)
|
|
(def create-empty-page dwp/create-empty-page)
|
|
|
|
;; Selection
|
|
(def select-shape dws/select-shape)
|
|
(def deselect-all dws/deselect-all)
|
|
(def select-shapes dws/select-shapes)
|
|
(def duplicate-selected dws/duplicate-selected)
|
|
(def handle-selection dws/handle-selection)
|
|
(def select-inside-group dws/select-inside-group)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Shortcuts
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; Shortcuts impl https://github.com/ccampbell/mousetrap
|
|
|
|
(def shortcuts
|
|
{"ctrl+i" #(st/emit! (toggle-layout-flags :assets))
|
|
"ctrl+l" #(st/emit! (toggle-layout-flags :sitemap :layers))
|
|
"ctrl+shift+r" #(st/emit! (toggle-layout-flags :rules))
|
|
"ctrl+a" #(st/emit! (toggle-layout-flags :dynamic-alignment))
|
|
"ctrl+p" #(st/emit! (toggle-layout-flags :colorpalette))
|
|
"ctrl+'" #(st/emit! (toggle-layout-flags :display-grid))
|
|
"ctrl+shift+'" #(st/emit! (toggle-layout-flags :snap-grid))
|
|
"+" #(st/emit! (increase-zoom nil))
|
|
"-" #(st/emit! (decrease-zoom nil))
|
|
"ctrl+g" #(st/emit! group-selected)
|
|
"shift+g" #(st/emit! ungroup-selected)
|
|
"shift+0" #(st/emit! reset-zoom)
|
|
"shift+1" #(st/emit! zoom-to-fit-all)
|
|
"shift+2" #(st/emit! zoom-to-selected-shape)
|
|
"ctrl+d" #(st/emit! duplicate-selected)
|
|
"ctrl+z" #(st/emit! dwc/undo)
|
|
"ctrl+shift+z" #(st/emit! dwc/redo)
|
|
"ctrl+y" #(st/emit! dwc/redo)
|
|
"ctrl+q" #(st/emit! dwc/reinitialize-undo)
|
|
"a" #(st/emit! (select-for-drawing :frame))
|
|
"b" #(st/emit! (select-for-drawing :rect))
|
|
"e" #(st/emit! (select-for-drawing :circle))
|
|
"t" #(st/emit! (select-for-drawing :text))
|
|
"ctrl+c" #(st/emit! copy-selected)
|
|
"ctrl+v" #(st/emit! paste)
|
|
"escape" #(st/emit! :interrupt deselect-all)
|
|
"del" #(st/emit! delete-selected)
|
|
"backspace" #(st/emit! delete-selected)
|
|
"ctrl+up" #(st/emit! (vertical-order-selected :up))
|
|
"ctrl+down" #(st/emit! (vertical-order-selected :down))
|
|
"ctrl+shift+up" #(st/emit! (vertical-order-selected :top))
|
|
"ctrl+shift+down" #(st/emit! (vertical-order-selected :bottom))
|
|
"shift+up" #(st/emit! (dwt/move-selected :up true))
|
|
"shift+down" #(st/emit! (dwt/move-selected :down true))
|
|
"shift+right" #(st/emit! (dwt/move-selected :right true))
|
|
"shift+left" #(st/emit! (dwt/move-selected :left true))
|
|
"up" #(st/emit! (dwt/move-selected :up false))
|
|
"down" #(st/emit! (dwt/move-selected :down false))
|
|
"right" #(st/emit! (dwt/move-selected :right false))
|
|
"left" #(st/emit! (dwt/move-selected :left false))})
|
|
|