Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-02-13 02:28:18 -05:00
Code Issues Activity

♻️ Reorder functions, for more clarity, and add some comments

Browse source
This commit is contained in:
Andrés Moya 2021-07-08 15:20:43 +02:00 • committed by Alonso Torres
parent 741d3050ad
commit 56795f8d26
8 changed files with 560 additions and 529 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

64
common/src/app/common/geom/shapes.cljc
View file

@ -7,50 +7,12 @@
(ns app.common.geom.shapes
(:require
[app.common.data :as d]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.intersect :as gin]
[app.common.geom.shapes.path :as gsp]
[app.common.geom.shapes.rect :as gpr]
[app.common.geom.shapes.transforms :as gtr]
[app.common.spec :as us]))
;; --- Resize (Dimensions)
(defn resize-modifiers
[shape attr value]
(us/assert map? shape)
(us/assert #{:width :height} attr)
(us/assert number? value)
(let [{:keys [proportion proportion-lock]} shape
size (select-keys (:selrect shape) [:width :height])
new-size (if-not proportion-lock
(assoc size attr value)
(if (= attr :width)
(-> size
(assoc :width value)
(assoc :height (/ value proportion)))
(-> size
(assoc :height value)
(assoc :width (* value proportion)))))
width (:width new-size)
height (:height new-size)
shape-transform (:transform shape (gmt/matrix))
shape-transform-inv (:transform-inverse shape (gmt/matrix))
shape-center (gco/center-shape shape)
{sr-width :width sr-height :height} (:selrect shape)
origin (-> (gpt/point (:selrect shape))
(gtr/transform-point-center shape-center shape-transform))
scalev (gpt/divide (gpt/point width height)
(gpt/point sr-width sr-height))]
{:resize-vector scalev
:resize-origin origin
:resize-transform shape-transform
:resize-transform-inverse shape-transform-inv}))
[app.common.geom.shapes.transforms :as gtr]))
;; --- Setup (Initialize)
;; FIXME: Is this the correct place for these functions?
@ -164,15 +126,6 @@
(assoc :selrect selrect
:points points))))
(defn rotation-modifiers
[shape center angle]
(let [displacement (let [shape-center (gco/center-shape shape)]
(-> (gmt/matrix)
(gmt/rotate angle center)
(gmt/rotate (- angle) shape-center)))]
{:rotation angle
:displacement displacement}))
;; EXPORTS
(d/export gco/center-shape)
@ -187,17 +140,20 @@
(d/export gpr/points->rect)
(d/export gpr/center->rect)
(d/export gtr/transform-shape)
(d/export gtr/calc-child-modifiers)
(d/export gtr/move)
(d/export gtr/absolute-move)
(d/export gtr/transform-matrix)
(d/export gtr/inverse-transform-matrix)
(d/export gtr/transform-point-center)
(d/export gtr/transform-rect)
(d/export gtr/update-group-selrect)
(d/export gtr/transform-points)
(d/export gtr/transform-rect)
(d/export gtr/calculate-adjust-matrix)
(d/export gtr/move)
(d/export gtr/absolute-move)
(d/export gtr/update-group-selrect)
(d/export gtr/resize-modifiers)
(d/export gtr/rotation-modifiers)
(d/export gtr/merge-modifiers)
(d/export gtr/transform-shape)
(d/export gtr/calc-child-modifiers)
;; PATHS
(d/export gsp/content->points)

360
common/src/app/common/geom/shapes/transforms.cljc
View file

