0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-15 17:21:17 -05:00

🎉 Improved transformations

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

View file

@ -108,10 +108,11 @@
}
.workspace-viewport {
height: calc(100% - 40px);
height: 100%;
overflow: scroll;
transition: none;
width: 100%;
margin-top: 20px;
.viewport {
&.drawing {

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))})

View file

@ -0,0 +1,273 @@
(ns uxbox.main.data.workspace.common
(:require
[clojure.set :as set]
[cljs.spec.alpha :as s]
[beicon.core :as rx]
[potok.core :as ptk]
[uxbox.main.worker :as uw]
[uxbox.main.geom :as geom]
[uxbox.common.data :as d]
[uxbox.common.spec :as us]
[uxbox.common.pages :as cp]
[uxbox.common.uuid :as uuid]))
;; --- Protocols
(defprotocol IBatchedChange)
(defprotocol IUpdateGroup
(get-ids [this]))
(declare append-undo)
(declare reset-undo)
(declare commit-changes)
(declare calculate-shape-to-frame-relationship-changes)
(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 rehash-shape-frame-relationship
[ids]
(ptk/reify ::rehash-shape-frame-relationship
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-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- 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- 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 (:current-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))))))))))
(defn diff-and-commit-changes
[page-id]
(ptk/reify ::diff-and-commit-changes
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-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)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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 (:current-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))))
(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- 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))))))

View file

