3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-06-02 12:11:39 +02:00
Code Issues Projects Releases Packages Wiki Activity

♻️ Refactor transforms

Browse source
This commit is contained in:
alonso.torres 2020-11-10 17:52:23 +01:00
parent 2c50bb16dc
commit af68c26aea
32 changed files with 1085 additions and 685 deletions
Download patch file Download diff file Expand all files Collapse all files

32
common/app/common/data.cljc
View file

@ -7,12 +7,14 @@
(ns app.common.data (ns app.common.data
"Data manipulation and query helper functions." "Data manipulation and query helper functions."
(:refer-clojure :exclude [concat read-string hash-map]) (:refer-clojure :exclude [concat read-string hash-map])
(:require [clojure.set :as set] (:require
[linked.set :as lks] [clojure.set :as set]
#?(:cljs [cljs.reader :as r] [linked.set :as lks]
:clj [clojure.edn :as r]) [app.common.math :as mth]
#?(:cljs [cljs.core :as core] #?(:cljs [cljs.reader :as r]
:clj [clojure.core :as core])) :clj [clojure.edn :as r])
#?(:cljs [cljs.core :as core]
:clj [clojure.core :as core]))
#?(:clj #?(:clj
(:import linked.set.LinkedSet))) (:import linked.set.LinkedSet)))
@ -261,3 +263,21 @@
(defn coalesce (defn coalesce
[val default] [val default]
(or 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))

24
common/app/common/geom/align.cljc
View file

@ -10,11 +10,7 @@
(ns app.common.geom.align (ns app.common.geom.align
(:require (:require
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[app.common.spec :as us]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.math :as mth]
[app.common.data :as d])) [app.common.data :as d]))
;; --- Alignment ;; --- Alignment
@ -23,6 +19,20 @@
(declare calc-align-pos) (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 (defn align-to-rect
"Move the shape so that it is aligned with the given rectangle "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 in the given axis. Take account the form of the shape and the
@ -34,7 +44,7 @@
align-pos (calc-align-pos wrapper-rect rect axis) align-pos (calc-align-pos wrapper-rect rect axis)
delta {:x (- (:x align-pos) (:x wrapper-rect)) delta {:x (- (:x align-pos) (:x wrapper-rect))
:y (- (:y align-pos) (:y wrapper-rect))}] :y (- (:y align-pos) (:y wrapper-rect))}]
(gsh/recursive-move shape delta objects))) (recursive-move shape delta objects)))
(defn calc-align-pos (defn calc-align-pos
[wrapper-rect rect axis] [wrapper-rect rect axis]
@ -80,7 +90,7 @@
; The rectangle that wraps the whole selection ; The rectangle that wraps the whole selection
wrapper-rect (gsh/selection-rect shapes) wrapper-rect (gsh/selection-rect shapes)
; Sort shapes by the center point in the given axis ; Sort shapes by the center point in the given axis
sorted-shapes (sort-by #(coord (gsh/center %)) shapes) sorted-shapes (sort-by #(coord (gsh/center-shape %)) shapes)
; Each shape wrapped in its own rectangle ; Each shape wrapped in its own rectangle
wrapped-shapes (map #(gsh/selection-rect [%]) sorted-shapes) wrapped-shapes (map #(gsh/selection-rect [%]) sorted-shapes)
; The total space between shapes ; The total space between shapes
@ -106,7 +116,7 @@
new-pos new-pos
(conj deltas delta)))))] (conj deltas delta)))))]
(mapcat #(gsh/recursive-move %1 {coord %2 other-coord 0} objects) (mapcat #(recursive-move %1 {coord %2 other-coord 0} objects)
sorted-shapes deltas))))) sorted-shapes deltas)))))
;; Adjusto to viewport ;; Adjusto to viewport

10
common/app/common/geom/matrix.cljc
View file

@ -121,3 +121,13 @@
([m angle-x angle-y p] ([m angle-x angle-y p]
(multiply m (skew-matrix 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))))

62
common/app/common/geom/proportions.cljc Normal file
View file

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

227
common/app/common/geom/shapes.cljc
View file

