From af68c26aeabba467d3c4c6bbb377665426dabe11 Mon Sep 17 00:00:00 2001 From: "alonso.torres" Date: Tue, 10 Nov 2020 17:52:23 +0100 Subject: [PATCH] :recycle: Refactor transforms --- common/app/common/data.cljc | 32 +- common/app/common/geom/align.cljc | 24 +- common/app/common/geom/matrix.cljc | 10 + common/app/common/geom/proportions.cljc | 62 ++ common/app/common/geom/shapes.cljc | 227 ++---- common/app/common/geom/shapes/common.cljc | 65 +- common/app/common/geom/shapes/path.cljc | 4 +- common/app/common/geom/shapes/rect.cljc | 141 ++-- common/app/common/geom/shapes/transforms.cljc | 685 +++++++++++------- common/app/common/pages.cljc | 10 +- frontend/src/app/main/data/workspace.cljs | 159 +--- .../src/app/main/data/workspace/common.cljs | 92 ++- .../src/app/main/data/workspace/drawing.cljs | 34 + .../app/main/data/workspace/drawing/box.cljs | 3 +- .../main/data/workspace/drawing/common.cljs | 14 +- .../main/data/workspace/drawing/curve.cljs | 8 +- .../app/main/data/workspace/drawing/path.cljs | 110 ++- .../app/main/data/workspace/libraries.cljs | 4 +- .../app/main/data/workspace/transforms.cljs | 15 +- frontend/src/app/main/exports.cljs | 2 +- frontend/src/app/main/snap.cljs | 2 +- frontend/src/app/main/store.cljs | 14 +- .../src/app/main/ui/shapes/custom_stroke.cljs | 3 +- frontend/src/app/main/ui/shapes/path.cljs | 12 +- .../src/app/main/ui/workspace/selection.cljs | 6 +- .../ui/workspace/shapes/bounding_box.cljs | 2 +- .../app/main/ui/workspace/snap_distances.cljs | 5 +- .../src/app/main/ui/workspace/viewport.cljs | 3 +- frontend/src/app/main/worker.cljs | 4 +- frontend/src/app/util/geom/snap_points.cljs | 4 +- frontend/src/app/util/worker.cljs | 6 +- frontend/src/app/worker/selection.cljs | 8 +- 32 files changed, 1085 insertions(+), 685 deletions(-) create mode 100644 common/app/common/geom/proportions.cljc diff --git a/common/app/common/data.cljc b/common/app/common/data.cljc index 3034e369b..18cfe35dc 100644 --- a/common/app/common/data.cljc +++ b/common/app/common/data.cljc @@ -7,12 +7,14 @@ (ns app.common.data "Data manipulation and query helper functions." (:refer-clojure :exclude [concat read-string hash-map]) - (:require [clojure.set :as set] - [linked.set :as lks] - #?(:cljs [cljs.reader :as r] - :clj [clojure.edn :as r]) - #?(:cljs [cljs.core :as core] - :clj [clojure.core :as core])) + (:require + [clojure.set :as set] + [linked.set :as lks] + [app.common.math :as mth] + #?(:cljs [cljs.reader :as r] + :clj [clojure.edn :as r]) + #?(:cljs [cljs.core :as core] + :clj [clojure.core :as core])) #?(:clj (:import linked.set.LinkedSet))) @@ -261,3 +263,21 @@ (defn coalesce [val default] (or val default)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Data Parsing / Conversion +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defn nilf + "Returns a new function that if you pass nil as any argument will + return nil" + [f] + (fn [& args] + (if (some nil? args) + nil + (apply f args)))) + +(defn check-num + "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)) diff --git a/common/app/common/geom/align.cljc b/common/app/common/geom/align.cljc index 64089b70c..4cec0fdf5 100644 --- a/common/app/common/geom/align.cljc +++ b/common/app/common/geom/align.cljc @@ -10,11 +10,7 @@ (ns app.common.geom.align (:require [clojure.spec.alpha :as s] - [app.common.spec :as us] [app.common.geom.shapes :as gsh] - [app.common.geom.matrix :as gmt] - [app.common.geom.point :as gpt] - [app.common.math :as mth] [app.common.data :as d])) ;; --- Alignment @@ -23,6 +19,20 @@ (declare calc-align-pos) +;; Duplicated from pages-helpers to remove cyclic dependencies +(defn- get-children [id objects] + (let [shapes (vec (get-in objects [id :shapes]))] + (if shapes + (d/concat shapes (mapcat #(get-children % objects) shapes)) + []))) + +(defn- recursive-move + "Move the shape and all its recursive children." + [shape dpoint objects] + (let [children-ids (get-children (:id shape) objects) + children (map #(get objects %) children-ids)] + (map #(gsh/move % dpoint) (cons shape children)))) + (defn align-to-rect "Move the shape so that it is aligned with the given rectangle in the given axis. Take account the form of the shape and the @@ -34,7 +44,7 @@ align-pos (calc-align-pos wrapper-rect rect axis) delta {:x (- (:x align-pos) (:x wrapper-rect)) :y (- (:y align-pos) (:y wrapper-rect))}] - (gsh/recursive-move shape delta objects))) + (recursive-move shape delta objects))) (defn calc-align-pos [wrapper-rect rect axis] @@ -80,7 +90,7 @@ ; The rectangle that wraps the whole selection wrapper-rect (gsh/selection-rect shapes) ; Sort shapes by the center point in the given axis - sorted-shapes (sort-by #(coord (gsh/center %)) shapes) + sorted-shapes (sort-by #(coord (gsh/center-shape %)) shapes) ; Each shape wrapped in its own rectangle wrapped-shapes (map #(gsh/selection-rect [%]) sorted-shapes) ; The total space between shapes @@ -106,7 +116,7 @@ new-pos (conj deltas delta)))))] - (mapcat #(gsh/recursive-move %1 {coord %2 other-coord 0} objects) + (mapcat #(recursive-move %1 {coord %2 other-coord 0} objects) sorted-shapes deltas))))) ;; Adjusto to viewport diff --git a/common/app/common/geom/matrix.cljc b/common/app/common/geom/matrix.cljc index f3b9a0007..185197f16 100644 --- a/common/app/common/geom/matrix.cljc +++ b/common/app/common/geom/matrix.cljc @@ -121,3 +121,13 @@ ([m angle-x angle-y p] (multiply m (skew-matrix angle-x angle-y p)))) +(defn m-equal [m1 m2 threshold] + (let [th-eq (fn [a b] (<= (mth/abs (- a b)) threshold)) + {m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f} m1 + {m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f} m2] + (and (th-eq m1a m2a) + (th-eq m1b m2b) + (th-eq m1c m2c) + (th-eq m1d m2d) + (th-eq m1e m2e) + (th-eq m1f m2f)))) diff --git a/common/app/common/geom/proportions.cljc b/common/app/common/geom/proportions.cljc new file mode 100644 index 000000000..e70a9b3b5 --- /dev/null +++ b/common/app/common/geom/proportions.cljc @@ -0,0 +1,62 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; This Source Code Form is "Incompatible With Secondary Licenses", as +;; defined by the Mozilla Public License, v. 2.0. +;; +;; Copyright (c) 2020 UXBOX Labs SL + +(ns app.common.geom.proportions + (:require + [clojure.spec.alpha :as s] + [app.common.spec :as us] + [app.common.geom.matrix :as gmt] + [app.common.geom.point :as gpt] + [app.common.geom.shapes.common :as gco] + [app.common.geom.shapes.transforms :as gtr] + [app.common.geom.shapes.rect :as gpr] + [app.common.math :as mth] + [app.common.data :as d])) + +;; --- Proportions + +(declare assign-proportions-path) +(declare assign-proportions-rect) + +(defn assign-proportions + [{:keys [type] :as shape}] + (case type + :path (assign-proportions-path shape) + (assign-proportions-rect shape))) + +(defn- assign-proportions-rect + [{:keys [width height] :as shape}] + (assoc shape :proportion (/ width height))) + + +;; --- Setup Proportions + +(declare setup-proportions-const) +(declare setup-proportions-image) + +(defn setup-proportions + [shape] + (case (:type shape) + :icon (setup-proportions-image shape) + :image (setup-proportions-image shape) + :text shape + (setup-proportions-const shape))) + +(defn setup-proportions-image + [{:keys [metadata] :as shape}] + (let [{:keys [width height]} metadata] + (assoc shape + :proportion (/ width height) + :proportion-lock false))) + +(defn setup-proportions-const + [shape] + (assoc shape + :proportion 1 + :proportion-lock false)) diff --git a/common/app/common/geom/shapes.cljc b/common/app/common/geom/shapes.cljc index 0bb89d5cf..8cf607315 100644 --- a/common/app/common/geom/shapes.cljc +++ b/common/app/common/geom/shapes.cljc @@ -19,31 +19,19 @@ [app.common.math :as mth] [app.common.data :as d])) -(defn- nilf - "Returns a new function that if you pass nil as any argument will - return nil" - [f] - (fn [& args] - (if (some nil? args) - nil - (apply f args)))) - ;; --- Relative Movement -(declare move-rect) -(declare move-path) - -(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 {dx :x dy :y}] - (let [inc-x (nilf (fn [x] (+ (-chk x) (-chk dx)))) + (let [dx (d/check-num dx) + dy (d/check-num dy)] + (-> shape + (assoc-in [:modifiers :displacement] (gmt/translate-matrix (gpt/point dx dy))) + (gtr/transform-shape))) + + #_(let [inc-x (nilf (fn [x] (+ (-chk x) (-chk dx)))) inc-y (nilf (fn [y] (+ (-chk y) (-chk dy)))) inc-point (nilf (fn [p] (-> p (update :x inc-x) @@ -60,57 +48,20 @@ (update :points #(mapv inc-point %)) (update :segments #(mapv inc-point %))))) -;; Duplicated from pages-helpers to remove cyclic dependencies -(defn get-children [id objects] - (let [shapes (vec (get-in objects [id :shapes]))] - (if shapes - (d/concat shapes (mapcat #(get-children % objects) shapes)) - []))) - -(defn recursive-move - "Move the shape and all its recursive children." - [shape dpoint objects] - (let [children-ids (get-children (:id shape) objects) - children (map #(get objects %) children-ids)] - (map #(move % dpoint) (cons shape children)))) - ;; --- Absolute Movement (declare absolute-move-rect) (defn absolute-move "Move the shape to the exactly specified position." - [shape position] - (case (:type shape) - (:curve :path) 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 (- (-chk x) (-chk (:x shape))) 0) - dy (if y (- (-chk y) (-chk (:y shape))) 0)] + [shape {:keys [x y]}] + (let [dx (- (d/check-num x) (-> shape :selrect :x)) + dy (- (d/check-num y) (-> shape :selrect :y))] (move shape (gpt/point dx dy)))) -;; --- Proportions - -(declare assign-proportions-path) -(declare assign-proportions-rect) - -(defn assign-proportions - [{:keys [type] :as shape}] - (case type - :path (assign-proportions-path shape) - (assign-proportions-rect shape))) - -(defn- assign-proportions-rect - [{:keys [width height] :as shape}] - (assoc shape :proportion (/ width height))) - ;; --- Paths -(defn update-path-point +#_(defn update-path-point "Update a concrete point in the path. The point should exists before, this function @@ -118,34 +69,9 @@ [shape index point] (assoc-in shape [:segments index] point)) -;; --- Setup Proportions - -(declare setup-proportions-const) -(declare setup-proportions-image) - -(defn setup-proportions - [shape] - (case (:type shape) - :icon (setup-proportions-image shape) - :image (setup-proportions-image shape) - :text shape - (setup-proportions-const shape))) - -(defn setup-proportions-image - [{:keys [metadata] :as shape}] - (let [{:keys [width height]} metadata] - (assoc shape - :proportion (/ width height) - :proportion-lock false))) - -(defn setup-proportions-const - [shape] - (assoc shape - :proportion 1 - :proportion-lock false)) ;; --- Resize (Dimensions) - +;;; TODO: CHANGE TO USE THE MODIFIERS (defn resize [shape width height] (us/assert map? shape) @@ -177,28 +103,21 @@ (resize shape (:width new-size) (:height new-size)))) ;; --- Setup (Initialize) - -(declare setup-rect) -(declare setup-image) - -(defn setup - "A function that initializes the first coordinates for - the shape. Used mainly for draw operations." - [shape props] - (case (:type shape) - :image (setup-image shape props) - (setup-rect shape props))) +;; FIXME: Is this the correct place for these functions? (defn- setup-rect "A specialized function for setup rect-like shapes." [shape {:keys [x y width height]}] - (as-> shape $ - (assoc $ :x x - :y y - :width width - :height height) - (assoc $ :points (gtr/shape->points $)) - (assoc $ :selrect (gpr/points->selrect (:points $))))) + (let [rect {:x x :y y :width width :height height} + points (gpr/rect->points rect) + selrect (gpr/points->selrect points)] + (assoc shape + :x x + :y y + :width width + :height height + :points points + :selrect selrect))) (defn- setup-image [{:keys [metadata] :as shape} {:keys [x y width height] :as props}] @@ -208,26 +127,26 @@ (:height metadata)) :proportion-lock true))) +(defn setup + "A function that initializes the first coordinates for + the shape. Used mainly for draw operations." + [shape props] + (case (:type shape) + :image (setup-image shape props) + (setup-rect shape props))) ;; --- Resolve Shape -(declare resolve-rect-shape) -(declare translate-from-frame) -(declare translate-to-frame) - -(defn resolve-shape - [objects shape] - (case (:type shape) - :rect (resolve-rect-shape objects shape) - :group (resolve-rect-shape objects shape) - :frame (resolve-rect-shape objects shape))) - -(defn- resolve-rect-shape - [objects {:keys [parent] :as shape}] - (loop [pobj (get objects parent)] - (if (= :frame (:type pobj)) - (translate-from-frame shape pobj) - (recur (get objects (:parent pobj)))))) +;; (declare resolve-rect-shape) +;; (declare translate-from-frame) +;; (declare translate-to-frame) +;; +;; (defn resolve-shape +;; [objects shape] +;; (loop [pobj (get objects parent)] +;; (if (= :frame (:type pobj)) +;; (translate-from-frame shape pobj) +;; (recur (get objects (:parent pobj)))))) ;; --- Outer Rect @@ -236,24 +155,8 @@ "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 (map :selrect shapes) - minx (transduce (map :x1) min ##Inf shapes) - miny (transduce (map :y1) min ##Inf shapes) - maxx (transduce (map :x2) max ##-Inf shapes) - maxy (transduce (map :y2) max ##-Inf shapes)] - {:x1 minx - :y1 miny - :x2 maxx - :y2 maxy - :x minx - :y miny - :width (- maxx minx) - :height (- maxy miny) - :points [(gpt/point minx miny) - (gpt/point maxx miny) - (gpt/point maxx maxy) - (gpt/point minx maxy)] - :type :rect})) + (let [points (->> shapes (mapcat :points))] + (gpr/points->selrect points))) (defn translate-to-frame [shape {:keys [x y] :as frame}] @@ -269,18 +172,20 @@ "Check if a shape is contained in the provided selection rect." [shape selrect] - (let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} (gpr/shape->rect-shape selrect) - {rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (gpr/shape->rect-shape shape)] + (let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} selrect + {rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (:selrect shape)] (and (neg? (- sy1 ry1)) (neg? (- sx1 rx1)) (pos? (- sy2 ry2)) (pos? (- sx2 rx2))))) +;; TODO: This not will work for rotated shapes (defn overlaps? "Check if a shape overlaps with provided selection rect." - [shape selrect] - (let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} (gpr/shape->rect-shape selrect) - {rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (gpr/shape->rect-shape shape)] + [shape rect] + (let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} (gpr/rect->selrect rect) + {rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (gpr/points->selrect (:points shape))] + (and (< rx1 sx2) (> rx2 sx1) (< ry1 sy2) @@ -368,23 +273,29 @@ (defn setup-selrect [{:keys [x y width height] :as shape}] (-> shape - (assoc :selrect {:x x :y y - :width width :height height - :x1 x :y1 y - :x2 (+ x width) :y2 (+ y height)}))) + (assoc :selrect + {:x x :y y + :width width :height height + :x1 x :y1 y + :x2 (+ x width) :y2 (+ y height)}))) ;; EXPORTS -(def center gco/center) +(defn center-shape [shape] (gco/center-shape shape)) +(defn center-selrect [selrect] (gco/center-selrect selrect)) +(defn center-rect [rect] (gco/center-rect rect)) -(def shape->rect-shape gpr/shape->rect-shape) -(def fix-invalid-rect-values gtr/fix-invalid-rect-values) -(def rect->rect-shape gpr/rect->rect-shape) -(def points->selrect gpr/points->selrect) +(defn rect->selrect [rect] (gpr/rect->selrect rect)) -(def transform-shape-point gtr/transform-shape-point) -(def update-path-selrect gtr/update-path-selrect) -(def transform gtr/transform) +#_(def shape->rect-shape gpr/shape->rect-shape) +#_(def fix-invalid-rect-values gtr/fix-invalid-rect-values) +#_(def rect->rect-shape gpr/rect->rect-shape) +(defn points->selrect [points] (gpr/points->selrect points)) + +#_(def transform-shape-point gtr/transform-shape-point) +#_(def update-path-selrect gtr/update-path-selrect) +#_(def transform gtr/transform) (defn transform-shape [shape] (gtr/transform-shape shape)) -(def transform-matrix gtr/transform-matrix) - +(defn transform-matrix [shape] (gtr/transform-matrix shape)) +(defn transform-point-center [point center transform] (gtr/transform-point-center point center transform)) +(defn transform-rect [rect mtx] (gtr/transform-rect rect mtx)) diff --git a/common/app/common/geom/shapes/common.cljc b/common/app/common/geom/shapes/common.cljc index 1ef8728f7..f69a7d3ea 100644 --- a/common/app/common/geom/shapes/common.cljc +++ b/common/app/common/geom/shapes/common.cljc @@ -17,32 +17,30 @@ [app.common.math :as mth] [app.common.data :as d])) -;; --- Center +(defn center-rect + [{:keys [x y width height]}] + (gpt/point (+ x (/ width 2)) + (+ y (/ height 2)))) -(declare center-rect) -(declare center-path) +(defn center-selrect + "Calculate the center of the shape." + [selrect] + (center-rect selrect)) -(defn center +(defn center-shape "Calculate the center of the shape." [shape] - (case (:type shape) - :curve (center-path shape) - :path (center-path shape) - (center-rect shape))) + (center-rect (:selrect shape))) -(defn- center-rect - [{:keys [x y width height] :as shape}] - (gpt/point (+ x (/ width 2)) (+ y (/ height 2)))) +(defn center-points [points] + (let [minx (transduce (map :x) min ##Inf points) + miny (transduce (map :y) min ##Inf points) + maxx (transduce (map :x) max ##-Inf points) + maxy (transduce (map :y) max ##-Inf points)] + (gpt/point (/ (+ minx maxx) 2) + (/ (+ miny maxy) 2)))) -(defn- center-path - [{: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)))) - -(defn center->rect +(defn make-centered-rect "Creates a rect given a center and a width and height" [center width height] {:x (- (:x center) (/ width 2)) @@ -50,3 +48,30 @@ :width width :height height}) +;; --- Center +#_( + (declare center-rect) + (declare center-path) + + + + + + (defn- center-path + [{: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)))) + + (defn center->rect + "Creates a rect given a center and a width and height" + [center width height] + {:x (- (:x center) (/ width 2)) + :y (- (:y center) (/ height 2)) + :width width + :height height}) + + + ) diff --git a/common/app/common/geom/shapes/path.cljc b/common/app/common/geom/shapes/path.cljc index 60810fc7f..10b6fa0e4 100644 --- a/common/app/common/geom/shapes/path.cljc +++ b/common/app/common/geom/shapes/path.cljc @@ -16,6 +16,8 @@ [app.common.math :as mth] [app.common.data :as d])) +(defn segments->points [segments] + segments) + (defn content->points [content] (map #(gpt/point (-> % :param :x) (-> % :param :y)) content)) - diff --git a/common/app/common/geom/shapes/rect.cljc b/common/app/common/geom/shapes/rect.cljc index 8f06cae97..e5204a5e9 100644 --- a/common/app/common/geom/shapes/rect.cljc +++ b/common/app/common/geom/shapes/rect.cljc @@ -18,66 +18,97 @@ [app.common.math :as mth] [app.common.data :as d])) -;; --- SHAPE -> RECT +(defn rect->points [{:keys [x y width height]}] + [(gpt/point x y) + (gpt/point (+ x width) y) + (gpt/point (+ x width) (+ y height)) + (gpt/point x (+ y height))]) -(defn- rect->rect-shape - [{:keys [x y width height] :as shape}] - (assoc shape - :x1 x - :y1 y - :x2 (+ x width) - :y2 (+ y height))) - -(defn- path->rect-shape - [{:keys [segments] :as shape}] - (merge shape - {:type :rect} - (:selrect shape))) - -(defn shape->rect-shape - "Coerce shape to rect like shape." - - [{:keys [type] :as shape}] - (case type - (:curve :path) (path->rect-shape shape) - (rect->rect-shape shape))) - -;; Shape->PATH - -(declare rect->path) - -(defn shape->path - [shape] - (case (:type shape) - (:curve :path) 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)) - (gpt/point x y)]] - (-> shape - (assoc :type :path) - (assoc :segments points)))) - -;; -- Points - -(defn points->selrect [points] +(defn points->rect [points] (let [minx (transduce (map :x) min ##Inf points) miny (transduce (map :y) min ##Inf points) maxx (transduce (map :x) max ##-Inf points) maxy (transduce (map :y) max ##-Inf points)] - {:x1 minx - :y1 miny - :x2 maxx - :y2 maxy - :x minx + {:x minx :y miny :width (- maxx minx) - :height (- maxy miny) - :type :rect})) + :height (- maxy miny)})) +(defn points->selrect [points] + (let [{:keys [x y width height] :as rect} (points->rect points)] + (assoc rect + :x1 x + :x2 (+ x width) + :y1 y + :y2 (+ y height)))) + +(defn rect->selrect [rect] + (-> rect rect->points points->selrect)) + +;; --- SHAPE -> RECT +#_( + (defn- rect->rect-shape + [{:keys [x y width height] :as shape}] + (assoc shape + :x1 x + :y1 y + :x2 (+ x width) + :y2 (+ y height))) + + (defn- path->rect-shape + [{:keys [segments] :as shape}] + (merge shape + {:type :rect} + (:selrect shape))) + + (defn shape->rect-shape + "Coerce shape to rect like shape." + + [{:keys [type] :as shape}] + (case type + (:curve :path) (path->rect-shape shape) + (rect->rect-shape shape))) + + ;; Shape->PATH + + (declare rect->path) + + (defn shape->path + [shape] + (case (:type shape) + (:curve :path) 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)) + (gpt/point x y)]] + (-> shape + (assoc :type :path) + (assoc :segments points)))) + + ;; -- Points + + (defn points->selrect [points] + (let [minx (transduce (map :x) min ##Inf points) + miny (transduce (map :y) min ##Inf points) + maxx (transduce (map :x) max ##-Inf points) + maxy (transduce (map :y) max ##-Inf points)] + {:x1 minx + :y1 miny + :x2 maxx + :y2 maxy + :x minx + :y miny + :width (- maxx minx) + :height (- maxy miny) + :type :rect})) + + + + + ) diff --git a/common/app/common/geom/shapes/transforms.cljc b/common/app/common/geom/shapes/transforms.cljc index ecb2acd16..94771bbf7 100644 --- a/common/app/common/geom/shapes/transforms.cljc +++ b/common/app/common/geom/shapes/transforms.cljc @@ -19,160 +19,82 @@ [app.common.math :as mth] [app.common.data :as d])) -;; --- Transform Shape +(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 (gco/center-shape shape)] + (-> (gmt/matrix) + (gmt/translate shape-center) + (gmt/multiply (:transform shape (gmt/matrix))) + (gmt/translate (gpt/negate shape-center)))))) -(declare transform-rect) -(declare transform-path) - -(defn transform - "Apply the matrix transformation to shape." - [{:keys [type] :as shape} xfmt] - (if (gmt/matrix? xfmt) - (case type - :path (transform-path shape xfmt) - :curve (transform-path shape xfmt) - (transform-rect shape xfmt)) - shape)) - -(defn center-transform [shape matrix] - (let [shape-center (gco/center shape)] - (-> shape - (transform - (-> (gmt/matrix) - (gmt/translate shape-center) - (gmt/multiply matrix) - (gmt/translate (gpt/negate shape-center))))))) - -(defn- transform-rect - [{:keys [x y width height] :as shape} mx] - (let [tl (gpt/transform (gpt/point x y) mx) - tr (gpt/transform (gpt/point (+ x width) y) mx) - bl (gpt/transform (gpt/point x (+ y height)) mx) - br (gpt/transform (gpt/point (+ x width) (+ y height)) mx) - ;; TODO: replace apply with transduce (performance) - minx (apply min (map :x [tl tr bl br])) - maxx (apply max (map :x [tl tr bl br])) - miny (apply min (map :y [tl tr bl br])) - maxy (apply max (map :y [tl tr bl br]))] - (assoc shape - :x minx - :y miny - :width (- maxx minx) - :height (- maxy miny)))) - -(defn- transform-path - [{:keys [segments] :as shape} xfmt] - (let [segments (mapv #(gpt/transform % xfmt) segments)] - (assoc shape :segments segments))) - - -(defn transform-shape-point +(defn transform-point-center "Transform a point around the shape center" - [point shape transform] - (let [shape-center (gco/center shape)] - (gpt/transform - point - (-> (gmt/multiply - (gmt/translate-matrix shape-center) - transform - (gmt/translate-matrix (gpt/negate shape-center))))))) + [point center matrix] + (gpt/transform + point + (gmt/multiply (gmt/translate-matrix center) + matrix + (gmt/translate-matrix (gpt/negate center))))) -(defn shape->points [shape] - (let [points (case (:type shape) - (:curve :path) (if (:content shape) - (gpa/content->points (:content shape)) - (:segments shape)) - (let [{:keys [x y width height]} shape] - [(gpt/point x y) - (gpt/point (+ x width) y) - (gpt/point (+ x width) (+ y height)) - (gpt/point x (+ y height))]))] - (->> points - (map #(transform-shape-point % shape (:transform shape (gmt/matrix)))) - (map gpt/round) - (vec)))) +(defn transform-points + ([points matrix] + (transform-points points nil matrix)) -(defn rect-path-dimensions [rect-path] - (let [seg (:segments rect-path) - [width height] (mapv (fn [[c1 c2]] (gpt/distance c1 c2)) (take 2 (d/zip seg (rest seg))))] - {:width width - :height height})) + ([points center matrix] -(defn update-path-selrect [shape] - (as-> shape $ - (assoc $ :points (shape->points $)) - (assoc $ :selrect (gpr/points->selrect (:points $))) - (assoc $ :x (get-in $ [:selrect :x])) - (assoc $ :y (get-in $ [:selrect :y])) - (assoc $ :width (get-in $ [:selrect :width])) - (assoc $ :height (get-in $ [:selrect :height])))) + (let [prev (if center (gmt/translate-matrix center) (gmt/matrix)) + post (if center (gmt/translate-matrix (gpt/negate center)) (gmt/matrix)) -(defn fix-invalid-rect-values - [rect-shape] - (letfn [(check [num] - (if (or (nil? num) (mth/nan? num) (= ##Inf num) (= ##-Inf num)) 0 num)) - (to-positive [num] (if (< num 1) 1 num))] - (-> rect-shape - (update :x check) - (update :y check) - (update :width (comp to-positive check)) - (update :height (comp to-positive check))))) + tr-point (fn [point] + (gpt/transform point (gmt/multiply prev matrix post)))] + (mapv tr-point points)))) -(defn calculate-rec-path-skew-angle - [path-shape] - (let [p1 (get-in path-shape [:segments 2]) - p2 (get-in path-shape [:segments 3]) - p3 (get-in path-shape [:segments 4]) - v1 (gpt/to-vec p1 p2) - v2 (gpt/to-vec p2 p3)] - (- 90 (gpt/angle-with-other v1 v2)))) +(defn transform-rect + "Transform a rectangles and changes its attributes" + [{:keys [x y width height] :as rect} matrix] -(defn calculate-rec-path-height - "Calculates the height of a paralelogram given by the path" - [path-shape] - (let [p1 (get-in path-shape [:segments 2]) - p2 (get-in path-shape [:segments 3]) - p3 (get-in path-shape [:segments 4]) - v1 (gpt/to-vec p1 p2) - v2 (gpt/to-vec p2 p3) - angle (gpt/angle-with-other v1 v2)] - (* (gpt/length v2) (mth/sin (mth/radians angle))))) - -(defn calculate-rec-path-rotation - [path-shape1 path-shape2 resize-vector] - - (let [idx-1 0 - idx-2 (cond (and (neg? (:x resize-vector)) (pos? (:y resize-vector))) 1 - (and (neg? (:x resize-vector)) (neg? (:y resize-vector))) 2 - (and (pos? (:x resize-vector)) (neg? (:y resize-vector))) 3 - :else 0) - p1 (get-in path-shape1 [:segments idx-1]) - p2 (get-in path-shape2 [:segments idx-2]) - v1 (gpt/to-vec (gco/center path-shape1) p1) - v2 (gpt/to-vec (gco/center path-shape2) p2) - - rot-angle (gpt/angle-with-other v1 v2) - rot-sign (if (> (* (:y v1) (:x v2)) (* (:x v1) (:y v2))) -1 1)] - (* rot-sign rot-angle))) + (let [points (-> (gpr/rect->points rect) + (transform-points matrix))] + (gpr/points->rect points))) -(defn transform-apply-modifiers - [shape] - (let [modifiers (:modifiers shape) - ds-modifier (:displacement modifiers (gmt/matrix)) +(defn- shape->points [shape] + (let [transform-point + (fn [point] + (-> point + (transform-point-center (gco/center-shape shape) + (:transform shape (gmt/matrix))) + (gpt/round))) + + points (cond + (and (= :path (:type shape)) (:content shape)) + (gpa/content->points (:content shape)) + + (seq (:segments shape)) + (gpa/segments->points (:content shape)) + + :else + (gpr/rect->points shape))] + (mapv transform-point 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 [current-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 (cond - (and (< res-x 0) (> res-x -0.01)) -0.01 - (and (>= res-x 0) (< res-x 0.01)) 0.01 - :else res-x) - - res-y (cond - (and (< res-y 0) (> res-y -0.01)) -0.01 - (and (>= res-y 0) (< res-y 0.01)) 0.01 - :else res-y) - + 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)) @@ -181,162 +103,423 @@ resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix)) rt-modif (or (:rotation modifiers) 0) - shape (-> shape - (transform ds-modifier)) + transform (-> (gmt/matrix) - shape-center (gco/center shape)] + ;; 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)) - (-> (gpr/shape->path shape) - (transform (-> (gmt/matrix) + ;; Applies the stacked transformations + (gmt/translate center) + (gmt/multiply (gmt/rotate-matrix rt-modif)) + #_(gmt/multiply current-transform) + (gmt/translate (gpt/negate center)) - ;; 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)) + ;; Displacement + (gmt/multiply ds-modifier))] + transform)) - ;; 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-skew-angle + "Calculates the skew angle of the paralelogram given by the points" + [[p1 p2 p3 p4]] + (let [v1 (gpt/to-vec p3 p4) + v2 (gpt/to-vec p4 p1)] + (- 90 (gpt/angle-with-other v1 v2)))) -(defn transform-path-shape - [shape] - (-> shape - transform-apply-modifiers - update-path-selrect) - ;; TODO: Addapt for paths is not working - #_(let [shape-path (transform-apply-modifiers shape) - shape-path-center (center shape-path) +(defn- calculate-height + "Calculates the height of a paralelogram given by the points" + [[p1 p2 p3 p4]] + (let [v1 (gpt/to-vec p3 p4) + v2 (gpt/to-vec p4 p1) + angle (gpt/angle-with-other v1 v2)] + (* (gpt/length v2) (mth/sin (mth/radians angle))))) - 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- calculate-rotation + "Calculates the rotation between two shapes given the resize vector direction" + [points-shape1 points-shape2 flip-x flip-y] -(defn transform-rect-shape - [shape] - (let [;; Apply modifiers to the rect as a path so we have the end shape expected - shape-path (transform-apply-modifiers shape) - shape-center (gco/center shape-path) - resize-vector (-> (get-in shape [:modifiers :resize-vector] (gpt/point 1 1)) - (update :x #(if (zero? %) 1 %)) - (update :y #(if (zero? %) 1 %))) + (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 (gco/center-points points-shape1) p1) + v2 (gpt/to-vec (gco/center-points points-shape2) p2) - ;; Reverse the current transformation stack to get the base rectangle - shape-path-temp (center-transform shape-path (:transform-inverse shape (gmt/matrix))) - shape-path-temp-dim (rect-path-dimensions shape-path-temp) - shape-path-temp-rec (gpr/shape->rect-shape shape-path-temp) + rot-angle (gpt/angle-with-other v1 v2) + rot-sign (if (> (* (:y v1) (:x v2)) (* (:x v1) (:y v2))) -1 1)] + (* rot-sign rot-angle))) - ;; This rectangle is the new data for the current rectangle. We want to change our rectangle - ;; to have this width, height, x, y - rec (gco/center->rect shape-center (:width shape-path-temp-dim) (:height shape-path-temp-dim)) - rec (fix-invalid-rect-values rec) - rec-path (gpr/rect->path rec) +(defn- calculate-dimensions + [[p1 p2 p3 p4]] + (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`. + This is compose of three transformations: skew, resize and rotation" + [points-temp points-rec flip-x flip-y] + (let [center (gco/center-points points-temp) - ;; The next matrix is a series of transformations we have to do to the previous rec so that - ;; after applying them the end result is the `shape-path-temp` - ;; This is compose of three transformations: skew, resize and rotation stretch-matrix (gmt/matrix) - skew-angle (calculate-rec-path-skew-angle shape-path-temp) + skew-angle (calculate-skew-angle points-temp) ;; When one of the axis is flipped we have to reverse the skew - skew-angle (if (neg? (* (:x resize-vector) (:y resize-vector))) (- skew-angle) skew-angle ) + ;; skew-angle (if (neg? (* (:x resize-vector) (:y resize-vector))) (- skew-angle) skew-angle ) + skew-angle (if (and (or flip-x flip-y) + (not (and flip-x flip-y))) (- skew-angle) skew-angle ) skew-angle (if (mth/nan? skew-angle) 0 skew-angle) - stretch-matrix (gmt/multiply stretch-matrix (gmt/skew-matrix skew-angle 0)) - h1 (calculate-rec-path-height shape-path-temp) - h2 (calculate-rec-path-height (center-transform rec-path stretch-matrix)) + h1 (calculate-height points-temp) + h2 (calculate-height (transform-points points-temp center stretch-matrix)) h3 (/ h1 h2) h3 (if (mth/nan? h3) 1 h3) stretch-matrix (gmt/multiply stretch-matrix (gmt/scale-matrix (gpt/point 1 h3))) - rotation-angle (calculate-rec-path-rotation (center-transform rec-path stretch-matrix) - shape-path-temp resize-vector) + rotation-angle (calculate-rotation + (transform-points points-rec (gco/center-points points-rec) stretch-matrix) + points-temp + flip-x + flip-y) stretch-matrix (gmt/multiply (gmt/rotate-matrix rotation-angle) stretch-matrix) + stretch-matrix (-> (gmt/matrix) + (gmt/rotate rotation-angle) + (gmt/skew skew-angle 0) + (gmt/scale (gpt/point 1 h3))) + + ;; This is the inverse to be able to remove the transformation stretch-matrix-inverse (-> (gmt/matrix) (gmt/scale (gpt/point 1 h3)) (gmt/skew (- skew-angle) 0) - (gmt/rotate (- rotation-angle))) + (gmt/rotate (- rotation-angle)))] + [stretch-matrix stretch-matrix-inverse])) + + +(defn set-points-path + [shape points] + (let [shape (reduce (fn [acc [idx {:keys [x y]}]] + (-> acc + (assoc-in [:content idx :params :x] x) + (assoc-in [:content idx :params :y] y))) shape (d/enumerate points)) + + shape (assoc shape + :points points + :selrect (gpr/points->selrect points))] + shape)) + +(defn set-points-curve + [shape points] + shape) + +(defn set-points-rect + "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 points] + ;; + (let [center (gco/center-points points) + + ;; Reverse the current transformation stack to get the base rectangle + tr-inverse (:transform-inverse shape (gmt/matrix)) + modifiers (:modifiers shape) + + points-temp (transform-points points center tr-inverse) + points-temp-dim (calculate-dimensions points-temp) + + ;; This rectangle is the new data for the current rectangle. We want to change our rectangle + ;; to have this width, height, x, y + rect-shape (gco/make-centered-rect center + (:width points-temp-dim) + (:height points-temp-dim)) + rect-points (gpr/rect->points rect-shape) + + [matrix matrix-inverse] (calculate-adjust-matrix points-temp rect-points (:flip-x shape) (:flip-y shape)) + ;;[matrix matrix-inverse] [(gmt/matrix) (gmt/matrix)] new-shape (as-> shape $ - (merge $ rec) + (merge $ rect-shape) (update $ :x #(mth/precision % 0)) (update $ :y #(mth/precision % 0)) (update $ :width #(mth/precision % 0)) (update $ :height #(mth/precision % 0)) - (update $ :transform #(gmt/multiply (or % (gmt/matrix)) stretch-matrix)) - (update $ :transform-inverse #(gmt/multiply stretch-matrix-inverse (or % (gmt/matrix)))) - (assoc $ :points (shape->points $)) - (assoc $ :selrect (gpr/points->selrect (:points $))) - (update $ :selrect fix-invalid-rect-values) + (update $ :transform #(gmt/multiply (or % (gmt/matrix)) matrix)) + (update $ :transform-inverse #(gmt/multiply matrix-inverse (or % (gmt/matrix)))) + (assoc $ :points (into [] points)) + (assoc $ :selrect (gpr/rect->selrect rect-shape) #_(gpr/points->selrect points)) (update $ :rotation #(mod (+ (or % 0) (or (get-in $ [:modifiers :rotation]) 0)) 360)))] new-shape)) -(defn transform-shape - "Transform the shape properties given the modifiers" - ([shape] - - (letfn [(transform-by-type [shape] - (case (:type shape) - (:curve :path) - (transform-path-shape shape) +(defn set-points [shape points] + (let [set-points-fn + (case (:type shape) + :path set-points-path + :curve set-points-curve + set-points-rect)] + (set-points-fn shape points))) - #_:default - (transform-rect-shape shape)))] - - (cond-> shape - (:modifiers shape) (transform-by-type) - :always (dissoc :modifiers))) +(defn set-flip [shape modifiers] + (cond-> shape + (< (get-in modifiers [:resize-vector :x]) 0) (update :flip-x not) + (< (get-in modifiers [:resize-vector :y]) 0) (update :flip-y not))) - #_(cond-> shape - (and (:modifiers shape) (#{:curve :path} (:type shape))) - (transform-path-shape shape) - - (and (:modifiers shape) (not (#{:curve :path} (:type shape)))) - (transform-rect-shape shape) +(defn transform-shape [shape] + (if (:modifiers shape) + (let [points (:points shape (shape->points shape)) + center (gco/center-points points) + transform (modifiers->transform (:transform shape (gmt/matrix)) center (:modifiers shape)) + tr-points (transform-points points transform)] + (-> shape + (set-flip (:modifiers shape)) + (set-points tr-points) + (dissoc :modifiers))) + shape)) - true - (dissoc :modifiers) - )) - #_([frame shape kk] +#_(defn transform-shape + "Transform the shape properties given the modifiers" + ([shape] + (letfn [(transform-by-type [shape] + (case (:type shape) + (:curve :path) + (transform-path-shape shape) + + #_:default + (transform-rect-shape shape)))] + + (cond-> shape + (:modifiers shape) (transform-by-type) + :always (dissoc :modifiers))))) + +;; --- Transform Shape + +#_( + (declare transform-rect) + (declare transform-path) + (declare transform) + + (defn center-transform [shape matrix] + (let [shape-center (gco/center shape)] + (-> shape + (transform + (-> (gmt/matrix) + (gmt/translate shape-center) + (gmt/multiply matrix) + (gmt/translate (gpt/negate shape-center))))))) + + (defn- transform-rect + [{:keys [x y width height] :as shape} mx] + (let [tl (gpt/transform (gpt/point x y) mx) + tr (gpt/transform (gpt/point (+ x width) y) mx) + bl (gpt/transform (gpt/point x (+ y height)) mx) + br (gpt/transform (gpt/point (+ x width) (+ y height)) mx) + ;; TODO: replace apply with transduce (performance) + minx (apply min (map :x [tl tr bl br])) + maxx (apply max (map :x [tl tr bl br])) + miny (apply min (map :y [tl tr bl br])) + maxy (apply max (map :y [tl tr bl br]))] + (assoc shape + :x minx + :y miny + :width (- maxx minx) + :height (- maxy miny)))) + + (defn- transform-path + [{:keys [segments] :as shape} xfmt] + (let [segments (mapv #(gpt/transform % xfmt) segments)] + (assoc shape :segments segments))) - #_(if (:modifiers shape) - (-> (case (:type shape) - (:curve :path) (transform-path-shape shape) - (transform-rect-shape shape)) - (dissoc :modifiers)) - shape) - #_(let [new-shape - ] - - #_(cond-> new-shape - frame (translate-to-frame frame))))) + + (defn update-path-selrect [shape] + (as-> shape $ + (assoc $ :points (shape->points $)) + (assoc $ :selrect (gpr/points->selrect (:points $))) + (assoc $ :x (get-in $ [:selrect :x])) + (assoc $ :y (get-in $ [:selrect :y])) + (assoc $ :width (get-in $ [:selrect :width])) + (assoc $ :height (get-in $ [:selrect :height])))) + + (defn fix-invalid-rect-values + [rect-shape] + (letfn [(check [num] + (if (or (nil? num) (mth/nan? num) (= ##Inf num) (= ##-Inf num)) 0 num)) + (to-positive [num] (if (< num 1) 1 num))] + (-> rect-shape + (update :x check) + (update :y check) + (update :width (comp to-positive check)) + (update :height (comp to-positive check))))) + + + + + + + (declare transform-points) + + (defn apply-modifiers + [transform-stack modifiers points] + (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) + + points (transform-points ds-modifier) + center (gco/center-points points)] + + (-> points + (transform-points + (-> (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/multiply transform-stack) + (gmt/translate (gpt/negate center))))))) + + (defn transform-path-shape + [shape] + shape + #_(-> shape + transform-apply-modifiers + update-path-selrect) + ;; 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 adjust-rect-transforms [shape] + ) + + (defn transform-rect-shape + [shape] + (let [points (-> (:points shape (shape->points shape)) + (apply-modifiers (:transform shape) (:modifiers shape) points)) + + center (gco/center-points points) + + resize-vector (-> (get-in shape [:modifiers :resize-vector] (gpt/point 1 1)) + (update :x #(if (zero? %) 1 %)) + (update :y #(if (zero? %) 1 %))) + + ;; Reverse the current transformation stack to get the base rectangle + tr-inverse (:transform-inverse shape (gmt/matrix)) + points-temp (transform-poins points center tr-inverse) + points-temp-dim (gpr/rect-points-dimensions points) + points-temp-rec (gpr/points->selrect points) + + ;; This rectangle is the new data for the current rectangle. We want to change our rectangle + ;; to have this width, height, x, y + rec (-> (gco/center->rect center (:width points-temp-dim) (:height points-temp-dim)) + (gpr/rect->points)) + ;;rec (fix-invalid-rect-values rec) + ;;rec-path (gpr/rect->path rec) + + ;; The next matrix is a series of transformations we have to do to the previous rec so that + ;; after applying them the end result is the `shape-path-temp` + ;; This is compose of three transformations: skew, resize and rotation + stretch-matrix (gmt/matrix) + + skew-angle (calculate-rec-path-skew-angle shape-path-temp) + + ;; When one of the axis is flipped we have to reverse the skew + skew-angle (if (neg? (* (:x resize-vector) (:y resize-vector))) (- skew-angle) skew-angle ) + skew-angle (if (mth/nan? skew-angle) 0 skew-angle) -(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 (gco/center shape)] - (-> (gmt/matrix) - (gmt/translate shape-center) - (gmt/multiply (:transform shape (gmt/matrix))) - (gmt/translate (gpt/negate shape-center)))))) + stretch-matrix (gmt/multiply stretch-matrix (gmt/skew-matrix skew-angle 0)) + + h1 (calculate-rec-path-height shape-path-temp) + h2 (calculate-rec-path-height (center-transform rec-path stretch-matrix)) + h3 (/ h1 h2) + h3 (if (mth/nan? h3) 1 h3) + + stretch-matrix (gmt/multiply stretch-matrix (gmt/scale-matrix (gpt/point 1 h3))) + + rotation-angle (calculate-rec-path-rotation (center-transform rec-path stretch-matrix) + shape-path-temp resize-vector) + + stretch-matrix (gmt/multiply (gmt/rotate-matrix rotation-angle) stretch-matrix) + + ;; This is the inverse to be able to remove the transformation + stretch-matrix-inverse (-> (gmt/matrix) + (gmt/scale (gpt/point 1 h3)) + (gmt/skew (- skew-angle) 0) + (gmt/rotate (- rotation-angle))) + + new-shape (as-> shape $ + (merge $ rec) + (update $ :x #(mth/precision % 0)) + (update $ :y #(mth/precision % 0)) + (update $ :width #(mth/precision % 0)) + (update $ :height #(mth/precision % 0)) + (update $ :transform #(gmt/multiply (or % (gmt/matrix)) stretch-matrix)) + (update $ :transform-inverse #(gmt/multiply stretch-matrix-inverse (or % (gmt/matrix)))) + (assoc $ :points (shape->points $)) + (assoc $ :selrect (gpr/points->selrect (:points $))) + (update $ :selrect fix-invalid-rect-values) + (update $ :rotation #(mod (+ (or % 0) + (or (get-in $ [:modifiers :rotation]) 0)) 360)))] + new-shape)) + + (defn transform-points + "Apply the matrix transformation to points" + [points xfmt] + + (cond->> points + (gmt/matrix? xfmt) (map #(gpt/transform % xfmt)))) + + #_(defn transform + "Apply the matrix transformation to shape" + [{:keys [type] :as shape} xfmt] + (if (gmt/matrix? xfmt) + (case type + :path (transform-path shape xfmt) + :curve (transform-path shape xfmt) + (transform-rect shape xfmt)) + shape)) + + + + + + ) diff --git a/common/app/common/pages.cljc b/common/app/common/pages.cljc index 0feaccbfc..ae5a91983 100644 --- a/common/app/common/pages.cljc +++ b/common/app/common/pages.cljc @@ -273,7 +273,9 @@ (s/every uuid? :kind vector?)) (s/def ::shape-attrs - (s/keys :opt-un [:internal.shape/blocked + (s/keys :req-un [:internal.shape/selrect + :internal.shape/points] + :opt-un [:internal.shape/blocked :internal.shape/collapsed :internal.shape/content :internal.shape/fill-color @@ -309,8 +311,6 @@ :internal.shape/width :internal.shape/height :internal.shape/interactions - :internal.shape/selrect - :internal.shape/points :internal.shape/masked-group? :internal.shape/shadow :internal.shape/blur])) @@ -764,7 +764,7 @@ (defn rotation-modifiers [center shape angle] - (let [displacement (let [shape-center (geom/center shape)] + (let [displacement (let [shape-center (geom/center-shape shape)] (-> (gmt/matrix) (gmt/rotate angle center) (gmt/rotate (- angle) shape-center)))] @@ -783,7 +783,7 @@ (distinct)) shapes))) (update-group [group objects] - (let [gcenter (geom/center group) + (let [gcenter (geom/center-shape group) gxfm (comp (map #(get objects %)) (map #(-> % diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs index ea4755fcc..70cf54a20 100644 --- a/frontend/src/app/main/data/workspace.cljs +++ b/frontend/src/app/main/data/workspace.cljs @@ -14,6 +14,7 @@ [app.common.geom.matrix :as gmt] [app.common.geom.point :as gpt] [app.common.geom.shapes :as gsh] + [app.common.geom.proportions :as gpr] [app.common.geom.align :as gal] [app.common.math :as mth] [app.common.pages :as cp] @@ -30,6 +31,7 @@ [app.main.data.workspace.selection :as dws] [app.main.data.workspace.texts :as dwtxt] [app.main.data.workspace.transforms :as dwt] + [app.main.data.workspace.drawing :as dwd] [app.main.repo :as rp] [app.main.store :as st] [app.main.streams :as ms] @@ -472,10 +474,10 @@ (let [vbox (update vbox :x + (:left-offset vbox)) new-zoom (if (fn? zoom) (zoom (:zoom local)) zoom) old-zoom (:zoom local) - center (if center center (gsh/center vbox)) + center (if center center (gsh/center-rect vbox)) scale (/ old-zoom new-zoom) mtx (gmt/scale-matrix (gpt/point scale) center) - vbox' (gsh/transform vbox mtx) + vbox' (gsh/transform-rect vbox mtx) vbox' (update vbox' :x - (:left-offset vbox))] (-> local (assoc :zoom new-zoom) @@ -546,50 +548,6 @@ ;; --- Add shape to Workspace -(declare start-edition-mode) - -(defn add-shape - [attrs] - (us/verify ::shape-attrs attrs) - (ptk/reify ::add-shape - ptk/WatchEvent - (watch [_ state stream] - (let [page-id (:current-page-id state) - objects (dwc/lookup-page-objects state page-id) - - id (uuid/next) - shape (geom/setup-proportions attrs) - - unames (dwc/retrieve-used-names objects) - name (dwc/generate-unique-name unames (:name shape)) - - frame-id (or (:frame-id attrs) - (cph/frame-id-by-position objects attrs)) - - shape (merge - (if (= :frame (:type shape)) - cp/default-frame-attrs - cp/default-shape-attrs) - (assoc shape - :id id - :name name)) - - rchange {:type :add-obj - :id id - :page-id page-id - :frame-id frame-id - :obj shape} - uchange {:type :del-obj - :page-id page-id - :id id}] - - (rx/concat - (rx/of (dwc/commit-changes [rchange] [uchange] {:commit-local? true}) - (dws/select-shapes (d/ordered-set id))) - (when (= :text (:type attrs)) - (->> (rx/of (start-edition-mode id)) - (rx/observe-on :async)))))))) - (defn- viewport-center [state] (let [{:keys [x y width height]} (get-in state [:workspace-local :vbox])] @@ -615,8 +573,8 @@ (merge data) (merge {:x x :y y}) (assoc :frame-id frame-id) - (rx/of (add-shape shape)))))) (gsh/setup-selrect))] + (rx/of (dwc/add-shape shape)))))) ;; --- Update Shape Attrs @@ -954,7 +912,7 @@ (defn align-objects [axis] - (us/verify ::geom/align-axis axis) + (us/verify ::gal/align-axis axis) (ptk/reify :align-objects ptk/WatchEvent (watch [_ state stream] @@ -992,17 +950,17 @@ [objects object-id axis] (let [object (get objects object-id) frame (get objects (:frame-id object))] - (geom/align-to-rect object frame axis objects))) + (gal/align-to-rect object frame axis objects))) (defn align-objects-list [objects selected axis] (let [selected-objs (map #(get objects %) selected) - rect (geom/selection-rect selected-objs)] - (mapcat #(geom/align-to-rect % rect axis objects) selected-objs))) + rect (gsh/selection-rect selected-objs)] + (mapcat #(gal/align-to-rect % rect axis objects) selected-objs))) (defn distribute-objects [axis] - (us/verify ::geom/dist-axis axis) + (us/verify ::gal/dist-axis axis) (ptk/reify :align-objects ptk/WatchEvent (watch [_ state stream] @@ -1010,7 +968,7 @@ objects (dwc/lookup-page-objects state page-id) selected (get-in state [:workspace-local :selected]) moved (-> (map #(get objects %) selected) - (geom/distribute-space axis objects))] + (gal/distribute-space axis objects))] (loop [moved (seq moved) rchanges [] uchanges []] @@ -1035,62 +993,6 @@ :operations ops2 :id (:id curr)}))))))))) -;; --- Start shape "edition mode" - -(declare clear-edition-mode) - -(defn start-edition-mode - [id] - (us/assert ::us/uuid id) - (ptk/reify ::start-edition-mode - ptk/UpdateEvent - (update [_ state] - (assoc-in state [:workspace-local :edition] id)) - - ptk/WatchEvent - (watch [_ state stream] - (->> stream - (rx/filter dwc/interrupt?) - (rx/take 1) - (rx/map (constantly clear-edition-mode)))))) - -(def clear-edition-mode - (ptk/reify ::clear-edition-mode - ptk/UpdateEvent - (update [_ state] - (update state :workspace-local dissoc :edition)))) - -;; --- Select for Drawing - -(def clear-drawing - (ptk/reify ::clear-drawing - ptk/UpdateEvent - (update [_ state] - (update state :workspace-drawing dissoc :tool :object)))) - -(defn select-for-drawing - ([tool] (select-for-drawing tool nil)) - ([tool data] - (ptk/reify ::select-for-drawing - ptk/UpdateEvent - (update [_ state] - (update state :workspace-drawing assoc :tool tool :object data)) - - ptk/WatchEvent - (watch [_ state stream] - (let [stoper (rx/filter (ptk/type? ::clear-drawing) stream)] - (rx/merge - (rx/of (dws/deselect-all)) - - ;; NOTE: comments are a special case and they manage they - ;; own interrupt cycle. - (when (not= tool :comments) - (->> stream - (rx/filter dwc/interrupt?) - (rx/take 1) - (rx/map (constantly clear-drawing)) - (rx/take-until stoper))))))))) - ;; --- Update Dimensions ;; Event mainly used for handling user modification of the size of the @@ -1104,7 +1006,7 @@ (ptk/reify ::update-dimensions ptk/WatchEvent (watch [_ state stream] - (rx/of (dwc/update-shapes ids #(geom/resize-rect % attr value)))))) + (rx/of (dwc/update-shapes ids #(gsh/resize-rect % attr value)))))) ;; --- Shape Proportions @@ -1118,7 +1020,7 @@ (if-not lock (assoc shape :proportion-lock false) (-> (assoc shape :proportion-lock true) - (geom/assign-proportions))))))))) + (gpr/assign-proportions))))))))) ;; --- Update Shape Position (s/def ::x number?) @@ -1157,7 +1059,7 @@ (let [page-id (:current-page-id state)] (-> state (update-in [:workspace-data page-id :objects id :segments index] gpt/add delta) - (update-in [:workspace-data page-id :objects id] geom/update-path-selrect)))))) + (update-in [:workspace-data page-id :objects id] gsh/update-path-selrect)))))) ;; --- Shape attrs (Layers Sidebar) @@ -1290,7 +1192,7 @@ ;; When the parent frame is not selected we change to relative ;; coordinates (let [frame (get objects (:frame-id shape))] - (geom/translate-to-frame shape frame)) + (gsh/translate-to-frame shape frame)) shape)) (prepare [result objects selected id] @@ -1329,7 +1231,7 @@ ptk/WatchEvent (watch [_ state stream] (let [selected-objs (map #(get objects %) selected) - wrapper (geom/selection-rect selected-objs) + wrapper (gsh/selection-rect selected-objs) orig-pos (gpt/point (:x1 wrapper) (:y1 wrapper)) mouse-pos @ms/mouse-position @@ -1359,7 +1261,7 @@ (map #(get-in % [:obj :id])) (into (d/ordered-set)))] (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}) - (dws/select-shapes selected)))))) + (dwc/select-shapes selected)))))) (defn- image-uploaded [image] @@ -1446,7 +1348,7 @@ page-id (:current-page-id state) frame-id (-> (dwc/lookup-page-objects state page-id) (cph/frame-id-by-position @ms/mouse-position)) - shape (geom/setup-selrect + shape (gsh/setup-selrect {:id id :type :text :name "Text" @@ -1459,7 +1361,7 @@ :content (as-content text)})] (rx/of dwc/start-undo-transaction (dws/deselect-all) - (add-shape shape) + (dwc/add-shape shape) dwc/commit-undo-transaction))))) (defn update-shape-flags @@ -1490,7 +1392,7 @@ (when-not (empty? shapes) (let [[group rchanges uchanges] (dws/prepare-create-group page-id shapes "Group-" false)] (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}) - (dws/select-shapes (d/ordered-set (:id group)))))))))) + (dwc/select-shapes (d/ordered-set (:id group)))))))))) (def ungroup-selected (ptk/reify ::ungroup-selected @@ -1568,7 +1470,7 @@ :val (:fill-color mask)}]}))] (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}) - (dws/select-shapes (d/ordered-set (:id group)))))))))) + (dwc/select-shapes (d/ordered-set (:id group)))))))))) (def unmask-group (ptk/reify ::unmask-group @@ -1595,7 +1497,7 @@ :val (:masked-group? group)}]}]] (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}) - (dws/select-shapes (d/ordered-set (:id group)))))))))) + (dwc/select-shapes (d/ordered-set (:id group)))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1718,10 +1620,14 @@ (def select-shape dws/select-shape) (def deselect-all dws/deselect-all) -(def select-shapes dws/select-shapes) +(def select-shapes dwc/select-shapes) (def duplicate-selected dws/duplicate-selected) (def handle-selection dws/handle-selection) (def select-inside-group dws/select-inside-group) +(def select-for-drawing dwd/select-for-drawing) +(def clear-edition-mode dwc/clear-edition-mode) +(def add-shape dwc/add-shape) +(def start-edition-mode dwc/start-edition-mode) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1753,12 +1659,12 @@ "ctrl+shift+z" #(st/emit! dwc/redo) "ctrl+y" #(st/emit! dwc/redo) "ctrl+q" #(st/emit! dwc/reinitialize-undo) - "a" #(st/emit! (select-for-drawing :frame)) - "b" #(st/emit! (select-for-drawing :rect)) - "e" #(st/emit! (select-for-drawing :circle)) + "a" #(st/emit! (dwd/select-for-drawing :frame)) + "b" #(st/emit! (dwd/select-for-drawing :rect)) + "e" #(st/emit! (dwd/select-for-drawing :circle)) "t" #(st/emit! dwtxt/start-edit-if-selected - (select-for-drawing :text)) - "w" #(st/emit! (select-for-drawing :path)) + (dwd/select-for-drawing :text)) + "w" #(st/emit! (dwd/select-for-drawing :path)) "ctrl+c" #(st/emit! copy-selected) "ctrl+v" #(st/emit! paste) "ctrl+x" #(st/emit! copy-selected delete-selected) @@ -1778,4 +1684,3 @@ "right" #(st/emit! (dwt/move-selected :right false)) "left" #(st/emit! (dwt/move-selected :left false)) "i" #(st/emit! (mdc/picker-for-selected-shape ))}) - diff --git a/frontend/src/app/main/data/workspace/common.cljs b/frontend/src/app/main/data/workspace/common.cljs index 282efc500..3275799b5 100644 --- a/frontend/src/app/main/data/workspace/common.cljs +++ b/frontend/src/app/main/data/workspace/common.cljs @@ -20,8 +20,12 @@ [app.common.uuid :as uuid] [app.main.worker :as uw] [app.util.timers :as ts] - [app.common.geom.shapes :as geom])) + [app.common.geom.proportions :as gpr] + [app.common.geom.shapes :as gsh])) +(s/def ::shape-attrs ::cp/shape-attrs) +(s/def ::set-of-string (s/every string? :kind set?)) +(s/def ::ordered-set-of-uuid (s/every uuid? :kind d/ordered-set?)) ;; --- Protocols (declare setup-selection-index) @@ -158,7 +162,7 @@ (defn get-frame-at-point [objects point] (let [frames (cph/select-frames objects)] - (d/seek #(geom/has-point? % point) frames))) + (d/seek #(gsh/has-point? % point) frames))) (defn- extract-numeric-suffix @@ -171,8 +175,6 @@ [objects] (into #{} (map :name) (vals objects))) -(s/def ::set-of-string - (s/every string? :kind set?)) (defn generate-unique-name "A unique name generator" @@ -434,3 +436,85 @@ [rchanges uchanges] (impl-gen-changes objects page-id (seq ids))] (rx/of (commit-changes rchanges uchanges {:commit-local? true}))))))) + +(defn select-shapes + [ids] + (us/verify ::ordered-set-of-uuid ids) + (ptk/reify ::select-shapes + ptk/UpdateEvent + (update [_ state] + (assoc-in state [:workspace-local :selected] ids)) + + ptk/WatchEvent + (watch [_ state stream] + (let [page-id (:current-page-id state) + objects (lookup-page-objects state page-id)] + (rx/of (expand-all-parents ids objects)))))) + +;; --- Start shape "edition mode" + +(declare clear-edition-mode) + +(defn start-edition-mode + [id] + (us/assert ::us/uuid id) + (ptk/reify ::start-edition-mode + ptk/UpdateEvent + (update [_ state] + (assoc-in state [:workspace-local :edition] id)) + + ptk/WatchEvent + (watch [_ state stream] + (->> stream + (rx/filter interrupt?) + (rx/take 1) + (rx/map (constantly clear-edition-mode)))))) + +(def clear-edition-mode + (ptk/reify ::clear-edition-mode + ptk/UpdateEvent + (update [_ state] + (update state :workspace-local dissoc :edition)))) + + +(defn add-shape + [attrs] + (us/verify ::shape-attrs attrs) + (ptk/reify ::add-shape + ptk/WatchEvent + (watch [_ state stream] + (let [page-id (:current-page-id state) + objects (lookup-page-objects state page-id) + + id (uuid/next) + shape (gpr/setup-proportions attrs) + + unames (retrieve-used-names objects) + name (generate-unique-name unames (:name shape)) + + frame-id (or (:frame-id attrs) + (cph/frame-id-by-position objects attrs)) + + shape (merge + (if (= :frame (:type shape)) + cp/default-frame-attrs + cp/default-shape-attrs) + (assoc shape + :id id + :name name)) + + rchange {:type :add-obj + :id id + :page-id page-id + :frame-id frame-id + :obj shape} + uchange {:type :del-obj + :page-id page-id + :id id}] + + (rx/concat + (rx/of (commit-changes [rchange] [uchange] {:commit-local? true}) + (select-shapes (d/ordered-set id))) + (when (= :text (:type attrs)) + (->> (rx/of (start-edition-mode id)) + (rx/observe-on :async)))))))) diff --git a/frontend/src/app/main/data/workspace/drawing.cljs b/frontend/src/app/main/data/workspace/drawing.cljs index aeff2af30..63b0668fc 100644 --- a/frontend/src/app/main/data/workspace/drawing.cljs +++ b/frontend/src/app/main/data/workspace/drawing.cljs @@ -12,15 +12,48 @@ (:require [beicon.core :as rx] [potok.core :as ptk] + [app.common.spec :as us] [app.common.pages :as cp] [app.common.uuid :as uuid] + [app.main.data.workspace.common :as dwc] + [app.main.data.workspace.selection :as dws] [app.main.data.workspace.drawing.common :as common] [app.main.data.workspace.drawing.path :as path] [app.main.data.workspace.drawing.curve :as curve] [app.main.data.workspace.drawing.box :as box])) +(declare start-drawing) (declare handle-drawing) +;; --- Select for Drawing + +(defn select-for-drawing + ([tool] (select-for-drawing tool nil)) + ([tool data] + (ptk/reify ::select-for-drawing + ptk/UpdateEvent + (update [_ state] + (update state :workspace-drawing assoc :tool tool :object data)) + + ptk/WatchEvent + (watch [_ state stream] + (let [stoper (rx/filter (ptk/type? ::clear-drawing) stream)] + (rx/merge + (rx/of (dws/deselect-all)) + + (when (= tool :path) + (rx/of (start-drawing :path))) + + ;; NOTE: comments are a special case and they manage they + ;; own interrupt cycle. + (when (not= tool :comments) + (->> stream + (rx/filter dwc/interrupt?) + (rx/take 1) + (rx/map (constantly common/clear-drawing)) + (rx/take-until stoper))))))))) + + ;; NOTE/TODO: when an exception is raised in some point of drawing the ;; draw lock is not released so the user need to refresh in order to ;; be able draw again. THIS NEED TO BE REVISITED @@ -68,3 +101,4 @@ ;; Export (def close-drawing-path path/close-drawing-path) + diff --git a/frontend/src/app/main/data/workspace/drawing/box.cljs b/frontend/src/app/main/data/workspace/drawing/box.cljs index 35e84e278..bdcdb1aea 100644 --- a/frontend/src/app/main/data/workspace/drawing/box.cljs +++ b/frontend/src/app/main/data/workspace/drawing/box.cljs @@ -74,7 +74,8 @@ ;; Initial SNAP (->> (snap/closest-snap-point page-id [shape] layout initial) (rx/map (fn [{:keys [x y]}] - #(update-in % [:workspace-drawing :object] assoc :x x :y y)))) + #(update-in % [:workspace-drawing :object] gsh/absolute-move (gpt/point x y)) + ))) (->> ms/mouse-position (rx/filter #(> (gpt/distance % initial) 2)) diff --git a/frontend/src/app/main/data/workspace/drawing/common.cljs b/frontend/src/app/main/data/workspace/drawing/common.cljs index 24ffb0d65..424287b3f 100644 --- a/frontend/src/app/main/data/workspace/drawing/common.cljs +++ b/frontend/src/app/main/data/workspace/drawing/common.cljs @@ -13,17 +13,23 @@ [potok.core :as ptk] [app.common.geom.point :as gpt] [app.common.geom.shapes :as gsh] - [app.main.data.workspace :as dw] [app.main.data.workspace.common :as dwc] + [app.main.data.workspace.selection :as dws] [app.main.streams :as ms])) +(def clear-drawing + (ptk/reify ::clear-drawing + ptk/UpdateEvent + (update [_ state] + (update state :workspace-drawing dissoc :tool :object)))) + (def handle-finish-drawing (ptk/reify ::handle-finish-drawing ptk/WatchEvent (watch [_ state stream] (let [shape (get-in state [:workspace-drawing :object])] (rx/concat - (rx/of dw/clear-drawing) + (rx/of clear-drawing) (when (:initialized? shape) (let [shape-click-width (case (:type shape) :text 3 @@ -52,5 +58,5 @@ (rx/of dwc/start-undo-transaction) (rx/empty)) - (rx/of (dw/deselect-all) - (dw/add-shape shape)))))))))) + (rx/of (dws/deselect-all) + (dwc/add-shape shape)))))))))) diff --git a/frontend/src/app/main/data/workspace/drawing/curve.cljs b/frontend/src/app/main/data/workspace/drawing/curve.cljs index 5053d79fd..108a8b521 100644 --- a/frontend/src/app/main/data/workspace/drawing/curve.cljs +++ b/frontend/src/app/main/data/workspace/drawing/curve.cljs @@ -11,6 +11,7 @@ (:require [beicon.core :as rx] [potok.core :as ptk] + [app.common.geom.point :as gpt] [app.common.geom.shapes :as gsh] [app.main.streams :as ms] [app.util.geom.path :as path] @@ -27,13 +28,18 @@ (defn insert-point-segment [state point] (update-in state [:workspace-drawing :object :segments] (fnil conj []) point)) +(defn update-selrect [{:keys [segments] :as shape}] + (let [points (->> segments + (map #(apply gpt/point %)))] + (assoc shape :selrect (gsh/points->selrect points)))) + (defn finish-drawing-curve [state] (update-in state [:workspace-drawing :object] (fn [shape] (-> shape (update :segments #(path/simplify % simplify-tolerance)) - (gsh/update-path-selrect))))) + (update-selrect))))) (defn handle-drawing-curve [] (ptk/reify ::handle-drawing-curve diff --git a/frontend/src/app/main/data/workspace/drawing/path.cljs b/frontend/src/app/main/data/workspace/drawing/path.cljs index 3d92288fc..e9b7382b4 100644 --- a/frontend/src/app/main/data/workspace/drawing/path.cljs +++ b/frontend/src/app/main/data/workspace/drawing/path.cljs @@ -17,23 +17,23 @@ [app.util.geom.path :as path] [app.main.data.workspace.drawing.common :as common])) -(defn stoper-event? [{:keys [type shift] :as event}] +(defn finish-event? [{:keys [type shift] :as event}] (or (= event ::end-path-drawing) (= event :interrupt) - (and (ms/mouse-event? event) + #_(and (ms/mouse-event? event) (or (= type :double-click) (= type :context-menu))) (and (ms/keyboard-event? event) (= type :down) (= 13 (:key event))))) -(defn init-path [] +#_(defn init-path [] (fn [state] (update-in state [:workspace-drawing :object] assoc :content [] :initialized? true))) -(defn add-path-command [command] +#_(defn add-path-command [command] (fn [state] (update-in state [:workspace-drawing :object :content] conj command))) @@ -43,7 +43,7 @@ (cond-> state exists? (assoc-in [:workspace-drawing :object :segments index] point)))) -(defn finish-drawing-path [] +#_(defn finish-drawing-path [] (fn [state] (update-in state [:workspace-drawing :object] @@ -52,17 +52,109 @@ (gsh/update-path-selrect)))))) -(defn handle-drawing-path [] +(defn calculate-selrect [shape] + (let [points (->> shape + :content + (mapv #(gpt/point + (-> % :params :x) + (-> % :params :y))))] + (assoc shape + :points points + :selrect (gsh/points->selrect points)))) +(defn init-path [] + (ptk/reify ::init-path + ptk/UpdateEvent + (update [_ state] + (-> state + (assoc-in [:workspace-drawing :object :initialized?] true) + (assoc-in [:workspace-drawing :object :last-point] nil))))) + +(defn finish-path [] + (ptk/reify ::finish-path + ptk/UpdateEvent + (update [_ state] + (-> state + (assoc-in [:workspace-drawing :object :last-point] nil) + (update-in [:workspace-drawing :object] calculate-selrect))))) + +(defn add-node [{:keys [x y]}] + (ptk/reify ::add-node + ptk/UpdateEvent + (update [_ state] + (let [point {:x x :y y} + last-point (get-in state [:workspace-drawing :object :last-point]) + command (if last-point + {:command :line-to + :params point} + {:command :move-to + :params point})] + (-> state + (assoc-in [:workspace-drawing :object :last-point] point) + (update-in [:workspace-drawing :object :content] (fnil conj []) command)))))) + +(defn drag-handler [{:keys [x y]}] + (ptk/reify ::drag-handler + ptk/UpdateEvent + (update [_ state] + (-> state)))) + +(defn make-click-stream + [stream down-event] + (->> stream + (rx/filter ms/mouse-click?) + (rx/debounce 200) + (rx/first) + (rx/map #(add-node down-event)))) + +(defn make-drag-stream + [stream down-event] + (let [mouse-up (->> stream (rx/filter ms/mouse-up?)) + drag-events (->> ms/mouse-position + (rx/take-until mouse-up) + (rx/map #(drag-handler %)))] + (->> (rx/timer 400) + (rx/merge-map #(rx/concat + (add-node down-event) + drag-events))))) + +(defn make-dbl-click-stream + [stream down-event] + (->> stream + (rx/filter ms/mouse-double-click?) + (rx/first) + (rx/merge-map + #(rx/of (add-node down-event) + ::end-path-drawing)))) + +(defn handle-drawing-path [] (ptk/reify ::handle-drawing-path ptk/WatchEvent (watch [_ state stream] ;; clicks stream<[MouseEvent, Position]> - clicks (->> stream - (rx/filter ms/mouse-click?) - (rx/with-latest vector ms/mouse-position)) + (let [ + + mouse-down (->> stream (rx/filter ms/mouse-down?)) + finish-events (->> stream (rx/filter finish-event?)) + events (->> mouse-down + (rx/take-until finish-events) + (rx/throttle 100) + (rx/with-latest merge ms/mouse-position) + + ;; We change to the stream that emits the first event + (rx/switch-map + #(rx/race (make-click-stream stream %) + (make-drag-stream stream %) + (make-dbl-click-stream stream %))))] + + + (rx/concat + (rx/of (init-path)) + events + (rx/of (finish-path)) + (rx/of common/handle-finish-drawing))) ))) diff --git a/frontend/src/app/main/data/workspace/libraries.cljs b/frontend/src/app/main/data/workspace/libraries.cljs index 9fb6ef150..9bcf04238 100644 --- a/frontend/src/app/main/data/workspace/libraries.cljs +++ b/frontend/src/app/main/data/workspace/libraries.cljs @@ -251,7 +251,7 @@ (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}) - (dws/select-shapes (d/ordered-set (:id group)))))))))) + (dwc/select-shapes (d/ordered-set (:id group)))))))))) (defn rename-component [id new-name] @@ -407,7 +407,7 @@ new-shapes)] (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}) - (dws/select-shapes (d/ordered-set (:id new-shape)))))))) + (dwc/select-shapes (d/ordered-set (:id new-shape)))))))) (defn detach-component "Remove all references to components in the shape with the given id, diff --git a/frontend/src/app/main/data/workspace/transforms.cljs b/frontend/src/app/main/data/workspace/transforms.cljs index 56985d95c..331efc628 100644 --- a/frontend/src/app/main/data/workspace/transforms.cljs +++ b/frontend/src/app/main/data/workspace/transforms.cljs @@ -80,7 +80,8 @@ (defn start-resize [handler initial ids shape] (letfn [(resize [shape initial resizing-shapes [point lock? point-snap]] - (let [{:keys [width height rotation]} shape + (let [{:keys [width height]} (:selrect shape) + {:keys [rotation]} shape shapev (-> (gpt/point width height)) rotation (if (#{:curve :path} (:type shape)) 0 rotation) @@ -101,9 +102,11 @@ shape-transform (:transform shape (gmt/matrix)) shape-transform-inverse (:transform-inverse shape (gmt/matrix)) + shape-center (gsh/center-shape shape) + ;; Resize origin point given the selected handler - origin (-> (handler-resize-origin shape handler) - (gsh/transform-shape-point shape shape-transform))] + origin (-> (handler-resize-origin (:selrect shape) handler) + (gsh/transform-point-center shape-center shape-transform))] (rx/of (set-modifiers ids {:resize-vector scalev @@ -170,7 +173,7 @@ (watch [_ state stream] (let [stoper (rx/filter ms/mouse-up? stream) group (gsh/selection-rect shapes) - group-center (gsh/center group) + group-center (gsh/center-selrect group) initial-angle (gpt/angle @ms/mouse-position group-center) calculate-angle (fn [pos ctrl?] (let [angle (- (gpt/angle pos group-center) initial-angle) @@ -403,7 +406,7 @@ #(reduce update-shape % ids-with-children))))))) (defn rotation-modifiers [center shape angle] - (let [displacement (let [shape-center (gsh/center shape)] + (let [displacement (let [shape-center (gsh/center-shape shape)] (-> (gmt/matrix) (gmt/rotate angle center) (gmt/rotate (- angle) shape-center)))] @@ -416,7 +419,7 @@ (defn set-rotation ([delta-rotation shapes] - (set-rotation delta-rotation shapes (-> shapes gsh/selection-rect gsh/center))) + (set-rotation delta-rotation shapes (-> shapes gsh/selection-rect gsh/center-selrect))) ([delta-rotation shapes center] (letfn [(rotate-shape [objects angle shape center] diff --git a/frontend/src/app/main/exports.cljs b/frontend/src/app/main/exports.cljs index 6629597a8..74a543dad 100644 --- a/frontend/src/app/main/exports.cljs +++ b/frontend/src/app/main/exports.cljs @@ -45,7 +45,7 @@ (let [shapes (cph/select-toplevel-shapes objects {:include-frames? true})] (->> (gsh/selection-rect shapes) (gal/adjust-to-viewport vport) - (gsh/fix-invalid-rect-values)))) + #_(gsh/fix-invalid-rect-values)))) (declare shape-wrapper-factory) diff --git a/frontend/src/app/main/snap.cljs b/frontend/src/app/main/snap.cljs index 384302179..463da699b 100644 --- a/frontend/src/app/main/snap.cljs +++ b/frontend/src/app/main/snap.cljs @@ -166,7 +166,7 @@ (rx/merge-map (fn [[frame selrect]] (let [areas (->> (gsh/selrect->areas (or (:selrect frame) - (gsh/rect->rect-shape @refs/vbox)) selrect) + (gsh/rect->selrect @refs/vbox)) selrect) (d/mapm #(select-shapes-area page-id shapes objects %2))) snap-x (search-snap-distance selrect :x (:left areas) (:right areas)) snap-y (search-snap-distance selrect :y (:top areas) (:bottom areas))] diff --git a/frontend/src/app/main/store.cljs b/frontend/src/app/main/store.cljs index 28936dd5f..8860679b3 100644 --- a/frontend/src/app/main/store.cljs +++ b/frontend/src/app/main/store.cljs @@ -41,11 +41,10 @@ (when *assert* (defonce debug-subscription - (as-> stream $ - #_(rx/filter ptk/event? $) - (rx/filter (fn [s] (debug? :events)) $) - (rx/subscribe $ (fn [event] - (println "[stream]: " (repr-event event))))))) + (->> stream + (rx/filter ptk/event?) + (rx/filter (fn [s] (debug? :events))) + (rx/subs #(println "[stream]: " (repr-event %)))))) (defn emit! ([] nil) ([event] @@ -73,6 +72,11 @@ (defn ^:export dump-state [] (logjs "state" @state)) +(defn ^:export get-state [str-path] + (let [path (->> (str/split str-path " ") + (map d/read-string))] + (clj->js (get-in @state path)))) + (defn ^:export dump-objects [] (let [page-id (get @state :current-page-id)] (logjs "state" (get-in @state [:workspace-data :pages-index page-id :objects])))) diff --git a/frontend/src/app/main/ui/shapes/custom_stroke.cljs b/frontend/src/app/main/ui/shapes/custom_stroke.cljs index e509150dd..d9705dd7b 100644 --- a/frontend/src/app/main/ui/shapes/custom_stroke.cljs +++ b/frontend/src/app/main/ui/shapes/custom_stroke.cljs @@ -23,7 +23,8 @@ (let [shape (unchecked-get props "shape") base-props (unchecked-get props "base-props") elem-name (unchecked-get props "elem-name") - {:keys [x y width height]} (geom/shape->rect-shape shape) + ;; {:keys [x y width height]} (geom/shape->rect-shape shape) + {:keys [x y width height]} (:selrect shape) mask-id (mf/use-ctx mask-id-ctx) stroke-id (mf/use-var (uuid/next)) stroke-style (:stroke-style shape :none) diff --git a/frontend/src/app/main/ui/shapes/path.cljs b/frontend/src/app/main/ui/shapes/path.cljs index 677bc1649..ff1a0bce3 100644 --- a/frontend/src/app/main/ui/shapes/path.cljs +++ b/frontend/src/app/main/ui/shapes/path.cljs @@ -15,10 +15,12 @@ [app.main.ui.shapes.custom-stroke :refer [shape-custom-stroke]] [app.main.ui.shapes.group :refer [mask-id-ctx]] [app.common.geom.shapes :as geom] - [app.util.object :as obj])) + [app.util.object :as obj] + [app.util.geom.path :as ugp])) ;; --- Path Shape +;; LEGACY FORMAT (defn- render-path [{:keys [segments close?] :as shape}] (let [numsegs (count segments)] @@ -45,10 +47,14 @@ [props] (let [shape (unchecked-get props "shape") background? (unchecked-get props "background?") - {:keys [id x y width height]} (geom/shape->rect-shape shape) + ;; {:keys [id x y width height]} (geom/shape->rect-shape shape) + {:keys [id x y width height]} (:selrect shape) mask-id (mf/use-ctx mask-id-ctx) transform (geom/transform-matrix shape) - pdata (render-path shape) + pdata (if (:content shape) + (ugp/content->path (:content shape)) + (render-path shape)) + props (-> (attrs/extract-style-attrs shape) (obj/merge! #js {:transform transform diff --git a/frontend/src/app/main/ui/workspace/selection.cljs b/frontend/src/app/main/ui/workspace/selection.cljs index 4c149c3cb..120bcd543 100644 --- a/frontend/src/app/main/ui/workspace/selection.cljs +++ b/frontend/src/app/main/ui/workspace/selection.cljs @@ -181,7 +181,7 @@ on-rotate (obj/get props "on-rotate") current-transform (mf/deref refs/current-transform) - selrect (geom/shape->rect-shape shape) + selrect (:selrect shape) transform (geom/transform-matrix shape) tr-shape (geom/transform-shape shape)] @@ -269,8 +269,8 @@ (mf/defc multiple-selection-handlers [{:keys [shapes selected zoom color show-distances] :as props}] - (let [shape (geom/selection-rect shapes) - shape-center (geom/center shape) + (let [shape (geom/setup {:type :rect} (geom/selection-rect shapes)) + shape-center (geom/center-shape shape) hover-id (-> (mf/deref refs/current-hover) first) hover-id (when-not (d/seek #(= hover-id (:id %)) shapes) hover-id) diff --git a/frontend/src/app/main/ui/workspace/shapes/bounding_box.cljs b/frontend/src/app/main/ui/workspace/shapes/bounding_box.cljs index b6b44c91f..2a442bb25 100644 --- a/frontend/src/app/main/ui/workspace/shapes/bounding_box.cljs +++ b/frontend/src/app/main/ui/workspace/shapes/bounding_box.cljs @@ -42,7 +42,7 @@ (let [shape (unchecked-get props "shape") frame (unchecked-get props "frame") selrect (-> shape :selrect) - shape-center (geom/center shape) + shape-center (geom/center-shape shape) line-color (rdcolor #js {:seed (str (:id shape))}) zoom (mf/deref refs/selected-zoom)] [:g.bounding-box diff --git a/frontend/src/app/main/ui/workspace/snap_distances.cljs b/frontend/src/app/main/ui/workspace/snap_distances.cljs index a2559c01b..442131450 100644 --- a/frontend/src/app/main/ui/workspace/snap_distances.cljs +++ b/frontend/src/app/main/ui/workspace/snap_distances.cljs @@ -141,8 +141,9 @@ (fn [[selrect selected frame]] (let [lt-side (if (= coord :x) :left :top) gt-side (if (= coord :x) :right :bottom) - areas (gsh/selrect->areas (or (:selrect frame) - (gsh/rect->rect-shape @refs/vbox)) selrect) + container-selrec (or (:selrect frame) + (gsh/rect->selrect @refs/vbox)) + areas (gsh/selrect->areas container-selrec selrect) query-side (fn [side] (->> (uw/ask! {:cmd :selection/query :page-id page-id diff --git a/frontend/src/app/main/ui/workspace/viewport.cljs b/frontend/src/app/main/ui/workspace/viewport.cljs index 402399bd6..80619fa28 100644 --- a/frontend/src/app/main/ui/workspace/viewport.cljs +++ b/frontend/src/app/main/ui/workspace/viewport.cljs @@ -232,8 +232,9 @@ (st/emit! (ms/->MouseEvent :down ctrl? shift? alt?)) (cond (and (= 1 (.-which event))) + (if drawing-tool - (when (not= drawing-tool :comments) + (when (not (#{:comments :path} drawing-tool)) (st/emit! (dd/start-drawing drawing-tool))) (st/emit! dw/handle-selection)) diff --git a/frontend/src/app/main/worker.cljs b/frontend/src/app/main/worker.cljs index 63e490834..b0569216a 100644 --- a/frontend/src/app/main/worker.cljs +++ b/frontend/src/app/main/worker.cljs @@ -15,8 +15,8 @@ [app.util.worker :as uw])) (defn on-error - [instance error] - (js/console.error "Error on worker" (.-data error))) + [error] + (js/console.error "Error on worker" error)) (defonce instance (when (not= *target* "nodejs") diff --git a/frontend/src/app/util/geom/snap_points.cljs b/frontend/src/app/util/geom/snap_points.cljs index 8859a96c6..ee3a5f695 100644 --- a/frontend/src/app/util/geom/snap_points.cljs +++ b/frontend/src/app/util/geom/snap_points.cljs @@ -27,9 +27,9 @@ (defn shape-snap-points [shape] (let [shape (gsh/transform-shape shape) - shape-center (gsh/center shape)] + shape-center (gsh/center-shape shape)] (if (= :frame (:type shape)) (-> shape - (gsh/shape->rect-shape) + :selrect (frame-snap-points)) (into #{shape-center} (:points shape))))) diff --git a/frontend/src/app/util/worker.cljs b/frontend/src/app/util/worker.cljs index 3458d1898..e3f944011 100644 --- a/frontend/src/app/util/worker.cljs +++ b/frontend/src/app/util/worker.cljs @@ -38,10 +38,12 @@ (fn [event] (let [data (.-data event) data (t/decode data)] - (rx/push! bus data)))) + (if (:error data) + (on-error (:error data)) + (rx/push! bus data))))) (.addEventListener ins "error" (fn [error] - (on-error wrk error))) + (on-error wrk (.-data error)))) wrk)) diff --git a/frontend/src/app/worker/selection.cljs b/frontend/src/app/worker/selection.cljs index 2ff9b8ce5..c41de8a86 100644 --- a/frontend/src/app/worker/selection.cljs +++ b/frontend/src/app/worker/selection.cljs @@ -65,8 +65,7 @@ (defn- create-index [objects] - (let [shapes (->> (cph/select-toplevel-shapes objects {:include-frames? true}) - (map #(merge % (select-keys % [:x :y :width :height])))) + (let [shapes (cph/select-toplevel-shapes objects {:include-frames? true}) bounds (geom/selection-rect shapes) bounds #js {:x (:x bounds) :y (:y bounds) @@ -77,7 +76,8 @@ shapes))) (defn- index-object - [index {:keys [id x y width height] :as obj}] - (let [rect #js {:x x :y y :width width :height height}] + [index obj] + (let [{:keys [id x y width height]} (:selrect obj) + rect #js {:x x :y y :width width :height height}] (qdt/insert index rect obj)))