@ -0,0 +1,410 @@
(ns uxbox.main.data.workspace.transforms
"Events related with shapes transformations"
(:require
[cljs.spec.alpha :as s]
[beicon.core :as rx]
[potok.core :as ptk]
[uxbox.common.spec :as us]
[uxbox.common.data :as d]
[uxbox.main.refs :as refs]
[uxbox.main.store :as st]
[uxbox.main.streams :as ms]
[uxbox.main.geom :as geom]
[uxbox.util.geom.point :as gpt]
[uxbox.util.geom.matrix :as gmt]
[uxbox.main.data.helpers :as helpers]
[uxbox.main.data.workspace.common :refer [IBatchedChange IUpdateGroup] :as common]))
;; -- Specs
(s/def ::set-of-uuid
(s/every uuid? :kind set?))
;; -- Declarations
(declare assoc-resize-modifier-in-bulk)
(declare apply-displacement-in-bulk)
(declare apply-rotation)
(declare materialize-resize-modifier-in-bulk)
(declare materialize-displacement-in-bulk)
(declare materialize-rotation)
(defn- apply-zoom
[point]
(gpt/divide point (gpt/point @refs/selected-zoom)))
;; For each of the 8 handlers gives the modifier for resize
;; for example, right will only grow in the x coordinate and left
;; will grow in the inverse of the x coordinate
(def ^:private handler-modifiers
{:right [ 1 0]
:bottom [ 0 1]
:left [-1 0]
:top [ 0 -1]
:top-right [ 1 -1]
:top-left [-1 -1]
:bottom-right [ 1 1]
:bottom-left [-1 1]})
;; Given a handler returns the coordinate origin for resizes
;; this is the opposite of the handler so for right we want the
;; left side as origin of the resize
;; sx, sy => start x/y
;; mx, my => middle x/y
;; ex, ey => end x/y
(defn- handler-resize-origin [{sx :x sy :y :keys [width height]} handler]
(let [mx (+ sx (/ width 2))
my (+ sy (/ height 2))
ex (+ sx width)
ey (+ sy height)
[x y] (case handler
:right [sx my]
:bottom [mx sy]
:left [ex my]
:top [mx ey]
:top-right [sx ey]
:top-left [ex ey]
:bottom-right [sx sy]
:bottom-left [ex sy])]
(gpt/point x y)))
;; -- RESIZE
(defn start-resize
[vid ids shape objects]
(letfn [(resize [shape initial [point lock?]]
(let [frame (get objects (:frame-id shape))
{:keys [width height rotation]} shape
center (gpt/center shape)
shapev (-> (gpt/point width height))
;; Vector modifiers depending on the handler
handler-modif (let [[x y] (handler-modifiers vid)] (gpt/point x y))
;; Difference between the origin point in the coordinate system of the rotation
deltav (-> (gpt/subtract point initial)
(gpt/transform (gmt/rotate-matrix (- rotation)))
(gpt/multiply handler-modif))
;; Resize vector
scalev (gpt/divide (gpt/add shapev deltav) shapev)
shape-transform (:transform shape (gmt/matrix))
shape-transform-inverse (:transform-inverse shape (gmt/matrix))
;; Resize origin point given the selected handler
origin (-> (handler-resize-origin shape vid)
(geom/transform-shape-point shape shape-transform))]
(rx/of (assoc-resize-modifier-in-bulk ids {:resize-modifier-vector scalev
:resize-modifier-origin origin
:resize-modifier-transform shape-transform
:resize-modifier-transform-inverse shape-transform-inverse}))))
;; Unifies the instantaneous proportion lock modifier
;; activated by Ctrl key and the shapes own proportion
;; lock flag that can be activated on element options.
(normalize-proportion-lock [[point ctrl?]]
(let [proportion-lock? (:proportion-lock shape)]
[point (or proportion-lock? ctrl?)]))
;; Applies alginment to point if it is currently
;; activated on the current workspace
;; (apply-grid-alignment [point]
;; (if @refs/selected-alignment
;; (uwrk/align-point point)
;; (rx/of point)))
]
(reify
ptk/WatchEvent
(watch [_ state stream]
(let [initial (apply-zoom @ms/mouse-position)
shape (geom/shape->rect-shape shape)
stoper (rx/filter ms/mouse-up? stream)]
(rx/concat
(->> ms/mouse-position
(rx/map apply-zoom)
;; (rx/mapcat apply-grid-alignment)
(rx/with-latest vector ms/mouse-position-ctrl)
(rx/map normalize-proportion-lock)
(rx/mapcat (partial resize shape initial))
(rx/take-until stoper))
(rx/of (materialize-resize-modifier-in-bulk ids))))))))
(defn assoc-resize-modifier-in-bulk
[ids modifiers]
(us/verify ::set-of-uuid ids)
;; (us/verify gmt/matrix? resize-matrix)
;; (us/verify gmt/matrix? displacement-matrix)
(ptk/reify ::assoc-resize-modifier-in-bulk
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
rfn #(-> %1
(update-in [:workspace-data page-id :objects %2] (fn [item] (merge item modifiers))))
not-frame-id? (fn [shape-id] (not (= :frame (:type (get objects shape-id)))))
;; TODO: REMOVE FRAMES FROM IDS TO PROPAGATE
ids-with-children (concat ids (mapcat #(helpers/get-children % objects) (filter not-frame-id? ids)))]
(reduce rfn state ids-with-children)))))
(defn materialize-resize-modifier-in-bulk
[ids]
(ptk/reify ::materialize-resize-modifier-in-bulk
IUpdateGroup
(get-ids [_] ids)
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-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]
(update-in state [:workspace-data page-id :objects id] geom/transform-shape))
;; Applies materialize-shape over shape children
materialize-children
(fn [state id]
(reduce materialize-shape state (helpers/get-children id objects)))
;; For each shape makes permanent the displacemnt
update-shapes
(fn [state id]
(let [shape (-> (get objects id) geom/transform-shape)]
(-> state
(materialize-shape id)
(materialize-children id))))]
(reduce update-shapes state ids)))
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)]
(rx/of (common/diff-and-commit-changes page-id)
(common/rehash-shape-frame-relationship ids))))))
;; -- ROTATE
(defn start-rotate
[shapes]
(ptk/reify ::start-rotate
ptk/WatchEvent
(watch [_ state stream]
(let [stoper (rx/filter ms/mouse-up? stream)
group (geom/selection-rect shapes)
group-center (gpt/center group)
initial-angle (gpt/angle (apply-zoom @ms/mouse-position) group-center)
calculate-angle (fn [pos ctrl?]
(let [angle (- (gpt/angle pos group-center) initial-angle)
angle (if (neg? angle) (+ 360 angle) angle)
modval (mod angle 90)
angle (if ctrl?
(if (< 50 modval)
(+ angle (- 90 modval))
(- angle modval))
angle)
angle (if (= angle 360)
0
angle)]
angle))]
(rx/concat
(->> ms/mouse-position
(rx/map apply-zoom)
(rx/with-latest vector ms/mouse-position-ctrl)
(rx/map (fn [[pos ctrl?]]
(let [delta-angle (calculate-angle pos ctrl?)]
(apply-rotation delta-angle shapes))))
(rx/take-until stoper))
(rx/of (materialize-rotation shapes))
)))))
;; -- MOVE
(defn start-move-selected []
(ptk/reify ::start-move-selected
ptk/WatchEvent
(watch [_ state stream]
(let [selected (get-in state [:workspace-local :selected])
stoper (rx/filter ms/mouse-up? stream)
zero-point? #(= % (gpt/point 0 0))
position @ms/mouse-position]
(rx/concat
(->> (ms/mouse-position-deltas position)
(rx/filter (complement zero-point?))
(rx/map #(apply-displacement-in-bulk selected %))
(rx/take-until stoper))
(rx/of (materialize-displacement-in-bulk selected)))))))
(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)))
(defn move-selected
[direction align?]
(us/verify ::direction direction)
(us/verify boolean? align?)
(ptk/reify ::move-selected
ptk/WatchEvent
(watch [_ state stream]
(let [pid (:current-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))))))
;; -- Apply modifiers
(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 (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
rfn (fn [state id]
(let [path [:workspace-data page-id :objects id]
shape (get-in state path)
prev (:displacement-modifier shape (gmt/matrix))
curr (gmt/translate prev delta)]
(update-in state path #(assoc % :displacement-modifier curr))))
ids-with-children (concat ids (mapcat #(helpers/get-children % objects) ids))]
(reduce rfn state ids-with-children)))))
(defn materialize-displacement-in-bulk
[ids]
(ptk/reify ::materialize-displacement-in-bulk
IBatchedChange
IUpdateGroup
(get-ids [_] ids)
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-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))))
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)]
(rx/of (common/diff-and-commit-changes page-id)
(common/rehash-shape-frame-relationship ids))))))
(defn apply-rotation
[delta-rotation shapes]
(ptk/reify ::apply-rotation
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)]
(letfn [(calculate-displacement [shape angle center]
(let [shape-center (geom/center shape)]
(-> (gmt/matrix)
(gmt/rotate angle center)
(gmt/rotate (- angle) shape-center))))
(rotate-shape [state angle shape center]
(let [objects (get-in state [:workspace-data page-id :objects])
path [:workspace-data page-id :objects (:id shape)]
ds (calculate-displacement shape angle center)]
(-> state
(assoc-in (conj path :rotation-modifier) angle)
(assoc-in (conj path :displacement-modifier) ds))))
(rotate-around-center [state angle center shapes]
(reduce #(rotate-shape %1 angle %2 center) state shapes))]
(let [center (-> shapes geom/selection-rect gpt/center)
objects (get-in state [:workspace-data page-id :objects])
id->obj #(get objects %)
get-children (fn [shape] (map id->obj (helpers/get-children (:id shape) objects)))
shapes (concat shapes (mapcat get-children shapes))]
(rotate-around-center state delta-rotation center shapes)))))))
(defn materialize-rotation
[shapes]
(ptk/reify ::materialize-rotation
IBatchedChange
IUpdateGroup
(get-ids [_] (map :id shapes))
ptk/UpdateEvent
(update [_ state]
(letfn
[(materialize-shape [state shape]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
path [:workspace-data page-id :objects (:id shape)]]
(as-> state $
(update-in $ path geom/transform-shape)
(reduce materialize-shape $ (map #(get objects %) (:shapes shape))))))]
(reduce materialize-shape state shapes)))))

View file

@ -17,39 +17,29 @@
(declare move-rect)
(declare move-path)
(declare move-circle)
(defn- _chk
"Function that checks if a number is nil or nan. Will return 0 when not
valid and the number otherwise."
[v]
(if (or (not v) (mth/nan? v)) 0 v))
(defn move
"Move the shape relativelly to its current
position applying the provided delta."
[shape dpoint]
(case (:type shape)
:icon (move-rect shape dpoint)
:image (move-rect shape dpoint)
:rect (move-rect shape dpoint)
:frame (move-rect shape dpoint)
:text (move-rect shape dpoint)
:curve (move-path shape dpoint)
:path (move-path shape dpoint)
:circle (move-circle shape dpoint)
:group (move-rect shape dpoint)
shape))
(move-rect shape dpoint)))
(defn- move-rect
"A specialized function for relative movement
for rect-like shapes."
[shape {dx :x dy :y}]
(assoc shape
:x (mth/round (+ (:x shape) dx))
:y (mth/round (+ (:y shape) dy))))
(defn- move-circle
"A specialized function for relative movement
for circle shapes."
[shape {dx :x dy :y}]
(assoc shape
:cx (mth/round (+ (:cx shape) dx))
:cy (mth/round (+ (:cy shape) dy))))
:x (mth/round (+ (_chk (:x shape)) (_chk dx)))
:y (mth/round (+ (_chk (:y shape)) (_chk dy)))))
(defn- move-path
"A specialized function for relative movement
@ -71,35 +61,21 @@
;; --- Absolute Movement
(declare absolute-move-rect)
(declare absolute-move-circle)
(defn absolute-move
"Move the shape to the exactly specified position."
[shape position]
(case (:type shape)
:icon (absolute-move-rect shape position)
:frame (absolute-move-rect shape position)
:image (absolute-move-rect shape position)
:rect (absolute-move-rect shape position)
:text (absolute-move-rect shape position)
:group (absolute-move-rect shape position)
:circle (absolute-move-circle shape position)
shape))
:path shape
:curve shape
(absolute-move-rect shape position)))
(defn- absolute-move-rect
"A specialized function for absolute moviment
for rect-like shapes."
[shape {:keys [x y] :as pos}]
(let [dx (if x (- x (:x shape)) 0)
dy (if y (- y (:y shape)) 0)]
(move shape (gpt/point dx dy))))
(defn- absolute-move-circle
"A specialized function for absolute moviment
for rect-like shapes."
[shape {:keys [x y] :as pos}]
(let [dx (if x (- x (:cx shape)) 0)
dy (if y (- y (:cy shape)) 0)]
(let [dx (if x (- (_chk x) (_chk (:x shape))) 0)
dy (if y (- (_chk y) (_chk (:y shape))) 0)]
(move shape (gpt/point dx dy))))
;; --- Rotation
@ -113,16 +89,23 @@
[shape rotation]
(assoc shape :rotation rotation))
;; --- Corner points
(defn corner-points [points]
(let [minx (apply min (map :x points))
miny (apply min (map :y points))
maxx (apply max (map :x points))
maxy (apply max (map :y points))]
{:x1 minx :y1 miny :x2 maxx :y2 maxy}))
;; --- Size
(declare size-circle)
(declare size-path)
(defn size
"Calculate the size of the shape."
[shape]
(case (:type shape)
:circle (size-circle shape)
:curve (size-path shape)
:path (size-path shape)
shape))
@ -141,24 +124,15 @@
:width (- maxx minx)
:height (- maxy miny)))))
(defn- size-circle
"A specialized function for calculate size
for circle shape."
[{:keys [rx ry] :as shape}]
(merge shape {:width (* rx 2)
:height (* ry 2)}))
;; --- Center
(declare center-rect)
(declare center-circle)
(declare center-path)
(defn center
"Calculate the center of the shape."
[shape]
(case (:type shape)
:circle (center-circle shape)
:curve (center-path shape)
:path (center-path shape)
(center-rect shape)))
@ -167,30 +141,22 @@
[{:keys [x y width height] :as shape}]
(gpt/point (+ x (/ width 2)) (+ y (/ height 2))))
(defn- center-circle
[{:keys [cx cy] :as shape}]
(gpt/point cx cy))
(defn- center-path
[{:keys [segments x1 y1 x2 y2] :as shape}]
(if (and x1 y1 x2 y2)
(gpt/point (/ (+ x1 x2) 2) (/ (+ y1 y2) 2))
(let [minx (apply min (map :x segments))
miny (apply min (map :y segments))
maxx (apply max (map :x segments))
maxy (apply max (map :y segments))]
(gpt/point (/ (+ minx maxx) 2) (/ (+ miny maxy) 2)))))
[{:keys [segments] :as shape}]
(let [minx (apply min (map :x segments))
miny (apply min (map :y segments))
maxx (apply max (map :x segments))
maxy (apply max (map :y segments))]
(gpt/point (/ (+ minx maxx) 2) (/ (+ miny maxy) 2))))
;; --- Proportions
(declare assign-proportions-path)
(declare assign-proportions-circle)
(declare assign-proportions-rect)
(defn assign-proportions
[{:keys [type] :as shape}]
(case type
:circle (assign-proportions-circle shape)
:path (assign-proportions-path shape)
(assign-proportions-rect shape)))
@ -198,10 +164,6 @@
[{:keys [width height] :as shape}]
(assoc shape :proportion (/ width height)))
(defn- assign-proportions-circle
[{:as shape}]
(assoc shape :proportion 1))
;; TODO: implement the rest of shapes
;; --- Paths
@ -259,22 +221,6 @@
(assoc :height value)
(assoc :width (* value proportion)))))))
(defn resize-circle
[shape attr value]
(us/assert map? shape)
(us/assert #{:rx :ry} attr)
(us/assert number? value)
(let [{:keys [proportion proportion-lock]} shape]
(if-not proportion-lock
(assoc shape attr value)
(if (= attr :rx)
(-> shape
(assoc :rx value)
(assoc :ry (/ value proportion)))
(-> shape
(assoc :ry value)
(assoc :rx (* value proportion)))))))
;; --- Resize
(defn calculate-scale-ratio
@ -297,26 +243,6 @@
:right [:x1 :y1]
:left [:x2 :y1]))
(defn generate-resize-matrix
"Generate the resize transformation matrix given a corner-id, shape
and the scale factor vector. The shape should be of rect-like type.
Mainly used by drawarea and shape resize on workspace."
[vid shape [scalex scaley]]
(let [[cor-x cor-y] (get-vid-coords vid)
{:keys [x y width height rotation]} shape
cx (+ x (/ width 2))
cy (+ y (/ height 2))
center (gpt/point cx cy)
]
(-> (gmt/matrix)
;; Correction first otherwise the scale is going to deform the correction
(gmt/translate (gmt/correct-rotation
vid width height scalex scaley rotation))
(gmt/scale (gpt/point scalex scaley)
(gpt/point (cor-x shape)
(cor-y shape))))))
(defn resize-shape
"Apply a resize transformation to a rect-like shape. The shape
should have the `width` and `height` attrs, because these attrs
@ -325,9 +251,10 @@
Mainly used in drawarea and interactive resize on workspace
with the main objective that on the end of resize have a way
a calculte the resize ratio with `calculate-scale-ratio`."
[vid shape {:keys [x y] :as point} lock?]
[vid shape initial target lock?]
(let [[cor-x cor-y] (get-vid-coords vid)]
(let [{:keys [x y]} (gpt/subtract target initial)
[cor-x cor-y] (get-vid-coords vid)]
(let [final-x (if (#{:top :bottom} vid) (:x2 shape) x)
final-y (if (#{:right :left} vid) (:y2 shape) y)
width (Math/abs (- final-x (cor-x shape)))
@ -341,7 +268,6 @@
(declare setup-rect)
(declare setup-image)
(declare setup-circle)
(defn setup
"A function that initializes the first coordinates for
@ -349,7 +275,6 @@
[shape props]
(case (:type shape)
:image (setup-image shape props)
:circle (setup-circle shape props)
(setup-rect shape props)))
(defn- setup-rect
@ -361,15 +286,6 @@
:width width
:height height))
(defn- setup-circle
"A specialized function for setup circle shapes."
[shape {:keys [x y width height]}]
(assoc shape
:cx x
:cy y
:rx (mth/abs width)
:ry (mth/abs height)))
(defn- setup-image
[{:keys [metadata] :as shape} {:keys [x y width height] :as props}]
(assoc shape
@ -383,7 +299,6 @@
;; --- Coerce to Rect-like shape.
(declare circle->rect-shape)
(declare path->rect-shape)
(declare group->rect-shape)
(declare rect->rect-shape)
@ -392,7 +307,6 @@
"Coerce shape to rect like shape."
[{:keys [type] :as shape}]
(case type
:circle (circle->rect-shape shape)
:path (path->rect-shape shape)
:curve (path->rect-shape shape)
(rect->rect-shape shape)))
@ -414,6 +328,28 @@
:height (- maxy miny)
:type :rect}))
(declare rect->path)
(defn shape->path
[shape]
(case (:type shape)
:path shape
:curve shape
(rect->path shape)))
(defn rect->path
[{:keys [x y width height] :as shape}]
(let [points [(gpt/point x y)
(gpt/point (+ x width) y)
(gpt/point (+ x width) (+ y height))
(gpt/point x (+ y height))]]
(-> shape
(assoc :type :path)
(assoc :segments points))))
;; --- SHAPE -> RECT
(defn- rect->rect-shape
[{:keys [x y width height] :as shape}]
(assoc shape
@ -438,22 +374,6 @@
:width (- maxx minx)
:height (- maxy miny))))
(defn- circle->rect-shape
[{:keys [cx cy rx ry] :as shape}]
(let [width (* rx 2)
height (* ry 2)
x1 (- cx rx)
y1 (- cy ry)]
(assoc shape
:x1 x1
:y1 y1
:x2 (+ x1 width)
:y2 (+ y1 height)
:x x1
:y y1
:width width
:height height)))
;; --- Resolve Shape
(declare resolve-rect-shape)
@ -477,7 +397,6 @@
;; --- Transform Shape
(declare transform-rect)
(declare transform-circle)
(declare transform-path)
(defn transform
@ -485,16 +404,9 @@
[{:keys [type] :as shape} xfmt]
(if (gmt/matrix? xfmt)
(case type
:frame (transform-rect shape xfmt)
:group (transform-rect shape xfmt)
:rect (transform-rect shape xfmt)
:icon (transform-rect shape xfmt)
:text (transform-rect shape xfmt)
:image (transform-rect shape xfmt)
:path (transform-path shape xfmt)
:curve (transform-path shape xfmt)
:circle (transform-circle shape xfmt)
shape)
(transform-rect shape xfmt))
shape))
(defn- transform-rect
@ -514,27 +426,6 @@
:width (- maxx minx)
:height (- maxy miny))))
(defn- transform-circle
[{:keys [cx cy rx ry] :as shape} xfmt]
(let [{:keys [x1 y1 x2 y2]} (shape->rect-shape shape)
tl (gpt/transform (gpt/point x1 y1) xfmt)
tr (gpt/transform (gpt/point x2 y1) xfmt)
bl (gpt/transform (gpt/point x1 y2) xfmt)
br (gpt/transform (gpt/point x2 y2) xfmt)
;; TODO: replace apply with transduce (performance)
x (apply min (map :x [tl tr bl br]))
y (apply min (map :y [tl tr bl br]))
maxx (apply max (map :x [tl tr bl br]))
maxy (apply max (map :y [tl tr bl br]))
width (- maxx x)
height (- maxy y)
cx (+ x (/ width 2))
cy (+ y (/ height 2))
rx (/ width 2)
ry (/ height 2)]
(assoc shape :cx cx :cy cy :rx rx :ry ry)))
(defn- transform-path
[{:keys [segments] :as shape} xfmt]
(let [segments (mapv #(gpt/transform % xfmt) segments)]
@ -551,39 +442,17 @@
(and rotation (pos? rotation))
(gmt/rotate rotation (gpt/point cx cy)))))
(defn resolve-rotation
[shape]
(transform shape (rotation-matrix shape)))
(defn resolve-modifier
[{:keys [resize-modifier displacement-modifier rotation-modifier] :as shape}]
(cond-> shape
(gmt/matrix? resize-modifier)
(transform resize-modifier)
(gmt/matrix? displacement-modifier)
(transform displacement-modifier)
rotation-modifier
(update :rotation #(+ (or % 0) rotation-modifier))))
;; NOTE: we need apply `shape->rect-shape` 3 times because we need to
;; update the x1 x2 y1 y2 attributes on each step; this is because
;; some transform functions still uses that attributes. WE NEED TO
;; REFACTOR this, and remove any usage of the old xN yN attributes.
(def ^:private xf-resolve-shape
(comp (map shape->rect-shape)
(map resolve-modifier)
(map shape->rect-shape)
(map resolve-rotation)
(map shape->rect-shape)))
(declare transform-apply-modifiers)
(defn selection-rect
"Returns a rect that contains all the shapes and is aware of the
rotation of each shape. Mainly used for multiple selection."
[shapes]
(let [shapes (into [] xf-resolve-shape shapes)
(let [xf-resolve-shape (comp (map shape->rect-shape)
(map transform-apply-modifiers)
(map shape->rect-shape))
shapes (into [] xf-resolve-shape shapes)
minx (transduce (map :x1) min shapes)
miny (transduce (map :y1) min shapes)
maxx (transduce (map :x2) max shapes)
@ -744,16 +613,147 @@
:type :rect}]
(overlaps? shape selrect)))
(defn transform-shape-point
"Transform a point around the shape center"
[point shape transform]
(let [shape-center (center shape)]
(gpt/transform
point
(-> (gmt/multiply
(gmt/translate-matrix shape-center)
transform
(gmt/translate-matrix (gpt/negate shape-center)))))))
(defn- add-rotate-transform [shape rotation]
(let [rotation (or rotation 0)]
(-> shape
(update :transform #(gmt/multiply (gmt/rotate-matrix rotation) (or % (gmt/matrix))))
(update :transform-inverse #(gmt/multiply (or % (gmt/matrix)) (gmt/rotate-matrix (- rotation)))))))
(defn- add-stretch-transform [shape stretch]
(let [stretch (or stretch (gpt/point 1 1))]
(-> shape
(update :transform #(gmt/multiply (gmt/scale-matrix stretch) (or % (gmt/matrix))))
(update :transform-inverse #(gmt/multiply (or % (gmt/matrix)) (gmt/scale-matrix (gpt/inverse stretch)))))))
(defn- transform-apply-modifiers
[shape]
(let [ds-modifier (:displacement-modifier shape (gmt/matrix))
resize (:resize-modifier-vector shape (gpt/point 1 1))
origin (:resize-modifier-origin shape (gpt/point 0 0))
resize-transform (:resize-modifier-transform shape (gmt/matrix))
resize-transform-inverse (:resize-modifier-transform-inverse shape (gmt/matrix))
rt-modif (:rotation-modifier shape 0)
shape (-> shape
(transform ds-modifier))
shape-center (center shape)]
(-> (shape->path shape)
(transform (-> (gmt/matrix)
;; Applies the current resize transformation
(gmt/translate origin)
(gmt/multiply resize-transform)
(gmt/scale resize)
(gmt/multiply resize-transform-inverse)
(gmt/translate (gpt/negate origin))
;; Applies the stacked transformations
(gmt/translate shape-center)
(gmt/multiply (gmt/rotate-matrix rt-modif))
(gmt/multiply (:transform shape (gmt/matrix)))
(gmt/translate (gpt/negate shape-center)))))))
(defn calculate-stretch
[shape-path shape]
(let [{:keys [width height] :as selrect} (shape->rect-shape shape-path)
{width' :width height' :height :as selrect'} (selection-rect [shape])
shape-path-size (gpt/point width height)
shape-size (gpt/point width' height')]
(gpt/divide shape-path-size shape-size)))
(defn transform-selrect
[frame shape]
(-> (shape->rect-shape (transform-apply-modifiers shape))
(update :x - (:x frame 0))
(update :y - (:y frame 0))))
(defn dissoc-modifiers [shape]
(-> shape
(dissoc :rotation-modifier)
(dissoc :displacement-modifier)
(dissoc :resize-modifier)
(dissoc :resize-modifier-vector)
(dissoc :resize-modifier-origin)
(dissoc :resize-modifier-rotation)))
(defn transform-rect-shape
[shape]
(let [shape-path (transform-apply-modifiers shape)
shape-path-center (center shape-path)
shape-transform-inverse' (-> (gmt/matrix)
(gmt/translate shape-path-center)
(gmt/multiply (:transform-inverse shape (gmt/matrix)))
(gmt/multiply (gmt/rotate-matrix (- (:rotation-modifier shape 0))))
(gmt/translate (gpt/negate shape-path-center)))
;; Revert the transformation so we can calculate the rectangle properties: x, y, width, height
changes (-> shape-path
(transform shape-transform-inverse')
(path->rect-shape)
(select-keys [:x :y :width :height]))
;; Merges the rect values and updates de transformation matrix before calculating the stretch
new-shape (-> shape
(merge changes)
(add-rotate-transform (:rotation-modifier shape 0)))
;; Calculate the stretch deformation with the resize and rotation aplied
stretch (calculate-stretch shape-path (-> new-shape dissoc-modifiers))]
(-> new-shape
(add-stretch-transform stretch))))
(defn transform-path-shape
[shape]
(transform-apply-modifiers shape)
;; TODO: Addapt for paths is not working
#_(let [shape-path (transform-apply-modifiers shape)
shape-path-center (center shape-path)
shape-transform-inverse' (-> (gmt/matrix)
(gmt/translate shape-path-center)
(gmt/multiply (:transform-inverse shape (gmt/matrix)))
(gmt/multiply (gmt/rotate-matrix (- (:rotation-modifier shape 0))))
(gmt/translate (gpt/negate shape-path-center)))]
(-> shape-path
(transform shape-transform-inverse')
(add-rotate-transform (:rotation-modifier shape 0)))))
(defn transform-shape
"Transform the shape properties given the modifiers"
([shape] (transform-shape nil shape))
([frame shape]
(let [ds-modifier (:displacement-modifier shape)
rz-modifier (:resize-modifier shape)
frame-ds-modifier (:displacement-modifier frame)
rt-modifier (:rotation-modifier shape)]
(cond-> shape
(gmt/matrix? rz-modifier) (transform rz-modifier)
frame (move (gpt/point (- (:x frame)) (- (:y frame))))
(gmt/matrix? frame-ds-modifier) (transform frame-ds-modifier)
(gmt/matrix? ds-modifier) (transform ds-modifier)
rt-modifier (update :rotation #(+ (or % 0) rt-modifier))))))
(let [new-shape (cond
(#{:path :curve} (:type shape)) (transform-path-shape shape)
:else (transform-rect-shape shape))]
(-> new-shape
(update :x - (:x frame 0))
(update :y - (:y frame 0))
(update :rotation #(mod (+ % (:rotation-modifier shape)) 360))
(dissoc-modifiers)))))
(defn transform-matrix
"Returns a transformation matrix without changing the shape properties.
The result should be used in a `transform` attribute in svg"
([{:keys [x y] :as shape}]
(let [shape-center (center shape)]
(-> (gmt/matrix)
(gmt/translate shape-center)
(gmt/multiply (:transform shape (gmt/matrix)))
(gmt/translate (gpt/negate shape-center))))))

View file

@ -0,0 +1,43 @@
;; 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) 2020 UXBOX Labs SL
(ns uxbox.main.ui.shapes.bounding-box
(:require
[cuerdas.core :as str]
[rumext.alpha :as mf]
[uxbox.main.geom :as geom]
[uxbox.util.debug :refer [debug?] ]))
(defn fix [num]
(when num (.toFixed num 2)))
(mf/defc bounding-box
{::mf/wrap-props false}
[props]
(when (debug? :bounding-boxes)
(let [shape (unchecked-get props "shape")
frame (unchecked-get props "frame")
selrect (geom/transform-selrect frame shape)]
[:g
[:text {:x (:x selrect)
:y (- (:y selrect) 5)
:font-size 10
:fill "red"
:stroke "white"
:stroke-width 0.1}
(str/format "%s - (%s, %s)" (str/slice (str (:id shape)) 0 8) (fix (:x shape)) (fix (:y shape)))]
[:text {:x (-> selrect geom/center :x)
:y (-> selrect geom/center :y)
:fill "red"
:font-size 15
:text-anchor "middle"}
(str/format "%s°" (fix (+ (:rotation shape) (:rotation-modifier shape))))]
[:rect {:x (:x selrect)
:y (:y selrect)
:width (:width selrect)
:height (:height selrect)
:style {:stroke "red" :fill "transparent" :stroke-width "1px" :stroke-opacity 0.5}}]])))

View file

@ -13,7 +13,8 @@
[uxbox.main.ui.shapes.common :as common]
[uxbox.util.interop :as itr]
[uxbox.util.geom.matrix :as gmt]
[uxbox.util.geom.point :as gpt]))
[uxbox.util.geom.point :as gpt]
[uxbox.main.ui.shapes.bounding-box :refer [bounding-box]]))
;; --- Circle Wrapper
@ -28,19 +29,22 @@
[:g.shape {:class (when selected? "selected")
:on-mouse-down on-mouse-down
:on-context-menu on-context-menu}
[:& circle-shape {:shape (geom/transform-shape frame shape)}]]))
[:& circle-shape {:shape (geom/transform-shape frame shape)}]
[:& bounding-box {:shape shape :frame frame}]]))
;; --- Circle Shape
(mf/defc circle-shape
[{:keys [shape] :as props}]
(let [{:keys [id cx cy rx ry rotation]} shape
{::mf/wrap-props false}
[props]
(let [shape (unchecked-get props "shape")
{:keys [id x y width height]} shape
transform (geom/transform-matrix shape)
center (gpt/point cx cy)
rotation (or rotation 0)
transform (when (pos? rotation)
(str (-> (gmt/matrix)
(gmt/rotate rotation center))))
cx (+ x (/ width 2))
cy (+ y (/ height 2))
rx (/ width 2)
ry (/ height 2)
props (-> (attrs/extract-style-attrs shape)
(itr/obj-assign!

View file

@ -26,38 +26,6 @@
[uxbox.util.dom :as dom]))
;; --- Shape Movement (by mouse)
(def start-move-selected
(ptk/reify ::start-move-selected
ptk/WatchEvent
(watch [_ state stream]
(let [selected (get-in state [:workspace-local :selected])
stoper (rx/filter uws/mouse-up? stream)
zero-point? #(= % (gpt/point 0 0))
position @uws/mouse-position]
(rx/concat
(->> (uws/mouse-position-deltas position)
(rx/filter (complement zero-point?))
(rx/map #(dw/apply-displacement-in-bulk selected %))
(rx/take-until stoper))
(rx/of (dw/materialize-displacement-in-bulk selected)))))))
(def start-move-frame
(ptk/reify ::start-move-frame
ptk/WatchEvent
(watch [_ state stream]
(let [selected (get-in state [:workspace-local :selected])
stoper (rx/filter uws/mouse-up? stream)
zero-point? #(= % (gpt/point 0 0))
frame-id (first selected)
position @uws/mouse-position]
(rx/concat
(->> (uws/mouse-position-deltas position)
(rx/filter (complement zero-point?))
(rx/map #(dw/apply-frame-displacement frame-id %))
(rx/take-until stoper))
(rx/of (dw/materialize-frame-displacement frame-id)))))))
(defn on-mouse-down
[event {:keys [id type] :as shape}]
(let [selected @refs/selected-shapes
@ -75,14 +43,14 @@
(= type :frame)
(when selected?
(dom/stop-propagation event)
(st/emit! start-move-frame))
(st/emit! (dw/start-move-selected)))
(and (not selected?) (empty? selected))
(do
(dom/stop-propagation event)
(st/emit! dw/deselect-all
(dw/select-shape id)
start-move-selected))
(dw/start-move-selected)))
(and (not selected?) (not (empty? selected)))
(do
@ -91,11 +59,11 @@
(st/emit! (dw/select-shape id))
(st/emit! dw/deselect-all
(dw/select-shape id)
start-move-selected)))
(dw/start-move-selected))))
:else
(do
(dom/stop-propagation event)
(st/emit! start-move-selected))))))
(st/emit! (dw/start-move-selected)))))))
(defn on-context-menu

View file

@ -15,13 +15,13 @@
[uxbox.main.refs :as refs]
[uxbox.util.dom :as dom]
[uxbox.util.interop :as itr]
[uxbox.util.debug :refer [debug?]]
[uxbox.main.ui.shapes.common :as common]
[uxbox.main.ui.shapes.attrs :as attrs]
[uxbox.main.data.workspace :as dw]
[uxbox.main.store :as st]
[uxbox.main.streams :as ms]))
(defonce ^:dynamic *debug* (atom false))
[uxbox.main.streams :as ms]
[uxbox.main.ui.shapes.bounding-box :refer [bounding-box]]))
(defn- equals?
[np op]
@ -75,7 +75,8 @@
{:frame frame
:shape (geom/transform-shape frame shape)
:children children
:is-child-selected? is-child-selected?}]]))))
:is-child-selected? is-child-selected?}]
[:& bounding-box {:shape shape :frame frame}]]))))
(defn group-shape
[shape-wrapper]
@ -86,28 +87,18 @@
shape (unchecked-get props "shape")
children (unchecked-get props "children")
is-child-selected? (unchecked-get props "is-child-selected?")
{:keys [id x y width height rotation
displacement-modifier
resize-modifier]} shape
transform (when (and rotation (pos? rotation))
(str/format "rotate(%s %s %s)"
rotation
(+ x (/ width 2))
(+ y (/ height 2))))]
[:g {:transform transform}
{:keys [id x y width height]} shape
transform (geom/transform-matrix shape)]
[:g
(for [item children]
[:& shape-wrapper
{:frame frame
:shape (cond-> item
displacement-modifier (assoc :displacement-modifier displacement-modifier)
resize-modifier (assoc :resize-modifier resize-modifier))
:key (:id item)}])
{:frame frame :shape item :key (:id item)}])
(when (not is-child-selected?)
[:rect {:x x
[:rect {:transform transform
:x x
:y y
:fill (if (deref *debug*) "red" "transparent")
:fill (if (debug? :group) "red" "transparent")
:opacity 0.5
:id (str "group-" id)
:width width

View file

@ -15,7 +15,8 @@
[uxbox.main.ui.shapes.attrs :as attrs]
[uxbox.main.ui.shapes.common :as common]
[uxbox.util.interop :as itr]
[uxbox.util.geom.matrix :as gmt]))
[uxbox.util.geom.matrix :as gmt]
[uxbox.main.ui.shapes.bounding-box :refer [bounding-box]]))
;; --- Image Wrapper
@ -36,19 +37,15 @@
[:g.shape {:class (when selected? "selected")
:on-mouse-down on-mouse-down
:on-context-menu on-context-menu}
[:& image-shape {:shape (geom/transform-shape frame shape)}]]))
[:& image-shape {:shape (geom/transform-shape frame shape)}]
[:& bounding-box {:shape shape :frame frame}]]))
;; --- Image Shape
(mf/defc image-shape
[{:keys [shape] :as props}]
(let [{:keys [id x y width height rotation metadata]} shape
transform (when (and rotation (pos? rotation))
(str/format "rotate(%s %s %s)"
rotation
(+ x (/ width 2))
(+ y (/ height 2))))
transform (geom/transform-matrix shape)
uri (if (or (> (:thumb-width metadata) width)
(> (:thumb-height metadata) height))
(:thumb-uri metadata)

View file

@ -15,7 +15,8 @@
[uxbox.main.ui.shapes.attrs :as attrs]
[uxbox.main.ui.shapes.common :as common]
[uxbox.util.interop :as itr]
[uxbox.util.geom.matrix :as gmt]))
[uxbox.util.geom.matrix :as gmt]
[uxbox.main.ui.shapes.bounding-box :refer [bounding-box]]))
;; --- Path Wrapper
@ -25,17 +26,23 @@
[{:keys [shape frame] :as props}]
(let [selected (mf/deref refs/selected-shapes)
selected? (contains? selected (:id shape))
on-mouse-down #(common/on-mouse-down % shape)
on-context-menu #(common/on-context-menu % shape)
on-double-click
(fn [event]
(when selected?
(st/emit! (dw/start-edition-mode (:id shape)))))]
on-mouse-down (mf/use-callback
(mf/deps shape)
#(common/on-mouse-down % shape))
on-context-menu (mf/use-callback
(mf/deps shape)
#(common/on-context-menu % shape))
on-double-click (mf/use-callback
(mf/deps shape)
(fn [event]
(when selected?
(st/emit! (dw/start-edition-mode (:id shape))))))]
[:g.shape {:on-double-click on-double-click
:on-mouse-down on-mouse-down
:on-context-menu on-context-menu}
[:& path-shape {:shape (geom/transform-shape frame shape)
:background? true}]]))
[:& path-shape {:shape (geom/transform-shape frame shape) :background? true}]
[:& bounding-box {:shape shape :frame frame}]]))
;; --- Path Shape
@ -62,14 +69,8 @@
(mf/defc path-shape
[{:keys [shape background?] :as props}]
(let [{:keys [id x y width height rotation]} (geom/shape->rect-shape shape)
transform (when (and rotation (pos? rotation))
(str/format "rotate(%s %s %s)"
rotation
(+ x (/ width 2))
(+ y (/ height 2))))
(let [{:keys [id x y width height]} (geom/shape->rect-shape shape)
transform (geom/transform-matrix shape)
pdata (render-path shape)
props (-> (attrs/extract-style-attrs shape)
(itr/obj-assign!

View file

@ -14,7 +14,8 @@
[uxbox.main.refs :as refs]
[uxbox.main.ui.shapes.attrs :as attrs]
[uxbox.main.ui.shapes.common :as common]
[uxbox.util.interop :as itr]))
[uxbox.util.interop :as itr]
[uxbox.main.ui.shapes.bounding-box :refer [bounding-box]]))
;; --- Rect Wrapper
@ -33,7 +34,8 @@
#(common/on-context-menu % shape))]
[:g.shape {:on-mouse-down on-mouse-down
:on-context-menu on-context-menu}
[:& rect-shape {:shape (geom/transform-shape frame shape) }]]))
[:& rect-shape {:shape (geom/transform-shape frame shape) }]
[:& bounding-box {:shape shape :frame frame}]]))
;; --- Rect Shape
@ -41,11 +43,8 @@
{::mf/wrap-props false}
[props]
(let [shape (unchecked-get props "shape")
{:keys [id x y width height rotation]} shape
center (gpt/center shape)
transform (when (pos? rotation)
(str (-> (gmt/matrix)
(gmt/rotate rotation center))))
{:keys [id x y width height]} shape
transform (geom/transform-matrix shape)
props (-> (attrs/extract-style-attrs shape)
(itr/obj-assign!
#js {:x x

View file

@ -112,19 +112,23 @@
(let [shape (get-in state [:workspace-local :drawing])
shape (geom/setup shape {:x (:x point)
:y (:y point)
:width 2
:height 2})]
:width 10
:height 10})]
(assoc-in state [:workspace-local :drawing] (assoc shape ::initialized? true))))
(resize-shape [shape point lock?]
(resize-shape [{:keys [x y] :as shape} initial point lock?]
(let [shape' (geom/shape->rect-shape shape)
result (geom/resize-shape :bottom-right shape' point lock?)
scale (geom/calculate-scale-ratio shape' result)
mtx (geom/generate-resize-matrix :bottom-right shape' scale)]
(assoc shape :resize-modifier mtx)))
shapev (gpt/point (:width shape') (:height shape'))
deltav (gpt/subtract point initial)
scalev (gpt/divide (gpt/add shapev deltav) shapev)]
(update-drawing [state point lock?]
(update-in state [:workspace-local :drawing] resize-shape point lock?))]
(-> shape
(assoc :resize-modifier-vector scalev)
(assoc :resize-modifier-origin (gpt/point x y))
(assoc :resize-modifier-rotation 0))))
(update-drawing [state initial point lock?]
(update-in state [:workspace-local :drawing] resize-shape initial point lock?))]
(ptk/reify ::handle-drawing-generic
ptk/WatchEvent
@ -132,7 +136,7 @@
(let [{:keys [zoom flags]} (:workspace-local state)
stoper? #(or (ms/mouse-up? %) (= % :interrupt))
stoper (rx/filter stoper? stream)
initial @ms/mouse-position
mouse (->> ms/mouse-position
(rx/map #(gpt/divide % (gpt/point zoom))))]
(rx/concat
@ -141,7 +145,7 @@
(rx/map (fn [pt] #(initialize-drawing % pt))))
(->> mouse
(rx/with-latest vector ms/mouse-position-ctrl)
(rx/map (fn [[pt ctrl?]] #(update-drawing % pt ctrl?)))
(rx/map (fn [[pt ctrl?]] #(update-drawing % initial pt ctrl?)))
(rx/take-until stoper))
(rx/of handle-finish-drawing)))))))
@ -268,13 +272,12 @@
(rx/concat
(rx/of dw/clear-drawing)
(when (::initialized? shape)
(let [modifier (:resize-modifier shape)
shape (if (gmt/matrix? modifier)
(geom/transform shape modifier)
shape)
shape (dissoc shape ::initialized? :resize-modifier)]
;; Add & select the created shape to the workspace
(rx/of dw/deselect-all (dw/add-shape shape)))))))))
(let [shape (-> shape
(geom/transform-shape)
(dissoc shape ::initialized?))]
;; Add & select the created shape to the workspace
(rx/of dw/deselect-all
(dw/add-shape shape)))))))))
(def close-drawing-path
(ptk/reify ::close-drawing-path

View file

@ -149,7 +149,7 @@
;; :x 0 :y 0
:height c/viewport-height}
[:g {:transform (str "translate(0, " translate-y ")")}
[:g {:transform (str "translate(0, " (+ translate-y 20) ")")}
[:& vertical-rule-ticks {:zoom zoom}]]
[:rect {:x 0
:y 0

View file

@ -20,86 +20,8 @@
[uxbox.main.streams :as ms]
[uxbox.util.dom :as dom]
[uxbox.util.geom.point :as gpt]
[uxbox.util.geom.matrix :as gmt]))
(defn- apply-zoom
[point]
(gpt/divide point (gpt/point @refs/selected-zoom)))
;; --- Resize & Rotate
(defn- start-resize
[vid ids shape]
(letfn [(resize [shape [point lock?]]
(let [result (geom/resize-shape vid shape point lock?)
scale (geom/calculate-scale-ratio shape result)
mtx (geom/generate-resize-matrix vid shape scale)]
(rx/of (dw/assoc-resize-modifier-in-bulk ids mtx))))
;; Unifies the instantaneous proportion lock modifier
;; activated by Ctrl key and the shapes own proportion
;; lock flag that can be activated on element options.
(normalize-proportion-lock [[point ctrl?]]
(let [proportion-lock? (:proportion-lock shape)]
[point (or proportion-lock? ctrl?)]))
;; Applies alginment to point if it is currently
;; activated on the current workspace
;; (apply-grid-alignment [point]
;; (if @refs/selected-alignment
;; (uwrk/align-point point)
;; (rx/of point)))
]
(reify
ptk/WatchEvent
(watch [_ state stream]
(let [shape (->> (geom/shape->rect-shape shape)
(geom/size))
stoper (rx/filter ms/mouse-up? stream)]
(rx/concat
(->> ms/mouse-position
(rx/map apply-zoom)
;; (rx/mapcat apply-grid-alignment)
(rx/with-latest vector ms/mouse-position-ctrl)
(rx/map normalize-proportion-lock)
(rx/mapcat (partial resize shape))
(rx/take-until stoper))
(rx/of (dw/materialize-resize-modifier-in-bulk ids))))))))
(defn start-rotate
[shapes]
(ptk/reify ::start-rotate
ptk/WatchEvent
(watch [_ state stream]
(let [stoper (rx/filter ms/mouse-up? stream)
group (geom/selection-rect shapes)
group-center (gpt/center group)
initial-angle (gpt/angle @ms/mouse-position group-center)
calculate-angle (fn [pos ctrl?]
(let [angle (- (gpt/angle pos group-center) initial-angle)
angle (if (neg? angle) (+ 360 angle) angle)
modval (mod angle 90)
angle (if ctrl?
(if (< 50 modval)
(+ angle (- 90 modval))
(- angle modval))
angle)
angle (if (= angle 360)
0
angle)]
angle))]
(rx/concat
(->> ms/mouse-position
(rx/map apply-zoom)
(rx/with-latest vector ms/mouse-position-ctrl)
(rx/map (fn [[pos ctrl?]]
(let [delta-angle (calculate-angle pos ctrl?)]
(dw/apply-rotation delta-angle shapes))))
(rx/take-until stoper))
(rx/of (dw/materialize-rotation shapes))
)))))
[uxbox.util.geom.matrix :as gmt]
[uxbox.util.debug :refer [debug?]]))
;; --- Controls (Component)
@ -149,41 +71,44 @@
[{:keys [shape zoom on-resize on-rotate] :as props}]
(let [{:keys [x y width height rotation] :as shape} (geom/shape->rect-shape shape)
radius (if (> (max width height) handler-size-threshold) 6.0 4.0)
transform (geom/rotation-matrix shape)
transform (geom/transform-matrix shape)
resize-handlers {:top [(+ x (/ width 2 )) (- y 2)]
:right [(+ x width 1) (+ y (/ height 2))]
:bottom [(+ x (/ width 2)) (+ y height 2)]
:left [(- x 3) (+ y (/ height 2))]
resize-handlers {:top [(+ x (/ width 2 )) y]
:right [(+ x width) (+ y (/ height 2))]
:bottom [(+ x (/ width 2)) (+ y height)]
:left [x (+ y (/ height 2))]
:top-left [x y]
:top-right [(+ x width) y]
:bottom-left [x (+ y height)]
:bottom-right [(+ x width) (+ y height)]}]
[:g.controls {:transform transform}
[:rect.main {:x x :y y
[:g.controls
[:rect.main {:transform transform
:x x :y y
:width width
:height height
:stroke-dasharray (str (/ 8.0 zoom) "," (/ 5 zoom))
:vector-effect "non-scaling-stroke"
:style {:stroke "#1FDEA7"
:fill "transparent"
:stroke-opacity "1"}}]
(for [[position [cx cy]] resize-handlers]
[:* {:key (str "fragment-" (name position))}
[:& rotation-handler {:key (str "rotation-" (name position))
:cx cx
:cy cy
:position position
:rotation (:rotation shape)
:on-mouse-down on-rotate}]
(let [tp (gpt/transform (gpt/point cx cy) transform)]
[:* {:key (str "fragment-" (name position))}
[:& rotation-handler {:key (str "rotation-" (name position))
:cx (:x tp)
:cy (:y tp)
:position position
:rotation (:rotation shape)
:on-mouse-down on-rotate}]
[:& control-item {:key (str "resize-" (name position))
:class (name position)
:on-click #(on-resize position %)
:r (/ radius zoom)
:cx cx
:cy cy}]])]))
[:& control-item {:key (str "resize-" (name position))
:class (name position)
:on-click #(on-resize position %)
:r (/ radius zoom)
:cx (:x tp)
:cy (:y tp)}]]))]))
;; --- Selection Handlers (Component)
@ -210,18 +135,20 @@
(on-handler-move [delta index]
(st/emit! (dw/update-path (:id shape) index delta)))]
(let [displacement (:displacement modifiers)
(let [transform (geom/transform-matrix shape)
displacement (:displacement modifiers)
segments (cond->> (:segments shape)
displacement (map #(gpt/transform % displacement)))]
[:g.controls
(for [[index {:keys [x y]}] (map-indexed vector segments)]
[:circle {:cx x :cy y
:r (/ 6.0 zoom)
:key index
:on-mouse-down #(on-mouse-down % index)
:fill "#ffffff"
:stroke "#1FDEA7"
:style {:cursor "pointer"}}])])))
(let [{:keys [x y]} (gpt/transform (gpt/point x y) transform)]
[:circle {:cx x :cy y
:r (/ 6.0 zoom)
:key index
:on-mouse-down #(on-mouse-down % index)
:fill "#ffffff"
:stroke "#1FDEA7"
:style {:cursor "pointer"}}]))])))
;; TODO: add specs for clarity
@ -239,13 +166,13 @@
:fill "transparent"}}]]))
(mf/defc multiple-selection-handlers
[{:keys [shapes selected zoom] :as props}]
[{:keys [shapes selected zoom objects] :as props}]
(let [shape (geom/selection-rect shapes)
on-resize #(do (dom/stop-propagation %2)
(st/emit! (start-resize %1 selected shape)))
(st/emit! (dw/start-resize %1 selected shape objects)))
on-rotate #(do (dom/stop-propagation %)
(st/emit! (start-rotate shapes)))]
(st/emit! (dw/start-rotate shapes)))]
[:& controls {:shape shape
:zoom zoom
@ -254,13 +181,15 @@
(mf/defc single-selection-handlers
[{:keys [shape zoom objects] :as props}]
(let [shape (geom/transform-shape shape)
(let [shape-id (:id shape)
shape (geom/transform-shape shape)
shape' (if (debug? :simple-selection) (geom/selection-rect [shape]) shape)
on-resize #(do (dom/stop-propagation %2)
(st/emit! (start-resize %1 #{(:id shape)} shape)))
(st/emit! (dw/start-resize %1 #{shape-id} shape' objects)))
on-rotate #(do (dom/stop-propagation %)
(st/emit! (start-rotate [shape])))]
(st/emit! (dw/start-rotate [shape])))]
[:& controls {:shape shape
[:& controls {:shape shape'
:zoom zoom
:on-rotate on-rotate
:on-resize on-resize}]))
@ -284,6 +213,7 @@
(> num 1)
[:& multiple-selection-handlers {:shapes shapes
:selected selected
:objects objects
:zoom zoom}]
(and (= type :text)
@ -298,5 +228,5 @@
:else
[:& single-selection-handlers {:shape shape
:objects objects
:zoom zoom}])))
:zoom zoom
:objects objects}])))