@ -19,31 +19,19 @@
[app.common.math :as mth] [app.common.math :as mth]
[app.common.data :as d])) [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 ;; --- 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 (defn move
"Move the shape relativelly to its current "Move the shape relativelly to its current
position applying the provided delta." position applying the provided delta."
[shape {dx :x dy :y}] [shape {dx :x dy :y}]
(let [inc-x (nilf (fn [x] (+ (-chk x) (-chk dx)))) (let [dx (d/check-num dx)
dy (d/check-num dy)]
(-> shape
(assoc-in [:modifiers :displacement] (gmt/translate-matrix (gpt/point dx dy)))
(gtr/transform-shape)))
#_(let [inc-x (nilf (fn [x] (+ (-chk x) (-chk dx))))
inc-y (nilf (fn [y] (+ (-chk y) (-chk dy)))) inc-y (nilf (fn [y] (+ (-chk y) (-chk dy))))
inc-point (nilf (fn [p] (-> p inc-point (nilf (fn [p] (-> p
(update :x inc-x) (update :x inc-x)
@ -60,57 +48,20 @@
(update :points #(mapv inc-point %)) (update :points #(mapv inc-point %))
(update :segments #(mapv inc-point %))))) (update :segments #(mapv inc-point %)))))
;; Duplicated from pages-helpers to remove cyclic dependencies
(defn get-children [id objects]
(let [shapes (vec (get-in objects [id :shapes]))]
(if shapes
(d/concat shapes (mapcat #(get-children % objects) shapes))
[])))
(defn recursive-move
"Move the shape and all its recursive children."
[shape dpoint objects]
(let [children-ids (get-children (:id shape) objects)
children (map #(get objects %) children-ids)]
(map #(move % dpoint) (cons shape children))))
;; --- Absolute Movement ;; --- Absolute Movement
(declare absolute-move-rect) (declare absolute-move-rect)
(defn absolute-move (defn absolute-move
"Move the shape to the exactly specified position." "Move the shape to the exactly specified position."
[shape position] [shape {:keys [x y]}]
(case (:type shape) (let [dx (- (d/check-num x) (-> shape :selrect :x))
(:curve :path) shape dy (- (d/check-num y) (-> shape :selrect :y))]
(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)]
(move shape (gpt/point dx dy)))) (move shape (gpt/point dx dy))))
;; --- Proportions
(declare assign-proportions-path)
(declare assign-proportions-rect)
(defn assign-proportions
[{:keys [type] :as shape}]
(case type
:path (assign-proportions-path shape)
(assign-proportions-rect shape)))
(defn- assign-proportions-rect
[{:keys [width height] :as shape}]
(assoc shape :proportion (/ width height)))
;; --- Paths ;; --- Paths
(defn update-path-point #_(defn update-path-point
"Update a concrete point in the path. "Update a concrete point in the path.
The point should exists before, this function The point should exists before, this function
@ -118,34 +69,9 @@
[shape index point] [shape index point]
(assoc-in shape [:segments 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) ;; --- Resize (Dimensions)
;;; TODO: CHANGE TO USE THE MODIFIERS
(defn resize (defn resize
[shape width height] [shape width height]
(us/assert map? shape) (us/assert map? shape)
@ -177,28 +103,21 @@
(resize shape (:width new-size) (:height new-size)))) (resize shape (:width new-size) (:height new-size))))
;; --- Setup (Initialize) ;; --- Setup (Initialize)
;; FIXME: Is this the correct place for these functions?
(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)))
(defn- setup-rect (defn- setup-rect
"A specialized function for setup rect-like shapes." "A specialized function for setup rect-like shapes."
[shape {:keys [x y width height]}] [shape {:keys [x y width height]}]
(as-> shape $ (let [rect {:x x :y y :width width :height height}
(assoc $ :x x points (gpr/rect->points rect)
:y y selrect (gpr/points->selrect points)]
:width width (assoc shape
:height height) :x x
(assoc $ :points (gtr/shape->points $)) :y y
(assoc $ :selrect (gpr/points->selrect (:points $))))) :width width
:height height
:points points
:selrect selrect)))
(defn- setup-image (defn- setup-image
[{:keys [metadata] :as shape} {:keys [x y width height] :as props}] [{:keys [metadata] :as shape} {:keys [x y width height] :as props}]
@ -208,26 +127,26 @@
(:height metadata)) (:height metadata))
:proportion-lock true))) :proportion-lock true)))
(defn setup
"A function that initializes the first coordinates for
the shape. Used mainly for draw operations."
[shape props]
(case (:type shape)
:image (setup-image shape props)
(setup-rect shape props)))
;; --- Resolve Shape ;; --- Resolve Shape
(declare resolve-rect-shape) ;; (declare resolve-rect-shape)
(declare translate-from-frame) ;; (declare translate-from-frame)
(declare translate-to-frame) ;; (declare translate-to-frame)
;;
(defn resolve-shape ;; (defn resolve-shape
[objects shape] ;; [objects shape]
(case (:type shape) ;; (loop [pobj (get objects parent)]
:rect (resolve-rect-shape objects shape) ;; (if (= :frame (:type pobj))
:group (resolve-rect-shape objects shape) ;; (translate-from-frame shape pobj)
:frame (resolve-rect-shape objects shape))) ;; (recur (get objects (:parent pobj))))))
(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))))))
;; --- Outer Rect ;; --- Outer Rect
@ -236,24 +155,8 @@
"Returns a rect that contains all the shapes and is aware of the "Returns a rect that contains all the shapes and is aware of the
rotation of each shape. Mainly used for multiple selection." rotation of each shape. Mainly used for multiple selection."
[shapes] [shapes]
(let [shapes (map :selrect shapes) (let [points (->> shapes (mapcat :points))]
minx (transduce (map :x1) min ##Inf shapes) (gpr/points->selrect points)))
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}))
(defn translate-to-frame (defn translate-to-frame
[shape {:keys [x y] :as frame}] [shape {:keys [x y] :as frame}]
@ -269,18 +172,20 @@
"Check if a shape is contained in the "Check if a shape is contained in the
provided selection rect." provided selection rect."
[shape selrect] [shape selrect]
(let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} (gpr/shape->rect-shape selrect) (let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} selrect
{rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (gpr/shape->rect-shape shape)] {rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (:selrect shape)]
(and (neg? (- sy1 ry1)) (and (neg? (- sy1 ry1))
(neg? (- sx1 rx1)) (neg? (- sx1 rx1))
(pos? (- sy2 ry2)) (pos? (- sy2 ry2))
(pos? (- sx2 rx2))))) (pos? (- sx2 rx2)))))
;; TODO: This not will work for rotated shapes
(defn overlaps? (defn overlaps?
"Check if a shape overlaps with provided selection rect." "Check if a shape overlaps with provided selection rect."
[shape selrect] [shape rect]
(let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} (gpr/shape->rect-shape selrect) (let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} (gpr/rect->selrect rect)
{rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (gpr/shape->rect-shape shape)] {rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (gpr/points->selrect (:points shape))]
(and (< rx1 sx2) (and (< rx1 sx2)
(> rx2 sx1) (> rx2 sx1)
(< ry1 sy2) (< ry1 sy2)
@ -368,23 +273,29 @@
(defn setup-selrect [{:keys [x y width height] :as shape}] (defn setup-selrect [{:keys [x y width height] :as shape}]
(-> shape (-> shape
(assoc :selrect {:x x :y y (assoc :selrect
:width width :height height {:x x :y y
:x1 x :y1 y :width width :height height
:x2 (+ x width) :y2 (+ y height)}))) :x1 x :y1 y
:x2 (+ x width) :y2 (+ y height)})))
;; EXPORTS ;; EXPORTS
(def center gco/center) (defn center-shape [shape] (gco/center-shape shape))
(defn center-selrect [selrect] (gco/center-selrect selrect))
(defn center-rect [rect] (gco/center-rect rect))
(def shape->rect-shape gpr/shape->rect-shape) (defn rect->selrect [rect] (gpr/rect->selrect rect))
(def fix-invalid-rect-values gtr/fix-invalid-rect-values)
(def rect->rect-shape gpr/rect->rect-shape)
(def points->selrect gpr/points->selrect)
(def transform-shape-point gtr/transform-shape-point) #_(def shape->rect-shape gpr/shape->rect-shape)
(def update-path-selrect gtr/update-path-selrect) #_(def fix-invalid-rect-values gtr/fix-invalid-rect-values)
(def transform gtr/transform) #_(def rect->rect-shape gpr/rect->rect-shape)
(defn points->selrect [points] (gpr/points->selrect points))
#_(def transform-shape-point gtr/transform-shape-point)
#_(def update-path-selrect gtr/update-path-selrect)
#_(def transform gtr/transform)
(defn transform-shape [shape] (gtr/transform-shape shape)) (defn transform-shape [shape] (gtr/transform-shape shape))
(def transform-matrix gtr/transform-matrix) (defn transform-matrix [shape] (gtr/transform-matrix shape))
(defn transform-point-center [point center transform] (gtr/transform-point-center point center transform))
(defn transform-rect [rect mtx] (gtr/transform-rect rect mtx))

65
common/app/common/geom/shapes/common.cljc
View file

@ -17,32 +17,30 @@
[app.common.math :as mth] [app.common.math :as mth]
[app.common.data :as d])) [app.common.data :as d]))
;; --- Center (defn center-rect
[{:keys [x y width height]}]
(gpt/point (+ x (/ width 2))
(+ y (/ height 2))))
(declare center-rect) (defn center-selrect
(declare center-path) "Calculate the center of the shape."
[selrect]
(center-rect selrect))
(defn center (defn center-shape
"Calculate the center of the shape." "Calculate the center of the shape."
[shape] [shape]
(case (:type shape) (center-rect (:selrect shape)))
:curve (center-path shape)
:path (center-path shape)
(center-rect shape)))
(defn- center-rect (defn center-points [points]
[{:keys [x y width height] :as shape}] (let [minx (transduce (map :x) min ##Inf points)
(gpt/point (+ x (/ width 2)) (+ y (/ height 2)))) miny (transduce (map :y) min ##Inf points)
maxx (transduce (map :x) max ##-Inf points)
maxy (transduce (map :y) max ##-Inf points)]
(gpt/point (/ (+ minx maxx) 2)
(/ (+ miny maxy) 2))))
(defn- center-path (defn make-centered-rect
[{: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" "Creates a rect given a center and a width and height"
[center width height] [center width height]
{:x (- (:x center) (/ width 2)) {:x (- (:x center) (/ width 2))
@ -50,3 +48,30 @@
:width width :width width
:height height}) :height height})
;; --- Center
#_(
(declare center-rect)
(declare center-path)
(defn- center-path
[{:keys [segments] :as shape}]
(let [minx (apply min (map :x segments))
miny (apply min (map :y segments))
maxx (apply max (map :x segments))
maxy (apply max (map :y segments))]
(gpt/point (/ (+ minx maxx) 2) (/ (+ miny maxy) 2))))
(defn center->rect
"Creates a rect given a center and a width and height"
[center width height]
{:x (- (:x center) (/ width 2))
:y (- (:y center) (/ height 2))
:width width
:height height})
)

4
common/app/common/geom/shapes/path.cljc
View file

@ -16,6 +16,8 @@
[app.common.math :as mth] [app.common.math :as mth]
[app.common.data :as d])) [app.common.data :as d]))
(defn segments->points [segments]
segments)
(defn content->points [content] (defn content->points [content]
(map #(gpt/point (-> % :param :x) (-> % :param :y)) content)) (map #(gpt/point (-> % :param :x) (-> % :param :y)) content))

141
common/app/common/geom/shapes/rect.cljc
View file

@ -18,66 +18,97 @@
[app.common.math :as mth] [app.common.math :as mth]
[app.common.data :as d])) [app.common.data :as d]))
;; --- SHAPE -> RECT (defn rect->points [{:keys [x y width height]}]
[(gpt/point x y)
(gpt/point (+ x width) y)
(gpt/point (+ x width) (+ y height))
(gpt/point x (+ y height))])
(defn- rect->rect-shape (defn points->rect [points]
[{:keys [x y width height] :as shape}]
(assoc shape
:x1 x
:y1 y
:x2 (+ x width)
:y2 (+ y height)))
(defn- path->rect-shape
[{:keys [segments] :as shape}]
(merge shape
{:type :rect}
(:selrect shape)))
(defn shape->rect-shape
"Coerce shape to rect like shape."
[{:keys [type] :as shape}]
(case type
(:curve :path) (path->rect-shape shape)
(rect->rect-shape shape)))
;; Shape->PATH
(declare rect->path)
(defn shape->path
[shape]
(case (:type shape)
(:curve :path) shape
(rect->path shape)))
(defn rect->path
[{:keys [x y width height] :as shape}]
(let [points [(gpt/point x y)
(gpt/point (+ x width) y)
(gpt/point (+ x width) (+ y height))
(gpt/point x (+ y height))
(gpt/point x y)]]
(-> shape
(assoc :type :path)
(assoc :segments points))))
;; -- Points
(defn points->selrect [points]
(let [minx (transduce (map :x) min ##Inf points) (let [minx (transduce (map :x) min ##Inf points)
miny (transduce (map :y) min ##Inf points) miny (transduce (map :y) min ##Inf points)
maxx (transduce (map :x) max ##-Inf points) maxx (transduce (map :x) max ##-Inf points)
maxy (transduce (map :y) max ##-Inf points)] maxy (transduce (map :y) max ##-Inf points)]
{:x1 minx {:x minx
:y1 miny
:x2 maxx
:y2 maxy
:x minx
:y miny :y miny
:width (- maxx minx) :width (- maxx minx)
:height (- maxy miny) :height (- maxy miny)}))
:type :rect}))
(defn points->selrect [points]
(let [{:keys [x y width height] :as rect} (points->rect points)]
(assoc rect
:x1 x
:x2 (+ x width)
:y1 y
:y2 (+ y height))))
(defn rect->selrect [rect]
(-> rect rect->points points->selrect))
;; --- SHAPE -> RECT
#_(
(defn- rect->rect-shape
[{:keys [x y width height] :as shape}]
(assoc shape
:x1 x
:y1 y
:x2 (+ x width)
:y2 (+ y height)))
(defn- path->rect-shape
[{:keys [segments] :as shape}]
(merge shape
{:type :rect}
(:selrect shape)))
(defn shape->rect-shape
"Coerce shape to rect like shape."
[{:keys [type] :as shape}]
(case type
(:curve :path) (path->rect-shape shape)
(rect->rect-shape shape)))
;; Shape->PATH
(declare rect->path)
(defn shape->path
[shape]
(case (:type shape)
(:curve :path) shape
(rect->path shape)))
(defn rect->path
[{:keys [x y width height] :as shape}]
(let [points [(gpt/point x y)
(gpt/point (+ x width) y)
(gpt/point (+ x width) (+ y height))
(gpt/point x (+ y height))
(gpt/point x y)]]
(-> shape
(assoc :type :path)
(assoc :segments points))))
;; -- Points
(defn points->selrect [points]
(let [minx (transduce (map :x) min ##Inf points)
miny (transduce (map :y) min ##Inf points)
maxx (transduce (map :x) max ##-Inf points)
maxy (transduce (map :y) max ##-Inf points)]
{:x1 minx
:y1 miny
:x2 maxx
:y2 maxy
:x minx
:y miny
:width (- maxx minx)
:height (- maxy miny)
:type :rect}))
)

685
common/app/common/geom/shapes/transforms.cljc
View file

@ -19,160 +19,82 @@
[app.common.math :as mth] [app.common.math :as mth]
[app.common.data :as d])) [app.common.data :as d]))
;; --- Transform Shape (defn transform-matrix
"Returns a transformation matrix without changing the shape properties.
The result should be used in a `transform` attribute in svg"
([{:keys [x y] :as shape}]
(let [shape-center (gco/center-shape shape)]
(-> (gmt/matrix)
(gmt/translate shape-center)
(gmt/multiply (:transform shape (gmt/matrix)))
(gmt/translate (gpt/negate shape-center))))))
(declare transform-rect) (defn transform-point-center
(declare transform-path)
(defn transform
"Apply the matrix transformation to shape."
[{:keys [type] :as shape} xfmt]
(if (gmt/matrix? xfmt)
(case type
:path (transform-path shape xfmt)
:curve (transform-path shape xfmt)
(transform-rect shape xfmt))
shape))
(defn center-transform [shape matrix]
(let [shape-center (gco/center shape)]
(-> shape
(transform
(-> (gmt/matrix)
(gmt/translate shape-center)
(gmt/multiply matrix)
(gmt/translate (gpt/negate shape-center)))))))
(defn- transform-rect
[{:keys [x y width height] :as shape} mx]
(let [tl (gpt/transform (gpt/point x y) mx)
tr (gpt/transform (gpt/point (+ x width) y) mx)
bl (gpt/transform (gpt/point x (+ y height)) mx)
br (gpt/transform (gpt/point (+ x width) (+ y height)) mx)
;; TODO: replace apply with transduce (performance)
minx (apply min (map :x [tl tr bl br]))
maxx (apply max (map :x [tl tr bl br]))
miny (apply min (map :y [tl tr bl br]))
maxy (apply max (map :y [tl tr bl br]))]
(assoc shape
:x minx
:y miny
:width (- maxx minx)
:height (- maxy miny))))
(defn- transform-path
[{:keys [segments] :as shape} xfmt]
(let [segments (mapv #(gpt/transform % xfmt) segments)]
(assoc shape :segments segments)))
(defn transform-shape-point
"Transform a point around the shape center" "Transform a point around the shape center"
[point shape transform] [point center matrix]
(let [shape-center (gco/center shape)] (gpt/transform
(gpt/transform point
point (gmt/multiply (gmt/translate-matrix center)
(-> (gmt/multiply matrix
(gmt/translate-matrix shape-center) (gmt/translate-matrix (gpt/negate center)))))
transform
(gmt/translate-matrix (gpt/negate shape-center)))))))
(defn shape->points [shape] (defn transform-points
(let [points (case (:type shape) ([points matrix]
(:curve :path) (if (:content shape) (transform-points points nil matrix))
(gpa/content->points (:content shape))
(:segments shape))
(let [{:keys [x y width height]} shape]
[(gpt/point x y)
(gpt/point (+ x width) y)
(gpt/point (+ x width) (+ y height))
(gpt/point x (+ y height))]))]
(->> points
(map #(transform-shape-point % shape (:transform shape (gmt/matrix))))
(map gpt/round)
(vec))))
(defn rect-path-dimensions [rect-path] ([points center matrix]
(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 update-path-selrect [shape] (let [prev (if center (gmt/translate-matrix center) (gmt/matrix))
(as-> shape $ post (if center (gmt/translate-matrix (gpt/negate center)) (gmt/matrix))
(assoc $ :points (shape->points $))
(assoc $ :selrect (gpr/points->selrect (:points $)))
(assoc $ :x (get-in $ [:selrect :x]))
(assoc $ :y (get-in $ [:selrect :y]))
(assoc $ :width (get-in $ [:selrect :width]))
(assoc $ :height (get-in $ [:selrect :height]))))
(defn fix-invalid-rect-values tr-point (fn [point]
[rect-shape] (gpt/transform point (gmt/multiply prev matrix post)))]
(letfn [(check [num] (mapv tr-point points))))
(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 calculate-rec-path-skew-angle (defn transform-rect
[path-shape] "Transform a rectangles and changes its attributes"
(let [p1 (get-in path-shape [:segments 2]) [{:keys [x y width height] :as rect} matrix]
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 (let [points (-> (gpr/rect->points rect)
"Calculates the height of a paralelogram given by the path" (transform-points matrix))]
[path-shape] (gpr/points->rect points)))
(let [p1 (get-in path-shape [:segments 2])
p2 (get-in path-shape [:segments 3])
p3 (get-in path-shape [:segments 4])
v1 (gpt/to-vec p1 p2)
v2 (gpt/to-vec p2 p3)
angle (gpt/angle-with-other v1 v2)]
(* (gpt/length v2) (mth/sin (mth/radians angle)))))
(defn calculate-rec-path-rotation
[path-shape1 path-shape2 resize-vector]
(let [idx-1 0
idx-2 (cond (and (neg? (:x resize-vector)) (pos? (:y resize-vector))) 1
(and (neg? (:x resize-vector)) (neg? (:y resize-vector))) 2
(and (pos? (:x resize-vector)) (neg? (:y resize-vector))) 3
:else 0)
p1 (get-in path-shape1 [:segments idx-1])
p2 (get-in path-shape2 [:segments idx-2])
v1 (gpt/to-vec (gco/center path-shape1) p1)
v2 (gpt/to-vec (gco/center path-shape2) p2)
rot-angle (gpt/angle-with-other v1 v2)
rot-sign (if (> (* (:y v1) (:x v2)) (* (:x v1) (:y v2))) -1 1)]
(* rot-sign rot-angle)))
(defn transform-apply-modifiers (defn- shape->points [shape]
[shape] (let [transform-point
(let [modifiers (:modifiers shape) (fn [point]
ds-modifier (:displacement modifiers (gmt/matrix)) (-> point
(transform-point-center (gco/center-shape shape)
(:transform shape (gmt/matrix)))
(gpt/round)))
points (cond
(and (= :path (:type shape)) (:content shape))
(gpa/content->points (:content shape))
(seq (:segments shape))
(gpa/segments->points (:content shape))
:else
(gpr/rect->points shape))]
(mapv transform-point points)))
(defn normalize-scale
"We normalize the scale so it's not too close to 0"
[scale]
(cond
(and (< scale 0) (> scale -0.01)) -0.01
(and (>= scale 0) (< scale 0.01)) 0.01
:else scale))
(defn modifiers->transform [current-transform center modifiers]
(let [ds-modifier (:displacement modifiers (gmt/matrix))
{res-x :x res-y :y} (:resize-vector modifiers (gpt/point 1 1)) {res-x :x res-y :y} (:resize-vector modifiers (gpt/point 1 1))
;; Normalize x/y vector coordinates because scale by 0 is infinite ;; Normalize x/y vector coordinates because scale by 0 is infinite
res-x (cond res-x (normalize-scale res-x)
(and (< res-x 0) (> res-x -0.01)) -0.01 res-y (normalize-scale res-y)
(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) resize (gpt/point res-x res-y)
origin (:resize-origin modifiers (gpt/point 0 0)) origin (:resize-origin modifiers (gpt/point 0 0))
@ -181,162 +103,423 @@
resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix)) resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix))
rt-modif (or (:rotation modifiers) 0) rt-modif (or (:rotation modifiers) 0)
shape (-> shape transform (-> (gmt/matrix)
(transform ds-modifier))
shape-center (gco/center shape)] ;; Applies the current resize transformation
(gmt/translate origin)
(gmt/multiply resize-transform)
(gmt/scale resize)
(gmt/multiply resize-transform-inverse)
(gmt/translate (gpt/negate origin))
(-> (gpr/shape->path shape) ;; Applies the stacked transformations
(transform (-> (gmt/matrix) (gmt/translate center)
(gmt/multiply (gmt/rotate-matrix rt-modif))
#_(gmt/multiply current-transform)
(gmt/translate (gpt/negate center))
;; Applies the current resize transformation ;; Displacement
(gmt/translate origin) (gmt/multiply ds-modifier))]
(gmt/multiply resize-transform) transform))
(gmt/scale resize)
(gmt/multiply resize-transform-inverse)
(gmt/translate (gpt/negate origin))
;; Applies the stacked transformations (defn- calculate-skew-angle
(gmt/translate shape-center) "Calculates the skew angle of the paralelogram given by the points"
(gmt/multiply (gmt/rotate-matrix rt-modif)) [[p1 p2 p3 p4]]
(gmt/multiply (:transform shape (gmt/matrix))) (let [v1 (gpt/to-vec p3 p4)
(gmt/translate (gpt/negate shape-center))))))) v2 (gpt/to-vec p4 p1)]
(- 90 (gpt/angle-with-other v1 v2))))
(defn transform-path-shape (defn- calculate-height
[shape] "Calculates the height of a paralelogram given by the points"
(-> shape [[p1 p2 p3 p4]]
transform-apply-modifiers (let [v1 (gpt/to-vec p3 p4)
update-path-selrect) v2 (gpt/to-vec p4 p1)
;; TODO: Addapt for paths is not working angle (gpt/angle-with-other v1 v2)]
#_(let [shape-path (transform-apply-modifiers shape) (* (gpt/length v2) (mth/sin (mth/radians angle)))))
shape-path-center (center shape-path)
shape-transform-inverse' (-> (gmt/matrix) (defn- calculate-rotation
(gmt/translate shape-path-center) "Calculates the rotation between two shapes given the resize vector direction"
(gmt/multiply (:transform-inverse shape (gmt/matrix))) [points-shape1 points-shape2 flip-x flip-y]
(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-rect-shape (let [idx-1 0
[shape] idx-2 (cond (and flip-x (not flip-y)) 1
(let [;; Apply modifiers to the rect as a path so we have the end shape expected (and flip-x flip-y) 2
shape-path (transform-apply-modifiers shape) (and (not flip-x) flip-y) 3
shape-center (gco/center shape-path) :else 0)
resize-vector (-> (get-in shape [:modifiers :resize-vector] (gpt/point 1 1)) p1 (nth points-shape1 idx-1)
(update :x #(if (zero? %) 1 %)) p2 (nth points-shape2 idx-2)
(update :y #(if (zero? %) 1 %))) v1 (gpt/to-vec (gco/center-points points-shape1) p1)
v2 (gpt/to-vec (gco/center-points points-shape2) p2)
;; Reverse the current transformation stack to get the base rectangle rot-angle (gpt/angle-with-other v1 v2)
shape-path-temp (center-transform shape-path (:transform-inverse shape (gmt/matrix))) rot-sign (if (> (* (:y v1) (:x v2)) (* (:x v1) (:y v2))) -1 1)]
shape-path-temp-dim (rect-path-dimensions shape-path-temp) (* rot-sign rot-angle)))
shape-path-temp-rec (gpr/shape->rect-shape shape-path-temp)
;; This rectangle is the new data for the current rectangle. We want to change our rectangle (defn- calculate-dimensions
;; to have this width, height, x, y [[p1 p2 p3 p4]]
rec (gco/center->rect shape-center (:width shape-path-temp-dim) (:height shape-path-temp-dim)) (let [width (gpt/distance p1 p2)
rec (fix-invalid-rect-values rec) height (gpt/distance p2 p3)]
rec-path (gpr/rect->path rec) {:width width :height height}))
(defn calculate-adjust-matrix
"Calculates a matrix that is a series of transformations we have to do to the transformed rectangle so that
after applying them the end result is the `shape-pathn-temp`.
This is compose of three transformations: skew, resize and rotation"
[points-temp points-rec flip-x flip-y]
(let [center (gco/center-points points-temp)
;; The next matrix is a series of transformations we have to do to the previous rec so that
;; after applying them the end result is the `shape-path-temp`
;; This is compose of three transformations: skew, resize and rotation
stretch-matrix (gmt/matrix) stretch-matrix (gmt/matrix)
skew-angle (calculate-rec-path-skew-angle shape-path-temp) skew-angle (calculate-skew-angle points-temp)
;; When one of the axis is flipped we have to reverse the skew ;; When one of the axis is flipped we have to reverse the skew
skew-angle (if (neg? (* (:x resize-vector) (:y resize-vector))) (- skew-angle) skew-angle ) ;; skew-angle (if (neg? (* (:x resize-vector) (:y resize-vector))) (- skew-angle) skew-angle )
skew-angle (if (and (or flip-x flip-y)
(not (and flip-x flip-y))) (- skew-angle) skew-angle )
skew-angle (if (mth/nan? skew-angle) 0 skew-angle) skew-angle (if (mth/nan? skew-angle) 0 skew-angle)
stretch-matrix (gmt/multiply stretch-matrix (gmt/skew-matrix skew-angle 0)) stretch-matrix (gmt/multiply stretch-matrix (gmt/skew-matrix skew-angle 0))
h1 (calculate-rec-path-height shape-path-temp) h1 (calculate-height points-temp)
h2 (calculate-rec-path-height (center-transform rec-path stretch-matrix)) h2 (calculate-height (transform-points points-temp center stretch-matrix))
h3 (/ h1 h2) h3 (/ h1 h2)
h3 (if (mth/nan? h3) 1 h3) h3 (if (mth/nan? h3) 1 h3)
stretch-matrix (gmt/multiply stretch-matrix (gmt/scale-matrix (gpt/point 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) rotation-angle (calculate-rotation
shape-path-temp resize-vector) (transform-points points-rec (gco/center-points points-rec) stretch-matrix)
points-temp
flip-x
flip-y)
stretch-matrix (gmt/multiply (gmt/rotate-matrix rotation-angle) stretch-matrix) stretch-matrix (gmt/multiply (gmt/rotate-matrix rotation-angle) stretch-matrix)
stretch-matrix (-> (gmt/matrix)
(gmt/rotate rotation-angle)
(gmt/skew skew-angle 0)
(gmt/scale (gpt/point 1 h3)))
;; This is the inverse to be able to remove the transformation ;; This is the inverse to be able to remove the transformation
stretch-matrix-inverse (-> (gmt/matrix) stretch-matrix-inverse (-> (gmt/matrix)
(gmt/scale (gpt/point 1 h3)) (gmt/scale (gpt/point 1 h3))
(gmt/skew (- skew-angle) 0) (gmt/skew (- skew-angle) 0)
(gmt/rotate (- rotation-angle))) (gmt/rotate (- rotation-angle)))]
[stretch-matrix stretch-matrix-inverse]))
(defn set-points-path
[shape points]
(let [shape (reduce (fn [acc [idx {:keys [x y]}]]
(-> acc
(assoc-in [:content idx :params :x] x)
(assoc-in [:content idx :params :y] y))) shape (d/enumerate points))
shape (assoc shape
:points points
:selrect (gpr/points->selrect points))]
shape))
(defn set-points-curve
[shape points]
shape)
(defn set-points-rect
"Given a new set of points transformed, set up the rectangle so it keeps
its properties. We adjust de x,y,width,height and create a custom transform"
[shape points]
;;
(let [center (gco/center-points points)
;; Reverse the current transformation stack to get the base rectangle
tr-inverse (:transform-inverse shape (gmt/matrix))
modifiers (:modifiers shape)
points-temp (transform-points points center tr-inverse)
points-temp-dim (calculate-dimensions points-temp)
;; This rectangle is the new data for the current rectangle. We want to change our rectangle
;; to have this width, height, x, y
rect-shape (gco/make-centered-rect center
(:width points-temp-dim)
(:height points-temp-dim))
rect-points (gpr/rect->points rect-shape)
[matrix matrix-inverse] (calculate-adjust-matrix points-temp rect-points (:flip-x shape) (:flip-y shape))
;;[matrix matrix-inverse] [(gmt/matrix) (gmt/matrix)]
new-shape (as-> shape $ new-shape (as-> shape $
(merge $ rec) (merge $ rect-shape)
(update $ :x #(mth/precision % 0)) (update $ :x #(mth/precision % 0))
(update $ :y #(mth/precision % 0)) (update $ :y #(mth/precision % 0))
(update $ :width #(mth/precision % 0)) (update $ :width #(mth/precision % 0))
(update $ :height #(mth/precision % 0)) (update $ :height #(mth/precision % 0))
(update $ :transform #(gmt/multiply (or % (gmt/matrix)) stretch-matrix)) (update $ :transform #(gmt/multiply (or % (gmt/matrix)) matrix))
(update $ :transform-inverse #(gmt/multiply stretch-matrix-inverse (or % (gmt/matrix)))) (update $ :transform-inverse #(gmt/multiply matrix-inverse (or % (gmt/matrix))))
(assoc $ :points (shape->points $)) (assoc $ :points (into [] points))
(assoc $ :selrect (gpr/points->selrect (:points $))) (assoc $ :selrect (gpr/rect->selrect rect-shape) #_(gpr/points->selrect points))
(update $ :selrect fix-invalid-rect-values)
(update $ :rotation #(mod (+ (or % 0) (update $ :rotation #(mod (+ (or % 0)
(or (get-in $ [:modifiers :rotation]) 0)) 360)))] (or (get-in $ [:modifiers :rotation]) 0)) 360)))]
new-shape)) new-shape))
(defn transform-shape (defn set-points [shape points]
"Transform the shape properties given the modifiers" (let [set-points-fn
([shape] (case (:type shape)
:path set-points-path
(letfn [(transform-by-type [shape] :curve set-points-curve
(case (:type shape) set-points-rect)]
(:curve :path) (set-points-fn shape points)))
(transform-path-shape shape)
#_:default (defn set-flip [shape modifiers]
(transform-rect-shape shape)))] (cond-> shape
(< (get-in modifiers [:resize-vector :x]) 0) (update :flip-x not)
(cond-> shape (< (get-in modifiers [:resize-vector :y]) 0) (update :flip-y not)))
(:modifiers shape) (transform-by-type)
:always (dissoc :modifiers)))
#_(cond-> shape (defn transform-shape [shape]
(and (:modifiers shape) (#{:curve :path} (:type shape))) (if (:modifiers shape)
(transform-path-shape shape) (let [points (:points shape (shape->points shape))
center (gco/center-points points)
(and (:modifiers shape) (not (#{:curve :path} (:type shape)))) transform (modifiers->transform (:transform shape (gmt/matrix)) center (:modifiers shape))
(transform-rect-shape shape) tr-points (transform-points points transform)]
(-> shape
(set-flip (:modifiers shape))
(set-points tr-points)
(dissoc :modifiers)))
shape))
true #_(defn transform-shape
(dissoc :modifiers) "Transform the shape properties given the modifiers"
)) ([shape]
#_([frame shape kk] (letfn [(transform-by-type [shape]
(case (:type shape)
(:curve :path)
(transform-path-shape shape)
#_:default
(transform-rect-shape shape)))]
(cond-> shape
(:modifiers shape) (transform-by-type)
:always (dissoc :modifiers)))))
;; --- Transform Shape
#_(
(declare transform-rect)
(declare transform-path)
(declare transform)
(defn center-transform [shape matrix]
(let [shape-center (gco/center shape)]
(-> shape
(transform
(-> (gmt/matrix)
(gmt/translate shape-center)
(gmt/multiply matrix)
(gmt/translate (gpt/negate shape-center)))))))
(defn- transform-rect
[{:keys [x y width height] :as shape} mx]
(let [tl (gpt/transform (gpt/point x y) mx)
tr (gpt/transform (gpt/point (+ x width) y) mx)
bl (gpt/transform (gpt/point x (+ y height)) mx)
br (gpt/transform (gpt/point (+ x width) (+ y height)) mx)
;; TODO: replace apply with transduce (performance)
minx (apply min (map :x [tl tr bl br]))
maxx (apply max (map :x [tl tr bl br]))
miny (apply min (map :y [tl tr bl br]))
maxy (apply max (map :y [tl tr bl br]))]
(assoc shape
:x minx
:y miny
:width (- maxx minx)
:height (- maxy miny))))
(defn- transform-path
[{:keys [segments] :as shape} xfmt]
(let [segments (mapv #(gpt/transform % xfmt) segments)]
(assoc shape :segments segments)))
#_(if (:modifiers shape)
(-> (case (:type shape) (defn update-path-selrect [shape]
(:curve :path) (transform-path-shape shape) (as-> shape $
(transform-rect-shape shape)) (assoc $ :points (shape->points $))
(dissoc :modifiers)) (assoc $ :selrect (gpr/points->selrect (:points $)))
shape) (assoc $ :x (get-in $ [:selrect :x]))
#_(let [new-shape (assoc $ :y (get-in $ [:selrect :y]))
] (assoc $ :width (get-in $ [:selrect :width]))
(assoc $ :height (get-in $ [:selrect :height]))))
#_(cond-> new-shape
frame (translate-to-frame frame))))) (defn fix-invalid-rect-values
[rect-shape]
(letfn [(check [num]
(if (or (nil? num) (mth/nan? num) (= ##Inf num) (= ##-Inf num)) 0 num))
(to-positive [num] (if (< num 1) 1 num))]
(-> rect-shape
(update :x check)
(update :y check)
(update :width (comp to-positive check))
(update :height (comp to-positive check)))))
(declare transform-points)
(defn apply-modifiers
[transform-stack modifiers points]
(let [ds-modifier (:displacement modifiers (gmt/matrix))
{res-x :x res-y :y} (:resize-vector modifiers (gpt/point 1 1))
;; Normalize x/y vector coordinates because scale by 0 is infinite
res-x (normalize-scale res-x)
res-y (normalize-scale res-y)
resize (gpt/point res-x res-y)
origin (:resize-origin modifiers (gpt/point 0 0))
resize-transform (:resize-transform modifiers (gmt/matrix))
resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix))
rt-modif (or (:rotation modifiers) 0)
points (transform-points ds-modifier)
center (gco/center-points points)]
(-> points
(transform-points
(-> (gmt/matrix)
;; Applies the current resize transformation
(gmt/translate origin)
(gmt/multiply resize-transform)
(gmt/scale resize)
(gmt/multiply resize-transform-inverse)
(gmt/translate (gpt/negate origin))
;; Applies the stacked transformations
(gmt/translate center)
(gmt/multiply (gmt/rotate-matrix rt-modif))
(gmt/multiply transform-stack)
(gmt/translate (gpt/negate center)))))))
(defn transform-path-shape
[shape]
shape
#_(-> shape
transform-apply-modifiers
update-path-selrect)
;; TODO: Addapt for paths is not working
#_(let [shape-path (transform-apply-modifiers shape)
shape-path-center (center shape-path)
shape-transform-inverse' (-> (gmt/matrix)
(gmt/translate shape-path-center)
(gmt/multiply (:transform-inverse shape (gmt/matrix)))
(gmt/multiply (gmt/rotate-matrix (- (:rotation-modifier shape 0))))
(gmt/translate (gpt/negate shape-path-center)))]
(-> shape-path
(transform shape-transform-inverse')
(add-rotate-transform (:rotation-modifier shape 0)))))
(defn adjust-rect-transforms [shape]
)
(defn transform-rect-shape
[shape]
(let [points (-> (:points shape (shape->points shape))
(apply-modifiers (:transform shape) (:modifiers shape) points))
center (gco/center-points points)
resize-vector (-> (get-in shape [:modifiers :resize-vector] (gpt/point 1 1))
(update :x #(if (zero? %) 1 %))
(update :y #(if (zero? %) 1 %)))
;; Reverse the current transformation stack to get the base rectangle
tr-inverse (:transform-inverse shape (gmt/matrix))
points-temp (transform-poins points center tr-inverse)
points-temp-dim (gpr/rect-points-dimensions points)
points-temp-rec (gpr/points->selrect points)
;; This rectangle is the new data for the current rectangle. We want to change our rectangle
;; to have this width, height, x, y
rec (-> (gco/center->rect center (:width points-temp-dim) (:height points-temp-dim))
(gpr/rect->points))
;;rec (fix-invalid-rect-values rec)
;;rec-path (gpr/rect->path rec)
;; The next matrix is a series of transformations we have to do to the previous rec so that
;; after applying them the end result is the `shape-path-temp`
;; This is compose of three transformations: skew, resize and rotation
stretch-matrix (gmt/matrix)
skew-angle (calculate-rec-path-skew-angle shape-path-temp)
;; When one of the axis is flipped we have to reverse the skew
skew-angle (if (neg? (* (:x resize-vector) (:y resize-vector))) (- skew-angle) skew-angle )
skew-angle (if (mth/nan? skew-angle) 0 skew-angle)
(defn transform-matrix stretch-matrix (gmt/multiply stretch-matrix (gmt/skew-matrix skew-angle 0))
"Returns a transformation matrix without changing the shape properties.
The result should be used in a `transform` attribute in svg" h1 (calculate-rec-path-height shape-path-temp)
([{:keys [x y] :as shape}] h2 (calculate-rec-path-height (center-transform rec-path stretch-matrix))
(let [shape-center (gco/center shape)] h3 (/ h1 h2)
(-> (gmt/matrix) h3 (if (mth/nan? h3) 1 h3)
(gmt/translate shape-center)
(gmt/multiply (:transform shape (gmt/matrix))) stretch-matrix (gmt/multiply stretch-matrix (gmt/scale-matrix (gpt/point 1 h3)))
(gmt/translate (gpt/negate shape-center))))))
rotation-angle (calculate-rec-path-rotation (center-transform rec-path stretch-matrix)
shape-path-temp resize-vector)
stretch-matrix (gmt/multiply (gmt/rotate-matrix rotation-angle) stretch-matrix)
;; This is the inverse to be able to remove the transformation
stretch-matrix-inverse (-> (gmt/matrix)
(gmt/scale (gpt/point 1 h3))
(gmt/skew (- skew-angle) 0)
(gmt/rotate (- rotation-angle)))
new-shape (as-> shape $
(merge $ rec)
(update $ :x #(mth/precision % 0))
(update $ :y #(mth/precision % 0))
(update $ :width #(mth/precision % 0))
(update $ :height #(mth/precision % 0))
(update $ :transform #(gmt/multiply (or % (gmt/matrix)) stretch-matrix))
(update $ :transform-inverse #(gmt/multiply stretch-matrix-inverse (or % (gmt/matrix))))
(assoc $ :points (shape->points $))
(assoc $ :selrect (gpr/points->selrect (:points $)))
(update $ :selrect fix-invalid-rect-values)
(update $ :rotation #(mod (+ (or % 0)
(or (get-in $ [:modifiers :rotation]) 0)) 360)))]
new-shape))
(defn transform-points
"Apply the matrix transformation to points"
[points xfmt]
(cond->> points
(gmt/matrix? xfmt) (map #(gpt/transform % xfmt))))
#_(defn transform
"Apply the matrix transformation to shape"
[{:keys [type] :as shape} xfmt]
(if (gmt/matrix? xfmt)
(case type
:path (transform-path shape xfmt)
:curve (transform-path shape xfmt)
(transform-rect shape xfmt))
shape))
)

10
common/app/common/pages.cljc
View file

@ -273,7 +273,9 @@
(s/every uuid? :kind vector?)) (s/every uuid? :kind vector?))
(s/def ::shape-attrs (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/collapsed
:internal.shape/content :internal.shape/content
:internal.shape/fill-color :internal.shape/fill-color
@ -309,8 +311,6 @@
:internal.shape/width :internal.shape/width
:internal.shape/height :internal.shape/height
:internal.shape/interactions :internal.shape/interactions
:internal.shape/selrect
:internal.shape/points
:internal.shape/masked-group? :internal.shape/masked-group?
:internal.shape/shadow :internal.shape/shadow
:internal.shape/blur])) :internal.shape/blur]))
@ -764,7 +764,7 @@
(defn rotation-modifiers (defn rotation-modifiers
[center shape angle] [center shape angle]
(let [displacement (let [shape-center (geom/center shape)] (let [displacement (let [shape-center (geom/center-shape shape)]
(-> (gmt/matrix) (-> (gmt/matrix)
(gmt/rotate angle center) (gmt/rotate angle center)
(gmt/rotate (- angle) shape-center)))] (gmt/rotate (- angle) shape-center)))]
@ -783,7 +783,7 @@
(distinct)) (distinct))
shapes))) shapes)))
(update-group [group objects] (update-group [group objects]
(let [gcenter (geom/center group) (let [gcenter (geom/center-shape group)
gxfm (comp gxfm (comp
(map #(get objects %)) (map #(get objects %))
(map #(-> % (map #(-> %

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

@ -14,6 +14,7 @@
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.geom.proportions :as gpr]
[app.common.geom.align :as gal] [app.common.geom.align :as gal]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.pages :as cp] [app.common.pages :as cp]
@ -30,6 +31,7 @@
[app.main.data.workspace.selection :as dws] [app.main.data.workspace.selection :as dws]
[app.main.data.workspace.texts :as dwtxt] [app.main.data.workspace.texts :as dwtxt]
[app.main.data.workspace.transforms :as dwt] [app.main.data.workspace.transforms :as dwt]
[app.main.data.workspace.drawing :as dwd]
[app.main.repo :as rp] [app.main.repo :as rp]
[app.main.store :as st] [app.main.store :as st]
[app.main.streams :as ms] [app.main.streams :as ms]
@ -472,10 +474,10 @@
(let [vbox (update vbox :x + (:left-offset vbox)) (let [vbox (update vbox :x + (:left-offset vbox))
new-zoom (if (fn? zoom) (zoom (:zoom local)) zoom) new-zoom (if (fn? zoom) (zoom (:zoom local)) zoom)
old-zoom (:zoom local) old-zoom (:zoom local)
center (if center center (gsh/center vbox)) center (if center center (gsh/center-rect vbox))
scale (/ old-zoom new-zoom) scale (/ old-zoom new-zoom)
mtx (gmt/scale-matrix (gpt/point scale) center) mtx (gmt/scale-matrix (gpt/point scale) center)
vbox' (gsh/transform vbox mtx) vbox' (gsh/transform-rect vbox mtx)
vbox' (update vbox' :x - (:left-offset vbox))] vbox' (update vbox' :x - (:left-offset vbox))]
(-> local (-> local
(assoc :zoom new-zoom) (assoc :zoom new-zoom)
@ -546,50 +548,6 @@
;; --- Add shape to Workspace ;; --- 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 (defn- viewport-center
[state] [state]
(let [{:keys [x y width height]} (get-in state [:workspace-local :vbox])] (let [{:keys [x y width height]} (get-in state [:workspace-local :vbox])]
@ -615,8 +573,8 @@
(merge data) (merge data)
(merge {:x x :y y}) (merge {:x x :y y})
(assoc :frame-id frame-id) (assoc :frame-id frame-id)
(rx/of (add-shape shape))))))
(gsh/setup-selrect))] (gsh/setup-selrect))]
(rx/of (dwc/add-shape shape))))))
;; --- Update Shape Attrs ;; --- Update Shape Attrs
@ -954,7 +912,7 @@
(defn align-objects (defn align-objects
[axis] [axis]
(us/verify ::geom/align-axis axis) (us/verify ::gal/align-axis axis)
(ptk/reify :align-objects (ptk/reify :align-objects
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
@ -992,17 +950,17 @@
[objects object-id axis] [objects object-id axis]
(let [object (get objects object-id) (let [object (get objects object-id)
frame (get objects (:frame-id object))] 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 (defn align-objects-list
[objects selected axis] [objects selected axis]
(let [selected-objs (map #(get objects %) selected) (let [selected-objs (map #(get objects %) selected)
rect (geom/selection-rect selected-objs)] rect (gsh/selection-rect selected-objs)]
(mapcat #(geom/align-to-rect % rect axis objects) selected-objs))) (mapcat #(gal/align-to-rect % rect axis objects) selected-objs)))
(defn distribute-objects (defn distribute-objects
[axis] [axis]
(us/verify ::geom/dist-axis axis) (us/verify ::gal/dist-axis axis)
(ptk/reify :align-objects (ptk/reify :align-objects
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
@ -1010,7 +968,7 @@
objects (dwc/lookup-page-objects state page-id) objects (dwc/lookup-page-objects state page-id)
selected (get-in state [:workspace-local :selected]) selected (get-in state [:workspace-local :selected])
moved (-> (map #(get objects %) selected) moved (-> (map #(get objects %) selected)
(geom/distribute-space axis objects))] (gal/distribute-space axis objects))]
(loop [moved (seq moved) (loop [moved (seq moved)
rchanges [] rchanges []
uchanges []] uchanges []]
@ -1035,62 +993,6 @@
:operations ops2 :operations ops2
:id (:id curr)}))))))))) :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 ;; --- Update Dimensions
;; Event mainly used for handling user modification of the size of the ;; Event mainly used for handling user modification of the size of the
@ -1104,7 +1006,7 @@
(ptk/reify ::update-dimensions (ptk/reify ::update-dimensions
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (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 ;; --- Shape Proportions
@ -1118,7 +1020,7 @@
(if-not lock (if-not lock
(assoc shape :proportion-lock false) (assoc shape :proportion-lock false)
(-> (assoc shape :proportion-lock true) (-> (assoc shape :proportion-lock true)
(geom/assign-proportions))))))))) (gpr/assign-proportions)))))))))
;; --- Update Shape Position ;; --- Update Shape Position
(s/def ::x number?) (s/def ::x number?)
@ -1157,7 +1059,7 @@
(let [page-id (:current-page-id state)] (let [page-id (:current-page-id state)]
(-> state (-> state
(update-in [:workspace-data page-id :objects id :segments index] gpt/add delta) (update-in [:workspace-data page-id :objects id :segments index] gpt/add delta)
(update-in [:workspace-data page-id :objects id] geom/update-path-selrect)))))) (update-in [:workspace-data page-id :objects id] gsh/update-path-selrect))))))
;; --- Shape attrs (Layers Sidebar) ;; --- Shape attrs (Layers Sidebar)
@ -1290,7 +1192,7 @@
;; When the parent frame is not selected we change to relative ;; When the parent frame is not selected we change to relative
;; coordinates ;; coordinates
(let [frame (get objects (:frame-id shape))] (let [frame (get objects (:frame-id shape))]
(geom/translate-to-frame shape frame)) (gsh/translate-to-frame shape frame))
shape)) shape))
(prepare [result objects selected id] (prepare [result objects selected id]
@ -1329,7 +1231,7 @@
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [selected-objs (map #(get objects %) selected) (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)) orig-pos (gpt/point (:x1 wrapper) (:y1 wrapper))
mouse-pos @ms/mouse-position mouse-pos @ms/mouse-position
@ -1359,7 +1261,7 @@
(map #(get-in % [:obj :id])) (map #(get-in % [:obj :id]))
(into (d/ordered-set)))] (into (d/ordered-set)))]
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}) (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
(dws/select-shapes selected)))))) (dwc/select-shapes selected))))))
(defn- image-uploaded (defn- image-uploaded
[image] [image]
@ -1446,7 +1348,7 @@
page-id (:current-page-id state) page-id (:current-page-id state)
frame-id (-> (dwc/lookup-page-objects state page-id) frame-id (-> (dwc/lookup-page-objects state page-id)
(cph/frame-id-by-position @ms/mouse-position)) (cph/frame-id-by-position @ms/mouse-position))
shape (geom/setup-selrect shape (gsh/setup-selrect
{:id id {:id id
:type :text :type :text
:name "Text" :name "Text"
@ -1459,7 +1361,7 @@
:content (as-content text)})] :content (as-content text)})]
(rx/of dwc/start-undo-transaction (rx/of dwc/start-undo-transaction
(dws/deselect-all) (dws/deselect-all)
(add-shape shape) (dwc/add-shape shape)
dwc/commit-undo-transaction))))) dwc/commit-undo-transaction)))))
(defn update-shape-flags (defn update-shape-flags
@ -1490,7 +1392,7 @@
(when-not (empty? shapes) (when-not (empty? shapes)
(let [[group rchanges uchanges] (dws/prepare-create-group page-id shapes "Group-" false)] (let [[group rchanges uchanges] (dws/prepare-create-group page-id shapes "Group-" false)]
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}) (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 (def ungroup-selected
(ptk/reify ::ungroup-selected (ptk/reify ::ungroup-selected
@ -1568,7 +1470,7 @@
:val (:fill-color mask)}]}))] :val (:fill-color mask)}]}))]
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}) (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 (def unmask-group
(ptk/reify ::unmask-group (ptk/reify ::unmask-group
@ -1595,7 +1497,7 @@
:val (:masked-group? group)}]}]] :val (:masked-group? group)}]}]]
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}) (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
(dws/select-shapes (d/ordered-set (:id group)))))))))) (dwc/select-shapes (d/ordered-set (:id group))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1718,10 +1620,14 @@
(def select-shape dws/select-shape) (def select-shape dws/select-shape)
(def deselect-all dws/deselect-all) (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 duplicate-selected dws/duplicate-selected)
(def handle-selection dws/handle-selection) (def handle-selection dws/handle-selection)
(def select-inside-group dws/select-inside-group) (def select-inside-group dws/select-inside-group)
(def select-for-drawing dwd/select-for-drawing)
(def clear-edition-mode dwc/clear-edition-mode)
(def add-shape dwc/add-shape)
(def start-edition-mode dwc/start-edition-mode)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1753,12 +1659,12 @@
"ctrl+shift+z" #(st/emit! dwc/redo) "ctrl+shift+z" #(st/emit! dwc/redo)
"ctrl+y" #(st/emit! dwc/redo) "ctrl+y" #(st/emit! dwc/redo)
"ctrl+q" #(st/emit! dwc/reinitialize-undo) "ctrl+q" #(st/emit! dwc/reinitialize-undo)
"a" #(st/emit! (select-for-drawing :frame)) "a" #(st/emit! (dwd/select-for-drawing :frame))
"b" #(st/emit! (select-for-drawing :rect)) "b" #(st/emit! (dwd/select-for-drawing :rect))
"e" #(st/emit! (select-for-drawing :circle)) "e" #(st/emit! (dwd/select-for-drawing :circle))
"t" #(st/emit! dwtxt/start-edit-if-selected "t" #(st/emit! dwtxt/start-edit-if-selected
(select-for-drawing :text)) (dwd/select-for-drawing :text))
"w" #(st/emit! (select-for-drawing :path)) "w" #(st/emit! (dwd/select-for-drawing :path))
"ctrl+c" #(st/emit! copy-selected) "ctrl+c" #(st/emit! copy-selected)
"ctrl+v" #(st/emit! paste) "ctrl+v" #(st/emit! paste)
"ctrl+x" #(st/emit! copy-selected delete-selected) "ctrl+x" #(st/emit! copy-selected delete-selected)
@ -1778,4 +1684,3 @@
"right" #(st/emit! (dwt/move-selected :right false)) "right" #(st/emit! (dwt/move-selected :right false))
"left" #(st/emit! (dwt/move-selected :left false)) "left" #(st/emit! (dwt/move-selected :left false))
"i" #(st/emit! (mdc/picker-for-selected-shape ))}) "i" #(st/emit! (mdc/picker-for-selected-shape ))})

