diff --git a/.gitignore b/.gitignore
index a7cb67059..0e01a6685 100644
--- a/.gitignore
+++ b/.gitignore
@@ -30,3 +30,4 @@ node_modules
/media
/deploy
/web
+/_dump
diff --git a/common/app/common/attrs.cljc b/common/app/common/attrs.cljc
new file mode 100644
index 000000000..9008c9ae1
--- /dev/null
+++ b/common/app/common/attrs.cljc
@@ -0,0 +1,71 @@
+;; 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.attrs)
+
+(defn get-attrs-multi
+ [shapes attrs]
+ ;; Extract some attributes of a list of shapes.
+ ;; For each attribute, if the value is the same in all shapes,
+ ;; wll take this value. If there is any shape that is different,
+ ;; the value of the attribute will be the keyword :multiple.
+ ;;
+ ;; If some shape has the value nil in any attribute, it's
+ ;; considered a different value. If the shape does not contain
+ ;; the attribute, it's ignored in the final result.
+ ;;
+ ;; Example:
+ ;; (def shapes [{:stroke-color "#ff0000"
+ ;; :stroke-width 3
+ ;; :fill-color "#0000ff"
+ ;; :x 1000 :y 2000 :rx nil}
+ ;; {:stroke-width "#ff0000"
+ ;; :stroke-width 5
+ ;; :x 1500 :y 2000}])
+ ;;
+ ;; (get-attrs-multi shapes [:stroke-color
+ ;; :stroke-width
+ ;; :fill-color
+ ;; :rx
+ ;; :ry])
+ ;; >>> {:stroke-color "#ff0000"
+ ;; :stroke-width :multiple
+ ;; :fill-color "#0000ff"
+ ;; :rx nil
+ ;; :ry nil}
+ ;;
+ (let [defined-shapes (filter some? shapes)
+
+ combine-value (fn [v1 v2] (cond
+ (= v1 v2) v1
+ (= v1 :undefined) v2
+ (= v2 :undefined) v1
+ :else :multiple))
+
+ combine-values (fn [attrs shape values]
+ (map #(combine-value (get shape % :undefined)
+ (get values % :undefined)) attrs))
+
+ select-attrs (fn [shape attrs]
+ (zipmap attrs (map #(get shape % :undefined) attrs)))
+
+ reducer (fn [result shape]
+ (zipmap attrs (combine-values attrs shape result)))
+
+ combined (reduce reducer
+ (select-attrs (first defined-shapes) attrs)
+ (rest defined-shapes))
+
+ cleanup-value (fn [value]
+ (if (= value :undefined) nil value))
+
+ cleanup (fn [result]
+ (zipmap attrs (map #(cleanup-value (get result %)) attrs)))]
+
+ (cleanup combined)))
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
new file mode 100644
index 000000000..4cec0fdf5
--- /dev/null
+++ b/common/app/common/geom/align.cljc
@@ -0,0 +1,151 @@
+;; 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.align
+ (:require
+ [clojure.spec.alpha :as s]
+ [app.common.geom.shapes :as gsh]
+ [app.common.data :as d]))
+
+;; --- Alignment
+
+(s/def ::align-axis #{:hleft :hcenter :hright :vtop :vcenter :vbottom})
+
+(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
+ possible rotation. What is aligned is the rectangle that wraps
+ the shape with the given rectangle. If the shape is a group,
+ move also all of its recursive children."
+ [shape rect axis objects]
+ (let [wrapper-rect (gsh/selection-rect [shape])
+ align-pos (calc-align-pos wrapper-rect rect axis)
+ delta {:x (- (:x align-pos) (:x wrapper-rect))
+ :y (- (:y align-pos) (:y wrapper-rect))}]
+ (recursive-move shape delta objects)))
+
+(defn calc-align-pos
+ [wrapper-rect rect axis]
+ (case axis
+ :hleft (let [left (:x rect)]
+ {:x left
+ :y (:y wrapper-rect)})
+
+ :hcenter (let [center (+ (:x rect) (/ (:width rect) 2))]
+ {:x (- center (/ (:width wrapper-rect) 2))
+ :y (:y wrapper-rect)})
+
+ :hright (let [right (+ (:x rect) (:width rect))]
+ {:x (- right (:width wrapper-rect))
+ :y (:y wrapper-rect)})
+
+ :vtop (let [top (:y rect)]
+ {:x (:x wrapper-rect)
+ :y top})
+
+ :vcenter (let [center (+ (:y rect) (/ (:height rect) 2))]
+ {:x (:x wrapper-rect)
+ :y (- center (/ (:height wrapper-rect) 2))})
+
+ :vbottom (let [bottom (+ (:y rect) (:height rect))]
+ {:x (:x wrapper-rect)
+ :y (- bottom (:height wrapper-rect))})))
+
+;; --- Distribute
+
+(s/def ::dist-axis #{:horizontal :vertical})
+
+(defn distribute-space
+ "Distribute equally the space between shapes in the given axis. If
+ there is no space enough, it does nothing. It takes into account
+ the form of the shape and the rotation, what is distributed is
+ the wrapping recangles of the shapes. If any shape is a group,
+ move also all of its recursive children."
+ [shapes axis objects]
+ (let [coord (if (= axis :horizontal) :x :y)
+ other-coord (if (= axis :horizontal) :y :x)
+ size (if (= axis :horizontal) :width :height)
+ ; 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-shape %)) shapes)
+ ; Each shape wrapped in its own rectangle
+ wrapped-shapes (map #(gsh/selection-rect [%]) sorted-shapes)
+ ; The total space between shapes
+ space (reduce - (size wrapper-rect) (map size wrapped-shapes))]
+
+ (if (<= space 0)
+ shapes
+ (let [unit-space (/ space (- (count wrapped-shapes) 1))
+ ; Calculate the distance we need to move each shape.
+ ; The new position of each one is the position of the
+ ; previous one plus its size plus the unit space.
+ deltas (loop [shapes' wrapped-shapes
+ start-pos (coord wrapper-rect)
+ deltas []]
+
+ (let [first-shape (first shapes')
+ delta (- start-pos (coord first-shape))
+ new-pos (+ start-pos (size first-shape) unit-space)]
+
+ (if (= (count shapes') 1)
+ (conj deltas delta)
+ (recur (rest shapes')
+ new-pos
+ (conj deltas delta)))))]
+
+ (mapcat #(recursive-move %1 {coord %2 other-coord 0} objects)
+ sorted-shapes deltas)))))
+
+;; Adjusto to viewport
+
+(defn adjust-to-viewport
+ ([viewport srect] (adjust-to-viewport viewport srect nil))
+ ([viewport srect {:keys [padding] :or {padding 0}}]
+ (let [gprop (/ (:width viewport) (:height viewport))
+ srect (-> srect
+ (update :x #(- % padding))
+ (update :y #(- % padding))
+ (update :width #(+ % padding padding))
+ (update :height #(+ % padding padding)))
+ width (:width srect)
+ height (:height srect)
+ lprop (/ width height)]
+ (cond
+ (> gprop lprop)
+ (let [width' (* (/ width lprop) gprop)
+ padding (/ (- width' width) 2)]
+ (-> srect
+ (update :x #(- % padding))
+ (assoc :width width')))
+
+ (< gprop lprop)
+ (let [height' (/ (* height lprop) gprop)
+ padding (/ (- height' height) 2)]
+ (-> srect
+ (update :y #(- % padding))
+ (assoc :height height')))
+
+ :else srect))))
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/point.cljc b/common/app/common/geom/point.cljc
index 65b453b56..8ca2bb45b 100644
--- a/common/app/common/geom/point.cljc
+++ b/common/app/common/geom/point.cljc
@@ -26,6 +26,14 @@
[v]
(instance? Point v))
+(defn ^boolean point-like?
+ [{:keys [x y] :as v}]
+ (and (map? v)
+ (not (nil? x))
+ (not (nil? y))
+ (number? x)
+ (number? y)))
+
(defn point
"Create a Point instance."
([] (Point. 0 0))
@@ -37,9 +45,15 @@
(number? v)
(Point. v v)
+ (point-like? v)
+ (Point. (:x v) (:y v))
+
:else
(throw (ex-info "Invalid arguments" {:v v}))))
- ([x y] (Point. x y)))
+ ([x y]
+ ;;(assert (not (nil? x)))
+ ;;(assert (not (nil? y)))
+ (Point. x y)))
(defn add
"Returns the addition of the supplied value to both
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 b191ed5bf..5109d9d6a 100644
--- a/common/app/common/geom/shapes.cljc
+++ b/common/app/common/geom/shapes.cljc
@@ -13,63 +13,24 @@
[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.geom.shapes.path :as gsp]
[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))))
- inc-y (nilf (fn [y] (+ (-chk y) (-chk dy))))
- inc-point (nilf (fn [p] (-> p
- (update :x inc-x)
- (update :y inc-y))))]
+ (let [dx (d/check-num dx)
+ dy (d/check-num dy)]
(-> shape
- (update :x inc-x)
- (update :y inc-y)
- (update-in [:selrect :x] inc-x)
- (update-in [:selrect :x1] inc-x)
- (update-in [:selrect :x2] inc-x)
- (update-in [:selrect :y] inc-y)
- (update-in [:selrect :y1] inc-y)
- (update-in [:selrect :y2] inc-y)
- (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))))
+ (assoc-in [:modifiers :displacement] (gmt/translate-matrix (gpt/point dx dy)))
+ (gtr/transform-shape))))
;; --- Absolute Movement
@@ -77,116 +38,32 @@
(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))))
-;; --- Center
-
-(declare center-rect)
-(declare center-path)
-
-(defn center
- "Calculate the center of the shape."
- [shape]
- (case (:type shape)
- :curve (center-path shape)
- :path (center-path shape)
- (center-rect shape)))
-
-(defn- center-rect
- [{:keys [x y width height] :as shape}]
- (gpt/point (+ x (/ width 2)) (+ y (/ height 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
- "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})
-
-;; --- 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
- "Update a concrete point in the path.
-
- The point should exists before, this function
- does not adds it automatically."
- [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)
-
+;; Fixme: Improve using modifiers instead of calculating the selrect/points
(defn resize
[shape width height]
(us/assert map? shape)
(us/assert number? width)
(us/assert number? height)
- (-> shape
- (assoc :width width :height height)
- (update :selrect (fn [selrect]
- (assoc selrect
- :x2 (+ (:x1 selrect) width)
- :y2 (+ (:y1 selrect) height))))))
+ (let [selrect (-> (:selrect shape)
+ (assoc :width width)
+ (assoc :height height)
+ (assoc :x2 (+ (-> shape :selrect :x1) width))
+ (assoc :y2 (+ (-> shape :selrect :y1) height)))
+
+ center (gco/center-selrect selrect)
+ points (-> selrect gpr/rect->points (gtr/transform-points center (:transform shape)))]
+
+ (-> shape
+ (assoc :width width)
+ (assoc :height height)
+ (assoc :selrect selrect)
+ (assoc :points points))))
(defn resize-rect
[shape attr value]
@@ -207,31 +84,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)))
-
-(declare shape->points)
-(declare points->selrect)
+;; 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 (shape->points $))
- (assoc $ :selrect (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}]
@@ -241,157 +108,13 @@
(:height metadata))
:proportion-lock true)))
-;; --- Coerce to Rect-like shape.
-
-(declare path->rect-shape)
-(declare group->rect-shape)
-(declare rect->rect-shape)
-
-;; TODO: completly remove
-
-(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)))
-
-;; -- Points
-
-(declare transform-shape-point)
-
-(defn shape->points [shape]
- (let [points (case (:type shape)
- (:curve :path) (: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 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}))
-
-;; Shape->PATH
-
-(declare rect->path)
-
-(defn shape->path
- [shape]
+(defn setup
+ "A function that initializes the first coordinates for
+ the shape. Used mainly for draw operations."
+ [shape props]
(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))))
-
-;; --- 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)))
-
-;; --- 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))))))
-
-;; --- Transform Shape
-
-(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 (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)))
+ :image (setup-image shape props)
+ (setup-rect shape props)))
;; --- Outer Rect
@@ -399,24 +122,10 @@
"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}))
+ (->> shapes
+ (gtr/transform-shape)
+ (map (comp gpr/points->selrect :points))
+ (gpr/join-selrects)))
(defn translate-to-frame
[shape {:keys [x y] :as frame}]
@@ -426,117 +135,26 @@
[shape {:keys [x y] :as frame}]
(move shape (gpt/point x y)))
-;; --- Alignment
-
-(s/def ::align-axis #{:hleft :hcenter :hright :vtop :vcenter :vbottom})
-
-(declare calc-align-pos)
-
-(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
- possible rotation. What is aligned is the rectangle that wraps
- the shape with the given rectangle. If the shape is a group,
- move also all of its recursive children."
- [shape rect axis objects]
- (let [wrapper-rect (selection-rect [shape])
- align-pos (calc-align-pos wrapper-rect rect axis)
- delta {:x (- (:x align-pos) (:x wrapper-rect))
- :y (- (:y align-pos) (:y wrapper-rect))}]
- (recursive-move shape delta objects)))
-
-(defn calc-align-pos
- [wrapper-rect rect axis]
- (case axis
- :hleft (let [left (:x rect)]
- {:x left
- :y (:y wrapper-rect)})
-
- :hcenter (let [center (+ (:x rect) (/ (:width rect) 2))]
- {:x (- center (/ (:width wrapper-rect) 2))
- :y (:y wrapper-rect)})
-
- :hright (let [right (+ (:x rect) (:width rect))]
- {:x (- right (:width wrapper-rect))
- :y (:y wrapper-rect)})
-
- :vtop (let [top (:y rect)]
- {:x (:x wrapper-rect)
- :y top})
-
- :vcenter (let [center (+ (:y rect) (/ (:height rect) 2))]
- {:x (:x wrapper-rect)
- :y (- center (/ (:height wrapper-rect) 2))})
-
- :vbottom (let [bottom (+ (:y rect) (:height rect))]
- {:x (:x wrapper-rect)
- :y (- bottom (:height wrapper-rect))})))
-
-;; --- Distribute
-
-(s/def ::dist-axis #{:horizontal :vertical})
-
-(defn distribute-space
- "Distribute equally the space between shapes in the given axis. If
- there is no space enough, it does nothing. It takes into account
- the form of the shape and the rotation, what is distributed is
- the wrapping recangles of the shapes. If any shape is a group,
- move also all of its recursive children."
- [shapes axis objects]
- (let [coord (if (= axis :horizontal) :x :y)
- other-coord (if (= axis :horizontal) :y :x)
- size (if (= axis :horizontal) :width :height)
- ; The rectangle that wraps the whole selection
- wrapper-rect (selection-rect shapes)
- ; Sort shapes by the center point in the given axis
- sorted-shapes (sort-by #(coord (center %)) shapes)
- ; Each shape wrapped in its own rectangle
- wrapped-shapes (map #(selection-rect [%]) sorted-shapes)
- ; The total space between shapes
- space (reduce - (size wrapper-rect) (map size wrapped-shapes))]
-
- (if (<= space 0)
- shapes
- (let [unit-space (/ space (- (count wrapped-shapes) 1))
- ; Calculate the distance we need to move each shape.
- ; The new position of each one is the position of the
- ; previous one plus its size plus the unit space.
- deltas (loop [shapes' wrapped-shapes
- start-pos (coord wrapper-rect)
- deltas []]
-
- (let [first-shape (first shapes')
- delta (- start-pos (coord first-shape))
- new-pos (+ start-pos (size first-shape) unit-space)]
-
- (if (= (count shapes') 1)
- (conj deltas delta)
- (recur (rest shapes')
- new-pos
- (conj deltas delta)))))]
-
- (mapcat #(recursive-move %1 {coord %2 other-coord 0} objects)
- sorted-shapes deltas)))))
-
-
;; --- Helpers
(defn contained-in?
"Check if a shape is contained in the
provided selection rect."
[shape selrect]
- (let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} (shape->rect-shape selrect)
- {rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (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} (shape->rect-shape selrect)
- {rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (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)
@@ -564,43 +182,6 @@
:type :rect}]
(overlaps? shape selrect)))
-(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 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 (center path-shape1) p1)
- v2 (gpt/to-vec (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)))
-
(defn pad-selrec
([selrect] (pad-selrec selrect 1))
([selrect size]
@@ -658,310 +239,29 @@
(and (>= s1c1 s2c1) (<= s1c1 s2c2))
(and (>= s1c2 s2c1) (<= s1c2 s2c2)))))
-(defn transform-shape-point
- "Transform a point around the shape center"
- [point shape transform]
- (let [shape-center (center shape)]
- (gpt/transform
- point
- (-> (gmt/multiply
- (gmt/translate-matrix shape-center)
- transform
- (gmt/translate-matrix (gpt/negate shape-center)))))))
-
-(defn transform-apply-modifiers
- [shape]
- (let [modifiers (:modifiers shape)
- 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)
-
- 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)
-
- shape (-> shape
- (transform ds-modifier))
-
- shape-center (center shape)]
-
- (-> (shape->path shape)
- (transform (-> (gmt/matrix)
-
- ;; Applies the current resize transformation
- (gmt/translate origin)
- (gmt/multiply resize-transform)
- (gmt/scale resize)
- (gmt/multiply resize-transform-inverse)
- (gmt/translate (gpt/negate origin))
-
- ;; Applies the stacked transformations
- (gmt/translate shape-center)
- (gmt/multiply (gmt/rotate-matrix rt-modif))
- (gmt/multiply (:transform shape (gmt/matrix)))
- (gmt/translate (gpt/negate shape-center)))))))
-
-(defn 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}))
-
-(defn calculate-stretch [shape-path transform-inverse]
- (let [shape-center (center shape-path)
- shape-path-temp (transform
- shape-path
- (-> (gmt/matrix)
- (gmt/translate shape-center)
- (gmt/multiply transform-inverse)
- (gmt/translate (gpt/negate shape-center))))
-
- shape-path-temp-rec (shape->rect-shape shape-path-temp)
- shape-path-temp-dim (rect-path-dimensions shape-path-temp)]
- (gpt/divide (gpt/point (:width shape-path-temp-rec) (:height shape-path-temp-rec))
- (gpt/point (:width shape-path-temp-dim) (:height shape-path-temp-dim)))))
-
-(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)))))
-
-(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 (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 %)))
-
- ;; 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 (shape->rect-shape shape-path-temp)
-
- ;; This rectangle is the new data for the current rectangle. We want to change our rectangle
- ;; to have this width, height, x, y
- rec (center->rect shape-center (:width shape-path-temp-dim) (:height shape-path-temp-dim))
- rec (fix-invalid-rect-values rec)
- rec-path (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)
-
-
- 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 (points->selrect (:points $)))
- (update $ :selrect fix-invalid-rect-values)
- (update $ :rotation #(mod (+ (or % 0)
- (or (get-in $ [:modifiers :rotation]) 0)) 360)))]
- new-shape))
-
-(declare update-path-selrect)
-(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)
-
- shape-transform-inverse' (-> (gmt/matrix)
- (gmt/translate shape-path-center)
- (gmt/multiply (:transform-inverse shape (gmt/matrix)))
- (gmt/multiply (gmt/rotate-matrix (- (:rotation-modifier shape 0))))
- (gmt/translate (gpt/negate shape-path-center)))]
- (-> shape-path
- (transform shape-transform-inverse')
- (add-rotate-transform (:rotation-modifier shape 0)))))
-
-(defn transform-shape
- "Transform the shape properties given the modifiers"
- ([shape] (transform-shape nil shape))
- ([frame shape]
- (let [new-shape
- (if (:modifiers shape)
- (-> (case (:type shape)
- (:curve :path) (transform-path-shape shape)
- (transform-rect-shape shape))
- (dissoc :modifiers))
- shape)]
- (cond-> new-shape
- frame (translate-to-frame frame)))))
-
-
-(defn transform-matrix
- "Returns a transformation matrix without changing the shape properties.
- The result should be used in a `transform` attribute in svg"
- ([{:keys [x y] :as shape}]
- (let [shape-center (center shape)]
- (-> (gmt/matrix)
- (gmt/translate shape-center)
- (gmt/multiply (:transform shape (gmt/matrix)))
- (gmt/translate (gpt/negate shape-center))))))
-
-(defn update-path-selrect [shape]
- (as-> shape $
- (assoc $ :points (shape->points $))
- (assoc $ :selrect (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 adjust-to-viewport
- ([viewport srect] (adjust-to-viewport viewport srect nil))
- ([viewport srect {:keys [padding] :or {padding 0}}]
- (let [gprop (/ (:width viewport) (:height viewport))
- srect (-> srect
- (update :x #(- % padding))
- (update :y #(- % padding))
- (update :width #(+ % padding padding))
- (update :height #(+ % padding padding)))
- width (:width srect)
- height (:height srect)
- lprop (/ width height)]
- (cond
- (> gprop lprop)
- (let [width' (* (/ width lprop) gprop)
- padding (/ (- width' width) 2)]
- (-> srect
- (update :x #(- % padding))
- (assoc :width width')))
-
- (< gprop lprop)
- (let [height' (/ (* height lprop) gprop)
- padding (/ (- height' height) 2)]
- (-> srect
- (update :y #(- % padding))
- (assoc :height height')))
-
- :else srect))))
-
-(defn get-attrs-multi
- [shapes attrs]
- ;; Extract some attributes of a list of shapes.
- ;; For each attribute, if the value is the same in all shapes,
- ;; wll take this value. If there is any shape that is different,
- ;; the value of the attribute will be the keyword :multiple.
- ;;
- ;; If some shape has the value nil in any attribute, it's
- ;; considered a different value. If the shape does not contain
- ;; the attribute, it's ignored in the final result.
- ;;
- ;; Example:
- ;; (def shapes [{:stroke-color "#ff0000"
- ;; :stroke-width 3
- ;; :fill-color "#0000ff"
- ;; :x 1000 :y 2000 :rx nil}
- ;; {:stroke-width "#ff0000"
- ;; :stroke-width 5
- ;; :x 1500 :y 2000}])
- ;;
- ;; (get-attrs-multi shapes [:stroke-color
- ;; :stroke-width
- ;; :fill-color
- ;; :rx
- ;; :ry])
- ;; >>> {:stroke-color "#ff0000"
- ;; :stroke-width :multiple
- ;; :fill-color "#0000ff"
- ;; :rx nil
- ;; :ry nil}
- ;;
- (let [defined-shapes (filter some? shapes)
-
- combine-value (fn [v1 v2] (cond
- (= v1 v2) v1
- (= v1 :undefined) v2
- (= v2 :undefined) v1
- :else :multiple))
-
- combine-values (fn [attrs shape values]
- (map #(combine-value (get shape % :undefined)
- (get values % :undefined)) attrs))
-
- select-attrs (fn [shape attrs]
- (zipmap attrs (map #(get shape % :undefined) attrs)))
-
- reducer (fn [result shape]
- (zipmap attrs (combine-values attrs shape result)))
-
- combined (reduce reducer
- (select-attrs (first defined-shapes) attrs)
- (rest defined-shapes))
-
- cleanup-value (fn [value]
- (if (= value :undefined) nil value))
-
- cleanup (fn [result]
- (zipmap attrs (map #(cleanup-value (get result %)) attrs)))]
-
- (cleanup combined)))
-
(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)})))
+ (let [selrect (gpr/rect->selrect shape)
+ points (gpr/rect->points shape)]
+ (-> shape
+ (assoc :selrect selrect
+ :points points))))
+
+;; EXPORTS
+(defn center-shape [shape] (gco/center-shape shape))
+(defn center-selrect [selrect] (gco/center-selrect selrect))
+(defn center-rect [rect] (gco/center-rect rect))
+
+(defn rect->selrect [rect] (gpr/rect->selrect rect))
+(defn rect->points [rect] (gpr/rect->points rect))
+(defn points->selrect [points] (gpr/points->selrect points))
+
+(defn transform-shape [shape] (gtr/transform-shape shape))
+(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))
+
+;; PATHS
+(defn content->points [content] (gsp/content->points content))
+(defn content->selrect [content] (gsp/content->selrect content))
diff --git a/common/app/common/geom/shapes/common.cljc b/common/app/common/geom/shapes/common.cljc
new file mode 100644
index 000000000..ba3b83527
--- /dev/null
+++ b/common/app/common/geom/shapes/common.cljc
@@ -0,0 +1,52 @@
+;; 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.shapes.common
+ (: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.math :as mth]
+ [app.common.data :as d]))
+
+(defn center-rect
+ [{:keys [x y width height]}]
+ (when (and (mth/finite? x)
+ (mth/finite? y)
+ (mth/finite? width)
+ (mth/finite? height))
+ (gpt/point (+ x (/ width 2))
+ (+ y (/ height 2)))))
+
+(defn center-selrect
+ "Calculate the center of the shape."
+ [selrect]
+ (center-rect selrect))
+
+(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-shape
+ "Calculate the center of the shape."
+ [shape]
+ (center-rect (:selrect shape)))
+
+(defn make-centered-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
new file mode 100644
index 000000000..d62b8df08
--- /dev/null
+++ b/common/app/common/geom/shapes/path.cljc
@@ -0,0 +1,162 @@
+;; 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.shapes.path
+ (: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.rect :as gpr]
+ [app.common.math :as mth]
+ [app.common.data :as d]))
+
+(defn content->points [content]
+ (->> content
+ (map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y))))
+ (remove nil?)
+ (into [])))
+
+;; https://medium.com/@Acegikmo/the-ever-so-lovely-b%C3%A9zier-curve-eb27514da3bf
+;; https://en.wikipedia.org/wiki/Bernstein_polynomial
+(defn curve-values
+ "Parametric equation for cubic beziers. Given a start and end and
+ two intermediate points returns points for values of t.
+ If you draw t on a plane you got the bezier cube"
+ [start end h1 h2 t]
+
+ (let [t2 (* t t) ;; t square
+ t3 (* t2 t) ;; t cube
+
+ start-v (+ (- t3) (* 3 t2) (* -3 t) 1)
+ h1-v (+ (* 3 t3) (* -6 t2) (* 3 t))
+ h2-v (+ (* -3 t3) (* 3 t2))
+ end-v t3
+
+ coord-v (fn [coord]
+ (+ (* (coord start) start-v)
+ (* (coord h1) h1-v)
+ (* (coord h2) h2-v)
+ (* (coord end) end-v)))]
+
+ (gpt/point (coord-v :x) (coord-v :y))))
+
+;; https://pomax.github.io/bezierinfo/#extremities
+(defn curve-extremities
+ "Given a cubic bezier cube finds its roots in t. This are the extremities
+ if we calculate its values for x, y we can find a bounding box for the curve."
+ [start end h1 h2]
+
+ (let [coords [[(:x start) (:x h1) (:x h2) (:x end)]
+ [(:y start) (:y h1) (:y h2) (:y end)]]
+
+ coord->tvalue
+ (fn [[c0 c1 c2 c3]]
+
+ (let [a (+ (* -3 c0) (* 9 c1) (* -9 c2) (* 3 c3))
+ b (+ (* 6 c0) (* -12 c1) (* 6 c2))
+ c (+ (* 3 c1) (* -3 c0))
+
+ sqrt-b2-4ac (mth/sqrt (- (* b b) (* 4 a c)))]
+
+ (cond
+ (and (mth/almost-zero? a)
+ (not (mth/almost-zero? b)))
+ ;; When the term a is close to zero we have a linear equation
+ [(/ (- c) b)]
+
+ ;; If a is not close to zero return the two roots for a cuadratic
+ (not (mth/almost-zero? a))
+ [(/ (+ (- b) sqrt-b2-4ac)
+ (* 2 a))
+ (/ (- (- b) sqrt-b2-4ac)
+ (* 2 a))]
+
+ ;; If a and b close to zero we can't find a root for a constant term
+ :else
+ [])))]
+ (->> coords
+ (mapcat coord->tvalue)
+
+ ;; Only values in the range [0, 1] are valid
+ (filter #(and (>= % 0) (<= % 1)))
+
+ ;; Pass t-values to actual points
+ (map #(curve-values start end h1 h2 %)))
+ ))
+
+(defn command->point
+ ([command] (command->point command nil))
+ ([{params :params} coord]
+ (let [prefix (if coord (name coord) "")
+ xkey (keyword (str prefix "x"))
+ ykey (keyword (str prefix "y"))
+ x (get params xkey)
+ y (get params ykey)]
+ (gpt/point x y))))
+
+(defn content->selrect [content]
+ (let [calc-extremities
+ (fn [command prev]
+ (case (:command command)
+ :close-path []
+ :move-to [(command->point command)]
+
+ ;; If it's a line we add the beginning point and endpoint
+ :line-to [(command->point prev)
+ (command->point command)]
+
+ ;; We return the bezier extremities
+ :curve-to (d/concat
+ [(command->point prev)
+ (command->point command)]
+ (curve-extremities (command->point prev)
+ (command->point command)
+ (command->point command :c1)
+ (command->point command :c2)))))
+
+ extremities (mapcat calc-extremities
+ content
+ (d/concat [nil] content))]
+
+ (gpr/points->selrect extremities)))
+
+(defn transform-content [content transform]
+ (let [set-tr (fn [params px py]
+ (let [tr-point (-> (gpt/point (get params px) (get params py))
+ (gpt/transform transform))]
+ (assoc params
+ px (:x tr-point)
+ py (:y tr-point))))
+
+ transform-params
+ (fn [{:keys [x y c1x c1y c2x c2y] :as params}]
+ (cond-> params
+ (not (nil? x)) (set-tr :x :y)
+ (not (nil? c1x)) (set-tr :c1x :c1y)
+ (not (nil? c2x)) (set-tr :c2x :c2y)))]
+
+ (mapv #(update % :params transform-params) content)))
+
+(defn segments->content
+ ([segments]
+ (segments->content segments false))
+
+ ([segments closed?]
+ (let [initial (first segments)
+ lines (rest segments)]
+
+ (d/concat [{:command :move-to
+ :params (select-keys initial [:x :y])}]
+ (->> lines
+ (mapv #(hash-map :command :line-to
+ :params (select-keys % [:x :y]))))
+
+ (when closed?
+ [{:command :close-path}])))))
diff --git a/common/app/common/geom/shapes/rect.cljc b/common/app/common/geom/shapes/rect.cljc
new file mode 100644
index 000000000..bca71f3ad
--- /dev/null
+++ b/common/app/common/geom/shapes/rect.cljc
@@ -0,0 +1,60 @@
+;; 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.shapes.rect
+ (: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.math :as mth]
+ [app.common.data :as d]))
+
+(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 points->rect [points]
+ (let [minx (transduce (comp (map :x) (remove nil?)) min ##Inf points)
+ miny (transduce (comp (map :y) (remove nil?)) min ##Inf points)
+ maxx (transduce (comp (map :x) (remove nil?)) max ##-Inf points)
+ maxy (transduce (comp (map :y) (remove nil?)) max ##-Inf points)]
+ {:x minx
+ :y miny
+ :width (- maxx minx)
+ :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))
+
+(defn join-selrects [selrects]
+ (let [minx (transduce (comp (map :x1) (remove nil?)) min ##Inf selrects)
+ miny (transduce (comp (map :y1) (remove nil?)) min ##Inf selrects)
+ maxx (transduce (comp (map :x2) (remove nil?)) max ##-Inf selrects)
+ maxy (transduce (comp (map :y2) (remove nil?)) max ##-Inf selrects)]
+ {:x minx
+ :y miny
+ :x1 minx
+ :y1 miny
+ :x2 maxx
+ :y2 maxy
+ :width (- maxx minx)
+ :height (- maxy miny)}))
+
diff --git a/common/app/common/geom/shapes/transforms.cljc b/common/app/common/geom/shapes/transforms.cljc
new file mode 100644
index 000000000..ec5e51f4a
--- /dev/null
+++ b/common/app/common/geom/shapes/transforms.cljc
@@ -0,0 +1,263 @@
+;; 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.shapes.transforms
+ (: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.path :as gpa]
+ [app.common.geom.shapes.rect :as gpr]
+ [app.common.math :as mth]
+ [app.common.data :as d]))
+
+(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 (or (gco/center-shape shape)
+ (gpt/point 0 0))]
+ (-> (gmt/matrix)
+ (gmt/translate shape-center)
+ (gmt/multiply (:transform shape (gmt/matrix)))
+ (gmt/translate (gpt/negate shape-center))))))
+
+(defn transform-point-center
+ "Transform a point around the shape center"
+ [point center matrix]
+ (gpt/transform
+ point
+ (gmt/multiply (gmt/translate-matrix center)
+ matrix
+ (gmt/translate-matrix (gpt/negate center)))))
+
+(defn transform-points
+ ([points matrix]
+ (transform-points points nil matrix))
+
+ ([points center matrix]
+
+ (let [prev (if center (gmt/translate-matrix center) (gmt/matrix))
+ post (if center (gmt/translate-matrix (gpt/negate center)) (gmt/matrix))
+
+ tr-point (fn [point]
+ (gpt/transform point (gmt/multiply prev matrix post)))]
+ (mapv tr-point points))))
+
+(defn transform-rect
+ "Transform a rectangles and changes its attributes"
+ [{:keys [x y width height] :as rect} matrix]
+
+ (let [points (-> (gpr/rect->points rect)
+ (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]
+ (modifiers->transform (gmt/matrix) center modifiers))
+
+ ([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 (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 p2 p3 p4]]
+ (let [v1 (gpt/to-vec p3 p4)
+ v2 (gpt/to-vec p4 p1)]
+ (- 90 (gpt/angle-with-other v1 v2))))
+
+(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)))))
+
+(defn- calculate-rotation
+ "Calculates the rotation between two shapes given the resize vector direction"
+ [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 (gco/center-points points-shape1) p1)
+ v2 (gpt/to-vec (gco/center-points points-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)))
+
+(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)
+
+ stretch-matrix (gmt/matrix)
+
+ 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 (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-height points-temp)
+ h2 (calculate-height (transform-points points-rec 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-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)
+
+
+ ;; This is the inverse to be able to remove the transformation
+ stretch-matrix-inverse (-> (gmt/matrix)
+ (gmt/scale (gpt/point 1 (/ 1 h3)))
+ (gmt/skew (- skew-angle) 0)
+ (gmt/rotate (- rotation-angle)))]
+ [stretch-matrix stretch-matrix-inverse]))
+
+
+(defn apply-transform-path
+ [shape transform]
+ (let [content (gpa/transform-content (:content shape) transform)
+ selrect (gpa/content->selrect content)
+ points (gpr/rect->points selrect)
+ rotation (mod (+ (:rotation shape 0)
+ (or (get-in shape [:modifiers :rotation]) 0))
+ 360)]
+ (assoc shape
+ :content content
+ :points points
+ :selrect selrect)))
+
+(defn apply-transform-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 transform]
+ ;;
+ (let [points (-> shape :points (transform-points transform))
+ 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))]
+ (as-> shape $
+ (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)) matrix))
+ (update $ :transform-inverse #(gmt/multiply matrix-inverse (or % (gmt/matrix))))
+ (assoc $ :points (into [] points))
+ (assoc $ :selrect (gpr/rect->selrect rect-shape))
+ (update $ :rotation #(mod (+ (or % 0)
+ (or (get-in $ [:modifiers :rotation]) 0)) 360)))))
+
+(defn apply-transform [shape transform]
+ (let [apply-transform-fn
+ (case (:type shape)
+ :path apply-transform-path
+ apply-transform-rect)]
+ (apply-transform-fn shape transform)))
+
+(defn set-flip [shape modifiers]
+ (let [rx (get-in modifiers [:resize-vector :x])
+ ry (get-in modifiers [:resize-vector :y])]
+ (cond-> shape
+ (and rx (< rx 0)) (update :flip-x not)
+ (and ry (< ry 0)) (update :flip-y not))))
+
+(defn transform-shape [shape]
+ (let [center (gco/center-shape shape)]
+ (if (and (:modifiers shape) center)
+ (let [transform (modifiers->transform (:transform shape (gmt/matrix)) center (:modifiers shape))]
+ (-> shape
+ (set-flip (:modifiers shape))
+ (apply-transform transform)
+ (dissoc :modifiers)))
+ shape)))
diff --git a/common/app/common/math.cljc b/common/app/common/math.cljc
index 9125c7c35..dd16c402e 100644
--- a/common/app/common/math.cljc
+++ b/common/app/common/math.cljc
@@ -23,8 +23,8 @@
(defn finite?
[v]
- #?(:cljs (js/isFinite v)
- :clj (Double/isFinite v)))
+ #?(:cljs (and (not (nil? v)) (js/isFinite v))
+ :clj (and (not (nil? v)) (Double/isFinite v))))
(defn abs
[v]
@@ -135,3 +135,6 @@
(if (< num from)
from
(if (> num to) to num)))
+
+(defn almost-zero? [num]
+ (< (abs num) 1e-8))
diff --git a/common/app/common/pages.cljc b/common/app/common/pages.cljc
index 0feaccbfc..52accc13e 100644
--- a/common/app/common/pages.cljc
+++ b/common/app/common/pages.cljc
@@ -20,7 +20,7 @@
[app.common.spec :as us]
[app.common.uuid :as uuid]))
-(def file-version 2)
+(def file-version 3)
(def max-safe-int 9007199254740991)
(def min-safe-int -9007199254740991)
@@ -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]))
@@ -611,8 +611,7 @@
:stroke-alignment :center
:stroke-width 2
:stroke-color "#000000"
- :stroke-opacity 1
- :segments []}
+ :stroke-opacity 1}
{:type :frame
:name "Artboard"
@@ -624,44 +623,37 @@
:stroke-color "#000000"
:stroke-opacity 0}
- {:type :curve
- :name "Path"
- :fill-color "#000000"
- :fill-opacity 0
- :stroke-style :solid
- :stroke-alignment :center
- :stroke-width 2
- :stroke-color "#000000"
- :stroke-opacity 1
- :segments []}
-
{:type :text
:name "Text"
:content nil}])
(defn make-minimal-shape
[type]
- (let [shape (d/seek #(= type (:type %)) minimal-shapes)]
+ (let [type (cond (= type :curve) :path
+ :else type)
+ shape (d/seek #(= type (:type %)) minimal-shapes)]
(when-not shape
(ex/raise :type :assertion
:code :shape-type-not-implemented
:context {:type type}))
- (assoc shape
- :id (uuid/next)
- :x 0
- :y 0
- :width 1
- :height 1
- :selrect {:x 0
- :x1 0
- :x2 1
- :y 0
- :y1 0
- :y2 1
- :width 1
- :height 1}
- :points []
- :segments [])))
+
+ (cond-> shape
+ :always
+ (assoc :id (uuid/next))
+
+ (not= :path (:type shape))
+ (assoc :x 0
+ :y 0
+ :width 1
+ :height 1
+ :selrect {:x 0
+ :y 0
+ :x1 0
+ :y1 0
+ :x2 1
+ :y2 1
+ :width 1
+ :height 1}))))
(defn make-minimal-group
[frame-id selection-rect group-name]
@@ -764,13 +756,14 @@
(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)))]
{:rotation angle
:displacement displacement}))
+;; reg-objects operation "regenerates" the values for the parent groups
(defmethod process-change :reg-objects
[data {:keys [page-id shapes]}]
(letfn [(reg-objects [objects]
@@ -783,7 +776,7 @@
(distinct))
shapes)))
(update-group [group objects]
- (let [gcenter (geom/center group)
+ (let [gcenter (geom/center-shape group)
gxfm (comp
(map #(get objects %))
(map #(-> %
@@ -798,10 +791,10 @@
;; Rotate the group shape change the data and rotate back again
(-> group
- (assoc-in [:modifiers :rotation] (- (:rotation group 0)))
- (geom/transform-shape)
+ (assoc :selrect selrect)
+ (assoc :points (geom/rect->points selrect))
(merge (select-keys selrect [:x :y :width :height]))
- (assoc-in [:modifiers :rotation] (:rotation group))
+ (assoc-in [:modifiers :rotation] (:rotation group 0))
(geom/transform-shape))))]
(d/update-in-when data [:pages-index page-id :objects] reg-objects)))
diff --git a/common/app/common/pages_migrations.cljc b/common/app/common/pages_migrations.cljc
index 7d9b89bc0..75697f5e3 100644
--- a/common/app/common/pages_migrations.cljc
+++ b/common/app/common/pages_migrations.cljc
@@ -2,6 +2,7 @@
(:require
[app.common.pages :as cp]
[app.common.geom.shapes :as gsh]
+ [app.common.geom.shapes.path :as gsp]
[app.common.geom.point :as gpt]
[app.common.geom.matrix :as gmt]
[app.common.spec :as us]
@@ -35,7 +36,6 @@
;; -- MIGRATIONS --
;; Ensure that all :shape attributes on shapes are vectors.
-
(defmethod migrate 2
[data]
(letfn [(update-object [id object]
@@ -49,3 +49,63 @@
(update page :objects #(d/mapm update-object %)))]
(update data :pages-index #(d/mapm update-page %))))
+
+;; Changes paths formats
+(defmethod migrate 3
+ [data]
+ (letfn [(migrate-path [shape]
+ (if-not (contains? shape :content)
+ (let [content (gsp/segments->content (:segments shape) (:close? shape))
+ selrect (gsh/content->selrect content)
+ points (gsh/rect->points selrect)]
+ (-> shape
+ (dissoc :segments)
+ (dissoc :close?)
+ (assoc :content content)
+ (assoc :selrect selrect)
+ (assoc :points points)))
+ ;; If the shape contains :content is already in the new format
+ shape))
+
+ (fix-frames-selrects [frame]
+ (if (= (:id frame) uuid/zero)
+ frame
+ (let [frame-rect (select-keys frame [:x :y :width :height])]
+ (-> frame
+ (assoc :selrect (gsh/rect->selrect frame-rect))
+ (assoc :points (gsh/rect->points frame-rect))))))
+
+ (fix-empty-points [shape]
+ (let [shape (cond-> shape
+ (empty? (:selrect shape)) (gsh/setup-selrect))]
+ (cond-> shape
+ (empty? (:points shape))
+ (assoc :points (gsh/rect->points (:selrect shape))))))
+
+ (update-object [id object]
+ (cond-> object
+ (= :curve (:type object))
+ (assoc :type :path)
+
+ (or (#{:curve :path} (:type object)))
+ (migrate-path)
+
+ (= :frame (:type object))
+ (fix-frames-selrects)
+
+ (and (empty? (:points object)) (not= (:id object) uuid/zero))
+ (fix-empty-points)
+
+ :always
+ (->
+ ;; Setup an empty transformation to re-calculate selrects
+ ;; and points data
+ (assoc :modifiers {:displacement (gmt/matrix)})
+ (gsh/transform-shape))
+
+ ))
+
+ (update-page [id page]
+ (update page :objects #(d/mapm update-object %)))]
+
+ (update data :pages-index #(d/mapm update-page %))))
diff --git a/frontend/resources/images/cursors/comments.svg b/frontend/resources/images/cursors/comments.svg
new file mode 100644
index 000000000..4683f3a2e
--- /dev/null
+++ b/frontend/resources/images/cursors/comments.svg
@@ -0,0 +1,4 @@
+
diff --git a/frontend/resources/images/cursors/pen-node.svg b/frontend/resources/images/cursors/pen-node.svg
new file mode 100644
index 000000000..ba03c12c6
--- /dev/null
+++ b/frontend/resources/images/cursors/pen-node.svg
@@ -0,0 +1,4 @@
+
diff --git a/frontend/resources/images/cursors/pointer-move.svg b/frontend/resources/images/cursors/pointer-move.svg
new file mode 100644
index 000000000..895bbd8ee
--- /dev/null
+++ b/frontend/resources/images/cursors/pointer-move.svg
@@ -0,0 +1,6 @@
+
diff --git a/frontend/resources/images/cursors/pointer-node.svg b/frontend/resources/images/cursors/pointer-node.svg
new file mode 100644
index 000000000..185862c1d
--- /dev/null
+++ b/frontend/resources/images/cursors/pointer-node.svg
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/frontend/resources/images/icons/nodes-add.svg b/frontend/resources/images/icons/nodes-add.svg
new file mode 100644
index 000000000..9c5ecf93a
--- /dev/null
+++ b/frontend/resources/images/icons/nodes-add.svg
@@ -0,0 +1,3 @@
+
diff --git a/frontend/resources/images/icons/nodes-corner.svg b/frontend/resources/images/icons/nodes-corner.svg
new file mode 100644
index 000000000..295e316ab
--- /dev/null
+++ b/frontend/resources/images/icons/nodes-corner.svg
@@ -0,0 +1,3 @@
+
diff --git a/frontend/resources/images/icons/nodes-curve.svg b/frontend/resources/images/icons/nodes-curve.svg
new file mode 100644
index 000000000..b12913fc5
--- /dev/null
+++ b/frontend/resources/images/icons/nodes-curve.svg
@@ -0,0 +1,3 @@
+
diff --git a/frontend/resources/images/icons/nodes-join.svg b/frontend/resources/images/icons/nodes-join.svg
new file mode 100644
index 000000000..551451cb9
--- /dev/null
+++ b/frontend/resources/images/icons/nodes-join.svg
@@ -0,0 +1,3 @@
+
diff --git a/frontend/resources/images/icons/nodes-merge.svg b/frontend/resources/images/icons/nodes-merge.svg
new file mode 100644
index 000000000..5e0d9c336
--- /dev/null
+++ b/frontend/resources/images/icons/nodes-merge.svg
@@ -0,0 +1,3 @@
+
diff --git a/frontend/resources/images/icons/nodes-remove.svg b/frontend/resources/images/icons/nodes-remove.svg
new file mode 100644
index 000000000..e00ecd534
--- /dev/null
+++ b/frontend/resources/images/icons/nodes-remove.svg
@@ -0,0 +1,3 @@
+
diff --git a/frontend/resources/images/icons/nodes-separate.svg b/frontend/resources/images/icons/nodes-separate.svg
new file mode 100644
index 000000000..4e188e3cb
--- /dev/null
+++ b/frontend/resources/images/icons/nodes-separate.svg
@@ -0,0 +1,3 @@
+
diff --git a/frontend/resources/images/icons/nodes-snap.svg b/frontend/resources/images/icons/nodes-snap.svg
new file mode 100644
index 000000000..1bd5edac4
--- /dev/null
+++ b/frontend/resources/images/icons/nodes-snap.svg
@@ -0,0 +1,3 @@
+
diff --git a/frontend/resources/images/icons/pen.svg b/frontend/resources/images/icons/pen.svg
new file mode 100644
index 000000000..cc3c91147
--- /dev/null
+++ b/frontend/resources/images/icons/pen.svg
@@ -0,0 +1,3 @@
+
diff --git a/frontend/resources/images/icons/pointer-inner.svg b/frontend/resources/images/icons/pointer-inner.svg
new file mode 100644
index 000000000..50798578b
--- /dev/null
+++ b/frontend/resources/images/icons/pointer-inner.svg
@@ -0,0 +1,3 @@
+
diff --git a/frontend/resources/styles/main/partials/dashboard-grid.scss b/frontend/resources/styles/main/partials/dashboard-grid.scss
index 7f0364275..79b5da8ad 100644
--- a/frontend/resources/styles/main/partials/dashboard-grid.scss
+++ b/frontend/resources/styles/main/partials/dashboard-grid.scss
@@ -206,6 +206,12 @@
&.menu {
margin-right: 0;
+ width: 2rem;
+ height: 2rem;
+ display: flex;
+ justify-content: flex-end;
+ align-items: flex-end;
+ flex-direction: column;
svg {
fill: $color-gray-60;
diff --git a/frontend/resources/styles/main/partials/workspace.scss b/frontend/resources/styles/main/partials/workspace.scss
index ccccec01e..d6119cd4a 100644
--- a/frontend/resources/styles/main/partials/workspace.scss
+++ b/frontend/resources/styles/main/partials/workspace.scss
@@ -225,3 +225,88 @@
padding: $x-small;
}
}
+
+.viewport-actions {
+ position: absolute;
+ margin-left: auto;
+ width: 100%;
+ margin-top: 2rem;
+ display: flex;
+ flex-direction: row;
+ justify-content: center;
+ align-items: center;
+
+ .path-actions {
+ display: flex;
+ flex-direction: row;
+ background: white;
+ border-radius: 3px;
+ padding: 0.5rem;
+ border: 1px solid $color-gray-20;
+ box-shadow: 0 2px 8px rgba(0, 0, 0, 0.2);
+ }
+
+ .viewport-actions-group {
+ display: flex;
+ flex-direction: row;
+ border-right: 1px solid $color-gray-20;
+ }
+
+ .viewport-actions-entry {
+ width: 28px;
+ height: 28px;
+ margin: 0 0.25rem;
+ cursor: pointer;
+ display: flex;
+ justify-content: center;
+ align-items: center;
+ border-radius: 3px;
+
+ svg {
+ width: 20px;
+ height: 20px;
+ }
+
+ &:hover svg {
+ fill: $color-primary;
+ }
+
+ &.is-disabled {
+ opacity: 0.3;
+
+ &:hover svg {
+ fill: initial;
+ }
+ }
+
+ &.is-toggled {
+ background: $color-black;
+
+ svg {
+ fill: $color-primary;
+ }
+ }
+ }
+
+ .viewport-actions-entry-wide {
+ width: 27px;
+ height: 20px;
+
+ svg {
+ width: 27px;
+ height: 20px;
+ }
+ }
+
+ .path-actions > :first-child .viewport-actions-entry {
+ margin-left: 0;
+ }
+
+ .path-actions > :last-child {
+ border: none;
+ }
+
+ .path-actions > :last-child .viewport-actions-entry {
+ margin-right: 0;
+ }
+}
diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs
index 71ee25648..f75a89a67 100644
--- a/frontend/src/app/main/data/workspace.cljs
+++ b/frontend/src/app/main/data/workspace.cljs
@@ -13,7 +13,9 @@
[app.common.exceptions :as ex]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
- [app.common.geom.shapes :as geom]
+ [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]
[app.common.pages-helpers :as cph]
@@ -29,6 +31,8 @@
[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.data.workspace.drawing.path :as dwdp]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.streams :as ms]
@@ -339,7 +343,7 @@
(let [page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)
shapes (cph/select-toplevel-shapes objects {:include-frames? true})
- srect (geom/selection-rect shapes)
+ srect (gsh/selection-rect shapes)
local (assoc local :vport size :zoom 1)]
(cond
(or (not (mth/finite? (:width srect)))
@@ -348,7 +352,7 @@
(or (> (:width srect) width)
(> (:height srect) height))
- (let [srect (geom/adjust-to-viewport size srect {:padding 40})
+ (let [srect (gal/adjust-to-viewport size srect {:padding 40})
zoom (/ (:width size) (:width srect))]
(-> local
(assoc :zoom zoom)
@@ -471,10 +475,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 (geom/center vbox))
+ center (if center center (gsh/center-rect vbox))
scale (/ old-zoom new-zoom)
mtx (gmt/scale-matrix (gpt/point scale) center)
- vbox' (geom/transform vbox mtx)
+ vbox' (gsh/transform-rect vbox mtx)
vbox' (update vbox' :x - (:left-offset vbox))]
(-> local
(assoc :zoom new-zoom)
@@ -510,14 +514,14 @@
(let [page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)
shapes (cph/select-toplevel-shapes objects {:include-frames? true})
- srect (geom/selection-rect shapes)]
+ srect (gsh/selection-rect shapes)]
(if (or (mth/nan? (:width srect))
(mth/nan? (:height srect)))
state
(update state :workspace-local
(fn [{:keys [vbox vport] :as local}]
- (let [srect (geom/adjust-to-viewport vport srect {:padding 40})
+ (let [srect (gal/adjust-to-viewport vport srect {:padding 40})
zoom (/ (:width vport) (:width srect))]
(-> local
(assoc :zoom zoom)
@@ -534,10 +538,10 @@
objects (dwc/lookup-page-objects state page-id)
srect (->> selected
(map #(get objects %))
- (geom/selection-rect))]
+ (gsh/selection-rect))]
(update state :workspace-local
(fn [{:keys [vbox vport] :as local}]
- (let [srect (geom/adjust-to-viewport vport srect {:padding 40})
+ (let [srect (gal/adjust-to-viewport vport srect {:padding 40})
zoom (/ (:width vport) (:width srect))]
(-> local
(assoc :zoom zoom)
@@ -545,50 +549,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])]
@@ -614,8 +574,8 @@
(merge data)
(merge {:x x :y y})
(assoc :frame-id frame-id)
- (geom/setup-selrect))]
- (rx/of (add-shape shape))))))
+ (gsh/setup-selrect))]
+ (rx/of (dwc/add-shape shape))))))
;; --- Update Shape Attrs
@@ -953,7 +913,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]
@@ -991,17 +951,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]
@@ -1009,7 +969,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 []]
@@ -1034,62 +994,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
@@ -1103,7 +1007,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
@@ -1117,7 +1021,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?)
@@ -1142,23 +1046,6 @@
(rx/of (dwt/set-modifiers [id] {:displacement displ})
(dwt/apply-modifiers [id]))))))
-;; --- Path Modifications
-
-(defn update-path
- "Update a concrete point in the path shape."
- [id index delta]
- (us/verify ::us/uuid id)
- (us/verify ::us/integer index)
- (us/verify gpt/point? delta)
- (js/alert "TODO: broken")
- #_(ptk/reify ::update-path
- ptk/UpdateEvent
- (update [_ state]
- (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))))))
-
;; --- Shape attrs (Layers Sidebar)
(defn toggle-collapse
@@ -1290,7 +1177,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 +1216,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 +1246,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 +1333,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 +1346,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 +1377,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 +1455,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 +1482,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,11 +1605,16 @@
(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)
+(defn start-path-edit [id] (dwdp/start-path-edit id))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Shortcuts
@@ -1730,6 +1622,18 @@
;; Shortcuts impl https://github.com/ccampbell/mousetrap
+(defn esc-pressed []
+ (ptk/reify :esc-pressed
+ ptk/WatchEvent
+ (watch [_ state stream]
+ ;; Not interrupt when we're editing a path
+ (let [edition-id (get-in state [:workspace-local :edition])
+ path-edit-mode (get-in state [:workspace-local :edit-path edition-id :edit-mode])]
+ (if-not (= :draw path-edit-mode)
+ (rx/of :interrupt
+ (deselect-all true))
+ (rx/empty))))))
+
(def shortcuts
{"ctrl+i" #(st/emit! (toggle-layout-flags :assets))
"ctrl+l" #(st/emit! (toggle-layout-flags :sitemap :layers))
@@ -1753,15 +1657,16 @@
"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))
+ (dwd/select-for-drawing :text))
+ "p" #(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)
- "escape" #(st/emit! :interrupt (deselect-all true))
+ "escape" #(st/emit! (esc-pressed))
"del" #(st/emit! delete-selected)
"backspace" #(st/emit! delete-selected)
"ctrl+up" #(st/emit! (vertical-order-selected :up))
@@ -1777,4 +1682,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..594c00f03 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,92 @@
[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]
+ (let [page-id (:current-page-id state)
+ objects (get-in state [:workspace-data :pages-index page-id :objects])]
+ ;; Can only edit objects that exist
+ (if (contains? objects id)
+ (-> state
+ (assoc-in [:workspace-local :selected] #{id})
+ (assoc-in [:workspace-local :edition] id))
+ state)))
+
+ 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 (or (:id attrs) (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 bfe114418..d83d2b79c 100644
--- a/frontend/src/app/main/data/workspace/drawing.cljs
+++ b/frontend/src/app/main/data/workspace/drawing.cljs
@@ -12,24 +12,48 @@
(:require
[beicon.core :as rx]
[potok.core :as ptk]
- [app.common.geom.point :as gpt]
- [app.common.geom.shapes :as geom]
+ [app.common.spec :as us]
[app.common.pages :as cp]
[app.common.uuid :as uuid]
- [app.common.pages-helpers :as cph]
- [app.common.uuid :as uuid]
- [app.main.data.workspace :as dw]
[app.main.data.workspace.common :as dwc]
- [app.main.snap :as snap]
- [app.main.streams :as ms]
- [app.util.geom.path :as path]))
+ [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)
-(declare handle-drawing-generic)
-(declare handle-drawing-path)
-(declare handle-drawing-curve)
-(declare handle-finish-drawing)
-(declare conditional-align)
+
+;; --- 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.q
+ (when (and (not= tool :comments)
+ (not= tool :path))
+ (->> 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
@@ -38,20 +62,22 @@
(defn start-drawing
[type]
{:pre [(keyword? type)]}
- (let [id (uuid/next)]
+ (let [lock-id (uuid/next)]
(ptk/reify ::start-drawing
ptk/UpdateEvent
(update [_ state]
- (update-in state [:workspace-drawing :lock] #(if (nil? %) id %)))
+ (update-in state [:workspace-drawing :lock] #(if (nil? %) lock-id %)))
ptk/WatchEvent
(watch [_ state stream]
(let [lock (get-in state [:workspace-drawing :lock])]
- (when (= lock id)
- (rx/merge (->> (rx/filter #(= % handle-finish-drawing) stream)
- (rx/take 1)
- (rx/map (fn [_] #(update % :workspace-drawing dissoc :lock))))
- (rx/of (handle-drawing type)))))))))
+ (when (= lock lock-id)
+ (rx/merge
+ (rx/of (handle-drawing type))
+ (->> stream
+ (rx/filter (ptk/type? ::common/handle-finish-drawing) )
+ (rx/first)
+ (rx/map #(fn [state] (update state :workspace-drawing dissoc :lock)))))))))))
(defn handle-drawing
[type]
@@ -63,248 +89,15 @@
ptk/WatchEvent
(watch [_ state stream]
- (case type
- :path (rx/of handle-drawing-path)
- :curve (rx/of handle-drawing-curve)
- (rx/of handle-drawing-generic)))))
+ (rx/of (case type
+ :path
+ (path/handle-new-shape)
-(def handle-drawing-generic
- (letfn [(resize-shape [{:keys [x y width height] :as shape} point lock? point-snap]
- (let [;; The new shape behaves like a resize on the bottom-right corner
- initial (gpt/point (+ x width) (+ y height))
- shapev (gpt/point width height)
- deltav (gpt/to-vec initial point-snap)
- scalev (gpt/divide (gpt/add shapev deltav) shapev)
- scalev (if lock?
- (let [v (max (:x scalev) (:y scalev))]
- (gpt/point v v))
- scalev)]
- (-> shape
- (assoc ::click-draw? false)
- (assoc-in [:modifiers :resize-vector] scalev)
- (assoc-in [:modifiers :resize-origin] (gpt/point x y))
- (assoc-in [:modifiers :resize-rotation] 0))))
+ :curve
+ (curve/handle-drawing-curve)
- (update-drawing [state point lock? point-snap]
- (update-in state [:workspace-drawing :object] resize-shape point lock? point-snap))]
-
- (ptk/reify ::handle-drawing-generic
- ptk/WatchEvent
- (watch [_ state stream]
- (let [{:keys [flags]} (:workspace-local state)
-
- stoper? #(or (ms/mouse-up? %) (= % :interrupt))
- stoper (rx/filter stoper? stream)
- initial @ms/mouse-position
+ ;; default
+ (box/handle-drawing-box))))))
- page-id (:current-page-id state)
- objects (dwc/lookup-page-objects state page-id)
- layout (get state :workspace-layout)
-
- frames (cph/select-frames objects)
- fid (or (->> frames
- (filter #(geom/has-point? % initial))
- first
- :id)
- uuid/zero)
-
- shape (-> state
- (get-in [:workspace-drawing :object])
- (geom/setup {:x (:x initial) :y (:y initial) :width 1 :height 1})
- (assoc :frame-id fid)
- (assoc ::initialized? true)
- (assoc ::click-draw? true))]
- (rx/concat
- ;; Add shape to drawing state
- (rx/of #(assoc-in state [:workspace-drawing :object] shape))
-
- ;; 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))))
-
- (->> ms/mouse-position
- (rx/filter #(> (gpt/distance % initial) 2))
- (rx/with-latest vector ms/mouse-position-ctrl)
- (rx/switch-map
- (fn [[point :as current]]
- (->> (snap/closest-snap-point page-id [shape] layout point)
- (rx/map #(conj current %)))))
- (rx/map
- (fn [[pt ctrl? point-snap]]
- #(update-drawing % pt ctrl? point-snap)))
-
- (rx/take-until stoper))
- (rx/of handle-finish-drawing)))))))
-
-(def handle-drawing-path
- (letfn [(stoper-event? [{:keys [type shift] :as event}]
- (or (= event :path/end-path-drawing)
- (= event :interrupt)
- (and (ms/mouse-event? event)
- (or (= type :double-click)
- (= type :context-menu)))
- (and (ms/keyboard-event? event)
- (= type :down)
- (= 13 (:key event)))))
-
- (initialize-drawing [state point]
- (-> state
- (assoc-in [:workspace-drawing :object :segments] [point point])
- (assoc-in [:workspace-drawing :object ::initialized?] true)))
-
- (insert-point-segment [state point]
- (-> state
- (update-in [:workspace-drawing :object :segments] (fnil conj []) point)))
-
- (update-point-segment [state index point]
- (let [segments (count (get-in state [:workspace-drawing :object :segments]))
- exists? (< -1 index segments)]
- (cond-> state
- exists? (assoc-in [:workspace-drawing :object :segments index] point))))
-
- (finish-drawing-path [state]
- (update-in
- state [:workspace-drawing :object]
- (fn [shape] (-> shape
- (update :segments #(vec (butlast %)))
- (geom/update-path-selrect)))))]
-
- (ptk/reify ::handle-drawing-path
- ptk/WatchEvent
- (watch [_ state stream]
- (let [{:keys [flags]} (:workspace-local state)
-
- last-point (volatile! @ms/mouse-position)
-
- stoper (->> (rx/filter stoper-event? stream)
- (rx/share))
-
- mouse (rx/sample 10 ms/mouse-position)
-
- points (->> stream
- (rx/filter ms/mouse-click?)
- (rx/filter #(false? (:shift %)))
- (rx/with-latest vector mouse)
- (rx/map second))
-
- counter (rx/merge (rx/scan #(inc %) 1 points) (rx/of 1))
-
- stream' (->> mouse
- (rx/with-latest vector ms/mouse-position-ctrl)
- (rx/with-latest vector counter)
- (rx/map flatten))
-
- imm-transform #(vector (- % 7) (+ % 7) %)
- immanted-zones (vec (concat
- (map imm-transform (range 0 181 15))
- (map (comp imm-transform -) (range 0 181 15))))
-
- align-position (fn [angle pos]
- (reduce (fn [pos [a1 a2 v]]
- (if (< a1 angle a2)
- (reduced (gpt/update-angle pos v))
- pos))
- pos
- immanted-zones))]
-
- (rx/merge
- (rx/of #(initialize-drawing % @last-point))
-
- (->> points
- (rx/take-until stoper)
- (rx/map (fn [pt] #(insert-point-segment % pt))))
-
- (rx/concat
- (->> stream'
- (rx/take-until stoper)
- (rx/map (fn [[point ctrl? index :as xxx]]
- (let [point (if ctrl?
- (as-> point $
- (gpt/subtract $ @last-point)
- (align-position (gpt/angle $) $)
- (gpt/add $ @last-point))
- point)]
- #(update-point-segment % index point)))))
- (rx/of finish-drawing-path
- handle-finish-drawing))))))))
-
-(def simplify-tolerance 0.3)
-
-(def handle-drawing-curve
- (letfn [(stoper-event? [{:keys [type shift] :as event}]
- (ms/mouse-event? event) (= type :up))
-
- (initialize-drawing [state]
- (assoc-in state [:workspace-drawing :object ::initialized?] true))
-
- (insert-point-segment [state point]
- (update-in state [:workspace-drawing :object :segments] (fnil conj []) point))
-
- (finish-drawing-curve [state]
- (update-in
- state [:workspace-drawing :object]
- (fn [shape]
- (-> shape
- (update :segments #(path/simplify % simplify-tolerance))
- (geom/update-path-selrect)))))]
-
- (ptk/reify ::handle-drawing-curve
- ptk/WatchEvent
- (watch [_ state stream]
- (let [{:keys [flags]} (:workspace-local state)
- stoper (rx/filter stoper-event? stream)
- mouse (rx/sample 10 ms/mouse-position)]
- (rx/concat
- (rx/of initialize-drawing)
- (->> mouse
- (rx/map (fn [pt] #(insert-point-segment % pt)))
- (rx/take-until stoper))
- (rx/of finish-drawing-curve
- handle-finish-drawing)))))))
-
-(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)
- (when (::initialized? shape)
- (let [shape-click-width (case (:type shape)
- :text 3
- 20)
- shape-click-height (case (:type shape)
- :text 16
- 20)
- shape (if (::click-draw? shape)
- (-> shape
- (assoc-in [:modifiers :resize-vector]
- (gpt/point shape-click-width shape-click-height))
- (assoc-in [:modifiers :resize-origin]
- (gpt/point (:x shape) (:y shape))))
- shape)
-
- shape (cond-> shape
- (= (:type shape) :text) (assoc :grow-type
- (if (::click-draw? shape) :auto-width :fixed)))
-
- shape (-> shape
- geom/transform-shape
- (dissoc ::initialized? ::click-draw?))]
- ;; Add & select the created shape to the workspace
- (rx/concat
- (if (= :text (:type shape))
- (rx/of dwc/start-undo-transaction)
- (rx/empty))
-
- (rx/of (dw/deselect-all)
- (dw/add-shape shape))))))))))
-
-(def close-drawing-path
- (ptk/reify ::close-drawing-path
- ptk/UpdateEvent
- (update [_ state]
- (assoc-in state [:workspace-drawing :object :close?] true))))
diff --git a/frontend/src/app/main/data/workspace/drawing/box.cljs b/frontend/src/app/main/data/workspace/drawing/box.cljs
new file mode 100644
index 000000000..bdcdb1aea
--- /dev/null
+++ b/frontend/src/app/main/data/workspace/drawing/box.cljs
@@ -0,0 +1,92 @@
+;; 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.main.data.workspace.drawing.box
+ (:require
+ [beicon.core :as rx]
+ [potok.core :as ptk]
+ [app.common.geom.point :as gpt]
+ [app.common.geom.shapes :as gsh]
+ [app.common.uuid :as uuid]
+ [app.common.pages-helpers :as cph]
+ [app.main.data.workspace.common :as dwc]
+ [app.main.snap :as snap]
+ [app.main.streams :as ms]
+ [app.main.data.workspace.drawing.common :as common]))
+
+(defn resize-shape [{:keys [x y width height] :as shape} point lock? point-snap]
+ (let [;; The new shape behaves like a resize on the bottom-right corner
+ initial (gpt/point (+ x width) (+ y height))
+ shapev (gpt/point width height)
+ deltav (gpt/to-vec initial point-snap)
+ scalev (gpt/divide (gpt/add shapev deltav) shapev)
+ scalev (if lock?
+ (let [v (max (:x scalev) (:y scalev))]
+ (gpt/point v v))
+ scalev)]
+ (-> shape
+ (assoc :click-draw? false)
+ (assoc-in [:modifiers :resize-vector] scalev)
+ (assoc-in [:modifiers :resize-origin] (gpt/point x y))
+ (assoc-in [:modifiers :resize-rotation] 0))))
+
+(defn update-drawing [state point lock? point-snap]
+ (update-in state [:workspace-drawing :object] resize-shape point lock? point-snap))
+
+(defn handle-drawing-box []
+ (ptk/reify ::handle-drawing-box
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [{:keys [flags]} (:workspace-local state)
+
+ stoper? #(or (ms/mouse-up? %) (= % :interrupt))
+ stoper (rx/filter stoper? stream)
+ initial @ms/mouse-position
+
+
+ page-id (:current-page-id state)
+ objects (dwc/lookup-page-objects state page-id)
+ layout (get state :workspace-layout)
+
+ frames (cph/select-frames objects)
+ fid (or (->> frames
+ (filter #(gsh/has-point? % initial))
+ first
+ :id)
+ uuid/zero)
+
+ shape (-> state
+ (get-in [:workspace-drawing :object])
+ (gsh/setup {:x (:x initial) :y (:y initial) :width 1 :height 1})
+ (assoc :frame-id fid)
+ (assoc :initialized? true)
+ (assoc :click-draw? true))]
+ (rx/concat
+ ;; Add shape to drawing state
+ (rx/of #(assoc-in state [:workspace-drawing :object] shape))
+
+ ;; Initial SNAP
+ (->> (snap/closest-snap-point page-id [shape] layout initial)
+ (rx/map (fn [{:keys [x y]}]
+ #(update-in % [:workspace-drawing :object] gsh/absolute-move (gpt/point x y))
+ )))
+
+ (->> ms/mouse-position
+ (rx/filter #(> (gpt/distance % initial) 2))
+ (rx/with-latest vector ms/mouse-position-ctrl)
+ (rx/switch-map
+ (fn [[point :as current]]
+ (->> (snap/closest-snap-point page-id [shape] layout point)
+ (rx/map #(conj current %)))))
+ (rx/map
+ (fn [[pt ctrl? point-snap]]
+ #(update-drawing % pt ctrl? point-snap)))
+
+ (rx/take-until stoper))
+ (rx/of common/handle-finish-drawing))))))
diff --git a/frontend/src/app/main/data/workspace/drawing/common.cljs b/frontend/src/app/main/data/workspace/drawing/common.cljs
new file mode 100644
index 000000000..424287b3f
--- /dev/null
+++ b/frontend/src/app/main/data/workspace/drawing/common.cljs
@@ -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.main.data.workspace.drawing.common
+ (:require
+ [beicon.core :as rx]
+ [potok.core :as ptk]
+ [app.common.geom.point :as gpt]
+ [app.common.geom.shapes :as gsh]
+ [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 clear-drawing)
+ (when (:initialized? shape)
+ (let [shape-click-width (case (:type shape)
+ :text 3
+ 20)
+ shape-click-height (case (:type shape)
+ :text 16
+ 20)
+ shape (if (:click-draw? shape)
+ (-> shape
+ (assoc-in [:modifiers :resize-vector]
+ (gpt/point shape-click-width shape-click-height))
+ (assoc-in [:modifiers :resize-origin]
+ (gpt/point (:x shape) (:y shape))))
+ shape)
+
+ shape (cond-> shape
+ (= (:type shape) :text) (assoc :grow-type
+ (if (:click-draw? shape) :auto-width :fixed)))
+
+ shape (-> shape
+ (gsh/transform-shape)
+ (dissoc :initialized? :click-draw?))]
+ ;; Add & select the created shape to the workspace
+ (rx/concat
+ (if (= :text (:type shape))
+ (rx/of dwc/start-undo-transaction)
+ (rx/empty))
+
+ (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
new file mode 100644
index 000000000..e06e7240d
--- /dev/null
+++ b/frontend/src/app/main/data/workspace/drawing/curve.cljs
@@ -0,0 +1,63 @@
+;; 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.main.data.workspace.drawing.curve
+ (:require
+ [beicon.core :as rx]
+ [potok.core :as ptk]
+ [app.common.geom.point :as gpt]
+ [app.common.geom.shapes :as gsh]
+ [app.common.geom.shapes.path :as gsp]
+ [app.main.streams :as ms]
+ [app.util.geom.path :as path]
+ [app.main.data.workspace.drawing.common :as common]))
+
+(def simplify-tolerance 0.3)
+
+(defn stoper-event? [{:keys [type shift] :as event}]
+ (ms/mouse-event? event) (= type :up))
+
+(defn initialize-drawing [state]
+ (assoc-in state [:workspace-drawing :object :initialized?] true))
+
+(defn insert-point-segment [state point]
+ (update-in state [:workspace-drawing :object :segments] (fnil conj []) point))
+
+(defn curve-to-path [{:keys [segments] :as shape}]
+ (let [content (gsp/segments->content segments)
+ selrect (gsh/content->selrect content)
+ points (gsh/rect->points selrect)]
+ (-> shape
+ (dissoc :segments)
+ (assoc :content content)
+ (assoc :selrect selrect)
+ (assoc :points points))))
+
+(defn finish-drawing-curve [state]
+ (update-in
+ state [:workspace-drawing :object]
+ (fn [shape]
+ (-> shape
+ (update :segments #(path/simplify % simplify-tolerance))
+ (curve-to-path)))))
+
+(defn handle-drawing-curve []
+ (ptk/reify ::handle-drawing-curve
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [{:keys [flags]} (:workspace-local state)
+ stoper (rx/filter stoper-event? stream)
+ mouse (rx/sample 10 ms/mouse-position)]
+ (rx/concat
+ (rx/of initialize-drawing)
+ (->> mouse
+ (rx/map (fn [pt] #(insert-point-segment % pt)))
+ (rx/take-until stoper))
+ (rx/of finish-drawing-curve
+ common/handle-finish-drawing))))))
diff --git a/frontend/src/app/main/data/workspace/drawing/path.cljs b/frontend/src/app/main/data/workspace/drawing/path.cljs
new file mode 100644
index 000000000..024e6baee
--- /dev/null
+++ b/frontend/src/app/main/data/workspace/drawing/path.cljs
@@ -0,0 +1,688 @@
+;; 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.main.data.workspace.drawing.path
+ (:require
+ [beicon.core :as rx]
+ [potok.core :as ptk]
+ [app.common.math :as mth]
+ [app.common.data :as d]
+ [app.common.geom.point :as gpt]
+ [app.common.geom.shapes :as gsh]
+ [app.util.data :as ud]
+ [app.common.data :as cd]
+ [app.util.geom.path :as ugp]
+ [app.main.streams :as ms]
+ [app.main.data.workspace.common :as dwc]
+ [app.main.data.workspace.drawing.common :as common]
+ [app.common.geom.shapes.path :as gsp]))
+
+;; CONSTANTS
+(defonce enter-keycode 13)
+
+
+;; PRIVATE METHODS
+
+(defn get-path-id
+ "Retrieves the currently editing path id"
+ [state]
+ (or (get-in state [:workspace-local :edition])
+ (get-in state [:workspace-drawing :object :id])))
+
+(defn get-path
+ "Retrieves the location of the path object and additionaly can pass
+ the arguments. This location can be used in get-in, assoc-in... functions"
+ [state & path]
+ (let [edit-id (get-in state [:workspace-local :edition])
+ page-id (:current-page-id state)]
+ (cd/concat
+ (if edit-id
+ [:workspace-data :pages-index page-id :objects edit-id]
+ [:workspace-drawing :object])
+ path)))
+
+(defn update-selrect
+ "Updates the selrect and points for a path"
+ [shape]
+ (let [selrect (gsh/content->selrect (:content shape))
+ points (gsh/rect->points selrect)]
+ (assoc shape :points points :selrect selrect)))
+
+(defn next-node
+ "Calculates the next-node to be inserted."
+ [shape position prev-point prev-handler]
+ (let [last-command (-> shape :content last :command)
+ add-line? (and prev-point (not prev-handler) (not= last-command :close-path))
+ add-curve? (and prev-point prev-handler (not= last-command :close-path))]
+ (cond
+ add-line? {:command :line-to
+ :params position}
+ add-curve? {:command :curve-to
+ :params (ugp/make-curve-params position prev-handler)}
+ :else {:command :move-to
+ :params position})))
+
+(defn append-node
+ "Creates a new node in the path. Usualy used when drawing."
+ [shape position prev-point prev-handler]
+ (let [command (next-node shape position prev-point prev-handler)]
+ (-> shape
+ (update :content (fnil conj []) command)
+ (update-selrect))))
+
+(defn move-handler-modifiers [content index prefix match-opposite? dx dy]
+ (let [[cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])
+ [ocx ocy] (if (= prefix :c1) [:c2x :c2y] [:c1x :c1y])
+ opposite-index (ugp/opposite-index content index prefix)]
+
+ (cond-> {}
+ :always
+ (update index assoc cx dx cy dy)
+
+ (and match-opposite? opposite-index)
+ (update opposite-index assoc ocx (- dx) ocy (- dy)))))
+
+(defn end-path-event? [{:keys [type shift] :as event}]
+ (or (= event ::end-path)
+ (= (ptk/type event) :esc-pressed)
+ (= event :interrupt) ;; ESC
+ (and (ms/keyboard-event? event)
+ (= type :down)
+ ;; TODO: Enter now finish path but can finish drawing/editing as well
+ (= enter-keycode (:key event)))))
+
+
+;; EVENTS
+
+(defn init-path [id]
+ (ptk/reify ::init-path))
+
+(defn finish-path [id]
+ (ptk/reify ::finish-path
+ ptk/UpdateEvent
+ (update [_ state]
+ (-> state
+ (update-in [:workspace-local :edit-path id] dissoc :last-point :prev-handler :drag-handler :preview)))))
+
+(defn preview-next-point [{:keys [x y]}]
+ (ptk/reify ::preview-next-point
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (get-path-id state)
+ position (gpt/point x y)
+ shape (get-in state (get-path state))
+ {:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id])
+
+ command (next-node shape position last-point prev-handler)]
+ (assoc-in state [:workspace-local :edit-path id :preview] command)))))
+
+(defn add-node [{:keys [x y]}]
+ (ptk/reify ::add-node
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (get-path-id state)
+ position (gpt/point x y)
+ {:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id])]
+ (-> state
+ (assoc-in [:workspace-local :edit-path id :last-point] position)
+ (update-in [:workspace-local :edit-path id] dissoc :prev-handler)
+ (update-in (get-path state) append-node position last-point prev-handler))))))
+
+(defn start-drag-handler []
+ (ptk/reify ::start-drag-handler
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [content (get-in state (get-path state :content))
+ index (dec (count content))
+ command (get-in state (get-path state :content index :command))
+
+ make-curve
+ (fn [command]
+ (let [params (ugp/make-curve-params
+ (get-in content [index :params])
+ (get-in content [(dec index) :params]))]
+ (-> command
+ (assoc :command :curve-to :params params))))]
+
+ (cond-> state
+ (= command :line-to)
+ (update-in (get-path state :content index) make-curve))))))
+
+(defn drag-handler [{:keys [x y]}]
+ (ptk/reify ::drag-handler
+ ptk/UpdateEvent
+ (update [_ state]
+
+ (let [id (get-path-id state)
+ handler-position (gpt/point x y)
+ shape (get-in state (get-path state))
+ content (:content shape)
+ index (dec (count content))
+ node-position (ugp/command->point (nth content index))
+ {dx :x dy :y} (gpt/subtract handler-position node-position)
+ match-opposite? true
+ modifiers (move-handler-modifiers content (inc index) :c1 match-opposite? dx dy)]
+ (-> state
+ (assoc-in [:workspace-local :edit-path id :content-modifiers] modifiers)
+ (assoc-in [:workspace-local :edit-path id :prev-handler] handler-position)
+ (assoc-in [:workspace-local :edit-path id :drag-handler] handler-position))))))
+
+(defn finish-drag []
+ (ptk/reify ::finish-drag
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (get-path-id state)
+ modifiers (get-in state [:workspace-local :edit-path id :content-modifiers])
+ handler (get-in state [:workspace-local :edit-path id :drag-handler])]
+ (-> state
+ (update-in (get-path state :content) ugp/apply-content-modifiers modifiers)
+ (update-in [:workspace-local :edit-path id] dissoc :drag-handler)
+ (update-in [:workspace-local :edit-path id] dissoc :content-modifiers)
+ (assoc-in [:workspace-local :edit-path id :prev-handler] handler)
+ (update-in (get-path state) update-selrect))))
+
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [id (get-path-id state)
+ handler (get-in state [:workspace-local :edit-path id :prev-handler])]
+ ;; Update the preview because can be outdated after the dragging
+ (rx/of (preview-next-point handler))))))
+
+(defn close-path [position]
+ (ptk/reify ::close-path
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (rx/of (add-node position)
+ ::end-path))))
+
+(defn close-path-drag-start [position]
+ (ptk/reify ::close-path-drag-start
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [zoom (get-in state [:workspace-local :zoom])
+ threshold (/ 5 zoom)
+ check-if-dragging
+ (fn [current-position]
+ (let [start (gpt/point position)
+ current (gpt/point current-position)]
+ (>= (gpt/distance start current) 100)))
+
+ stop-stream
+ (->> stream (rx/filter #(or (end-path-event? %)
+ (ms/mouse-up? %))))
+
+ position-stream
+ (->> ms/mouse-position
+ (rx/take-until stop-stream)
+ (rx/throttle 50))
+
+ drag-events-stream
+ (->> position-stream
+ (rx/map #(drag-handler %)))]
+
+
+ (rx/concat
+ (rx/of (close-path position))
+
+ (->> position-stream
+ (rx/filter check-if-dragging)
+ (rx/take 1)
+ (rx/merge-map
+ #(rx/concat
+ (rx/of (start-drag-handler))
+ drag-events-stream
+ (rx/of (finish-drag))))))))))
+
+(defn close-path-drag-end [position]
+ (ptk/reify ::close-path-drag-end))
+
+(defn path-pointer-enter [position]
+ (ptk/reify ::path-pointer-enter))
+
+(defn path-pointer-leave [position]
+ (ptk/reify ::path-pointer-leave))
+
+(defn start-path-from-point [position]
+ (ptk/reify ::start-path-from-point
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [mouse-up (->> stream (rx/filter #(or (end-path-event? %)
+ (ms/mouse-up? %))))
+ drag-events (->> ms/mouse-position
+ (rx/take-until mouse-up)
+ (rx/map #(drag-handler %)))]
+
+ (rx/concat (rx/of (add-node position))
+ (rx/of (start-drag-handler))
+ drag-events
+ (rx/of (finish-drag))))
+ )))
+
+;; EVENT STREAMS
+
+(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 #(or (end-path-event? %)
+ (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
+ (rx/of (add-node down-event))
+ (rx/of (start-drag-handler))
+ drag-events
+ (rx/of (finish-drag)))))))
+
+(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))))
+
+(defn make-node-events-stream
+ [stream]
+ (->> (rx/merge
+ (->> stream (rx/filter (ptk/type? ::close-path)))
+ (->> stream (rx/filter (ptk/type? ::close-path-drag-start))))
+ (rx/take 1)
+ (rx/merge-map #(rx/empty))))
+
+;; MAIN ENTRIES
+
+(defn handle-drawing-path
+ [id]
+ (ptk/reify ::handle-drawing-path
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (get-path-id state)]
+ (-> state
+ (assoc-in [:workspace-local :edit-path id :edit-mode] :draw))))
+
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [mouse-down (->> stream (rx/filter ms/mouse-down?))
+ end-path-events (->> stream (rx/filter end-path-event?))
+
+ ;; Mouse move preview
+ mousemove-events
+ (->> ms/mouse-position
+ (rx/take-until end-path-events)
+ (rx/throttle 50)
+ (rx/map #(preview-next-point %)))
+
+ ;; From mouse down we can have: click, drag and double click
+ mousedown-events
+ (->> mouse-down
+ (rx/take-until end-path-events)
+ (rx/throttle 50)
+ (rx/with-latest merge ms/mouse-position)
+
+ ;; We change to the stream that emits the first event
+ (rx/switch-map
+ #(rx/race (make-node-events-stream stream)
+ (make-click-stream stream %)
+ (make-drag-stream stream %)
+ (make-dbl-click-stream stream %))))]
+
+ (rx/concat
+ (rx/of (init-path id))
+ (rx/merge mousemove-events
+ mousedown-events)
+ (rx/of (finish-path id)))))))
+
+(defn stop-path-edit []
+ (ptk/reify ::stop-path-edit
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (get-in state [:workspace-local :edition])]
+ (update state :workspace-local dissoc :edit-path id)))))
+
+(defn start-path-edit
+ [id]
+ (ptk/reify ::start-path-edit
+ ptk/UpdateEvent
+ (update [_ state]
+ ;; Only edit if the object has been created
+ (if-let [id (get-in state [:workspace-local :edition])]
+ (assoc-in state [:workspace-local :edit-path id] {:edit-mode :move
+ :selected #{}
+ :snap-toggled true})
+ state))
+
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (->> stream
+ (rx/filter #(= % :interrupt))
+ (rx/take 1)
+ (rx/map #(stop-path-edit))))))
+
+(defn modify-point [index prefix dx dy]
+ (ptk/reify ::modify-point
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (get-in state [:workspace-local :edition])
+ [cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])]
+ (-> state
+ (update-in [:workspace-local :edit-path id :content-modifiers (inc index)] assoc
+ :c1x dx :c1y dy)
+ (update-in [:workspace-local :edit-path id :content-modifiers index] assoc
+ :x dx :y dy :c2x dx :c2y dy)
+ )))))
+
+(defn modify-handler [id index prefix dx dy match-opposite?]
+ (ptk/reify ::modify-point
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [content (get-in state (get-path state :content))
+ [cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])
+ [ocx ocy] (if (= prefix :c1) [:c2x :c2y] [:c1x :c1y])
+ opposite-index (ugp/opposite-index content index prefix)]
+ (cond-> state
+ :always
+ (update-in [:workspace-local :edit-path id :content-modifiers index] assoc
+ cx dx cy dy)
+
+ (and match-opposite? opposite-index)
+ (update-in [:workspace-local :edit-path id :content-modifiers opposite-index] assoc
+ ocx (- dx) ocy (- dy)))))))
+
+(defn apply-content-modifiers []
+ (ptk/reify ::apply-content-modifiers
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [id (get-in state [:workspace-local :edition])
+ page-id (:current-page-id state)
+ shape (get-in state [:workspace-data :pages-index page-id :objects id])
+ {old-content :content old-selrect :selrect old-points :points} shape
+ content-modifiers (get-in state [:workspace-local :edit-path id :content-modifiers] {})
+ new-content (ugp/apply-content-modifiers old-content content-modifiers)
+ new-selrect (gsh/content->selrect new-content)
+ new-points (gsh/rect->points new-selrect)
+
+ rch [{:type :mod-obj
+ :id id
+ :page-id page-id
+ :operations [{:type :set :attr :content :val new-content}
+ {:type :set :attr :selrect :val new-selrect}
+ {:type :set :attr :points :val new-points}]}
+ {:type :reg-objects
+ :page-id page-id
+ :shapes [id]}]
+
+ uch [{:type :mod-obj
+ :id id
+ :page-id page-id
+ :operations [{:type :set :attr :content :val old-content}
+ {:type :set :attr :selrect :val old-selrect}
+ {:type :set :attr :points :val old-points}]}
+ {:type :reg-objects
+ :page-id page-id
+ :shapes [id]}]]
+
+ (rx/of (dwc/commit-changes rch uch {:commit-local? true})
+ (fn [state] (update-in state [:workspace-local :edit-path id] dissoc :content-modifiers)))))))
+
+(defn save-path-content []
+ (ptk/reify ::save-path-content
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [id (get-in state [:workspace-local :edition])
+ page-id (:current-page-id state)
+ old-content (get-in state [:workspace-local :edit-path id :old-content])
+ old-selrect (gsh/content->selrect old-content)
+ old-points (gsh/rect->points old-content)
+ shape (get-in state [:workspace-data :pages-index page-id :objects id])
+ {new-content :content new-selrect :selrect new-points :points} shape
+
+ rch [{:type :mod-obj
+ :id id
+ :page-id page-id
+ :operations [{:type :set :attr :content :val new-content}
+ {:type :set :attr :selrect :val new-selrect}
+ {:type :set :attr :points :val new-points}]}
+ {:type :reg-objects
+ :page-id page-id
+ :shapes [id]}]
+
+ uch [{:type :mod-obj
+ :id id
+ :page-id page-id
+ :operations [{:type :set :attr :content :val old-content}
+ {:type :set :attr :selrect :val old-selrect}
+ {:type :set :attr :points :val old-points}]}
+ {:type :reg-objects
+ :page-id page-id
+ :shapes [id]}]]
+
+ (rx/of (dwc/commit-changes rch uch {:commit-local? true}))))))
+
+(declare start-draw-mode)
+(defn check-changed-content []
+ (ptk/reify ::check-changed-content
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [id (get-path-id state)
+ content (get-in state (get-path state :content))
+ old-content (get-in state [:workspace-local :edit-path id :old-content])
+ mode (get-in state [:workspace-local :edit-path id :edit-mode])]
+
+ (cond
+ (not= content old-content) (rx/of (save-path-content)
+ (start-draw-mode))
+ (= mode :draw) (rx/of :interrupt)
+ :else (rx/of (finish-path id)))))))
+
+(defn move-path-point [start-point end-point]
+ (ptk/reify ::move-point
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (get-path-id state)
+ content (get-in state (get-path state :content))
+
+ {dx :x dy :y} (gpt/subtract end-point start-point)
+
+ handler-indices (-> (ugp/content->handlers content)
+ (get start-point))
+
+ command-for-point (fn [[index command]]
+ (let [point (ugp/command->point command)]
+ (= point start-point)))
+
+ point-indices (->> (d/enumerate content)
+ (filter command-for-point)
+ (map first))
+
+
+ point-reducer (fn [modifiers index]
+ (-> modifiers
+ (assoc-in [index :x] dx)
+ (assoc-in [index :y] dy)))
+
+ handler-reducer (fn [modifiers [index prefix]]
+ (let [cx (ud/prefix-keyword prefix :x)
+ cy (ud/prefix-keyword prefix :y)]
+ (-> modifiers
+ (assoc-in [index cx] dx)
+ (assoc-in [index cy] dy))))
+
+ modifiers (as-> (get-in state [:workspace-local :edit-path id :content-modifiers] {}) $
+ (reduce point-reducer $ point-indices)
+ (reduce handler-reducer $ handler-indices))]
+
+ (assoc-in state [:workspace-local :edit-path id :content-modifiers] modifiers)))))
+
+(defn start-move-path-point
+ [position]
+ (ptk/reify ::start-move-path-point
+ ptk/WatchEvent
+ ;; TODO REWRITE
+ (watch [_ state stream]
+ (let [stopper (->> stream (rx/filter ms/mouse-up?))]
+ (rx/concat
+ (->> ms/mouse-position
+ (rx/take-until stopper)
+ (rx/map #(move-path-point position %)))
+ (rx/of (apply-content-modifiers)))))))
+
+(defn start-move-handler
+ [index prefix]
+ (ptk/reify ::start-move-handler
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [id (get-in state [:workspace-local :edition])
+ [cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])
+ start-point @ms/mouse-position
+ start-delta-x (get-in state [:workspace-local :edit-path id :content-modifiers index cx] 0)
+ start-delta-y (get-in state [:workspace-local :edit-path id :content-modifiers index cy] 0)]
+
+ (rx/concat
+ (->> ms/mouse-position
+ (rx/take-until (->> stream (rx/filter ms/mouse-up?)))
+ (rx/with-latest vector ms/mouse-position-alt)
+ (rx/map
+ (fn [[pos alt?]]
+ (modify-handler
+ id
+ index
+ prefix
+ (+ start-delta-x (- (:x pos) (:x start-point)))
+ (+ start-delta-y (- (:y pos) (:y start-point)))
+ (not alt?))))
+ )
+ (rx/concat (rx/of (apply-content-modifiers))))))))
+
+(defn start-draw-mode []
+ (ptk/reify ::start-draw-mode
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (get-in state [:workspace-local :edition])
+ page-id (:current-page-id state)
+ old-content (get-in state [:workspace-data :pages-index page-id :objects id :content])]
+ (-> state
+ (assoc-in [:workspace-local :edit-path id :old-content] old-content))))
+
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [id (get-in state [:workspace-local :edition])
+ edit-mode (get-in state [:workspace-local :edit-path id :edit-mode])]
+ (if (= :draw edit-mode)
+ (rx/concat
+ (rx/of (handle-drawing-path id))
+ (->> stream
+ (rx/filter (ptk/type? ::finish-path))
+ (rx/take 1)
+ (rx/merge-map #(rx/of (check-changed-content)))))
+ (rx/empty))))))
+
+(defn change-edit-mode [mode]
+ (ptk/reify ::change-edit-mode
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (get-in state [:workspace-local :edition])]
+ (cond-> state
+ id (assoc-in [:workspace-local :edit-path id :edit-mode] mode))))
+
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [id (get-path-id state)]
+ (cond
+ (and id (= :move mode)) (rx/of ::end-path)
+ (and id (= :draw mode)) (rx/of (start-draw-mode))
+ :else (rx/empty))))))
+
+(defn select-handler [index type]
+ (ptk/reify ::select-handler
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (get-in state [:workspace-local :edition])]
+ (-> state
+ (update-in [:workspace-local :edit-path id :selected] (fnil conj #{}) [index type]))))))
+
+(defn select-node [position]
+ (ptk/reify ::select-node
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (get-in state [:workspace-local :edition])]
+ (-> state
+ (update-in [:workspace-local :edit-path id :selected-node] (fnil conj #{}) position))))))
+
+(defn deselect-node [position]
+ (ptk/reify ::deselect-node
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (get-in state [:workspace-local :edition])]
+ (-> state
+ (update-in [:workspace-local :edit-path id :selected-node] (fnil disj #{}) position))))))
+
+(defn add-to-selection-handler [index type]
+ (ptk/reify ::add-to-selection-handler
+ ptk/UpdateEvent
+ (update [_ state]
+ state)))
+
+(defn add-to-selection-node [index]
+ (ptk/reify ::add-to-selection-node
+ ptk/UpdateEvent
+ (update [_ state]
+ state)))
+
+(defn remove-from-selection-handler [index]
+ (ptk/reify ::remove-from-selection-handler
+ ptk/UpdateEvent
+ (update [_ state]
+ state)))
+
+(defn remove-from-selection-node [index]
+ (ptk/reify ::remove-from-selection-handler
+ ptk/UpdateEvent
+ (update [_ state]
+ state)))
+
+(defn handle-new-shape-result [shape-id]
+ (ptk/reify ::handle-new-shape-result
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [content (get-in state [:workspace-drawing :object :content] [])]
+ (if (> (count content) 1)
+ (assoc-in state [:workspace-drawing :object :initialized?] true)
+ state)))
+
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (->> (rx/of common/handle-finish-drawing
+ (dwc/start-edition-mode shape-id)
+ (start-path-edit shape-id)
+ (change-edit-mode :draw))))))
+
+(defn handle-new-shape
+ "Creates a new path shape"
+ []
+ (ptk/reify ::handle-new-shape
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [shape-id (get-in state [:workspace-drawing :object :id])]
+ (rx/concat
+ (rx/of (handle-drawing-path shape-id))
+ (->> stream
+ (rx/filter (ptk/type? ::finish-path))
+ (rx/take 1)
+ (rx/observe-on :async)
+ (rx/map #(handle-new-shape-result shape-id))))))))
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/texts.cljs b/frontend/src/app/main/data/workspace/texts.cljs
index 34616e94c..c13a6dda2 100644
--- a/frontend/src/app/main/data/workspace/texts.cljs
+++ b/frontend/src/app/main/data/workspace/texts.cljs
@@ -17,6 +17,7 @@
[goog.object :as gobj]
[potok.core :as ptk]
[app.common.geom.shapes :as geom]
+ [app.common.attrs :as attrs]
[app.main.data.workspace.common :as dwc]
[app.main.fonts :as fonts]
[app.util.object :as obj]
@@ -125,7 +126,7 @@
(map #(if (is-text-node? %)
(merge ut/default-text-attrs %)
%)))]
- (geom/get-attrs-multi nodes attrs)))
+ (attrs/get-attrs-multi nodes attrs)))
(defn current-text-values
[{:keys [editor default attrs shape]}]
diff --git a/frontend/src/app/main/data/workspace/transforms.cljs b/frontend/src/app/main/data/workspace/transforms.cljs
index 56985d95c..6c203d643 100644
--- a/frontend/src/app/main/data/workspace/transforms.cljs
+++ b/frontend/src/app/main/data/workspace/transforms.cljs
@@ -80,10 +80,11 @@
(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)
+ rotation (if (= :path (:type shape)) 0 rotation)
;; Vector modifiers depending on the handler
handler-modif (let [[x y] (handler-modifiers handler)] (gpt/point x y))
@@ -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 cf8a129dd..38721a84c 100644
--- a/frontend/src/app/main/exports.cljs
+++ b/frontend/src/app/main/exports.cljs
@@ -15,7 +15,8 @@
[app.common.pages :as cp]
[app.common.pages-helpers :as cph]
[app.common.math :as mth]
- [app.common.geom.shapes :as geom]
+ [app.common.geom.shapes :as gsh]
+ [app.common.geom.align :as gal]
[app.common.geom.point :as gpt]
[app.common.geom.matrix :as gmt]
[app.main.ui.shapes.filters :as filters]
@@ -42,9 +43,9 @@
(defn- calculate-dimensions
[{:keys [objects] :as data} vport]
(let [shapes (cph/select-toplevel-shapes objects {:include-frames? true})]
- (->> (geom/selection-rect shapes)
- (geom/adjust-to-viewport vport)
- (geom/fix-invalid-rect-values))))
+ (->> (gsh/selection-rect shapes)
+ (gal/adjust-to-viewport vport)
+ #_(gsh/fix-invalid-rect-values))))
(declare shape-wrapper-factory)
@@ -55,7 +56,7 @@
(mf/fnc frame-wrapper
[{:keys [shape] :as props}]
(let [childs (mapv #(get objects %) (:shapes shape))
- shape (geom/transform-shape shape)]
+ shape (gsh/transform-shape shape)]
[:> shape-container {:shape shape}
[:& frame-shape {:shape shape :childs childs}]]))))
@@ -78,11 +79,11 @@
(let [group-wrapper (mf/use-memo (mf/deps objects) #(group-wrapper-factory objects))
frame-wrapper (mf/use-memo (mf/deps objects) #(frame-wrapper-factory objects))]
(when (and shape (not (:hidden shape)))
- (let [shape (geom/transform-shape frame shape)
+ (let [shape (-> (gsh/transform-shape shape)
+ (gsh/translate-to-frame frame))
opts #js {:shape shape}]
[:> shape-container {:shape shape}
(case (:type shape)
- :curve [:> path/path-shape opts]
:text [:> text/text-shape opts]
:rect [:> rect/rect-shape opts]
:path [:> path/path-shape opts]
diff --git a/frontend/src/app/main/snap.cljs b/frontend/src/app/main/snap.cljs
index 384302179..e20db5f63 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))]
@@ -195,7 +195,7 @@
(or (filter-shapes id)
(not (contains? layout :dynamic-alignment)))))
shape (if (> (count shapes) 1)
- (->> shapes (map gsh/transform-shape) gsh/selection-rect)
+ (->> shapes (map gsh/transform-shape) gsh/selection-rect (gsh/setup {:type :rect}))
(->> shapes (first)))
shapes-points (->> shape
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/streams.cljs b/frontend/src/app/main/streams.cljs
index cc5c720c9..597f89223 100644
--- a/frontend/src/app/main/streams.cljs
+++ b/frontend/src/app/main/streams.cljs
@@ -26,6 +26,11 @@
[v]
(instance? MouseEvent v))
+(defn mouse-down?
+ [v]
+ (and (mouse-event? v)
+ (= :down (:type v))))
+
(defn mouse-up?
[v]
(and (mouse-event? v)
@@ -36,6 +41,11 @@
(and (mouse-event? v)
(= :click (:type v))))
+(defn mouse-double-click?
+ [v]
+ (and (mouse-event? v)
+ (= :double-click (:type v))))
+
(defrecord PointerEvent [source pt ctrl shift alt])
(defn pointer-event?
diff --git a/frontend/src/app/main/ui/cursors.clj b/frontend/src/app/main/ui/cursors.clj
index 414297d11..d7ed83b71 100644
--- a/frontend/src/app/main/ui/cursors.clj
+++ b/frontend/src/app/main/ui/cursors.clj
@@ -19,6 +19,7 @@
(def default-hotspot-x 12)
(def default-hotspot-y 12)
(def default-rotation 0)
+(def default-height 20)
(defn parse-svg [svg-data]
(-> svg-data
@@ -53,25 +54,27 @@
(str/replace #"\s+$" "")))
(defn encode-svg-cursor
- [id rotation x y]
+ [id rotation x y height]
(let [svg-path (str cursor-folder "/" (name id) ".svg")
data (-> svg-path io/resource slurp parse-svg uri/percent-encode)
transform (if rotation (str " transform='rotate(" rotation ")'") "")
data (clojure.pprint/cl-format
nil
- "url(\"data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 16 16' width='20px' height='20px'~A%3E~A%3C/svg%3E\") ~A ~A, auto"
- transform data x y)]
+ "url(\"data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 16 16' width='20px' height='~Apx'~A%3E~A%3C/svg%3E\") ~A ~A, auto"
+ height transform data x y )]
data))
(defmacro cursor-ref
"Creates a static cursor given its name, rotation and x/y hotspot"
- ([id] (encode-svg-cursor id default-rotation default-hotspot-x default-hotspot-y))
- ([id rotation] (encode-svg-cursor id rotation default-hotspot-x default-hotspot-y))
- ([id rotation x y] (encode-svg-cursor id rotation x y)))
+ ([id] (encode-svg-cursor id default-rotation default-hotspot-x default-hotspot-y default-height))
+ ([id rotation] (encode-svg-cursor id rotation default-hotspot-x default-hotspot-y default-height))
+ ([id rotation x y] (encode-svg-cursor id rotation x y default-height))
+ ([id rotation x y height] (encode-svg-cursor id rotation x y height))
+ )
(defmacro cursor-fn
"Creates a dynamic cursor that can be rotated in runtime"
[id initial]
- (let [cursor (encode-svg-cursor id "{{rotation}}" default-hotspot-x default-hotspot-y)]
+ (let [cursor (encode-svg-cursor id "{{rotation}}" default-hotspot-x default-hotspot-y default-height)]
`(fn [rot#]
(str/replace ~cursor "{{rotation}}" (+ ~initial rot#)))))
diff --git a/frontend/src/app/main/ui/cursors.cljs b/frontend/src/app/main/ui/cursors.cljs
index f7dd21fed..24028c30f 100644
--- a/frontend/src/app/main/ui/cursors.cljs
+++ b/frontend/src/app/main/ui/cursors.cljs
@@ -8,8 +8,7 @@
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.main.ui.cursors
- (:require-macros [app.main.ui.cursors :refer [cursor-ref
- cursor-fn]])
+ (:require-macros [app.main.ui.cursors :refer [cursor-ref cursor-fn]])
(:require [rumext.alpha :as mf]
[cuerdas.core :as str]
[app.util.timers :as ts]))
@@ -33,6 +32,10 @@
(def rotate (cursor-fn :rotate 90))
(def text (cursor-ref :text))
(def picker (cursor-ref :picker 0 0 24))
+(def pointer-node (cursor-ref :pointer-node 0 0 10 32))
+(def pointer-move (cursor-ref :pointer-move 0 0 10 42))
+(def pen-node (cursor-ref :pen-node 0 0 10 36))
+(def comments (cursor-ref :comments 0 2 20))
(mf/defc debug-preview
{::mf/wrap-props false}
@@ -49,7 +52,9 @@
[:div {:style {:width "100px"
:height "100px"
:background-image (-> value (str/replace #"(url\(.*\)).*" "$1"))
- :background-size "cover"
+ :background-size "contain"
+ :background-repeat "no-repeat"
+ :background-position "center"
:cursor value}}]
[:span {:style {:white-space "nowrap"
diff --git a/frontend/src/app/main/ui/handoff/attributes.cljs b/frontend/src/app/main/ui/handoff/attributes.cljs
index 487396f0a..4cf91cafb 100644
--- a/frontend/src/app/main/ui/handoff/attributes.cljs
+++ b/frontend/src/app/main/ui/handoff/attributes.cljs
@@ -28,7 +28,6 @@
:rect [:layout :fill :stroke :shadow :blur]
:circle [:layout :fill :stroke :shadow :blur]
:path [:layout :fill :stroke :shadow :blur]
- :curve [:layout :fill :stroke :shadow :blur]
:image [:image :layout :shadow :blur]
:text [:layout :text :shadow :blur]})
diff --git a/frontend/src/app/main/ui/handoff/render.cljs b/frontend/src/app/main/ui/handoff/render.cljs
index 26e0c8d5d..714abbc6e 100644
--- a/frontend/src/app/main/ui/handoff/render.cljs
+++ b/frontend/src/app/main/ui/handoff/render.cljs
@@ -122,11 +122,11 @@
(mf/deps objects)
#(group-container-factory objects))]
(when (and shape (not (:hidden shape)))
- (let [shape (geom/transform-shape frame shape)
+ (let [shape (-> (geom/transform-shape shape)
+ (geom/translate-to-frame frame))
opts #js {:shape shape
:frame frame}]
(case (:type shape)
- :curve [:> path-wrapper opts]
:text [:> text-wrapper opts]
:rect [:> rect-wrapper opts]
:path [:> path-wrapper opts]
diff --git a/frontend/src/app/main/ui/icons.cljs b/frontend/src/app/main/ui/icons.cljs
index 5f9fc0705..f620afd84 100644
--- a/frontend/src/app/main/ui/icons.cljs
+++ b/frontend/src/app/main/ui/icons.cljs
@@ -128,6 +128,16 @@
(def checkbox-checked (icon-xref :checkbox-checked))
(def checkbox-unchecked (icon-xref :checkbox-unchecked))
(def code (icon-xref :code))
+(def nodes-add (icon-xref :nodes-add))
+(def nodes-corner (icon-xref :nodes-corner))
+(def nodes-curve (icon-xref :nodes-curve))
+(def nodes-join (icon-xref :nodes-join))
+(def nodes-merge (icon-xref :nodes-merge))
+(def nodes-remove (icon-xref :nodes-remove))
+(def nodes-separate (icon-xref :nodes-separate))
+(def nodes-snap (icon-xref :nodes-snap))
+(def pen (icon-xref :pen))
+(def pointer-inner (icon-xref :pointer-inner))
(def loader-pencil
(mf/html
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..85a0e0cd2 100644
--- a/frontend/src/app/main/ui/shapes/path.cljs
+++ b/frontend/src/app/main/ui/shapes/path.cljs
@@ -15,40 +15,21 @@
[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
-(defn- render-path
- [{:keys [segments close?] :as shape}]
- (let [numsegs (count segments)]
- (loop [buffer []
- index 0]
- (cond
- (>= index numsegs)
- (if close?
- (str/join " " (conj buffer "Z"))
- (str/join " " buffer))
-
- (zero? index)
- (let [{:keys [x y] :as segment} (nth segments index)
- buffer (conj buffer (str/istr "M~{x},~{y}"))]
- (recur buffer (inc index)))
-
- :else
- (let [{:keys [x y] :as segment} (nth segments index)
- buffer (conj buffer (str/istr "L~{x},~{y}"))]
- (recur buffer (inc index)))))))
-
(mf/defc path-shape
{::mf/wrap-props false}
[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 (ugp/content->path (:content shape))
props (-> (attrs/extract-style-attrs shape)
(obj/merge!
#js {:transform transform
diff --git a/frontend/src/app/main/ui/viewer/shapes.cljs b/frontend/src/app/main/ui/viewer/shapes.cljs
index 8cca3ce1e..211c50b1f 100644
--- a/frontend/src/app/main/ui/viewer/shapes.cljs
+++ b/frontend/src/app/main/ui/viewer/shapes.cljs
@@ -149,10 +149,10 @@
shape (unchecked-get props "shape")
frame (unchecked-get props "frame")]
(when (and shape (not (:hidden shape)))
- (let [shape (geom/transform-shape frame shape)
+ (let [shape (-> (geom/transform-shape shape)
+ (geom/translate-to-frame frame))
opts #js {:shape shape}]
(case (:type shape)
- :curve [:> path-wrapper opts]
:text [:> text-wrapper opts]
:rect [:> rect-wrapper opts]
:path [:> path-wrapper opts]
diff --git a/frontend/src/app/main/ui/workspace.cljs b/frontend/src/app/main/ui/workspace.cljs
index ea77a68b9..dfca19099 100644
--- a/frontend/src/app/main/ui/workspace.cljs
+++ b/frontend/src/app/main/ui/workspace.cljs
@@ -29,7 +29,7 @@
[app.main.ui.workspace.rules :refer [horizontal-rule vertical-rule]]
[app.main.ui.workspace.scroll :as scroll]
[app.main.ui.workspace.sidebar :refer [left-sidebar right-sidebar]]
- [app.main.ui.workspace.viewport :refer [viewport coordinates]]
+ [app.main.ui.workspace.viewport :refer [viewport viewport-actions coordinates]]
[app.util.dom :as dom]
[beicon.core :as rx]
[cuerdas.core :as str]
@@ -65,6 +65,7 @@
(when (contains? layout :rules)
[:& workspace-rules {:local local}])
+ [:& viewport-actions]
[:& viewport {:file file
:local local
:layout layout}]]]
diff --git a/frontend/src/app/main/ui/workspace/drawarea.cljs b/frontend/src/app/main/ui/workspace/drawarea.cljs
index 33143af7f..5cb752341 100644
--- a/frontend/src/app/main/ui/workspace/drawarea.cljs
+++ b/frontend/src/app/main/ui/workspace/drawarea.cljs
@@ -12,6 +12,7 @@
[app.main.data.workspace.drawing :as dd]
[app.main.store :as st]
[app.main.ui.workspace.shapes :as shapes]
+ [app.main.ui.workspace.shapes.path :refer [path-editor]]
[app.common.geom.shapes :as gsh]
[app.common.data :as d]
[app.util.dom :as dom]
@@ -22,10 +23,13 @@
(mf/defc draw-area
[{:keys [shape zoom] :as props}]
- (when (:id shape)
- (case (:type shape)
- (:path :curve) [:& path-draw-area {:shape shape}]
- [:& generic-draw-area {:shape shape :zoom zoom}])))
+
+ [:g.draw-area
+ [:& shapes/shape-wrapper {:shape shape}]
+
+ (case (:type shape)
+ :path [:& path-editor {:shape shape :zoom zoom}]
+ #_:default [:& generic-draw-area {:shape shape :zoom zoom}])])
(mf/defc generic-draw-area
[{:keys [shape zoom]}]
@@ -34,43 +38,10 @@
(not (d/nan? x))
(not (d/nan? y)))
- [:g
- [:& shapes/shape-wrapper {:shape shape}]
- [:rect.main {:x x :y y
- :width width
- :height height
- :style {:stroke "#1FDEA7"
- :fill "transparent"
- :stroke-width (/ 1 zoom)}}]])))
+ [:rect.main {:x x :y y
+ :width width
+ :height height
+ :style {:stroke "#1FDEA7"
+ :fill "transparent"
+ :stroke-width (/ 1 zoom)}}])))
-(mf/defc path-draw-area
- [{:keys [shape] :as props}]
- (let [locale (i18n/use-locale)
-
- on-click
- (fn [event]
- (dom/stop-propagation event)
- (st/emit! (dw/assign-cursor-tooltip nil)
- dd/close-drawing-path
- :path/end-path-drawing))
-
- on-mouse-enter
- (fn [event]
- (let [msg (t locale "workspace.viewport.click-to-close-path")]
- (st/emit! (dw/assign-cursor-tooltip msg))))
-
- on-mouse-leave
- (fn [event]
- (st/emit! (dw/assign-cursor-tooltip nil)))]
-
- (when-let [{:keys [x y] :as segment} (first (:segments shape))]
- [:g
- [:& shapes/shape-wrapper {:shape shape}]
- (when (not= :curve (:type shape))
- [:circle.close-bezier
- {:cx x
- :cy y
- :r 5
- :on-click on-click
- :on-mouse-enter on-mouse-enter
- :on-mouse-leave on-mouse-leave}])])))
diff --git a/frontend/src/app/main/ui/workspace/selection.cljs b/frontend/src/app/main/ui/workspace/selection.cljs
index 4c149c3cb..54787f1e9 100644
--- a/frontend/src/app/main/ui/workspace/selection.cljs
+++ b/frontend/src/app/main/ui/workspace/selection.cljs
@@ -31,7 +31,8 @@
[app.common.geom.matrix :as gmt]
[app.util.debug :refer [debug?]]
[app.main.ui.workspace.shapes.outline :refer [outline]]
- [app.main.ui.measurements :as msr]))
+ [app.main.ui.measurements :as msr]
+ [app.main.ui.workspace.shapes.path :refer [path-editor]]))
(def rotation-handler-size 25)
(def resize-point-radius 4)
@@ -181,7 +182,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)]
@@ -214,44 +215,6 @@
:resize-side [:> resize-side-handler props])))])))
;; --- Selection Handlers (Component)
-(mf/defc path-edition-selection-handlers
- [{:keys [shape modifiers zoom color] :as props}]
- (letfn [(on-mouse-down [event index]
- (dom/stop-propagation event)
- ;; TODO: this need code ux refactor
- (let [stoper (get-edition-stream-stoper)
- stream (->> (ms/mouse-position-deltas @ms/mouse-position)
- (rx/take-until stoper))]
- ;; (when @refs/selected-alignment
- ;; (st/emit! (dw/initial-path-point-align (:id shape) index)))
- (rx/subscribe stream #(on-handler-move % index))))
-
- (get-edition-stream-stoper []
- (let [stoper? #(and (ms/mouse-event? %) (= (:type %) :up))]
- (rx/merge
- (rx/filter stoper? st/stream)
- (->> st/stream
- (rx/filter #(= % :interrupt))
- (rx/take 1)))))
-
- (on-handler-move [delta index]
- (st/emit! (dw/update-path (:id shape) index delta)))]
-
- (let [transform (geom/transform-matrix shape)
- displacement (:displacement modifiers)
- segments (cond->> (:segments shape)
- displacement (map #(gpt/transform % displacement)))]
- [:g.controls
- (for [[index {:keys [x y]}] (map-indexed vector segments)]
- (let [{:keys [x y]} (gpt/transform (gpt/point x y) transform)]
- [:circle {:cx x :cy y
- :r (/ 6.0 zoom)
- :key index
- :on-mouse-down #(on-mouse-down % index)
- :fill "#ffffff"
- :stroke color
- :style {:cursor cur/move-pointer}}]))])))
-
;; TODO: add specs for clarity
(mf/defc text-edition-selection-handlers
@@ -269,8 +232,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 (map geom/transform-shape))))
+ 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)
@@ -314,7 +277,7 @@
hover-id (when-not (= shape-id hover-id) hover-id)
hover-shape (mf/deref (refs/object-by-id hover-id))
- shape' (if (debug? :simple-selection) (geom/selection-rect [shape]) shape)
+ shape' (if (debug? :simple-selection) (geom/setup {:type :rect} (geom/selection-rect [shape])) shape)
on-resize (fn [current-position initial-position event]
(dom/stop-propagation event)
(st/emit! (dw/start-resize current-position initial-position #{shape-id} shape')))
@@ -322,7 +285,6 @@
on-rotate
#(do (dom/stop-propagation %)
(st/emit! (dw/start-rotate [shape])))]
-
[:*
[:& controls {:shape shape'
:zoom zoom
@@ -366,12 +328,11 @@
[:& text-edition-selection-handlers {:shape shape
:zoom zoom
:color color}]
- (and (or (= type :path)
- (= type :curve))
+
+ (and (= type :path)
(= edition (:id shape)))
- [:& path-edition-selection-handlers {:shape shape
- :zoom zoom
- :color color}]
+ [:& path-editor {:zoom zoom
+ :shape shape}]
:else
[:& single-selection-handlers {:shape shape
diff --git a/frontend/src/app/main/ui/workspace/shapes.cljs b/frontend/src/app/main/ui/workspace/shapes.cljs
index f0b8bc2b5..52cb95040 100644
--- a/frontend/src/app/main/ui/workspace/shapes.cljs
+++ b/frontend/src/app/main/ui/workspace/shapes.cljs
@@ -82,7 +82,8 @@
(let [shape (unchecked-get props "shape")
frame (unchecked-get props "frame")
ghost? (unchecked-get props "ghost?")
- shape (geom/transform-shape frame shape)
+ shape (-> (geom/transform-shape shape)
+ (geom/translate-to-frame frame))
opts #js {:shape shape
:frame frame}
alt? (mf/use-state false)
@@ -107,7 +108,6 @@
:on-mouse-leave on-mouse-leave
:style {:cursor (if @alt? cur/duplicate nil)}}
(case (:type shape)
- :curve [:> path/path-wrapper opts]
:path [:> path/path-wrapper opts]
:text [:> text/text-wrapper opts]
:group [:> group-wrapper opts]
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/shapes/common.cljs b/frontend/src/app/main/ui/workspace/shapes/common.cljs
index 302c0cf48..af268cd69 100644
--- a/frontend/src/app/main/ui/workspace/shapes/common.cljs
+++ b/frontend/src/app/main/ui/workspace/shapes/common.cljs
@@ -23,6 +23,7 @@
(defn- on-mouse-down
[event {:keys [id type] :as shape}]
(let [selected @refs/selected-shapes
+ edition @refs/selected-edition
selected? (contains? selected id)
drawing? @refs/selected-drawing-tool
button (.-which (.-nativeEvent event))]
@@ -35,9 +36,8 @@
nil
(= type :frame)
- (when selected?
- (dom/stop-propagation event)
- (st/emit! (dw/start-move-selected)))
+ (do (dom/stop-propagation event)
+ (st/emit! (dw/start-move-selected)))
:else
(do
@@ -50,7 +50,8 @@
(st/emit! (dw/deselect-all)))
(st/emit! (dw/select-shape id))))
- (st/emit! (dw/start-move-selected)))))))
+ (when (not= edition id)
+ (st/emit! (dw/start-move-selected))))))))
(defn on-context-menu
[event shape]
diff --git a/frontend/src/app/main/ui/workspace/shapes/frame.cljs b/frontend/src/app/main/ui/workspace/shapes/frame.cljs
index 433b22f3f..1d84fa620 100644
--- a/frontend/src/app/main/ui/workspace/shapes/frame.cljs
+++ b/frontend/src/app/main/ui/workspace/shapes/frame.cljs
@@ -131,7 +131,7 @@
(not (:hidden shape)))
[:g {:class (when selected? "selected")
:on-context-menu on-context-menu
- :on-double-click on-double-click
+ ;; :on-double-click on-double-click
:on-mouse-down on-mouse-down}
[:& frame-title {:frame shape
diff --git a/frontend/src/app/main/ui/workspace/shapes/outline.cljs b/frontend/src/app/main/ui/workspace/shapes/outline.cljs
index 361636e44..309bdc5ff 100644
--- a/frontend/src/app/main/ui/workspace/shapes/outline.cljs
+++ b/frontend/src/app/main/ui/workspace/shapes/outline.cljs
@@ -13,8 +13,8 @@
[app.common.geom.shapes :as gsh]
[app.util.object :as obj]
[rumext.util :refer [map->obj]]
- [app.main.ui.shapes.path :as path]
- [app.main.refs :as refs]))
+ [app.main.refs :as refs]
+ [app.util.geom.path :as ugp]))
(mf/defc outline
@@ -28,7 +28,7 @@
outline-type (case (:type shape)
:circle "ellipse"
- (:curve :path) "path"
+ :path "path"
"rect")
common {:fill "transparent"
@@ -44,8 +44,8 @@
:rx (/ width 2)
:ry (/ height 2)}
- (:curve :path)
- {:d (path/render-path shape)}
+ :path
+ {:d (ugp/content->path (:content shape))}
{:x x
:y y
diff --git a/frontend/src/app/main/ui/workspace/shapes/path.cljs b/frontend/src/app/main/ui/workspace/shapes/path.cljs
index 81fd43816..d7330361e 100644
--- a/frontend/src/app/main/ui/workspace/shapes/path.cljs
+++ b/frontend/src/app/main/ui/workspace/shapes/path.cljs
@@ -10,46 +10,290 @@
(ns app.main.ui.workspace.shapes.path
(:require
[rumext.alpha :as mf]
- [app.common.data :as d]
+ [okulary.core :as l]
+ [app.util.data :as d]
[app.util.dom :as dom]
[app.util.timers :as ts]
+ [app.main.refs :as refs]
[app.main.streams :as ms]
[app.main.constants :as c]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.data.workspace :as dw]
[app.main.data.workspace.drawing :as dr]
+ [app.main.data.workspace.drawing.path :as drp]
[app.main.ui.keyboard :as kbd]
[app.main.ui.shapes.path :as path]
[app.main.ui.shapes.filters :as filters]
[app.main.ui.shapes.shape :refer [shape-container]]
- [app.main.ui.workspace.shapes.common :as common]))
+ [app.main.ui.workspace.shapes.common :as common]
+ [app.util.geom.path :as ugp]
+ [app.common.geom.point :as gpt]
+ [app.main.ui.cursors :as cur]
+ [app.main.ui.icons :as i]))
+
+(def primary-color "#1FDEA7")
+(def secondary-color "#DB00FF")
+(def black-color "#000000")
+(def white-color "#FFFFFF")
+(def gray-color "#B1B2B5")
+
+(def current-edit-path-ref
+ (let [selfn (fn [local]
+ (let [id (:edition local)]
+ (get-in local [:edit-path id])))]
+ (l/derived selfn refs/workspace-local)))
+
+(defn make-edit-path-ref [id]
+ (mf/use-memo
+ (mf/deps id)
+ (let [selfn #(get-in % [:edit-path id])]
+ #(l/derived selfn refs/workspace-local))))
+
+(defn make-content-modifiers-ref [id]
+ (mf/use-memo
+ (mf/deps id)
+ (let [selfn #(get-in % [:edit-path id :content-modifiers])]
+ #(l/derived selfn refs/workspace-local))))
(mf/defc path-wrapper
{::mf/wrap-props false}
[props]
(let [shape (unchecked-get props "shape")
hover? (or (mf/deref refs/current-hover) #{})
+
on-mouse-down (mf/use-callback
(mf/deps shape)
#(common/on-mouse-down % shape))
on-context-menu (mf/use-callback
(mf/deps shape)
#(common/on-context-menu % shape))
+
on-double-click (mf/use-callback
(mf/deps shape)
(fn [event]
- (when (and (not (::dr/initialized? shape)) (hover? (:id shape)))
+ (when (not (::dr/initialized? shape))
(do
(dom/stop-propagation event)
(dom/prevent-default event)
- (st/emit! (dw/start-edition-mode (:id shape)))))))]
+ (st/emit! (dw/start-edition-mode (:id shape))
+ (dw/start-path-edit (:id shape)))))))
+ content-modifiers-ref (make-content-modifiers-ref (:id shape))
+ content-modifiers (mf/deref content-modifiers-ref)
+ editing-id (mf/deref refs/selected-edition)
+ editing? (= editing-id (:id shape))
+ shape (update shape :content ugp/apply-content-modifiers content-modifiers)]
[:> shape-container {:shape shape
+ :pointer-events (when editing? "none")
:on-double-click on-double-click
:on-mouse-down on-mouse-down
:on-context-menu on-context-menu}
-
[:& path/path-shape {:shape shape
:background? true}]]))
+(mf/defc path-actions [{:keys [shape]}]
+ (let [id (mf/deref refs/selected-edition)
+ {:keys [edit-mode selected snap-toggled] :as all} (mf/deref current-edit-path-ref)]
+ [:div.path-actions
+ [:div.viewport-actions-group
+ [:div.viewport-actions-entry {:class (when (= edit-mode :draw) "is-toggled")
+ :on-click #(st/emit! (drp/change-edit-mode :draw))} i/pen]
+ [:div.viewport-actions-entry {:class (when (= edit-mode :move) "is-toggled")
+ :on-click #(st/emit! (drp/change-edit-mode :move))} i/pointer-inner]]
+
+ [:div.viewport-actions-group
+ [:div.viewport-actions-entry {:class "is-disabled"} i/nodes-add]
+ [:div.viewport-actions-entry {:class "is-disabled"} i/nodes-remove]]
+
+ [:div.viewport-actions-group
+ [:div.viewport-actions-entry {:class "is-disabled"} i/nodes-merge]
+ [:div.viewport-actions-entry {:class "is-disabled"} i/nodes-join]
+ [:div.viewport-actions-entry {:class "is-disabled"} i/nodes-separate]]
+
+ [:div.viewport-actions-group
+ [:div.viewport-actions-entry {:class "is-disabled"} i/nodes-corner]
+ [:div.viewport-actions-entry {:class "is-disabled"} i/nodes-curve]]
+
+ [:div.viewport-actions-group
+ [:div.viewport-actions-entry {:class (when snap-toggled "is-toggled")} i/nodes-snap]]]))
+
+
+(mf/defc path-point [{:keys [position zoom edit-mode hover? selected? preview? start-path?]}]
+ (let [{:keys [x y]} position
+
+ on-enter
+ (fn [event]
+ (st/emit! (drp/path-pointer-enter position)))
+
+ on-leave
+ (fn [event]
+ (st/emit! (drp/path-pointer-leave position)))
+
+ on-click
+ (fn [event]
+ (dom/stop-propagation event)
+ (dom/prevent-default event)
+
+ (cond
+ (and (= edit-mode :move) (not selected?))
+ (st/emit! (drp/select-node position))
+
+ (and (= edit-mode :move) selected?)
+ (st/emit! (drp/deselect-node position))))
+
+ on-mouse-down
+ (fn [event]
+ (dom/stop-propagation event)
+ (dom/prevent-default event)
+
+ (cond
+ (= edit-mode :move)
+ (st/emit! (drp/start-move-path-point position))
+
+ (and (= edit-mode :draw) start-path?)
+ (st/emit! (drp/start-path-from-point position))
+
+ (and (= edit-mode :draw) (not start-path?))
+ (st/emit! (drp/close-path-drag-start position))))]
+ [:g.path-point
+ [:circle.path-point
+ {:cx x
+ :cy y
+ :r (/ 3 zoom)
+ :style {:cursor (when (= edit-mode :draw) cur/pen-node)
+ :stroke-width (/ 1 zoom)
+ :stroke (cond (or selected? hover?) black-color
+ preview? secondary-color
+ :else primary-color)
+ :fill (cond selected? primary-color
+ :else white-color)}}]
+ [:circle {:cx x
+ :cy y
+ :r (/ 10 zoom)
+ :on-click on-click
+ :on-mouse-down on-mouse-down
+ :style {:fill "transparent"}}]]))
+
+(mf/defc path-handler [{:keys [index prefix point handler zoom selected? hover? edit-mode]}]
+ (when (and point handler)
+ (let [{:keys [x y]} handler
+ on-click
+ (fn [event]
+ (dom/stop-propagation event)
+ (dom/prevent-default event)
+ (cond
+ (= edit-mode :move)
+ (drp/select-handler index prefix)))
+
+ on-mouse-down
+ (fn [event]
+ (dom/stop-propagation event)
+ (dom/prevent-default event)
+
+ (cond
+ (= edit-mode :move)
+ (st/emit! (drp/start-move-handler index prefix))))]
+
+ [:g.handler {:pointer-events (when (= edit-mode :draw))}
+ [:line
+ {:x1 (:x point)
+ :y1 (:y point)
+ :x2 x
+ :y2 y
+ :style {:stroke gray-color
+ :stroke-width (/ 1 zoom)}}]
+ [:rect
+ {:x (- x (/ 3 zoom))
+ :y (- y (/ 3 zoom))
+ :width (/ 6 zoom)
+ :height (/ 6 zoom)
+
+ :style {:cursor cur/pointer-move
+ :stroke-width (/ 1 zoom)
+ :stroke (cond (or selected? hover?) black-color
+ :else primary-color)
+ :fill (cond selected? primary-color
+ :else white-color)}}]
+ [:circle {:cx x
+ :cy y
+ :r (/ 10 zoom)
+ :on-click on-click
+ :on-mouse-down on-mouse-down
+ :style {:fill "transparent"}}]])))
+
+(mf/defc path-preview [{:keys [zoom command from]}]
+ [:g.preview {:style {:pointer-events "none"}}
+ (when (not= :move-to (:command command))
+ [:path {:style {:fill "transparent"
+ :stroke secondary-color
+ :stroke-width (/ 1 zoom)}
+ :d (ugp/content->path [{:command :move-to
+ :params {:x (:x from)
+ :y (:y from)}}
+ command])}])
+ [:& path-point {:position (:params command)
+ :preview? true
+ :zoom zoom}]])
+
+(mf/defc path-editor
+ [{:keys [shape zoom]}]
+
+ (let [edit-path-ref (make-edit-path-ref (:id shape))
+ {:keys [edit-mode selected drag-handler prev-handler preview content-modifiers last-point]} (mf/deref edit-path-ref)
+ {:keys [content]} shape
+ selected (or selected #{})
+ content (ugp/apply-content-modifiers content content-modifiers)
+ points (->> content ugp/content->points (into #{}))
+ last-command (last content)
+ last-p (->> content last ugp/command->point)
+ handlers (ugp/content->handlers content)]
+
+ [:g.path-editor
+ (when (and preview (not drag-handler))
+ [:& path-preview {:command preview
+ :from last-p
+ :zoom zoom}])
+
+ (for [position points]
+ [:g.path-node
+ [:& path-point {:position position
+ :selected? false
+ :zoom zoom
+ :edit-mode edit-mode
+ :start-path? (nil? last-point)}]
+
+ [:g.point-handlers {:pointer-events (when (= edit-mode :draw) "none")}
+ (for [[index prefix] (get handlers position)]
+ (let [command (get content index)
+ x (get-in command [:params (d/prefix-keyword prefix :x)])
+ y (get-in command [:params (d/prefix-keyword prefix :y)])
+ handler-position (gpt/point x y)]
+ [:& path-handler {:point position
+ :handler handler-position
+ :index index
+ :prefix prefix
+ :zoom zoom
+ :selected? false
+ :hover? false
+ :preview? false
+ :edit-mode edit-mode}]))]])
+
+ (when prev-handler
+ [:g.prev-handler {:pointer-events "none"}
+ [:& path-handler {:point last-p
+ :handler prev-handler
+ :zoom zoom
+ :selected false}]])
+
+ (when drag-handler
+ [:g.drag-handler {:pointer-events "none"}
+ (when (not= :move-to (:command last-command))
+ [:& path-handler {:point last-p
+ :handler (ugp/opposite-handler last-p drag-handler)
+ :zoom zoom
+ :selected false}])
+ [:& path-handler {:point last-p
+ :handler drag-handler
+ :zoom zoom
+ :selected false}]])]))
diff --git a/frontend/src/app/main/ui/workspace/sidebar/history.cljs b/frontend/src/app/main/ui/workspace/sidebar/history.cljs
index aebc62bb5..2ad04ab13 100644
--- a/frontend/src/app/main/ui/workspace/sidebar/history.cljs
+++ b/frontend/src/app/main/ui/workspace/sidebar/history.cljs
@@ -129,7 +129,6 @@
:rect i/box
:circle i/circle
:text i/text
- :curve i/curve
:path i/curve
:frame i/artboard
:group i/folder
@@ -141,7 +140,7 @@
i/layers))
(defn is-shape? [type]
- #{:shape :rect :circle :text :curve :path :frame :group})
+ #{:shape :rect :circle :text :path :frame :group})
(defn parse-entry [{:keys [redo-changes]}]
(->> redo-changes
diff --git a/frontend/src/app/main/ui/workspace/sidebar/layers.cljs b/frontend/src/app/main/ui/workspace/sidebar/layers.cljs
index 2b83cb73f..9bf828715 100644
--- a/frontend/src/app/main/ui/workspace/sidebar/layers.cljs
+++ b/frontend/src/app/main/ui/workspace/sidebar/layers.cljs
@@ -39,7 +39,6 @@
:circle i/circle
:path i/curve
:rect i/box
- :curve i/curve
:text i/text
:group (if (some? (:component-id shape))
i/component
diff --git a/frontend/src/app/main/ui/workspace/sidebar/options.cljs b/frontend/src/app/main/ui/workspace/sidebar/options.cljs
index 0a4020a8d..467d87f94 100644
--- a/frontend/src/app/main/ui/workspace/sidebar/options.cljs
+++ b/frontend/src/app/main/ui/workspace/sidebar/options.cljs
@@ -48,7 +48,6 @@
:icon [:& icon/options {:shape shape}]
:circle [:& circle/options {:shape shape}]
:path [:& path/options {:shape shape}]
- :curve [:& path/options {:shape shape}]
:image [:& image/options {:shape shape}]
nil)
[:& exports-menu
diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/group.cljs b/frontend/src/app/main/ui/workspace/sidebar/options/group.cljs
index 43711deb7..4dac6c4d8 100644
--- a/frontend/src/app/main/ui/workspace/sidebar/options/group.cljs
+++ b/frontend/src/app/main/ui/workspace/sidebar/options/group.cljs
@@ -11,6 +11,7 @@
(ns app.main.ui.workspace.sidebar.options.group
(:require
[rumext.alpha :as mf]
+ [app.common.attrs :as attrs]
[app.common.geom.shapes :as geom]
[app.common.pages-helpers :as cph]
[app.main.refs :as refs]
@@ -43,7 +44,7 @@
(merge
;; All values extracted from the group shape, except
;; border radius, that needs to be looked up from children
- (geom/get-attrs-multi (map #(get-shape-attrs
+ (attrs/get-attrs-multi (map #(get-shape-attrs
%
measure-attrs
nil
@@ -51,7 +52,7 @@
nil)
[shape])
measure-attrs)
- (geom/get-attrs-multi (map #(get-shape-attrs
+ (attrs/get-attrs-multi (map #(get-shape-attrs
%
[:rx :ry]
nil
@@ -64,10 +65,10 @@
(select-keys shape component-attrs)
fill-values
- (geom/get-attrs-multi shape-with-children fill-attrs)
+ (attrs/get-attrs-multi shape-with-children fill-attrs)
stroke-values
- (geom/get-attrs-multi (map #(get-shape-attrs
+ (attrs/get-attrs-multi (map #(get-shape-attrs
%
stroke-attrs
nil
@@ -77,7 +78,7 @@
stroke-attrs)
font-values
- (geom/get-attrs-multi (map #(get-shape-attrs
+ (attrs/get-attrs-multi (map #(get-shape-attrs
%
nil
text-font-attrs
@@ -87,7 +88,7 @@
text-font-attrs)
align-values
- (geom/get-attrs-multi (map #(get-shape-attrs
+ (attrs/get-attrs-multi (map #(get-shape-attrs
%
nil
text-align-attrs
@@ -97,7 +98,7 @@
text-align-attrs)
spacing-values
- (geom/get-attrs-multi (map #(get-shape-attrs
+ (attrs/get-attrs-multi (map #(get-shape-attrs
%
nil
text-spacing-attrs
@@ -107,7 +108,7 @@
text-spacing-attrs)
valign-values
- (geom/get-attrs-multi (map #(get-shape-attrs
+ (attrs/get-attrs-multi (map #(get-shape-attrs
%
nil
text-valign-attrs
@@ -117,7 +118,7 @@
text-valign-attrs)
decoration-values
- (geom/get-attrs-multi (map #(get-shape-attrs
+ (attrs/get-attrs-multi (map #(get-shape-attrs
%
nil
text-decoration-attrs
@@ -127,7 +128,7 @@
text-decoration-attrs)
transform-values
- (geom/get-attrs-multi (map #(get-shape-attrs
+ (attrs/get-attrs-multi (map #(get-shape-attrs
%
nil
text-transform-attrs
diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/measures.cljs b/frontend/src/app/main/ui/workspace/sidebar/options/measures.cljs
index f76fa2ee0..6d67412d8 100644
--- a/frontend/src/app/main/ui/workspace/sidebar/options/measures.cljs
+++ b/frontend/src/app/main/ui/workspace/sidebar/options/measures.cljs
@@ -43,11 +43,15 @@
old-shapes (deref (refs/objects-by-id ids))
frames (map #(deref (refs/object-by-id (:frame-id %))) old-shapes)
- shapes (map gsh/transform-shape frames old-shapes)
- values (cond-> values
- (not= (:x values) :multiple) (assoc :x (:x (:selrect (first shapes))))
- (not= (:y values) :multiple) (assoc :y (:y (:selrect (first shapes)))))
+ shapes (as-> old-shapes $
+ (map gsh/transform-shape $)
+ (map gsh/translate-to-frame $ frames))
+
+ values (let [{:keys [x y]} (-> shapes first :points gsh/points->selrect)]
+ (cond-> values
+ (not= (:x values) :multiple) (assoc :x x)
+ (not= (:y values) :multiple) (assoc :y y)))
proportion-lock (:proportion-lock values)
@@ -65,7 +69,7 @@
do-position-change
(fn [shape' frame' value attr]
- (let [from (-> shape' :selrect attr)
+ (let [from (-> shape' :points gsh/points->selrect attr)
to (+ value (attr frame'))
target (+ (attr shape') (- to from))]
(st/emit! (udw/update-position (:id shape') {attr target}))))
diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/multiple.cljs b/frontend/src/app/main/ui/workspace/sidebar/options/multiple.cljs
index b13a69acb..03f45783b 100644
--- a/frontend/src/app/main/ui/workspace/sidebar/options/multiple.cljs
+++ b/frontend/src/app/main/ui/workspace/sidebar/options/multiple.cljs
@@ -11,6 +11,7 @@
(:require
[rumext.alpha :as mf]
[app.common.geom.shapes :as geom]
+ [app.common.attrs :as attrs]
[app.main.data.workspace.texts :as dwt]
[app.main.ui.workspace.sidebar.options.measures :refer [measure-attrs measures-menu]]
[app.main.ui.workspace.sidebar.options.fill :refer [fill-attrs fill-menu]]
@@ -48,9 +49,9 @@
text-attrs
convert-attrs
extract-fn))]
- (geom/get-attrs-multi (map mapfn shapes) (or attrs text-attrs))))
+ (attrs/get-attrs-multi (map mapfn shapes) (or attrs text-attrs))))
- measure-values (geom/get-attrs-multi shapes measure-attrs)
+ measure-values (attrs/get-attrs-multi shapes measure-attrs)
fill-values (extract {:attrs fill-attrs
:text-attrs ot/text-fill-attrs
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/snap_points.cljs b/frontend/src/app/main/ui/workspace/snap_points.cljs
index 480d1d57c..1a24da932 100644
--- a/frontend/src/app/main/ui/workspace/snap_points.cljs
+++ b/frontend/src/app/main/ui/workspace/snap_points.cljs
@@ -58,7 +58,7 @@
(defn get-snap
[coord {:keys [shapes page-id filter-shapes local]}]
(let [shape (if (> (count shapes) 1)
- (->> shapes (map gsh/transform-shape) gsh/selection-rect)
+ (->> shapes (map gsh/transform-shape) gsh/selection-rect (gsh/setup {:type :rect}))
(->> shapes (first)))
shape (if (:modifiers local)
diff --git a/frontend/src/app/main/ui/workspace/viewport.cljs b/frontend/src/app/main/ui/workspace/viewport.cljs
index 402399bd6..c469e240b 100644
--- a/frontend/src/app/main/ui/workspace/viewport.cljs
+++ b/frontend/src/app/main/ui/workspace/viewport.cljs
@@ -1,4 +1,4 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
+; 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/.
;;
@@ -52,7 +52,8 @@
[goog.events :as events]
[potok.core :as ptk]
[promesa.core :as p]
- [rumext.alpha :as mf])
+ [rumext.alpha :as mf]
+ [app.main.ui.workspace.shapes.path :refer [path-actions]])
(:import goog.events.EventType))
;; --- Coordinates Widget
@@ -198,17 +199,21 @@
vport
vbox
edition
+ edit-path
tooltip
selected
panning
picking-color?]} local
page-id (mf/use-ctx ctx/current-page-id)
- selrect-orig (->> (mf/deref refs/selected-objects)
- (gsh/selection-rect))
- selrect (-> selrect-orig
- (assoc :modifiers (:modifiers local))
- (gsh/transform-shape))
+
+ selected-objects (mf/deref refs/selected-objects)
+ selrect-orig (->> selected-objects
+ (gsh/selection-rect))
+ selrect (->> selected-objects
+ (map #(assoc % :modifiers (:modifiers local)))
+ (map gsh/transform-shape)
+ (gsh/selection-rect))
alt? (mf/use-state false)
viewport-ref (mf/use-ref nil)
@@ -217,9 +222,9 @@
drawing (mf/deref refs/workspace-drawing)
drawing-tool (:tool drawing)
drawing-obj (:object drawing)
+ drawing-path? (and edition (= :draw (get-in edit-path [edition :edit-mode])))
zoom (or zoom 1)
-
on-mouse-down
(mf/use-callback
(mf/deps drawing-tool edition)
@@ -231,14 +236,13 @@
alt? (kbd/alt? event)]
(st/emit! (ms/->MouseEvent :down ctrl? shift? alt?))
(cond
- (and (= 1 (.-which event)))
+ (and (= 1 (.-which event)) (not edition))
(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))
- (and (not edition)
- (= 2 (.-which event)))
+ (and (= 2 (.-which event)))
(handle-viewport-positioning viewport-ref)))))
on-context-menu
@@ -265,18 +269,18 @@
on-pointer-down
(mf/use-callback
- (fn [event]
+ (fn [event]
(let [target (dom/get-target event)]
- ; Capture mouse pointer to detect the movements even if cursor
- ; leaves the viewport or the browser itself
- ; https://developer.mozilla.org/en-US/docs/Web/API/Element/setPointerCapture
+ ; Capture mouse pointer to detect the movements even if cursor
+ ; leaves the viewport or the browser itself
+ ; https://developer.mozilla.org/en-US/docs/Web/API/Element/setPointerCapture
(.setPointerCapture target (.-pointerId event)))))
on-pointer-up
(mf/use-callback
- (fn [event]
+ (fn [event]
(let [target (dom/get-target event)]
- ; Release pointer on mouse up
+ ; Release pointer on mouse up
(.releasePointerCapture target (.-pointerId event)))))
on-click
@@ -290,12 +294,16 @@
on-double-click
(mf/use-callback
+ (mf/deps edition edit-path)
(fn [event]
(dom/stop-propagation event)
(let [ctrl? (kbd/ctrl? event)
shift? (kbd/shift? event)
alt? (kbd/alt? event)]
- (st/emit! (ms/->MouseEvent :double-click ctrl? shift? alt?)))))
+ (st/emit! (ms/->MouseEvent :double-click ctrl? shift? alt?))
+
+ (if (not drawing-path?)
+ (st/emit! dw/clear-edition-mode)))))
on-key-down
(mf/use-callback
@@ -425,6 +433,7 @@
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dw/add-shape (-> shape
+ (assoc :id (uuid/next))
(assoc :x final-x)
(assoc :y final-y)))))
@@ -527,12 +536,12 @@
:class (when drawing-tool "drawing")
:style {:cursor (cond
panning cur/hand
- (= drawing-tool :comments) cur/hand
+ (= drawing-tool :comments) cur/comments
(= drawing-tool :frame) cur/create-artboard
(= drawing-tool :rect) cur/create-rectangle
(= drawing-tool :circle) cur/create-ellipse
- (= drawing-tool :path) cur/pen
- (= drawing-tool :curve)cur/pencil
+ (or (= drawing-tool :path) drawing-path?) cur/pen
+ (= drawing-tool :curve) cur/pencil
drawing-tool cur/create-shape
:else cur/pointer-inner)
:background-color (get options :background "#E8E9EA")}
@@ -606,3 +615,13 @@
(when (= options-mode :prototype)
[:& interactions {:selected selected}])]]))
+
+(mf/defc viewport-actions []
+ (let [edition (mf/deref refs/selected-edition)
+ selected (mf/deref refs/selected-objects)
+ shape (-> selected first)]
+ (when (and (= (count selected) 1)
+ (= (:id shape) edition)
+ (= :path (:type shape)))
+ [:div.viewport-actions
+ [:& path-actions {:shape shape}]])))
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/data.cljs b/frontend/src/app/util/data.cljs
index 0a6c2889c..2350262e9 100644
--- a/frontend/src/app/util/data.cljs
+++ b/frontend/src/app/util/data.cljs
@@ -118,6 +118,33 @@
(into {}))
m1))
+(defn with-next
+ "Given a collectin will return a new collection where each element
+ is paried with the next item in the collection
+ (with-next (range 5)) => [[0 1] [1 2] [2 3] [3 4] [4 nil]"
+ [coll]
+ (map vector
+ coll
+ (concat [] (rest coll) [nil])))
+
+(defn with-prev
+ "Given a collectin will return a new collection where each element
+ is paried with the previous item in the collection
+ (with-prev (range 5)) => [[0 nil] [1 0] [2 1] [3 2] [4 3]"
+ [coll]
+ (map vector
+ coll
+ (concat [nil] coll)))
+
+(defn with-prev-next
+ "Given a collection will return a new collection where every item is paired
+ with the previous and the next item of a collection
+ (with-prev-next (range 5)) => [[0 nil 1] [1 0 2] [2 1 3] [3 2 4] [4 3 nil]"
+ [coll]
+ (map vector
+ coll
+ (concat [nil] coll)
+ (concat [] (rest coll) [nil])))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Numbers Parsing
@@ -221,3 +248,7 @@
;; nil
;; (throw e#)))))))
+(defn prefix-keyword [prefix kw]
+ (let [prefix (if (keyword? prefix) (name prefix) prefix)
+ kw (if (keyword? kw) (name kw) kw)]
+ (keyword (str prefix kw))))
diff --git a/frontend/src/app/util/geom/path.cljs b/frontend/src/app/util/geom/path.cljs
index 0ef690191..601c62874 100644
--- a/frontend/src/app/util/geom/path.cljs
+++ b/frontend/src/app/util/geom/path.cljs
@@ -8,7 +8,12 @@
;; Copyright (c) 2016-2017 Andrey Antukh
(ns app.util.geom.path
- (:require [app.util.geom.path-impl-simplify :as impl-simplify]))
+ (:require
+ [cuerdas.core :as str]
+ [app.util.data :as d]
+ [app.common.data :as cd]
+ [app.common.geom.point :as gpt]
+ [app.util.geom.path-impl-simplify :as impl-simplify]))
(defn simplify
([points]
@@ -16,3 +21,269 @@
([points tolerance]
(let [points (into-array points)]
(into [] (impl-simplify/simplify points tolerance true)))))
+
+;;
+(def commands-regex #"(?i)[a-z][^a-z]*")
+
+;; Matches numbers for path values allows values like... -.01, 10, +12.22
+;; 0 and 1 are special because can refer to flags
+(def num-regex #"([+-]?(([1-9]\d*(\.\d+)?)|(\.\d+)|0|1))")
+
+
+(defn coord-n [size]
+ (re-pattern (str "(?i)[a-z]\\s*"
+ (->> (range size)
+ (map #(identity num-regex))
+ (str/join "\\s+")))))
+
+
+(defn parse-params [cmd-str num-params]
+ (let [fix-starting-dot (fn [arg] (str/replace arg #"([^\d]|^)\." "$10."))]
+ (->> (re-seq num-regex cmd-str)
+ (map first)
+ (map fix-starting-dot)
+ (map d/read-string)
+ (partition num-params))))
+
+(defn command->param-list [{:keys [command params]}]
+ (case command
+ (:move-to :line-to :smooth-quadratic-bezier-curve-to)
+ (let [{:keys [x y]} params] [x y])
+
+ :close-path
+ []
+
+ (:line-to-horizontal :line-to-vertical)
+ (let [{:keys [value]} params] [value])
+
+ :curve-to
+ (let [{:keys [c1x c1y c2x c2y x y]} params] [c1x c1y c2x c2y x y])
+
+ (:smooth-curve-to :quadratic-bezier-curve-to)
+ (let [{:keys [cx cy x y]} params] [cx cy x y])
+
+ :elliptical-arc
+ (let [{:keys [rx ry x-axis-rotation large-arc-flag sweep-flag x y]} params]
+ [rx ry x-axis-rotation large-arc-flag sweep-flag x y])))
+
+;; Path specification
+;; https://www.w3.org/TR/SVG11/paths.html
+(defmulti parse-command (comp str/upper first))
+
+(defmethod parse-command "M" [cmd]
+ (let [relative (str/starts-with? cmd "m")
+ params (parse-params cmd 2)]
+ (for [[x y] params]
+ {:command :move-to
+ :relative relative
+ :params {:x x :y y}})))
+
+(defmethod parse-command "Z" [cmd]
+ [{:command :close-path}])
+
+(defmethod parse-command "L" [cmd]
+ (let [relative (str/starts-with? cmd "l")
+ params (parse-params cmd 2)]
+ (for [[x y] params]
+ {:command :line-to
+ :relative relative
+ :params {:x x :y y}})))
+
+(defmethod parse-command "H" [cmd]
+ (let [relative (str/starts-with? cmd "h")
+ params (parse-params cmd 1)]
+ (for [[value] params]
+ {:command :line-to-horizontal
+ :relative relative
+ :params {:value value}})))
+
+(defmethod parse-command "V" [cmd]
+ (let [relative (str/starts-with? cmd "v")
+ params (parse-params cmd 1)]
+ (for [[value] params]
+ {:command :line-to-vertical
+ :relative relative
+ :params {:value value}})))
+
+(defmethod parse-command "C" [cmd]
+ (let [relative (str/starts-with? cmd "c")
+ params (parse-params cmd 6)]
+ (for [[c1x c1y c2x c2y x y] params]
+ {:command :curve-to
+ :relative relative
+ :params {:c1x c1x
+ :c1y c1y
+ :c2x c2x
+ :c2y c2y
+ :x x
+ :y y}})))
+
+(defmethod parse-command "S" [cmd]
+ (let [relative (str/starts-with? cmd "s")
+ params (parse-params cmd 4)]
+ (for [[cx cy x y] params]
+ {:command :smooth-curve-to
+ :relative relative
+ :params {:cx cx
+ :cy cy
+ :x x
+ :y y}})))
+
+(defmethod parse-command "Q" [cmd]
+ (let [relative (str/starts-with? cmd "s")
+ params (parse-params cmd 4)]
+ (for [[cx cy x y] params]
+ {:command :quadratic-bezier-curve-to
+ :relative relative
+ :params {:cx cx
+ :cy cy
+ :x x
+ :y y}})))
+
+(defmethod parse-command "T" [cmd]
+ (let [relative (str/starts-with? cmd "t")
+ params (parse-params cmd (coord-n 2))]
+ (for [[cx cy x y] params]
+ {:command :smooth-quadratic-bezier-curve-to
+ :relative relative
+ :params {:x x
+ :y y}})))
+
+(defmethod parse-command "A" [cmd]
+ (let [relative (str/starts-with? cmd "a")
+ params (parse-params cmd 7)]
+ (for [[rx ry x-axis-rotation large-arc-flag sweep-flag x y] params]
+ {:command :elliptical-arc
+ :relative relative
+ :params {:rx rx
+ :ry ry
+ :x-axis-rotation x-axis-rotation
+ :large-arc-flag large-arc-flag
+ :sweep-flag sweep-flag
+ :x x
+ :y y}})))
+
+(defn command->string [{:keys [command relative params] :as entry}]
+ (let [command-str (case command
+ :move-to "M"
+ :close-path "Z"
+ :line-to "L"
+ :line-to-horizontal "H"
+ :line-to-vertical "V"
+ :curve-to "C"
+ :smooth-curve-to "S"
+ :quadratic-bezier-curve-to "Q"
+ :smooth-quadratic-bezier-curve-to "T"
+ :elliptical-arc "A")
+ command-str (if relative (str/lower command-str) command-str)
+ param-list (command->param-list entry)]
+ (str/fmt "%s%s" command-str (str/join " " param-list))))
+
+(defn path->content [string]
+ (let [clean-string (-> string
+ (str/trim)
+ ;; Change "commas" for spaces
+ (str/replace #"," " ")
+ ;; Remove all consecutive spaces
+ (str/replace #"\s+" " "))
+ commands (re-seq commands-regex clean-string)]
+ (mapcat parse-command commands)))
+
+(defn content->path [content]
+ (->> content
+ (map command->string)
+ (str/join "")))
+
+(defn make-curve-params
+ ([point]
+ (make-curve-params point point point))
+
+ ([point handler] (make-curve-params point handler point))
+
+ ([point h1 h2]
+ {:x (:x point)
+ :y (:y point)
+ :c1x (:x h1)
+ :c1y (:y h1)
+ :c2x (:x h2)
+ :c2y (:y h2)}))
+
+(defn opposite-handler
+ "Calculates the coordinates of the opposite handler"
+ [point handler]
+ (let [phv (gpt/to-vec point handler)]
+ (gpt/add point (gpt/negate phv))))
+
+(defn opposite-handler-keep-distance
+ "Calculates the coordinates of the opposite handler but keeping the old distance"
+ [point handler old-opposite]
+ (let [old-distance (gpt/distance point old-opposite)
+ phv (gpt/to-vec point handler)
+ phv2 (gpt/multiply
+ (gpt/unit (gpt/negate phv))
+ (gpt/point old-distance))]
+ (gpt/add point phv2)))
+
+(defn apply-content-modifiers [content modifiers]
+ (letfn [(apply-to-index [content [index params]]
+ (if (contains? content index)
+ (cond-> content
+ (and
+ (or (:c1x params) (:c1y params) (:c2x params) (:c2y params))
+ (= :line-to (get-in content [index :params :command])))
+ (-> (assoc-in [index :command] :curve-to)
+ (assoc-in [index :params] :curve-to) (make-curve-params
+ (get-in content [index :params])
+ (get-in content [(dec index) :params])))
+
+ (:x params) (update-in [index :params :x] + (:x params))
+ (:y params) (update-in [index :params :y] + (:y params))
+
+ (:c1x params) (update-in [index :params :c1x] + (:c1x params))
+ (:c1y params) (update-in [index :params :c1y] + (:c1y params))
+
+ (:c2x params) (update-in [index :params :c2x] + (:c2x params))
+ (:c2y params) (update-in [index :params :c2y] + (:c2y params)))
+ content))]
+ (reduce apply-to-index content modifiers)))
+
+(defn command->point [{{:keys [x y]} :params}]
+ (gpt/point x y))
+
+(defn content->points [content]
+ (->> content
+ (map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y))))
+ (remove nil?)
+ (into [])))
+
+(defn content->handlers [content]
+ (->> (d/with-prev content) ;; [cmd, prev]
+ (d/enumerate) ;; [idx [cmd, prev]]
+
+ (mapcat (fn [[index [cur-cmd prev-cmd]]]
+ (if (and prev-cmd
+ (= :curve-to (:command cur-cmd)))
+ (let [cur-pos (command->point cur-cmd)
+ pre-pos (command->point prev-cmd)]
+ [[pre-pos [index :c1]]
+ [cur-pos [index :c2]]])
+ [])))
+
+ (group-by first)
+ (cd/mapm #(mapv second %2))))
+
+(defn opposite-index [content index prefix]
+ (let [point (if (= prefix :c2)
+ (command->point (nth content index))
+ (command->point (nth content (dec index))))
+
+ handlers (-> (content->handlers content)
+ (get point))
+
+ opposite-prefix (if (= prefix :c1) :c2 :c1)
+
+ result (when (<= (count handlers) 2)
+ (->> handlers
+ (d/seek (fn [[index prefix]] (= prefix opposite-prefix)))
+ (first)))]
+ result))
diff --git a/frontend/src/app/util/geom/snap_points.cljs b/frontend/src/app/util/geom/snap_points.cljs
index 8859a96c6..2f9fdb000 100644
--- a/frontend/src/app/util/geom/snap_points.cljs
+++ b/frontend/src/app/util/geom/snap_points.cljs
@@ -14,22 +14,22 @@
[app.common.geom.shapes :as gsh]
[app.common.geom.point :as gpt]))
-(defn- frame-snap-points [{:keys [x y width height] :as frame}]
- (into #{(gpt/point x y)
- (gpt/point (+ x (/ width 2)) y)
- (gpt/point (+ x width) y)
+(defn- selrect-snap-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- frame-snap-points [{:keys [x y width height] :as selrect}]
+ (into (selrect-snap-points selrect)
+ #{(gpt/point (+ x (/ width 2)) y)
(gpt/point (+ x width) (+ y (/ height 2)))
- (gpt/point (+ x width) (+ y height))
(gpt/point (+ x (/ width 2)) (+ y height))
- (gpt/point x (+ y height))
(gpt/point x (+ y (/ height 2)))}))
(defn shape-snap-points
[shape]
- (let [shape (gsh/transform-shape shape)
- shape-center (gsh/center shape)]
- (if (= :frame (:type shape))
- (-> shape
- (gsh/shape->rect-shape)
- (frame-snap-points))
- (into #{shape-center} (:points shape)))))
+ (let [shape (gsh/transform-shape shape)]
+ (case (:type shape)
+ :frame (-> shape :selrect frame-snap-points)
+ (into #{(gsh/center-shape shape)} (: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)))