3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-06-08 23:51:38 +02:00
Code Issues Projects Releases Packages Wiki Activity

🎉 Improved transformations

Browse source
This commit is contained in:
alonso.torres 2020-04-22 13:35:53 +02:00
parent d050103f58
commit b73958efd0
21 changed files with 1257 additions and 1017 deletions
Download patch file Download diff file Expand all files Collapse all files

667
frontend/src/uxbox/main/data/workspace.cljs
View file

@ -39,7 +39,9 @@
[uxbox.util.router :as rt]
[uxbox.util.time :as dt]
[uxbox.util.transit :as t]
[uxbox.util.webapi :as wapi]))
[uxbox.util.webapi :as wapi]
[uxbox.main.data.workspace.common :refer [IBatchedChange IUpdateGroup] :as common]
[uxbox.main.data.workspace.transforms :as transforms]))
;; TODO: temporal workaround
(def clear-ruler nil)
@ -58,10 +60,6 @@
(defn interrupt? [e] (= e :interrupt))
;; --- Protocols
(defprotocol IBatchedChange)
;; --- Declarations
(declare fetch-project)
@ -70,7 +68,6 @@
(declare handle-pointer-send)
(declare handle-page-change)
(declare shapes-changes-commited)
(declare commit-changes)
(declare fetch-bundle)
(declare initialize-ws)
(declare finalize-ws)
@ -165,7 +162,7 @@
(let [page (get-in state [:workspace-pages page-id])
local (get-in state [:workspace-cache page-id] workspace-default)]
(-> state
(assoc ::page-id page-id ; mainly used by events
(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)))))
@ -185,6 +182,44 @@
(assoc-in [:workspace-cache page-id] local)
(update :workspace-data dissoc page-id))))))
(declare adjust-group-shapes)
(defn initialize-group-check []
(ptk/reify ::initialize-group-check
ptk/WatchEvent
(watch [_ state stream]
(->> stream
(rx/filter #(satisfies? IUpdateGroup %))
(rx/map #(adjust-group-shapes (common/get-ids %)))))))
(defn adjust-group-shapes
[ids]
(ptk/reify ::adjust-group-shapes
IBatchedChange
ptk/UpdateEvent
(update [_ state]
(let [page-id (:page-id state)
objects (get-in state [:workspace-data page-id :objects])
groups-to-adjust (->> ids
(mapcat #(reverse (helpers/get-all-parents % objects)))
(map #(get objects %))
(filter #(= (:type %) :group))
(map #(:id %))
distinct)
update-group
(fn [state group]
(let [objects (get-in state [:workspace-data page-id :objects])
group-objects (map #(get objects %) (:shapes group))
selrect (geom/selection-rect group-objects)]
(merge group (select-keys selrect [:x :y :width :height]))))
reduce-fn
#(update-in %1 [:workspace-data page-id :objects %2] (partial update-group %1))]
(reduce reduce-fn state groups-to-adjust)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Workspace WebSocket
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -293,98 +328,19 @@
(rx/of (shapes-changes-commited msg)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Undo/Redo
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def MAX-UNDO-SIZE 50)
(defn- conj-undo-entry
[undo data]
(let [undo (conj undo data)]
(if (> (count undo) MAX-UNDO-SIZE)
(into [] (take MAX-UNDO-SIZE undo))
undo)))
(defn- materialize-undo
[changes index]
(ptk/reify ::materialize-undo
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)]
(-> state
(update-in [:workspace-data page-id] cp/process-changes changes)
(assoc-in [:workspace-local :undo-index] index))))))
(defn- reset-undo
[index]
(ptk/reify ::reset-undo
ptk/UpdateEvent
(update [_ state]
(-> state
(update :workspace-local dissoc :undo-index)
(update-in [:workspace-local :undo]
(fn [queue]
(into [] (take (inc index) queue))))))))
(s/def ::undo-changes ::cp/changes)
(s/def ::redo-changes ::cp/changes)
(s/def ::undo-entry
(s/keys :req-un [::undo-changes ::redo-changes]))
(defn- append-undo
[entry]
(us/verify ::undo-entry entry)
(ptk/reify ::append-undo
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-local :undo] (fnil conj-undo-entry []) entry))))
(def undo
(ptk/reify ::undo
ptk/WatchEvent
(watch [_ state stream]
(let [local (:workspace-local state)
undo (:undo local [])
index (or (:undo-index local)
(dec (count undo)))]
(when-not (or (empty? undo) (= index -1))
(let [changes (get-in undo [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 [local (:workspace-local state)
undo (:undo local [])
index (or (:undo-index local)
(dec (count undo)))]
(when-not (or (empty? undo) (= index (dec (count undo))))
(let [changes (get-in undo [(inc index) :redo-changes])]
(rx/of (materialize-undo changes (inc index))
(commit-changes changes [] {:save-undo? false}))))))))
(def reinitialize-undo
(ptk/reify ::reset-undo
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local dissoc :undo-index :undo))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Persistence
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare persist-changes)
(declare diff-and-commit-changes)
(defn initialize-page-persistence
[page-id]
(ptk/reify ::initialize-persistence
ptk/UpdateEvent
(update [_ state]
(assoc state ::page-id page-id))
(assoc state :current-page-id page-id))
ptk/WatchEvent
(watch [_ state stream]
@ -407,7 +363,7 @@
(->> stream
(rx/filter #(satisfies? IBatchedChange %))
(rx/debounce 200)
(rx/map (fn [_] (diff-and-commit-changes page-id)))
(rx/map (fn [_] (common/diff-and-commit-changes page-id)))
(rx/take-until stoper)))))))
(defn persist-changes
@ -428,57 +384,9 @@
(rx/map shapes-changes-commited))))))
(defn- generate-operations
[ma mb]
(let [ma-keys (set (keys ma))
mb-keys (set (keys mb))
added (set/difference mb-keys ma-keys)
removed (set/difference ma-keys mb-keys)
both (set/intersection ma-keys mb-keys)]
(d/concat
(mapv #(array-map :type :set :attr % :val (get mb %)) added)
(mapv #(array-map :type :set :attr % :val nil) removed)
(loop [k (first both)
r (rest both)
rs []]
(if k
(let [vma (get ma k)
vmb (get mb k)]
(if (= vma vmb)
(recur (first r) (rest r) rs)
(recur (first r) (rest r) (conj rs {:type :set
:attr k
:val vmb}))))
rs)))))
(defn- generate-changes
[prev curr]
(letfn [(impl-diff [res id]
(let [prev-obj (get-in prev [:objects id])
curr-obj (get-in curr [:objects id])
ops (generate-operations (dissoc prev-obj :shapes :frame-id)
(dissoc curr-obj :shapes :frame-id))]
(if (empty? ops)
res
(conj res {:type :mod-obj
:operations ops
:id id}))))]
(reduce impl-diff [] (set/union (set (keys (:objects prev)))
(set (keys (:objects curr)))))))
(defn diff-and-commit-changes
[page-id]
(ptk/reify ::diff-and-commit-changes
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (::page-id state)
curr (get-in state [:workspace-data page-id])
prev (get-in state [:workspace-pages page-id :data])
changes (generate-changes prev curr)
undo-changes (generate-changes curr prev)]
(when-not (empty? changes)
(rx/of (commit-changes changes undo-changes)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Fetching & Uploading
@ -917,29 +825,13 @@
(recur (inc counter))
candidate)))))
(defn- calculate-frame-overlap
[objects shape]
(let [rshp (geom/shape->rect-shape shape)
xfmt (comp
(filter #(= :frame (:type %)))
(filter #(not= (:id shape) (:id %)))
(filter #(not= uuid/zero (:id %)))
(filter #(geom/overlaps? % rshp)))
frame (->> (vals objects)
(sequence xfmt)
(first))]
(or (:id frame) uuid/zero)))
(defn add-shape
[attrs]
(us/verify ::shape-attrs attrs)
(ptk/reify ::add-shape
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (::page-id state)
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
id (uuid/next)
@ -950,7 +842,7 @@
frame-id (if (= :frame (:type shape))
uuid/zero
(calculate-frame-overlap objects shape))
(common/calculate-frame-overlap objects shape))
shape (merge
(if (= :frame (:type shape))
@ -968,7 +860,7 @@
uchange {:type :del-obj
:id id}]
(rx/of (commit-changes [rchange] [uchange] {:commit-local? true})
(rx/of (common/commit-changes [rchange] [uchange] {:commit-local? true})
(select-shapes #{id}))))))
@ -1015,7 +907,7 @@
moved-obj (geom/move renamed-obj delta)
frame-id (if frame-id
frame-id
(calculate-frame-overlap objects moved-obj))
(common/calculate-frame-overlap objects moved-obj))
parent-id (or parent-id frame-id)
@ -1074,7 +966,7 @@
(ptk/reify ::duplicate-selected
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (::page-id state)
(let [page-id (:current-page-id state)
selected (get-in state [:workspace-local :selected])
objects (get-in state [:workspace-data page-id :objects])
delta (gpt/point 0 0)
@ -1089,7 +981,7 @@
(map #(get-in % [:obj :id]))
(into #{}))]
(rx/of (commit-changes rchanges uchanges {:commit-local? true})
(rx/of (common/commit-changes rchanges uchanges {:commit-local? true})
(select-shapes selected))))))
@ -1114,7 +1006,7 @@
(ptk/reify ::select-inside-group
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
group (get objects group-id)
children (map #(get objects %) (:shapes group))
@ -1130,9 +1022,12 @@
(us/verify ::shape-attrs attrs)
(ptk/reify ::update-shape
IBatchedChange
IUpdateGroup
(get-ids [_] [id])
ptk/UpdateEvent
(update [_ state]
(let [pid (::page-id state)]
(let [pid (:current-page-id state)]
(update-in state [:workspace-data pid :objects id] merge attrs)))))
;; --- Update Page Options
@ -1144,7 +1039,7 @@
IBatchedChange
ptk/UpdateEvent
(update [_ state]
(let [pid (::page-id state)]
(let [pid (:current-page-id state)]
(update-in state [:workspace-data pid :options] merge opts)))))
;; --- Update Selected Shapes attrs
@ -1189,37 +1084,14 @@
(s/def ::direction #{:up :down :right :left})
(s/def ::loc #{:up :down :bottom :top})
(declare apply-displacement-in-bulk)
(declare materialize-displacement-in-bulk)
(defn move-selected
[direction align?]
(us/verify ::direction direction)
(us/verify boolean? align?)
(ptk/reify ::move-selected
ptk/WatchEvent
(watch [_ state stream]
(let [pid (::page-id state)
selected (get-in state [:workspace-local :selected])
options (get-in state [:workspace-data pid :options])
shapes (map #(get-in state [:workspace-data pid :objects %]) selected)
shape (geom/shapes->rect-shape shapes)
displacement (if align?
(get-displacement-with-grid shape direction options)
(get-displacement shape direction))]
(rx/of (apply-displacement-in-bulk selected displacement)
(materialize-displacement-in-bulk selected))))))
;; --- 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 (::page-id state)
(let [page-id (:current-page-id state)
session-id (:session-id state)
objects (get-in state [:workspace-data page-id :objects])
cpindex (helpers/calculate-child-parent-map objects)
@ -1244,14 +1116,14 @@
:parent-id (get cpindex id)
:obj obj}))
(reverse (map :id rchanges)))]
(rx/of (commit-changes rchanges uchanges {:commit-local? true}))))))
(rx/of (common/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 (::page-id state)
(let [page-id (:current-page-id state)
lookup #(get-in state [:workspace-data page-id :objects %])
selected (get-in state [:workspace-local :selected])
@ -1270,7 +1142,7 @@
IBatchedChange
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)]
(let [page-id (:current-page-id state)]
(update-in state [:workspace-data page-id :objects id] assoc :name name)))))
;; --- Shape Vertical Ordering
@ -1281,7 +1153,7 @@
(ptk/reify ::vertical-order-selected-shpes
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (::page-id state)
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
selected (seq (get-in state [:workspace-local :selected]))
@ -1299,7 +1171,7 @@
:id frame-id
:operations [{:type :abs-order :id id :index cindex}]}))
selected)]
(rx/of (commit-changes rchanges uchanges {:commit-local? true}))))))
(rx/of (common/commit-changes rchanges uchanges {:commit-local? true}))))))
;; --- Change Shape Order (D&D Ordering)
@ -1315,11 +1187,11 @@
(ptk/reify ::relocate-shape
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (::page-id state)
(let [page-id (:current-page-id state)
selected (get-in state [:workspace-local :selected])
objects (get-in state [:workspace-data page-id :objects])
parent-id (helpers/get-parent ref-id objects)]
(rx/of (commit-changes [{:type :mov-objects
(rx/of (common/commit-changes [{:type :mov-objects
:parent-id parent-id
:index index
:shapes (vec selected)}]
@ -1361,7 +1233,7 @@
IBatchedChange
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
selected (get-in state [:workspace-local :selected])
moved-objs (if (= 1 (count selected))
@ -1389,7 +1261,7 @@
IBatchedChange
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
selected (get-in state [:workspace-local :selected])
selected-objs (map #(get objects %) selected)
@ -1399,340 +1271,6 @@
;; --- Temportal displacement for Shape / Selection
(defn- retrieve-toplevel-shapes
[objects]
(let [lookup #(get objects %)
root (lookup uuid/zero)
childs (:shapes root)]
(loop [id (first childs)
ids (rest childs)
res []]
(if (nil? id)
res
(let [obj (lookup id)
typ (:type obj)]
(recur (first ids)
(rest ids)
(if (= :frame typ)
(into res (:shapes obj))
(conj res id))))))))
(defn- calculate-shape-to-frame-relationship-changes
[objects ids]
(loop [id (first ids)
ids (rest ids)
rch []
uch []]
(if (nil? id)
[rch uch]
(let [obj (get objects id)
fid (calculate-frame-overlap objects obj)]
(if (not= fid (:frame-id obj))
(recur (first ids)
(rest ids)
(conj rch {:type :mov-objects
:parent-id fid
:shapes [id]})
(conj uch {:type :mov-objects
:parent-id (:frame-id obj)
:shapes [id]}))
(recur (first ids)
(rest ids)
rch
uch))))))
(defn- rehash-shape-frame-relationship
[ids]
(ptk/reify ::rehash-shape-frame-relationship
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (::page-id state)
objects (get-in state [:workspace-data page-id :objects])
ids (retrieve-toplevel-shapes objects)
[rch uch] (calculate-shape-to-frame-relationship-changes objects ids)
]
(when-not (empty? rch)
(rx/of (commit-changes rch uch {:commit-local? true})))))))
(defn- adjust-group-shapes
[state ids]
(let [page-id (::page-id state)
objects (get-in state [:workspace-data page-id :objects])
groups-to-adjust (->> ids
(mapcat #(reverse (helpers/get-all-parents % objects)))
(map #(get objects %))
(filter #(= (:type %) :group))
(map #(:id %))
distinct)
update-group
(fn [state group]
(let [objects (get-in state [:workspace-data page-id :objects])
group-objects (map #(get objects %) (:shapes group))
selrect (geom/selection-rect group-objects)]
(merge group (select-keys selrect [:x :y :width :height]))))
reduce-fn
#(update-in %1 [:workspace-data page-id :objects %2] (partial update-group %1))]
(reduce reduce-fn state groups-to-adjust)))
(defn assoc-resize-modifier-in-bulk
[ids xfmt]
(us/verify ::set-of-uuid ids)
(us/verify gmt/matrix? xfmt)
(ptk/reify ::assoc-resize-modifier-in-bulk
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)
rfn #(assoc-in %1 [:workspace-data page-id
:objects %2 :resize-modifier] xfmt)]
(reduce rfn state ids)))))
(defn materialize-resize-modifier-in-bulk
[ids]
(ptk/reify ::materialize-resize-modifier-in-bulk
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)
objects (get-in state [:workspace-data page-id :objects])
;; Updates the resize data for a single shape
materialize-shape
(fn [state id mtx]
(update-in
state
[:workspace-data page-id :objects id]
#(-> %
(dissoc :resize-modifier)
(geom/transform mtx))))
;; Applies materialize-shape over shape children
materialize-children
(fn [state id mtx]
(reduce #(materialize-shape %1 %2 mtx) state (helpers/get-children id objects)))
;; For each shape makes permanent the displacemnt
update-shapes
(fn [state id]
(let [shape (get objects id)
mtx (:resize-modifier shape (gmt/matrix))]
(if (= (:type shape) :frame)
(materialize-shape state id mtx)
(-> state
(materialize-shape id mtx)
(materialize-children id mtx)))))]
(as-> state $
(reduce update-shapes $ ids)
(adjust-group-shapes $ ids))))
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (::page-id state)]
(rx/of (diff-and-commit-changes page-id)
(rehash-shape-frame-relationship ids))))))
(defn apply-displacement-in-bulk
"Apply the same displacement delta to all shapes identified by the set
if ids."
[ids delta]
(us/verify ::set-of-uuid ids)
(us/verify gpt/point? delta)
(ptk/reify ::apply-displacement-in-bulk
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)
rfn (fn [state id]
(let [objects (get-in state [:workspace-data page-id :objects])
shape (get objects id)
prev (:displacement-modifier shape (gmt/matrix))
curr (gmt/translate prev delta)]
(->> (assoc shape :displacement-modifier curr)
(assoc-in state [:workspace-data page-id :objects id]))))]
(reduce rfn state ids)))))
(defn materialize-displacement-in-bulk
[ids]
(ptk/reify ::materialize-displacement-in-bulk
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)
objects (get-in state [:workspace-data page-id :objects])
;; Updates the displacement data for a single shape
materialize-shape
(fn [state id mtx]
(update-in
state
[:workspace-data page-id :objects id]
#(-> %
(dissoc :displacement-modifier)
(geom/transform mtx))))
;; Applies materialize-shape over shape children
materialize-children
(fn [state id mtx]
(reduce #(materialize-shape %1 %2 mtx) state (helpers/get-children id objects)))
;; For each shape makes permanent the resize
update-shapes
(fn [state id]
(let [shape (get objects id)
mtx (:displacement-modifier shape (gmt/matrix))]
(-> state
(materialize-shape id mtx)
(materialize-children id mtx))))]
(as-> state $
(reduce update-shapes $ ids)
(adjust-group-shapes $ ids))))
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (::page-id state)]
(rx/of (diff-and-commit-changes page-id)
(rehash-shape-frame-relationship ids))))))
(defn apply-frame-displacement
"Apply the same displacement delta to all shapes identified by the
set if ids."
[id delta]
(us/verify ::us/uuid id)
(us/verify gpt/point? delta)
(ptk/reify ::apply-frame-displacement
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)]
(update-in state [:workspace-data page-id :objects id]
(fn [shape]
(let [prev (:displacement-modifier shape (gmt/matrix))
xfmt (gmt/translate prev delta)]
(assoc shape :displacement-modifier xfmt))))))))
(defn materialize-frame-displacement
[id]
(us/verify ::us/uuid id)
(ptk/reify ::materialize-frame-displacement
IBatchedChange
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)
objects (get-in state [:workspace-data page-id :objects])
frame (get objects id)
xfmt (or (:displacement-modifier frame) (gmt/matrix))
frame (-> frame
(dissoc :displacement-modifier)
(geom/transform xfmt))
shapes (->> (helpers/get-children id objects)
(map #(get objects %))
(map #(geom/transform % xfmt))
(d/index-by :id))
shapes (assoc shapes (:id frame) frame)]
(update-in state [:workspace-data page-id :objects] merge shapes)))))
(defn apply-rotation
[delta-rotation shapes]
(ptk/reify ::apply-rotation
ptk/UpdateEvent
(update [_ state]
(let [group (geom/selection-rect shapes)
group-center (gpt/center group)
calculate-displacement
(fn [shape angle]
(let [shape-rect (geom/shape->rect-shape shape)
shape-center (gpt/center shape-rect)]
(-> (gmt/matrix)
(gmt/rotate angle group-center)
(gmt/rotate (- angle) shape-center))))
page-id (::page-id state)
rotate-shape
(fn [state shape]
(let [path [:workspace-data page-id :objects (:id shape)]
ds (calculate-displacement shape delta-rotation)]
(-> state
(assoc-in (conj path :rotation-modifier) delta-rotation)
(assoc-in (conj path :displacement-modifier) ds))))]
(reduce rotate-shape state shapes)))))
(defn materialize-rotation
[shapes]
(ptk/reify ::materialize-rotation
IBatchedChange
ptk/UpdateEvent
(update [_ state]
(let [apply-rotation
(fn [shape]
(let [ds-modifier (or (:displacement-modifier shape) (gmt/matrix))]
(-> shape
(update :rotation #(mod (+ % (:rotation-modifier shape)) 360))
(geom/transform ds-modifier)
(dissoc :rotation-modifier)
(dissoc :displacement-modifier))))
materialize-shape
(fn [state shape]
(let [path [:workspace-data (::page-id state) :objects (:id shape)]]
(update-in state path apply-rotation)))]
(reduce materialize-shape state shapes)))))
(defn- update-selection-index
[page-id]
(ptk/reify ::update-selection-index
ptk/EffectEvent
(effect [_ state stream]
(let [objects (get-in state [:workspace-pages page-id :data :objects])
lookup #(get objects %)]
(uw/ask! {:cmd :selection/update-index
:page-id page-id
:objects objects})))))
(defn commit-changes
([changes undo-changes] (commit-changes changes undo-changes {}))
([changes undo-changes {:keys [save-undo?
commit-local?]
:or {save-undo? true
commit-local? false}
:as opts}]
(us/verify ::cp/changes changes)
(us/verify ::cp/changes undo-changes)
(ptk/reify ::commit-changes
cljs.core/IDeref
(-deref [_] changes)
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)
state (update-in state [:workspace-pages page-id :data] cp/process-changes changes)]
(cond-> state
commit-local? (update-in [:workspace-data page-id] cp/process-changes changes))))
ptk/WatchEvent
(watch [_ state stream]
(let [page (:workspace-page state)
uidx (get-in state [:workspace-local :undo-index] ::not-found)]
(rx/concat
(rx/of (update-selection-index (:id page)))
(when (and save-undo? (not= uidx ::not-found))
(rx/of (reset-undo uidx)))
(when save-undo?
(let [entry {:undo-changes undo-changes
:redo-changes changes}]
(rx/of (append-undo entry))))))))))
(s/def ::shapes-changes-commited
(s/keys :req-un [::page-id ::revn ::cp/changes]))
@ -1810,9 +1348,12 @@
(us/verify ::us/number value)
(ptk/reify ::update-rect-dimensions
IBatchedChange
IUpdateGroup
(get-ids [_] [id])
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)]
(let [page-id (:current-page-id state)]
(update-in state [:workspace-data page-id :objects id]
geom/resize-rect attr value)))))
@ -1823,10 +1364,14 @@
(us/verify ::us/number value)
(ptk/reify ::update-rect-dimensions
IBatchedChange
IUpdateGroup
(get-ids [_] [id])
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)]
(update-in state [:workspace-data page-id :objects id]
(let [page-id (:current-page-id state)]
state
#_(update-in state [:workspace-data page-id :objects id]
geom/resize-circle attr value)))))
;; --- Shape Proportions
@ -1836,7 +1381,7 @@
(ptk/reify ::toggle-shape-proportion-lock
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)
(let [page-id (:current-page-id state)
shape (get-in state [:workspace-data page-id :objects id])]
(if (:proportion-lock shape)
(assoc-in state [:workspace-data page-id :objects id :proportion-lock] false)
@ -1855,9 +1400,12 @@
(us/verify ::us/uuid id)
(us/verify ::position position)
(ptk/reify ::update-position
IUpdateGroup
(get-ids [_] [id])
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)]
(let [page-id (:current-page-id state)]
(update-in state [:workspace-data page-id :objects id]
geom/absolute-move position)))))
@ -1872,7 +1420,7 @@
(ptk/reify ::update-path
ptk/UpdateEvent
(update [_ state]
(let [page-id (::page-id state)]
(let [page-id (:current-page-id state)]
(update-in state [:workspace-data page-id :objects id :segments index]
gpt/add delta)))))
@ -2015,7 +1563,7 @@
(ptk/reify ::copy-selected
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (::page-id state)
(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)]
@ -2036,7 +1584,7 @@
mouse-pos @ms/mouse-position
delta (gpt/subtract mouse-pos orig-pos)
page-id (::page-id state)
page-id (:current-page-id state)
unames (-> (get-in state [:workspace-data page-id :objects])
(retrieve-used-names))
@ -2048,7 +1596,7 @@
(filter #(selected (:old-id %)))
(map #(get-in % [:obj :id]))
(into #{}))]
(rx/of (commit-changes rchanges uchanges {:commit-local? true})
(rx/of (common/commit-changes rchanges uchanges {:commit-local? true})
(select-shapes selected))))))
(def paste
@ -2133,14 +1681,14 @@
:shapes (vec selected)}
{:type :del-obj
:id id}]]
(rx/of (commit-changes rchanges uchanges {:commit-local? true})
(rx/of (common/commit-changes rchanges uchanges {:commit-local? true})
(select-shapes #{id}))))))))
(def remove-group
(ptk/reify ::remove-group
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (::page-id state)
(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)
@ -2169,7 +1717,21 @@
:parent-id parent-id
:shapes [group-id]
:index index-in-parent}]]
(rx/of (commit-changes rchanges uchanges {:commit-local? true}))))))))
(rx/of (common/commit-changes rchanges uchanges {:commit-local? true}))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Exports
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Transform
(def start-rotate transforms/start-rotate)
(def start-resize transforms/start-resize)
(def start-move-selected transforms/start-move-selected)
(def move-selected transforms/move-selected)
(def apply-displacement-in-bulk transforms/apply-displacement-in-bulk)
(def materialize-displacement-in-bulk transforms/materialize-displacement-in-bulk)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Shortcuts
@ -2189,10 +1751,10 @@
"shift+1" #(st/emit! reset-zoom)
"shift+2" #(st/emit! zoom-to-200)
"ctrl+d" #(st/emit! duplicate-selected)
"ctrl+z" #(st/emit! undo)
"ctrl+shift+z" #(st/emit! redo)
"ctrl+y" #(st/emit! redo)
"ctrl+q" #(st/emit! reinitialize-undo)
"ctrl+z" #(st/emit! common/undo)
"ctrl+shift+z" #(st/emit! common/redo)
"ctrl+y" #(st/emit! common/redo)
"ctrl+q" #(st/emit! common/reinitialize-undo)
"ctrl+b" #(st/emit! (select-for-drawing :rect))
"ctrl+e" #(st/emit! (select-for-drawing :circle))
"ctrl+t" #(st/emit! (select-for-drawing :text))
@ -2204,11 +1766,12 @@
"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! (move-selected :up true))
"shift+down" #(st/emit! (move-selected :down true))
"shift+right" #(st/emit! (move-selected :right true))
"shift+left" #(st/emit! (move-selected :left true))
"up" #(st/emit! (move-selected :up false))
"down" #(st/emit! (move-selected :down false))
"right" #(st/emit! (move-selected :right false))
"left" #(st/emit! (move-selected :left false))})
"shift+up" #(st/emit! (transforms/move-selected :up true))
"shift+down" #(st/emit! (transforms/move-selected :down true))
"shift+right" #(st/emit! (transforms/move-selected :right true))
"shift+left" #(st/emit! (transforms/move-selected :left true))
"up" #(st/emit! (transforms/move-selected :up false))
"down" #(st/emit! (transforms/move-selected :down false))
"right" #(st/emit! (transforms/move-selected :right false))
"left" #(st/emit! (transforms/move-selected :left false))})