92
frontend/src/app/main/data/workspace/common.cljs
View file

@ -20,8 +20,12 @@
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.main.worker :as uw] [app.main.worker :as uw]
[app.util.timers :as ts] [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 ;; --- Protocols
(declare setup-selection-index) (declare setup-selection-index)
@ -158,7 +162,7 @@
(defn get-frame-at-point (defn get-frame-at-point
[objects point] [objects point]
(let [frames (cph/select-frames objects)] (let [frames (cph/select-frames objects)]
(d/seek #(geom/has-point? % point) frames))) (d/seek #(gsh/has-point? % point) frames)))
(defn- extract-numeric-suffix (defn- extract-numeric-suffix
@ -171,8 +175,6 @@
[objects] [objects]
(into #{} (map :name) (vals objects))) (into #{} (map :name) (vals objects)))
(s/def ::set-of-string
(s/every string? :kind set?))
(defn generate-unique-name (defn generate-unique-name
"A unique name generator" "A unique name generator"
@ -434,3 +436,85 @@
[rchanges uchanges] (impl-gen-changes objects page-id (seq ids))] [rchanges uchanges] (impl-gen-changes objects page-id (seq ids))]
(rx/of (commit-changes rchanges uchanges {:commit-local? true}))))))) (rx/of (commit-changes rchanges uchanges {:commit-local? true})))))))
(defn select-shapes
[ids]
(us/verify ::ordered-set-of-uuid ids)
(ptk/reify ::select-shapes
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :selected] ids))
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (lookup-page-objects state page-id)]
(rx/of (expand-all-parents ids objects))))))
;; --- Start shape "edition mode"
(declare clear-edition-mode)
(defn start-edition-mode
[id]
(us/assert ::us/uuid id)
(ptk/reify ::start-edition-mode
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :edition] id))
ptk/WatchEvent
(watch [_ state stream]
(->> stream
(rx/filter interrupt?)
(rx/take 1)
(rx/map (constantly clear-edition-mode))))))
(def clear-edition-mode
(ptk/reify ::clear-edition-mode
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local dissoc :edition))))
(defn add-shape
[attrs]
(us/verify ::shape-attrs attrs)
(ptk/reify ::add-shape
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (lookup-page-objects state page-id)
id (uuid/next)
shape (gpr/setup-proportions attrs)
unames (retrieve-used-names objects)
name (generate-unique-name unames (:name shape))
frame-id (or (:frame-id attrs)
(cph/frame-id-by-position objects attrs))
shape (merge
(if (= :frame (:type shape))
cp/default-frame-attrs
cp/default-shape-attrs)
(assoc shape
:id id
:name name))
rchange {:type :add-obj
:id id
:page-id page-id
:frame-id frame-id
:obj shape}
uchange {:type :del-obj
:page-id page-id
:id id}]
(rx/concat
(rx/of (commit-changes [rchange] [uchange] {:commit-local? true})
(select-shapes (d/ordered-set id)))
(when (= :text (:type attrs))
(->> (rx/of (start-edition-mode id))
(rx/observe-on :async))))))))