View file

@ -149,7 +149,6 @@
on-drop
(fn [side {:keys [id name] :as data}]
(let [index (if (= :top side) (inc index) index)]
;; (println "droping" name "on" side "of" (:name item) "/" index)
(st/emit! (dw/relocate-shape id (:id item) index))))
[dprops dref] (hooks/use-sortable

View file

@ -64,8 +64,8 @@
delta (if (= attr :x)
(gpt/point (math/neg (- pval cval)) 0)
(gpt/point 0 (math/neg (- pval cval))))]
(st/emit! (udw/apply-frame-displacement (:id shape) delta)
(udw/materialize-frame-displacement (:id shape)))))
(st/emit! (udw/apply-displacement-in-bulk #{(:id shape)} delta)
(udw/materialize-displacement-in-bulk #{(:id shape)}))))
on-width-change #(on-size-change % :width)
on-height-change #(on-size-change % :height)

View file

@ -0,0 +1,37 @@
(ns uxbox.util.debug
"Debugging utils")
(def debug-options #{:bounding-boxes :group :events #_:simple-selection})
(defonce ^:dynamic *debug* (atom #{}))
(defn debug-all! [] (reset! *debug* debug-options))
(defn debug-none! [] (reset! *debug* #{}))
(defn debug! [option] (swap! *debug* conj option))
(defn -debug! [option] (swap! *debug* disj option))
(defn debug? [option] (@*debug* option))
(defn tap
"Transducer function that can execute a side-effect `effect-fn` per input"
[effect-fn]
(fn [rf]
(fn
([] (rf))
([result] (rf result))
([result input]
(effect-fn input)
(rf result input)))))
(defn logjs
([str] (tap (partial logjs str)))
([str val]
(js/console.log str (clj->js val))
val))
(defn dump-state []
(logjs "state" @uxbox.main.store/state))
(defn dump-objects []
(let [page-id (get @uxbox.main.store/state :page-id)]
(logjs "state" (get-in @uxbox.main.store/state [:workspace-data page-id :objects]))))

View file

@ -33,6 +33,13 @@
([m1 m2 & others]
(reduce multiply (multiply m1 m2) others)))
(defn substract
[{m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f :as m1}
{m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f :as m2}]
(Matrix.
(- m1a m2a) (- m1b m2b) (- m1c m2c)
(- m1d m2d) (- m1e m2e) (- m1f m2f)))
(defn ^boolean matrix?
"Return true if `v` is Matrix instance."
[v]
@ -51,44 +58,47 @@
(Matrix. 1 0 0 1 x y))
(defn scale-matrix
[{x :x y :y :as pt}]
(assert (gpt/point? pt))
(Matrix. x 0 0 y 0 0))
([pt center]
(multiply (translate-matrix center)
(scale-matrix pt)
(translate-matrix (gpt/negate center))))
([{x :x y :y :as pt}]
(assert (gpt/point? pt))
(Matrix. x 0 0 y 0 0)))
(defn rotate-matrix
[a]
(let [a (mth/radians a)]
(Matrix. (mth/cos a)
(mth/sin a)
(- (mth/sin a))
(mth/cos a)
0
0)))
([angle point] (multiply (translate-matrix point)
(rotate-matrix angle)
(translate-matrix (gpt/negate point))))
([angle]
(let [a (mth/radians angle)]
(Matrix. (mth/cos a)
(mth/sin a)
(- (mth/sin a))
(mth/cos a)
0
0))))
(defn rotate
"Apply rotation transformation to the matrix."
([m angle]
(multiply m (rotate-matrix angle)))
([m angle center]
(multiply m
(translate-matrix center)
(rotate-matrix angle)
(translate-matrix (gpt/negate center)))))
(multiply m (rotate-matrix angle center))))
(defn scale
"Apply scale transformation to the matrix."
([m scale] (multiply m (scale-matrix scale)))
([m scale]
(multiply m (scale-matrix scale)))
([m scale center]
(multiply m
(translate-matrix center)
(scale-matrix scale)
(translate-matrix (gpt/negate center)))))
(multiply m (scale-matrix scale center))))
(defn translate
"Apply translate transformation to the matrix."
[m pt]
(multiply m (translate-matrix pt)))
;; --- Transit Adapter
(def matrix-write-handler
@ -118,4 +128,5 @@
(* ky' (Math/sin rad)))
dy (+ (* (- s3) (* ky' (- 1 (Math/cos rad))))
(* kx' (Math/sin rad)))]
(gpt/point (* s1 dx) (* s2 dy))))
(translate-matrix
(gpt/point (* s1 dx) (* s2 dy)))))

View file

@ -9,13 +9,17 @@
(ns uxbox.util.geom.point
(:refer-clojure :exclude [divide])
(:require [uxbox.util.math :as mth]
[cognitect.transit :as t]))
(:require
[cuerdas.core :as str]
[uxbox.util.math :as mth]
[cognitect.transit :as t]))
;; --- Point Impl
(defrecord Point [x y])
(defn s [{:keys [x y]}] (str "(" x "," y ")"))
(defn ^boolean point?
"Return true if `v` is Point instance."
[v]
@ -71,6 +75,11 @@
(assert (point? other))
(Point. (/ x ox) (/ y oy)))
(defn inverse
[{:keys [x y] :as p}]
(assert (point? p))
(Point. (/ 1 x) (/ 1 y)))
(defn negate
[{x :x y :y :as p}]
(assert (point? p))
@ -161,3 +170,4 @@
(t/read-handler
(fn [value]
(map->Point value))))

View file

@ -94,7 +94,7 @@
[state {:keys [id] :as item}]
(let [item (-> item
(geom/shape->rect-shape)
(geom/resolve-rotation)
(geom/transform-apply-modifiers)
(geom/shape->rect-shape))
width (+ (:x item 0) (:width item 0))
height (+ (:y item 0) (:height item 0))