@ -15,11 +15,13 @@
[app.common.geom.shapes.rect :as gpr]
[app.common.math :as mth]
[app.common.pages.spec :as spec]
[app.common.spec :as us]
[app.common.text :as txt]))
;; --- Relative Movement
(defn move-selrect [selrect {dx :x dy :y}]
(defn- move-selrect [selrect {dx :x dy :y}]
(-> selrect
(d/update-when :x + dx)
(d/update-when :y + dy)
@ -28,7 +30,7 @@
(d/update-when :x2 + dx)
(d/update-when :y2 + dy)))
(defn move-points [points move-vec]
(defn- move-points [points move-vec]
(->> points
(mapv #(gpt/add % move-vec))))
@ -48,9 +50,8 @@
(cond-> (= :path (:type shape))
(update :content gpa/move-content move-vec)))))
;; --- Absolute Movement
(declare absolute-move-rect)
;; --- Absolute Movement
(defn absolute-move
"Move the shape to the exactly specified position."
@ -59,6 +60,68 @@
dy (- (d/check-num y) (-> shape :selrect :y))]
(move shape (gpt/point dx dy))))
; ---- Geometric operations
(defn- normalize-scale
"We normalize the scale so it's not too close to 0"
[scale]
(cond
(and (< scale 0) (> scale -0.01)) -0.01
(and (>= scale 0) (< scale 0.01)) 0.01
:else scale))
(defn- calculate-skew-angle
"Calculates the skew angle of the paralelogram given by the points"
[[p1 _ p3 p4]]
(let [v1 (gpt/to-vec p3 p4)
v2 (gpt/to-vec p4 p1)]
;; If one of the vectors is zero it's a rectangle with 0 height or width
;; We don't skew these
(if (or (gpt/almost-zero? v1)
(gpt/almost-zero? v2))
0
(- 90 (gpt/angle-with-other v1 v2)))))
(defn- calculate-height
"Calculates the height of a paralelogram given by the points"
[[p1 _ _ p4]]
(-> (gpt/to-vec p4 p1)
(gpt/length)))
(defn- calculate-width
"Calculates the width of a paralelogram given by the points"
[[p1 p2 _ _]]
(-> (gpt/to-vec p1 p2)
(gpt/length)))
(defn- calculate-rotation
"Calculates the rotation between two shapes given the resize vector direction"
[center points-shape1 points-shape2 flip-x flip-y]
(let [idx-1 0
idx-2 (cond (and flip-x (not flip-y)) 1
(and flip-x flip-y) 2
(and (not flip-x) flip-y) 3
:else 0)
p1 (nth points-shape1 idx-1)
p2 (nth points-shape2 idx-2)
v1 (gpt/to-vec center p1)
v2 (gpt/to-vec center p2)
rot-angle (gpt/angle-with-other v1 v2)
rot-sign (gpt/angle-sign v1 v2)]
(* rot-sign rot-angle)))
(defn- calculate-dimensions
[[p1 p2 p3 _]]
(let [width (gpt/distance p1 p2)
height (gpt/distance p2 p3)]
{:width width :height height}))
;; --- Transformation matrix operations
(defn transform-matrix
"Returns a transformation matrix without changing the shape properties.
The result should be used in a `transform` attribute in svg"
@ -117,98 +180,6 @@
(transform-points matrix))]
(gpr/points->rect points)))
(defn normalize-scale
"We normalize the scale so it's not too close to 0"
[scale]
(cond
(and (< scale 0) (> scale -0.01)) -0.01
(and (>= scale 0) (< scale 0.01)) 0.01
:else scale))
(defn modifiers->transform
[center modifiers]
(let [ds-modifier (:displacement modifiers (gmt/matrix))
{res-x :x res-y :y} (:resize-vector modifiers (gpt/point 1 1))
;; Normalize x/y vector coordinates because scale by 0 is infinite
res-x (normalize-scale res-x)
res-y (normalize-scale res-y)
resize (gpt/point res-x res-y)
origin (:resize-origin modifiers (gpt/point 0 0))
resize-transform (:resize-transform modifiers (gmt/matrix))
resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix))
rt-modif (or (:rotation modifiers) 0)
center (gpt/transform center ds-modifier)
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 center)
(gmt/multiply (gmt/rotate-matrix rt-modif))
(gmt/translate (gpt/negate center))
;; Displacement
(gmt/multiply ds-modifier))]
transform))
(defn- calculate-skew-angle
"Calculates the skew angle of the paralelogram given by the points"
[[p1 _ p3 p4]]
(let [v1 (gpt/to-vec p3 p4)
v2 (gpt/to-vec p4 p1)]
;; If one of the vectors is zero it's a rectangle with 0 height or width
;; We don't skew these
(if (or (gpt/almost-zero? v1)
(gpt/almost-zero? v2))
0
(- 90 (gpt/angle-with-other v1 v2)))))
(defn- calculate-height
"Calculates the height of a paralelogram given by the points"
[[p1 _ _ p4]]
(-> (gpt/to-vec p4 p1)
(gpt/length)))
(defn- calculate-width
"Calculates the width of a paralelogram given by the points"
[[p1 p2 _ _]]
(-> (gpt/to-vec p1 p2)
(gpt/length)))
(defn- calculate-rotation
"Calculates the rotation between two shapes given the resize vector direction"
[center points-shape1 points-shape2 flip-x flip-y]
(let [idx-1 0
idx-2 (cond (and flip-x (not flip-y)) 1
(and flip-x flip-y) 2
(and (not flip-x) flip-y) 3
:else 0)
p1 (nth points-shape1 idx-1)
p2 (nth points-shape2 idx-2)
v1 (gpt/to-vec center p1)
v2 (gpt/to-vec center p2)
rot-angle (gpt/angle-with-other v1 v2)
rot-sign (gpt/angle-sign v1 v2)]
(* rot-sign rot-angle)))
(defn- calculate-dimensions
[[p1 p2 p3 _]]
(let [width (gpt/distance p1 p2)
height (gpt/distance p2 p3)]
{:width width :height height}))
(defn calculate-adjust-matrix
"Calculates a matrix that is a series of transformations we have to do to the transformed rectangle so that
after applying them the end result is the `shape-pathn-temp`.
@ -257,7 +228,7 @@
(gmt/rotate (- rotation-angle)))]
[stretch-matrix stretch-matrix-inverse rotation-angle])))
(defn apply-transform
(defn- apply-transform
"Given a new set of points transformed, set up the rectangle so it keeps
its properties. We adjust de x,y,width,height and create a custom transform"
[shape transform round-coords?]
@ -310,7 +281,145 @@
(assoc $ :selrect (gpr/rect->selrect rect-shape))
(assoc $ :rotation (mod (+ base-rotation modif-rotation) 360)))))
(defn set-flip [shape modifiers]
(defn- update-group-viewbox
"Updates the viewbox for groups imported from SVG's"
[{:keys [selrect svg-viewbox] :as group} new-selrect]
(let [;; Gets deltas for the selrect to update the svg-viewbox (for svg-imports)
deltas {:x (- (:x new-selrect 0) (:x selrect 0))
:y (- (:y new-selrect 0) (:y selrect 0))
:width (- (:width new-selrect 1) (:width selrect 1))
:height (- (:height new-selrect 1) (:height selrect 1))}]
(cond-> group
(and (some? svg-viewbox) (some? selrect) (some? new-selrect))
(update :svg-viewbox
#(-> %
(update :x + (:x deltas))
(update :y + (:y deltas))
(update :width + (:width deltas))
(update :height + (:height deltas)))))))
(defn update-group-selrect [group children]
(let [shape-center (gco/center-shape group)
;; Points for every shape inside the group
points (->> children (mapcat :points))
;; Invert to get the points minus the transforms applied to the group
base-points (transform-points points shape-center (:transform-inverse group (gmt/matrix)))
;; Defines the new selection rect with its transformations
new-points (-> (gpr/points->selrect base-points)
(gpr/rect->points)
(transform-points shape-center (:transform group (gmt/matrix))))
;; Calculte the new selrect
new-selrect (gpr/points->selrect base-points)]
;; Updates the shape and the applytransform-rect will update the other properties
(-> group
(update-group-viewbox new-selrect)
(assoc :selrect new-selrect)
(assoc :points new-points)
;; We're regenerating the selrect from its children so we
;; need to remove the flip flags
(assoc :flip-x false)
(assoc :flip-y false)
(apply-transform (gmt/matrix) true))))
;; --- Modifiers
(defn resize-modifiers
[shape attr value]
(us/assert map? shape)
(us/assert #{:width :height} attr)
(us/assert number? value)
(let [{:keys [proportion proportion-lock]} shape
size (select-keys (:selrect shape) [:width :height])
new-size (if-not proportion-lock
(assoc size attr value)
(if (= attr :width)
(-> size
(assoc :width value)
(assoc :height (/ value proportion)))
(-> size
(assoc :height value)
(assoc :width (* value proportion)))))
width (:width new-size)
height (:height new-size)
shape-transform (:transform shape (gmt/matrix))
shape-transform-inv (:transform-inverse shape (gmt/matrix))
shape-center (gco/center-shape shape)
{sr-width :width sr-height :height} (:selrect shape)
origin (-> (gpt/point (:selrect shape))
(transform-point-center shape-center shape-transform))
scalev (gpt/divide (gpt/point width height)
(gpt/point sr-width sr-height))]
{:resize-vector scalev
:resize-origin origin
:resize-transform shape-transform
:resize-transform-inverse shape-transform-inv}))
(defn rotation-modifiers
[shape center angle]
(let [displacement (let [shape-center (gco/center-shape shape)]
(-> (gmt/matrix)
(gmt/rotate angle center)
(gmt/rotate (- angle) shape-center)))]
{:rotation angle
:displacement displacement}))
(defn merge-modifiers
[objects modifiers]
(let [set-modifier
(fn [objects [id modifiers]]
(-> objects
(d/update-when id merge modifiers)))]
(->> modifiers
(reduce set-modifier objects))))
(defn- modifiers->transform
[center modifiers]
(let [ds-modifier (:displacement modifiers (gmt/matrix))
{res-x :x res-y :y} (:resize-vector modifiers (gpt/point 1 1))
;; Normalize x/y vector coordinates because scale by 0 is infinite
res-x (normalize-scale res-x)
res-y (normalize-scale res-y)
resize (gpt/point res-x res-y)
origin (:resize-origin modifiers (gpt/point 0 0))
resize-transform (:resize-transform modifiers (gmt/matrix))
resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix))
rt-modif (or (:rotation modifiers) 0)
center (gpt/transform center ds-modifier)
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 center)
(gmt/multiply (gmt/rotate-matrix rt-modif))
(gmt/translate (gpt/negate center))
;; Displacement
(gmt/multiply ds-modifier))]
transform))
(defn- set-flip [shape modifiers]
(let [rx (get-in modifiers [:resize-vector :x])
ry (get-in modifiers [:resize-vector :y])]
(cond-> shape
@ -319,7 +428,7 @@
(and ry (< ry 0)) (-> (update :flip-y not)
(update :rotation -)))))
(defn apply-displacement [shape]
(defn- apply-displacement [shape]
(let [modifiers (:modifiers shape)]
(if (contains? modifiers :displacement)
(let [mov-vec (-> (gpt/point 0 0)
@ -332,9 +441,8 @@
(dissoc :modifiers))))
shape)))
;; TODO: looks like orig-shape is useless argument
(defn apply-text-resize
[shape _orig-shape modifiers]
(defn- apply-text-resize
[shape modifiers]
(if (and (= (:type shape) :text)
(:resize-scale-text modifiers))
(let [merge-attrs (fn [attrs]
@ -364,7 +472,7 @@
(-> shape
(set-flip modifiers)
(apply-transform transform round-coords?)
(apply-text-resize shape modifiers)
(apply-text-resize modifiers)
(dissoc :modifiers)))
shape))))
@ -508,49 +616,3 @@
(assoc :resize-transform (:resize-transform parent-modifiers)
:resize-transform-inverse (:resize-transform-inverse parent-modifiers)))))
(defn update-group-viewbox
"Updates the viewbox for groups imported from SVG's"
[{:keys [selrect svg-viewbox] :as group} new-selrect]
(let [;; Gets deltas for the selrect to update the svg-viewbox (for svg-imports)
deltas {:x (- (:x new-selrect 0) (:x selrect 0))
:y (- (:y new-selrect 0) (:y selrect 0))
:width (- (:width new-selrect 1) (:width selrect 1))
:height (- (:height new-selrect 1) (:height selrect 1))}]
(cond-> group
(and (some? svg-viewbox) (some? selrect) (some? new-selrect))
(update :svg-viewbox
#(-> %
(update :x + (:x deltas))
(update :y + (:y deltas))
(update :width + (:width deltas))
(update :height + (:height deltas)))))))
(defn update-group-selrect [group children]
(let [shape-center (gco/center-shape group)
;; Points for every shape inside the group
points (->> children (mapcat :points))
;; Invert to get the points minus the transforms applied to the group
base-points (transform-points points shape-center (:transform-inverse group (gmt/matrix)))
;; Defines the new selection rect with its transformations
new-points (-> (gpr/points->selrect base-points)
(gpr/rect->points)
(transform-points shape-center (:transform group (gmt/matrix))))
;; Calculte the new selrect
new-selrect (gpr/points->selrect base-points)]
;; Updates the shape and the applytransform-rect will update the other properties
(-> group
(update-group-viewbox new-selrect)
(assoc :selrect new-selrect)
(assoc :points new-points)
;; We're regenerating the selrect from its children so we
;; need to remove the flip flags
(assoc :flip-x false)
(assoc :flip-y false)
(apply-transform (gmt/matrix) true))))