34
frontend/src/app/main/data/workspace/drawing.cljs
View file

@ -12,15 +12,48 @@
(:require (:require
[beicon.core :as rx] [beicon.core :as rx]
[potok.core :as ptk] [potok.core :as ptk]
[app.common.spec :as us]
[app.common.pages :as cp] [app.common.pages :as cp]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.drawing.common :as common] [app.main.data.workspace.drawing.common :as common]
[app.main.data.workspace.drawing.path :as path] [app.main.data.workspace.drawing.path :as path]
[app.main.data.workspace.drawing.curve :as curve] [app.main.data.workspace.drawing.curve :as curve]
[app.main.data.workspace.drawing.box :as box])) [app.main.data.workspace.drawing.box :as box]))
(declare start-drawing)
(declare handle-drawing) (declare handle-drawing)
;; --- Select for Drawing
(defn select-for-drawing
([tool] (select-for-drawing tool nil))
([tool data]
(ptk/reify ::select-for-drawing
ptk/UpdateEvent
(update [_ state]
(update state :workspace-drawing assoc :tool tool :object data))
ptk/WatchEvent
(watch [_ state stream]
(let [stoper (rx/filter (ptk/type? ::clear-drawing) stream)]
(rx/merge
(rx/of (dws/deselect-all))
(when (= tool :path)
(rx/of (start-drawing :path)))
;; NOTE: comments are a special case and they manage they
;; own interrupt cycle.
(when (not= tool :comments)
(->> stream
(rx/filter dwc/interrupt?)
(rx/take 1)
(rx/map (constantly common/clear-drawing))
(rx/take-until stoper)))))))))
;; NOTE/TODO: when an exception is raised in some point of drawing the ;; 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 ;; draw lock is not released so the user need to refresh in order to
;; be able draw again. THIS NEED TO BE REVISITED ;; be able draw again. THIS NEED TO BE REVISITED
@ -68,3 +101,4 @@
;; Export ;; Export
(def close-drawing-path path/close-drawing-path) (def close-drawing-path path/close-drawing-path)

