diff --git a/common/src/app/common/geom/shapes.cljc b/common/src/app/common/geom/shapes.cljc index c98eba760..8771ff2e3 100644 --- a/common/src/app/common/geom/shapes.cljc +++ b/common/src/app/common/geom/shapes.cljc @@ -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) diff --git a/common/src/app/common/geom/shapes/transforms.cljc b/common/src/app/common/geom/shapes/transforms.cljc index c5387aa92..9df0fede5 100644 --- a/common/src/app/common/geom/shapes/transforms.cljc +++ b/common/src/app/common/geom/shapes/transforms.cljc @@ -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)))) - diff --git a/common/src/app/common/pages.cljc b/common/src/app/common/pages.cljc index 0e69c9d53..fdf02cfa3 100644 --- a/common/src/app/common/pages.cljc +++ b/common/src/app/common/pages.cljc @@ -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) diff --git a/common/src/app/common/pages/helpers.cljc b/common/src/app/common/pages/helpers.cljc index 7ab687dca..2c7507243 100644 --- a/common/src/app/common/pages/helpers.cljc +++ b/common/src/app/common/pages/helpers.cljc @@ -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)))) diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs index 37c26e0f1..7c0a57c7d 100644 --- a/frontend/src/app/main/data/workspace.cljs +++ b/frontend/src/app/main/data/workspace.cljs @@ -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) diff --git a/frontend/src/app/main/data/workspace/transforms.cljs b/frontend/src/app/main/data/workspace/transforms.cljs index e503884de..713371c7e 100644 --- a/frontend/src/app/main/data/workspace/transforms.cljs +++ b/frontend/src/app/main/data/workspace/transforms.cljs @@ -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 --------------------------------------------- diff --git a/frontend/src/app/main/refs.cljs b/frontend/src/app/main/refs.cljs index 22e9adebe..236f4a0af 100644 --- a/frontend/src/app/main/refs.cljs +++ b/frontend/src/app/main/refs.cljs @@ -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))) diff --git a/frontend/src/app/main/ui/workspace/viewport.cljs b/frontend/src/app/main/ui/workspace/viewport.cljs index 07e73e287..a0fa7552c 100644 --- a/frontend/src/app/main/ui/workspace/viewport.cljs +++ b/frontend/src/app/main/ui/workspace/viewport.cljs @@ -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