1
common/src/app/common/pages.cljc
View file

@ -66,7 +66,6 @@
(d/export helpers/merge-path-item)
(d/export helpers/compact-path)
(d/export helpers/compact-name)
(d/export helpers/merge-modifiers)
;; Indices
(d/export indices/calculate-z-index)

9
common/src/app/common/pages/helpers.cljc
View file

@ -465,12 +465,3 @@
(let [path-split (split-path path)]
(merge-path-item (first path-split) name)))
(defn merge-modifiers
[objects modifiers]
(let [set-modifier
(fn [objects [id modifiers]]
(-> objects
(d/update-when id merge modifiers)))]
(->> modifiers
(reduce set-modifier objects))))

37
frontend/src/app/main/data/workspace.cljs
View file

@ -1139,33 +1139,6 @@
(gpr/assign-proportions))))]
(rx/of (dch/update-shapes [id] assign-proportions))))))
;; --- Update Shape Position
(s/def ::x number?)
(s/def ::y number?)
(s/def ::position
(s/keys :opt-un [::x ::y]))
(defn update-position
[id position]
(us/verify ::us/uuid id)
(us/verify ::position position)
(ptk/reify ::update-position
ptk/WatchEvent
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
shape (get objects id)
bbox (-> shape :points gsh/points->selrect)
cpos (gpt/point (:x bbox) (:y bbox))
pos (gpt/point (or (:x position) (:x bbox))
(or (:y position) (:y bbox)))
displ (gmt/translate-matrix (gpt/subtract pos cpos))]
(rx/of (dwt/set-modifiers [id] {:displacement displ})
(dwt/apply-modifiers [id]))))))
;; --- Update Shape Flags
(defn update-shape-flags
@ -1811,15 +1784,13 @@
;; Transform
(d/export dwt/start-rotate)
(d/export dwt/start-resize)
(d/export dwt/update-dimensions)
(d/export dwt/start-rotate)
(d/export dwt/increase-rotation)
(d/export dwt/start-move-selected)
(d/export dwt/move-selected)
(d/export dwt/set-rotation)
(d/export dwt/increase-rotation)
(d/export dwt/set-modifiers)
(d/export dwt/apply-modifiers)
(d/export dwt/update-dimensions)
(d/export dwt/update-position)
(d/export dwt/flip-horizontal-selected)
(d/export dwt/flip-vertical-selected)

611
frontend/src/app/main/data/workspace/transforms.cljs
View file

@ -24,18 +24,13 @@
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
;; -- Declarations
(declare set-modifiers)
(declare set-rotation)
(declare apply-modifiers)
;; -- Helpers --------------------------------------------------------
;; -- Helpers
;; For each of the 8 handlers gives the modifier for resize
;; For each of the 8 handlers gives the multiplier 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
(def ^:private handler-multipliers
{:right [ 1 0]
:bottom [ 0 1]
:left [-1 0]
@ -45,13 +40,16 @@
: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]
(defn- handler-resize-origin
"Given a handler, return 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
"
[{sx :x sy :y :keys [width height]} handler]
(let [mx (+ sx (/ width 2))
my (+ sy (/ height 2))
ex (+ sx width)
@ -95,8 +93,193 @@
(update [_ state]
(update state :workspace-local dissoc :transform))))
;; -- RESIZE
;; -- Temporary modifiers -------------------------------------------
;; During an interactive transformation of shapes (e.g. when resizing or rotating
;; a group with the mouse), there are a lot of objects that need to be modified
;; (in this case, the group and all its children).
;;
;; To avoid updating the shapes theirselves, and forcing redraw of all components
;; that depend on the "objects" global state, we set a "modifiers" structure, with
;; the changes that need to be applied, and store it in :workspace-modifiers global
;; variable. The viewport reads this and merges it into the objects list it uses to
;; paint the viewport content, redrawing only the objects that have new modifiers.
;;
;; When the interaction is finished (e.g. user releases mouse button), the
;; apply-modifiers event is done, that consolidates all modifiers into the base
;; geometric attributes of the shapes.
(declare set-modifiers-recursive)
(declare check-delta)
(declare set-local-displacement)
(declare clear-local-transform)
(defn- set-modifiers
([ids] (set-modifiers ids nil))
([ids modifiers]
(us/verify (s/coll-of uuid?) ids)
(ptk/reify ::set-modifiers
ptk/UpdateEvent
(update [_ state]
(let [modifiers (or modifiers (get-in state [:workspace-local :modifiers] {}))
page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
ids (->> ids (into #{} (remove #(get-in objects [% :blocked] false))))]
(reduce (fn [state id]
(update state :workspace-modifiers
#(set-modifiers-recursive %
objects
(get objects id)
modifiers
nil
nil)))
state
ids))))))
;; Rotation use different algorithm to calculate children modifiers (and do not use child constraints).
(defn- set-rotation-modifiers
([angle shapes]
(set-rotation-modifiers angle shapes (-> shapes gsh/selection-rect gsh/center-selrect)))
([angle shapes center]
(ptk/reify ::set-rotation-modifiers
ptk/UpdateEvent
(update [_ state]
(let [objects (wsh/lookup-page-objects state)
id->obj #(get objects %)
get-children (fn [shape] (map id->obj (cp/get-children (:id shape) objects)))
shapes (->> shapes (into [] (remove #(get % :blocked false))))
shapes (->> shapes (mapcat get-children) (concat shapes))
update-shape
(fn [modifiers shape]
(let [rotate-modifiers (gsh/rotation-modifiers shape center angle)]
(assoc-in modifiers [(:id shape) :modifiers] rotate-modifiers)))]
(-> state
(update :workspace-modifiers
#(reduce update-shape % shapes))))))))
(defn- apply-modifiers
[ids]
(us/verify (s/coll-of uuid?) ids)
(ptk/reify ::apply-modifiers
ptk/WatchEvent
(watch [_ state _]
(let [objects (wsh/lookup-page-objects state)
children-ids (->> ids (mapcat #(cp/get-children % objects)))
ids-with-children (d/concat [] children-ids ids)
object-modifiers (get state :workspace-modifiers)
ignore-tree (d/mapm #(get-in %2 [:modifiers :ignore-geometry?]) object-modifiers)]
(rx/of (dwu/start-undo-transaction)
(dch/update-shapes
ids-with-children
(fn [shape]
(-> shape
(merge (get object-modifiers (:id shape)))
(gsh/transform-shape)))
{:reg-objects? true
:ignore-tree ignore-tree
;; Attributes that can change in the transform. This way we don't have to check
;; all the attributes
:attrs [:selrect :points
:x :y
:width :height
:content
:transform
:transform-inverse
:rotation
:flip-x
:flip-y]})
(clear-local-transform)
(dwu/commit-undo-transaction))))))
(defn- set-modifiers-recursive
[modif-tree objects shape modifiers root transformed-root]
(let [children (->> (get shape :shapes [])
(map #(get objects %)))
transformed-shape (gsh/transform-shape (assoc shape :modifiers modifiers))
[root transformed-root ignore-geometry?]
(check-delta shape root transformed-shape transformed-root objects)
modifiers (assoc modifiers :ignore-geometry? ignore-geometry?)
set-child (fn [modif-tree child]
(let [child-modifiers (gsh/calc-child-modifiers shape
child
modifiers)]
(set-modifiers-recursive modif-tree
objects
child
child-modifiers
root
transformed-root)))]
(reduce set-child
(update-in modif-tree [(:id shape) :modifiers] #(merge % modifiers))
children)))
(defn- check-delta
"If the shape is a component instance, check its relative position respect the
root of the component, and see if it changes after applying a transformation."
[shape root transformed-shape transformed-root objects]
(let [root (cond
(:component-root? shape)
shape
(nil? root)
(cp/get-root-shape shape objects)
:else root)
transformed-root (cond
(:component-root? transformed-shape)
transformed-shape
(nil? transformed-root)
(cp/get-root-shape transformed-shape objects)
:else transformed-root)
shape-delta (when root
(gpt/point (- (:x shape) (:x root))
(- (:y shape) (:y root))))
transformed-shape-delta (when transformed-root
(gpt/point (- (:x transformed-shape) (:x transformed-root))
(- (:y transformed-shape) (:y transformed-root))))
ignore-geometry? (= shape-delta transformed-shape-delta)]
[root transformed-root ignore-geometry?]))
(defn- set-local-displacement [point]
(ptk/reify ::start-local-displacement
ptk/UpdateEvent
(update [_ state]
(let [mtx (gmt/translate-matrix point)]
(-> state
(assoc-in [:workspace-local :modifiers] {:displacement mtx}))))))
(defn- clear-local-transform []
(ptk/reify ::clear-local-transform
ptk/UpdateEvent
(update [_ state]
(-> state
(dissoc :workspace-modifiers)
(update :workspace-local dissoc :modifiers :current-move-selected)))))
;; -- Resize --------------------------------------------------------
(defn start-resize
"Enter mouse resize mode, until mouse button is released."
[handler ids shape]
(letfn [(resize [shape initial layout [point lock? point-snap]]
(let [{:keys [width height]} (:selrect shape)
@ -113,12 +296,12 @@
lock? (or lock? scale-text)
;; Vector modifiers depending on the handler
handler-modif (let [[x y] (handler-modifiers handler)] (gpt/point x y))
handler-mult (let [[x y] (handler-multipliers handler)] (gpt/point x y))
;; Difference between the origin point in the coordinate system of the rotation
deltav (-> (gpt/to-vec initial (if (= rotation 0) point-snap point))
(gpt/transform (gmt/rotate-matrix (- rotation)))
(gpt/multiply handler-modif))
(gpt/multiply handler-mult))
;; Resize vector
scalev (gpt/divide (gpt/add shapev deltav) shapev)
@ -185,8 +368,43 @@
(rx/of (apply-modifiers ids)
(finish-transform))))))))
(defn update-dimensions
"Change size of shapes, from the sideber options form."
[ids attr value]
(us/verify (s/coll-of ::us/uuid) ids)
(us/verify #{:width :height} attr)
(us/verify ::us/number value)
(ptk/reify ::update-dimensions
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data :pages-index page-id :objects])]
(reduce (fn [state id]
(let [shape (get objects id)
modifiers (gsh/resize-modifiers shape attr value)]
(update state :workspace-modifiers
#(set-modifiers-recursive %
objects
shape
modifiers
nil
nil))))
state
ids)))
ptk/WatchEvent
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
ids (d/concat [] ids (mapcat #(cp/get-children % objects) ids))]
(rx/of (apply-modifiers ids))))))
;; -- Rotate --------------------------------------------------------
(defn start-rotate
"Enter mouse rotate mode, until mouse button is released."
[shapes]
(ptk/reify ::start-rotate
ptk/UpdateEvent
@ -218,19 +436,37 @@
(rx/with-latest vector ms/mouse-position-ctrl)
(rx/map (fn [[pos ctrl?]]
(let [delta-angle (calculate-angle pos ctrl?)]
(set-rotation delta-angle shapes group-center))))
(set-rotation-modifiers delta-angle shapes group-center))))
(rx/take-until stoper))
(rx/of (apply-modifiers (map :id shapes))
(finish-transform)))))))
;; -- MOVE
(defn increase-rotation
"Rotate shapes a fixed angle, from a keyboard action."
[ids rotation]
(ptk/reify ::increase-rotation
ptk/WatchEvent
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
rotate-shape (fn [shape]
(let [delta (- rotation (:rotation shape))]
(set-rotation-modifiers delta [shape])))]
(rx/concat
(rx/from (->> ids (map #(get objects %)) (map rotate-shape)))
(rx/of (apply-modifiers ids)))))))
;; -- Move ----------------------------------------------------------
(declare start-move)
(declare start-move-duplicate)
(declare set-local-displacement)
(declare clear-local-transform)
(declare calculate-frame-for-move)
(declare get-displacement)
(defn start-move-selected
"Enter mouse move mode, until mouse button is released."
[]
(ptk/reify ::start-move-selected
ptk/WatchEvent
@ -255,7 +491,8 @@
;; Otherwise just plain old move
(rx/of (start-move initial selected)))))))))))
(defn start-move-duplicate [from-position]
(defn- start-move-duplicate
[from-position]
(ptk/reify ::start-move-selected
ptk/WatchEvent
(watch [_ _ stream]
@ -264,45 +501,7 @@
(rx/first)
(rx/map #(start-move from-position))))))
(defn calculate-frame-for-move [ids]
(ptk/reify ::calculate-frame-for-move
ptk/WatchEvent
(watch [it state _]
(let [position @ms/mouse-position
page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
frame-id (cp/frame-id-by-position objects position)
moving-shapes (->> ids
(cp/clean-loops objects)
(map #(get objects %))
(remove #(or (nil? %)
(= (:frame-id %) frame-id))))
rch [{:type :mov-objects
:page-id page-id
:parent-id frame-id
:shapes (mapv :id moving-shapes)}]
uch (->> moving-shapes
(reverse)
(mapv (fn [shape]
{:type :mov-objects
:page-id page-id
:parent-id (:parent-id shape)
:index (cp/get-index-in-parent objects (:id shape))
:shapes [(:id shape)]})))]
(when-not (empty? uch)
(rx/of dwu/pop-undo-into-transaction
(dch/commit-changes {:redo-changes rch
:undo-changes uch
:origin it})
(dwu/commit-undo-transaction)
(dwc/expand-collapse frame-id)))))))
(defn start-move
(defn- start-move
([from-position] (start-move from-position nil))
([from-position ids]
(ptk/reify ::start-move
@ -349,19 +548,10 @@
(calculate-frame-for-move ids)
(finish-transform)))))))))
(defn- get-displacement
"Retrieve the correct displacement delta point for the
provided direction speed and distances thresholds."
[direction]
(case direction
:up (gpt/point 0 (- 1))
:down (gpt/point 0 1)
:left (gpt/point (- 1) 0)
:right (gpt/point 1 0)))
(s/def ::direction #{:up :down :right :left})
(defn move-selected
"Move shapes a fixed increment in one direction, from a keyboard action."
[direction shift?]
(us/verify ::direction direction)
(us/verify boolean? shift?)
@ -405,209 +595,83 @@
(finish-transform))))
(rx/empty))))))
(s/def ::x number?)
(s/def ::y number?)
(s/def ::position
(s/keys :opt-un [::x ::y]))
;; -- Apply modifiers
(defn- check-delta
"If the shape is a component instance, check its relative position respect the
root of the component, and see if it changes after applying a transformation."
[shape root transformed-shape transformed-root objects]
(let [root (cond
(:component-root? shape)
shape
(nil? root)
(cp/get-root-shape shape objects)
:else root)
transformed-root (cond
(:component-root? transformed-shape)
transformed-shape
(nil? transformed-root)
(cp/get-root-shape transformed-shape objects)
:else transformed-root)
shape-delta (when root
(gpt/point (- (:x shape) (:x root))
(- (:y shape) (:y root))))
transformed-shape-delta (when transformed-root
(gpt/point (- (:x transformed-shape) (:x transformed-root))
(- (:y transformed-shape) (:y transformed-root))))
ignore-geometry? (= shape-delta transformed-shape-delta)]
[root transformed-root ignore-geometry?]))
(defn- set-modifiers-recursive
"Apply the modifiers to one shape, and the corresponding ones to all children,
depending on the child constraints. The modifiers are not directly applied to
the objects tree, but to a separated structure (modif-tree), that may be
merged later with the real objects. This way, the objects are changed only
once, avoiding unnecesary redrawings."
[modif-tree objects shape modifiers root transformed-root]
(let [children (->> (get shape :shapes [])
(map #(get objects %)))
transformed-shape (gsh/transform-shape (assoc shape :modifiers modifiers))
[root transformed-root ignore-geometry?]
(check-delta shape root transformed-shape transformed-root objects)
modifiers (assoc modifiers :ignore-geometry? ignore-geometry?)
set-child (fn [modif-tree child]
(let [child-modifiers (gsh/calc-child-modifiers shape
child
modifiers)]
(set-modifiers-recursive modif-tree
objects
child
child-modifiers
root
transformed-root)))]
(reduce set-child
(update-in modif-tree [(:id shape) :modifiers] #(merge % modifiers))
children)))
(defn set-modifiers
([ids] (set-modifiers ids nil))
([ids modifiers]
(us/verify (s/coll-of uuid?) ids)
(ptk/reify ::set-modifiers
ptk/UpdateEvent
(update [_ state]
(let [modifiers (or modifiers (get-in state [:workspace-local :modifiers] {}))
page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
ids (->> ids (into #{} (remove #(get-in objects [% :blocked] false))))]
(reduce (fn [state id]
(update state :workspace-modifiers
#(set-modifiers-recursive %
objects
(get objects id)
modifiers
nil
nil)))
state
ids))))))
;; Set-rotation is custom because applies different modifiers to each
;; shape adjusting their position.
(defn set-rotation
([angle shapes]
(set-rotation angle shapes (-> shapes gsh/selection-rect gsh/center-selrect)))
([angle shapes center]
(ptk/reify ::set-rotation
ptk/UpdateEvent
(update [_ state]
(let [objects (wsh/lookup-page-objects state)
id->obj #(get objects %)
get-children (fn [shape] (map id->obj (cp/get-children (:id shape) objects)))
shapes (->> shapes (into [] (remove #(get % :blocked false))))
shapes (->> shapes (mapcat get-children) (concat shapes))
update-shape
(fn [modifiers shape]
(let [rotate-modifiers (gsh/rotation-modifiers shape center angle)]
(assoc-in modifiers [(:id shape) :modifiers] rotate-modifiers)))]
(-> state
(update :workspace-modifiers
#(reduce update-shape % shapes))))))))
(defn increase-rotation [ids rotation]
(ptk/reify ::increase-rotation
(defn update-position
"Move shapes to a new position, from the sidebar options form."
[id position]
(us/verify ::us/uuid id)
(us/verify ::position position)
(ptk/reify ::update-position
ptk/WatchEvent
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
rotate-shape (fn [shape]
(let [delta (- rotation (:rotation shape))]
(set-rotation delta [shape])))]
(rx/concat
(rx/from (->> ids (map #(get objects %)) (map rotate-shape)))
(rx/of (apply-modifiers ids)))))))
shape (get objects id)
(defn apply-modifiers
bbox (-> shape :points gsh/points->selrect)
cpos (gpt/point (:x bbox) (:y bbox))
pos (gpt/point (or (:x position) (:x bbox))
(or (:y position) (:y bbox)))
displ (gmt/translate-matrix (gpt/subtract pos cpos))]
(rx/of (set-modifiers [id] {:displacement displ})
(apply-modifiers [id]))))))
(defn- calculate-frame-for-move
[ids]
(us/verify (s/coll-of uuid?) ids)
(ptk/reify ::apply-modifiers
(ptk/reify ::calculate-frame-for-move
ptk/WatchEvent
(watch [_ state _]
(let [objects (wsh/lookup-page-objects state)
children-ids (->> ids (mapcat #(cp/get-children % objects)))
ids-with-children (d/concat [] children-ids ids)
object-modifiers (get state :workspace-modifiers)
ignore-tree (d/mapm #(get-in %2 [:modifiers :ignore-geometry?]) object-modifiers)]
(rx/of (dwu/start-undo-transaction)
(dch/update-shapes
ids-with-children
(fn [shape]
(-> shape
(merge (get object-modifiers (:id shape)))
(gsh/transform-shape)))
{:reg-objects? true
:ignore-tree ignore-tree
;; Attributes that can change in the transform. This way we don't have to check
;; all the attributes
:attrs [:selrect :points
:x :y
:width :height
:content
:transform
:transform-inverse
:rotation
:flip-x
:flip-y]})
(clear-local-transform)
(dwu/commit-undo-transaction))))))
;; --- Update Dimensions
;; Event mainly used for handling user modification of the size of the
;; object from workspace sidebar options inputs.
(defn update-dimensions
[ids attr value]
(us/verify (s/coll-of ::us/uuid) ids)
(us/verify #{:width :height} attr)
(us/verify ::us/number value)
(ptk/reify ::update-dimensions
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data :pages-index page-id :objects])]
(reduce (fn [state id]
(let [shape (get objects id)
modifiers (gsh/resize-modifiers shape attr value)]
(update state :workspace-modifiers
#(set-modifiers-recursive %
objects
shape
modifiers
nil
nil))))
state
ids)))
ptk/WatchEvent
(watch [_ state _]
(let [page-id (:current-page-id state)
(watch [it state _]
(let [position @ms/mouse-position
page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
ids (d/concat [] ids (mapcat #(cp/get-children % objects) ids))]
(rx/of (apply-modifiers ids))))))
frame-id (cp/frame-id-by-position objects position)
moving-shapes (->> ids
(cp/clean-loops objects)
(map #(get objects %))
(remove #(or (nil? %)
(= (:frame-id %) frame-id))))
rch [{:type :mov-objects
:page-id page-id
:parent-id frame-id
:shapes (mapv :id moving-shapes)}]
uch (->> moving-shapes
(reverse)
(mapv (fn [shape]
{:type :mov-objects
:page-id page-id
:parent-id (:parent-id shape)
:index (cp/get-index-in-parent objects (:id shape))
:shapes [(:id shape)]})))]
(when-not (empty? uch)
(rx/of dwu/pop-undo-into-transaction
(dch/commit-changes {:redo-changes rch
:undo-changes uch
:origin it})
(dwu/commit-undo-transaction)
(dwc/expand-collapse frame-id)))))))
(defn- get-displacement
"Retrieve the correct displacement delta point for the
provided direction speed and distances thresholds."
[direction]
(case direction
:up (gpt/point 0 (- 1))
:down (gpt/point 0 1)
:left (gpt/point (- 1) 0)
:right (gpt/point 1 0)))
;; -- Flip ----------------------------------------------------------
(defn flip-horizontal-selected []
(ptk/reify ::flip-horizontal-selected
@ -641,19 +705,6 @@
:displacement (gmt/translate-matrix (gpt/point 0 (- (:height selrect))))})
(apply-modifiers selected))))))
(defn set-local-displacement [point]
(ptk/reify ::start-local-displacement
ptk/UpdateEvent
(update [_ state]
(let [mtx (gmt/translate-matrix point)]
(-> state
(assoc-in [:workspace-local :modifiers] {:displacement mtx}))))))
(defn clear-local-transform []
(ptk/reify ::clear-local-transform
ptk/UpdateEvent
(update [_ state]
(-> state
(dissoc :workspace-modifiers)
(update :workspace-local dissoc :modifiers :current-move-selected)))))
;; -- Transform to path ---------------------------------------------

3
frontend/src/app/main/refs.cljs
View file

@ -9,6 +9,7 @@
"A collection of derived refs."
(:require
[app.common.data :as d]
[app.common.geom.shapes :as gsh]
[app.common.pages :as cp]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.store :as st]
@ -239,7 +240,7 @@
modifiers (:workspace-modifiers state)
objects (cond-> objects
with-modifiers?
(cp/merge-modifiers modifiers))
(gsh/merge-modifiers modifiers))
xform (comp (map #(get objects %))
(remove nil?))]
(into [] xform ids)))

4
frontend/src/app/main/ui/workspace/viewport.cljs
View file

@ -7,7 +7,7 @@
(ns app.main.ui.workspace.viewport
(:require
[app.common.data :as d]
[app.common.pages :as cp]
[app.common.geom.shapes :as gsh]
[app.main.refs :as refs]
[app.main.ui.context :as ctx]
[app.main.ui.measurements :as msr]
@ -64,7 +64,7 @@
object-modifiers (mf/deref refs/workspace-modifiers)
objects (mf/use-memo
(mf/deps objects object-modifiers)
#(cp/merge-modifiers objects object-modifiers))
#(gsh/merge-modifiers objects object-modifiers))
background (get options :background "#E8E9EA")
;; STATE