3
frontend/src/app/main/data/workspace/drawing/box.cljs
View file

@ -74,7 +74,8 @@
;; Initial SNAP ;; Initial SNAP
(->> (snap/closest-snap-point page-id [shape] layout initial) (->> (snap/closest-snap-point page-id [shape] layout initial)
(rx/map (fn [{:keys [x y]}] (rx/map (fn [{:keys [x y]}]
#(update-in % [:workspace-drawing :object] assoc :x x :y y)))) #(update-in % [:workspace-drawing :object] gsh/absolute-move (gpt/point x y))
)))
(->> ms/mouse-position (->> ms/mouse-position
(rx/filter #(> (gpt/distance % initial) 2)) (rx/filter #(> (gpt/distance % initial) 2))

14
frontend/src/app/main/data/workspace/drawing/common.cljs
View file

@ -13,17 +13,23 @@
[potok.core :as ptk] [potok.core :as ptk]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.main.data.workspace :as dw]
[app.main.data.workspace.common :as dwc] [app.main.data.workspace.common :as dwc]
[app.main.data.workspace.selection :as dws]
[app.main.streams :as ms])) [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 (def handle-finish-drawing
(ptk/reify ::handle-finish-drawing (ptk/reify ::handle-finish-drawing
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [shape (get-in state [:workspace-drawing :object])] (let [shape (get-in state [:workspace-drawing :object])]
(rx/concat (rx/concat
(rx/of dw/clear-drawing) (rx/of clear-drawing)
(when (:initialized? shape) (when (:initialized? shape)
(let [shape-click-width (case (:type shape) (let [shape-click-width (case (:type shape)
:text 3 :text 3
@ -52,5 +58,5 @@
(rx/of dwc/start-undo-transaction) (rx/of dwc/start-undo-transaction)
(rx/empty)) (rx/empty))
(rx/of (dw/deselect-all) (rx/of (dws/deselect-all)
(dw/add-shape shape)))))))))) (dwc/add-shape shape))))))))))

8
frontend/src/app/main/data/workspace/drawing/curve.cljs
View file

@ -11,6 +11,7 @@
(:require (:require
[beicon.core :as rx] [beicon.core :as rx]
[potok.core :as ptk] [potok.core :as ptk]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.main.streams :as ms] [app.main.streams :as ms]
[app.util.geom.path :as path] [app.util.geom.path :as path]
@ -27,13 +28,18 @@
(defn insert-point-segment [state point] (defn insert-point-segment [state point]
(update-in state [:workspace-drawing :object :segments] (fnil conj []) point)) (update-in state [:workspace-drawing :object :segments] (fnil conj []) point))
(defn update-selrect [{:keys [segments] :as shape}]
(let [points (->> segments
(map #(apply gpt/point %)))]
(assoc shape :selrect (gsh/points->selrect points))))
(defn finish-drawing-curve [state] (defn finish-drawing-curve [state]
(update-in (update-in
state [:workspace-drawing :object] state [:workspace-drawing :object]
(fn [shape] (fn [shape]
(-> shape (-> shape
(update :segments #(path/simplify % simplify-tolerance)) (update :segments #(path/simplify % simplify-tolerance))
(gsh/update-path-selrect))))) (update-selrect)))))
(defn handle-drawing-curve [] (defn handle-drawing-curve []
(ptk/reify ::handle-drawing-curve (ptk/reify ::handle-drawing-curve

110
frontend/src/app/main/data/workspace/drawing/path.cljs
View file

@ -17,23 +17,23 @@
[app.util.geom.path :as path] [app.util.geom.path :as path]
[app.main.data.workspace.drawing.common :as common])) [app.main.data.workspace.drawing.common :as common]))
(defn stoper-event? [{:keys [type shift] :as event}] (defn finish-event? [{:keys [type shift] :as event}]
(or (= event ::end-path-drawing) (or (= event ::end-path-drawing)
(= event :interrupt) (= event :interrupt)
(and (ms/mouse-event? event) #_(and (ms/mouse-event? event)
(or (= type :double-click) (or (= type :double-click)
(= type :context-menu))) (= type :context-menu)))
(and (ms/keyboard-event? event) (and (ms/keyboard-event? event)
(= type :down) (= type :down)
(= 13 (:key event))))) (= 13 (:key event)))))
(defn init-path [] #_(defn init-path []
(fn [state] (fn [state]
(update-in state [:workspace-drawing :object] (update-in state [:workspace-drawing :object]
assoc :content [] assoc :content []
:initialized? true))) :initialized? true)))
(defn add-path-command [command] #_(defn add-path-command [command]
(fn [state] (fn [state]
(update-in state [:workspace-drawing :object :content] conj command))) (update-in state [:workspace-drawing :object :content] conj command)))
@ -43,7 +43,7 @@
(cond-> state (cond-> state
exists? (assoc-in [:workspace-drawing :object :segments index] point)))) exists? (assoc-in [:workspace-drawing :object :segments index] point))))
(defn finish-drawing-path [] #_(defn finish-drawing-path []
(fn [state] (fn [state]
(update-in (update-in
state [:workspace-drawing :object] state [:workspace-drawing :object]
@ -52,17 +52,109 @@
(gsh/update-path-selrect)))))) (gsh/update-path-selrect))))))
(defn handle-drawing-path [] (defn calculate-selrect [shape]
(let [points (->> shape
:content
(mapv #(gpt/point
(-> % :params :x)
(-> % :params :y))))]
(assoc shape
:points points
:selrect (gsh/points->selrect points))))
(defn init-path []
(ptk/reify ::init-path
ptk/UpdateEvent
(update [_ state]
(-> state
(assoc-in [:workspace-drawing :object :initialized?] true)
(assoc-in [:workspace-drawing :object :last-point] nil)))))
(defn finish-path []
(ptk/reify ::finish-path
ptk/UpdateEvent
(update [_ state]
(-> state
(assoc-in [:workspace-drawing :object :last-point] nil)
(update-in [:workspace-drawing :object] calculate-selrect)))))
(defn add-node [{:keys [x y]}]
(ptk/reify ::add-node
ptk/UpdateEvent
(update [_ state]
(let [point {:x x :y y}
last-point (get-in state [:workspace-drawing :object :last-point])
command (if last-point
{:command :line-to
:params point}
{:command :move-to
:params point})]
(-> state
(assoc-in [:workspace-drawing :object :last-point] point)
(update-in [:workspace-drawing :object :content] (fnil conj []) command))))))
(defn drag-handler [{:keys [x y]}]
(ptk/reify ::drag-handler
ptk/UpdateEvent
(update [_ state]
(-> state))))
(defn make-click-stream
[stream down-event]
(->> stream
(rx/filter ms/mouse-click?)
(rx/debounce 200)
(rx/first)
(rx/map #(add-node down-event))))
(defn make-drag-stream
[stream down-event]
(let [mouse-up (->> stream (rx/filter ms/mouse-up?))
drag-events (->> ms/mouse-position
(rx/take-until mouse-up)
(rx/map #(drag-handler %)))]
(->> (rx/timer 400)
(rx/merge-map #(rx/concat
(add-node down-event)
drag-events)))))
(defn make-dbl-click-stream
[stream down-event]
(->> stream
(rx/filter ms/mouse-double-click?)
(rx/first)
(rx/merge-map
#(rx/of (add-node down-event)
::end-path-drawing))))
(defn handle-drawing-path []
(ptk/reify ::handle-drawing-path (ptk/reify ::handle-drawing-path
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
;; clicks stream<[MouseEvent, Position]> ;; clicks stream<[MouseEvent, Position]>
clicks (->> stream (let [
(rx/filter ms/mouse-click?)
(rx/with-latest vector ms/mouse-position)) mouse-down (->> stream (rx/filter ms/mouse-down?))
finish-events (->> stream (rx/filter finish-event?))
events (->> mouse-down
(rx/take-until finish-events)
(rx/throttle 100)
(rx/with-latest merge ms/mouse-position)
;; We change to the stream that emits the first event
(rx/switch-map
#(rx/race (make-click-stream stream %)
(make-drag-stream stream %)
(make-dbl-click-stream stream %))))]
(rx/concat
(rx/of (init-path))
events
(rx/of (finish-path))
(rx/of common/handle-finish-drawing)))
))) )))

4
frontend/src/app/main/data/workspace/libraries.cljs
View file

@ -251,7 +251,7 @@
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}) (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 (defn rename-component
[id new-name] [id new-name]
@ -407,7 +407,7 @@
new-shapes)] new-shapes)]
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}) (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 (defn detach-component
"Remove all references to components in the shape with the given id, "Remove all references to components in the shape with the given id,

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

@ -80,7 +80,8 @@
(defn start-resize (defn start-resize
[handler initial ids shape] [handler initial ids shape]
(letfn [(resize [shape initial resizing-shapes [point lock? point-snap]] (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)) shapev (-> (gpt/point width height))
rotation (if (#{:curve :path} (:type shape)) 0 rotation) rotation (if (#{:curve :path} (:type shape)) 0 rotation)
@ -101,9 +102,11 @@
shape-transform (:transform shape (gmt/matrix)) shape-transform (:transform shape (gmt/matrix))
shape-transform-inverse (:transform-inverse shape (gmt/matrix)) shape-transform-inverse (:transform-inverse shape (gmt/matrix))
shape-center (gsh/center-shape shape)
;; Resize origin point given the selected handler ;; Resize origin point given the selected handler
origin (-> (handler-resize-origin shape handler) origin (-> (handler-resize-origin (:selrect shape) handler)
(gsh/transform-shape-point shape shape-transform))] (gsh/transform-point-center shape-center shape-transform))]
(rx/of (set-modifiers ids (rx/of (set-modifiers ids
{:resize-vector scalev {:resize-vector scalev
@ -170,7 +173,7 @@
(watch [_ state stream] (watch [_ state stream]
(let [stoper (rx/filter ms/mouse-up? stream) (let [stoper (rx/filter ms/mouse-up? stream)
group (gsh/selection-rect shapes) 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) initial-angle (gpt/angle @ms/mouse-position group-center)
calculate-angle (fn [pos ctrl?] calculate-angle (fn [pos ctrl?]
(let [angle (- (gpt/angle pos group-center) initial-angle) (let [angle (- (gpt/angle pos group-center) initial-angle)
@ -403,7 +406,7 @@
#(reduce update-shape % ids-with-children))))))) #(reduce update-shape % ids-with-children)))))))
(defn rotation-modifiers [center shape angle] (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/matrix)
(gmt/rotate angle center) (gmt/rotate angle center)
(gmt/rotate (- angle) shape-center)))] (gmt/rotate (- angle) shape-center)))]
@ -416,7 +419,7 @@
(defn set-rotation (defn set-rotation
([delta-rotation shapes] ([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] ([delta-rotation shapes center]
(letfn [(rotate-shape [objects angle shape center] (letfn [(rotate-shape [objects angle shape center]

2
frontend/src/app/main/exports.cljs
View file

@ -45,7 +45,7 @@
(let [shapes (cph/select-toplevel-shapes objects {:include-frames? true})] (let [shapes (cph/select-toplevel-shapes objects {:include-frames? true})]
(->> (gsh/selection-rect shapes) (->> (gsh/selection-rect shapes)
(gal/adjust-to-viewport vport) (gal/adjust-to-viewport vport)
(gsh/fix-invalid-rect-values)))) #_(gsh/fix-invalid-rect-values))))
(declare shape-wrapper-factory) (declare shape-wrapper-factory)

2
frontend/src/app/main/snap.cljs
View file

@ -166,7 +166,7 @@
(rx/merge-map (rx/merge-map
(fn [[frame selrect]] (fn [[frame selrect]]
(let [areas (->> (gsh/selrect->areas (or (:selrect frame) (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))) (d/mapm #(select-shapes-area page-id shapes objects %2)))
snap-x (search-snap-distance selrect :x (:left areas) (:right areas)) snap-x (search-snap-distance selrect :x (:left areas) (:right areas))
snap-y (search-snap-distance selrect :y (:top areas) (:bottom areas))] snap-y (search-snap-distance selrect :y (:top areas) (:bottom areas))]

14
frontend/src/app/main/store.cljs
View file

@ -41,11 +41,10 @@
(when *assert* (when *assert*
(defonce debug-subscription (defonce debug-subscription
(as-> stream $ (->> stream
#_(rx/filter ptk/event? $) (rx/filter ptk/event?)
(rx/filter (fn [s] (debug? :events)) $) (rx/filter (fn [s] (debug? :events)))
(rx/subscribe $ (fn [event] (rx/subs #(println "[stream]: " (repr-event %))))))
(println "[stream]: " (repr-event event)))))))
(defn emit! (defn emit!
([] nil) ([] nil)
([event] ([event]
@ -73,6 +72,11 @@
(defn ^:export dump-state [] (defn ^:export dump-state []
(logjs "state" @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 [] (defn ^:export dump-objects []
(let [page-id (get @state :current-page-id)] (let [page-id (get @state :current-page-id)]
(logjs "state" (get-in @state [:workspace-data :pages-index page-id :objects])))) (logjs "state" (get-in @state [:workspace-data :pages-index page-id :objects]))))

3
frontend/src/app/main/ui/shapes/custom_stroke.cljs
View file

@ -23,7 +23,8 @@
(let [shape (unchecked-get props "shape") (let [shape (unchecked-get props "shape")
base-props (unchecked-get props "base-props") base-props (unchecked-get props "base-props")
elem-name (unchecked-get props "elem-name") 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) mask-id (mf/use-ctx mask-id-ctx)
stroke-id (mf/use-var (uuid/next)) stroke-id (mf/use-var (uuid/next))
stroke-style (:stroke-style shape :none) stroke-style (:stroke-style shape :none)

12
frontend/src/app/main/ui/shapes/path.cljs
View file

@ -15,10 +15,12 @@
[app.main.ui.shapes.custom-stroke :refer [shape-custom-stroke]] [app.main.ui.shapes.custom-stroke :refer [shape-custom-stroke]]
[app.main.ui.shapes.group :refer [mask-id-ctx]] [app.main.ui.shapes.group :refer [mask-id-ctx]]
[app.common.geom.shapes :as geom] [app.common.geom.shapes :as geom]
[app.util.object :as obj])) [app.util.object :as obj]
[app.util.geom.path :as ugp]))
;; --- Path Shape ;; --- Path Shape
;; LEGACY FORMAT
(defn- render-path (defn- render-path
[{:keys [segments close?] :as shape}] [{:keys [segments close?] :as shape}]
(let [numsegs (count segments)] (let [numsegs (count segments)]
@ -45,10 +47,14 @@
[props] [props]
(let [shape (unchecked-get props "shape") (let [shape (unchecked-get props "shape")
background? (unchecked-get props "background?") 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) mask-id (mf/use-ctx mask-id-ctx)
transform (geom/transform-matrix shape) transform (geom/transform-matrix shape)
pdata (render-path shape) pdata (if (:content shape)
(ugp/content->path (:content shape))
(render-path shape))
props (-> (attrs/extract-style-attrs shape) props (-> (attrs/extract-style-attrs shape)
(obj/merge! (obj/merge!
#js {:transform transform #js {:transform transform

6
frontend/src/app/main/ui/workspace/selection.cljs
View file

@ -181,7 +181,7 @@
on-rotate (obj/get props "on-rotate") on-rotate (obj/get props "on-rotate")
current-transform (mf/deref refs/current-transform) current-transform (mf/deref refs/current-transform)
selrect (geom/shape->rect-shape shape) selrect (:selrect shape)
transform (geom/transform-matrix shape) transform (geom/transform-matrix shape)
tr-shape (geom/transform-shape shape)] tr-shape (geom/transform-shape shape)]
@ -269,8 +269,8 @@
(mf/defc multiple-selection-handlers (mf/defc multiple-selection-handlers
[{:keys [shapes selected zoom color show-distances] :as props}] [{:keys [shapes selected zoom color show-distances] :as props}]
(let [shape (geom/selection-rect shapes) (let [shape (geom/setup {:type :rect} (geom/selection-rect shapes))
shape-center (geom/center shape) shape-center (geom/center-shape shape)
hover-id (-> (mf/deref refs/current-hover) first) hover-id (-> (mf/deref refs/current-hover) first)
hover-id (when-not (d/seek #(= hover-id (:id %)) shapes) hover-id) hover-id (when-not (d/seek #(= hover-id (:id %)) shapes) hover-id)

2
frontend/src/app/main/ui/workspace/shapes/bounding_box.cljs
View file

@ -42,7 +42,7 @@
(let [shape (unchecked-get props "shape") (let [shape (unchecked-get props "shape")
frame (unchecked-get props "frame") frame (unchecked-get props "frame")
selrect (-> shape :selrect) selrect (-> shape :selrect)
shape-center (geom/center shape) shape-center (geom/center-shape shape)
line-color (rdcolor #js {:seed (str (:id shape))}) line-color (rdcolor #js {:seed (str (:id shape))})
zoom (mf/deref refs/selected-zoom)] zoom (mf/deref refs/selected-zoom)]
[:g.bounding-box [:g.bounding-box

5
frontend/src/app/main/ui/workspace/snap_distances.cljs
View file

@ -141,8 +141,9 @@
(fn [[selrect selected frame]] (fn [[selrect selected frame]]
(let [lt-side (if (= coord :x) :left :top) (let [lt-side (if (= coord :x) :left :top)
gt-side (if (= coord :x) :right :bottom) gt-side (if (= coord :x) :right :bottom)
areas (gsh/selrect->areas (or (:selrect frame) container-selrec (or (:selrect frame)
(gsh/rect->rect-shape @refs/vbox)) selrect) (gsh/rect->selrect @refs/vbox))
areas (gsh/selrect->areas container-selrec selrect)
query-side (fn [side] query-side (fn [side]
(->> (uw/ask! {:cmd :selection/query (->> (uw/ask! {:cmd :selection/query
:page-id page-id :page-id page-id

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

@ -232,8 +232,9 @@
(st/emit! (ms/->MouseEvent :down ctrl? shift? alt?)) (st/emit! (ms/->MouseEvent :down ctrl? shift? alt?))
(cond (cond
(and (= 1 (.-which event))) (and (= 1 (.-which event)))
(if drawing-tool (if drawing-tool
(when (not= drawing-tool :comments) (when (not (#{:comments :path} drawing-tool))
(st/emit! (dd/start-drawing drawing-tool))) (st/emit! (dd/start-drawing drawing-tool)))
(st/emit! dw/handle-selection)) (st/emit! dw/handle-selection))

4
frontend/src/app/main/worker.cljs
View file

@ -15,8 +15,8 @@
[app.util.worker :as uw])) [app.util.worker :as uw]))
(defn on-error (defn on-error
[instance error] [error]
(js/console.error "Error on worker" (.-data error))) (js/console.error "Error on worker" error))
(defonce instance (defonce instance
(when (not= *target* "nodejs") (when (not= *target* "nodejs")

4
frontend/src/app/util/geom/snap_points.cljs
View file

@ -27,9 +27,9 @@
(defn shape-snap-points (defn shape-snap-points
[shape] [shape]
(let [shape (gsh/transform-shape shape) (let [shape (gsh/transform-shape shape)
shape-center (gsh/center shape)] shape-center (gsh/center-shape shape)]
(if (= :frame (:type shape)) (if (= :frame (:type shape))
(-> shape (-> shape
(gsh/shape->rect-shape) :selrect
(frame-snap-points)) (frame-snap-points))
(into #{shape-center} (:points shape))))) (into #{shape-center} (:points shape)))))

6
frontend/src/app/util/worker.cljs
View file

@ -38,10 +38,12 @@
(fn [event] (fn [event]
(let [data (.-data event) (let [data (.-data event)
data (t/decode data)] data (t/decode data)]
(rx/push! bus data)))) (if (:error data)
(on-error (:error data))
(rx/push! bus data)))))
(.addEventListener ins "error" (.addEventListener ins "error"
(fn [error] (fn [error]
(on-error wrk error))) (on-error wrk (.-data error))))
wrk)) wrk))

8
frontend/src/app/worker/selection.cljs
View file

@ -65,8 +65,7 @@
(defn- create-index (defn- create-index
[objects] [objects]
(let [shapes (->> (cph/select-toplevel-shapes objects {:include-frames? true}) (let [shapes (cph/select-toplevel-shapes objects {:include-frames? true})
(map #(merge % (select-keys % [:x :y :width :height]))))
bounds (geom/selection-rect shapes) bounds (geom/selection-rect shapes)
bounds #js {:x (:x bounds) bounds #js {:x (:x bounds)
:y (:y bounds) :y (:y bounds)
@ -77,7 +76,8 @@
shapes))) shapes)))
(defn- index-object (defn- index-object
[index {:keys [id x y width height] :as obj}] [index obj]
(let [rect #js {:x x :y y :width width :height height}] (let [{:keys [id x y width height]} (:selrect obj)
rect #js {:x x :y y :width width :height height}]
(qdt/insert index rect obj))) (qdt/insert index rect obj)))