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

✨ Improve group modifiers calculation

Browse source
This commit is contained in:
alonso.torres 2023-10-13 09:04:16 +02:00
parent cafc75259a
commit 6507200735
8 changed files with 269 additions and 189 deletions
Download patch file Download diff file Expand all files Collapse all files

10
common/src/app/common/data.cljc
View file

@ -884,3 +884,13 @@
(extend-protocol ICloseable (extend-protocol ICloseable
AutoCloseable AutoCloseable
(close! [this] (.close this)))) (close! [this] (.close this))))
(defn take-until
"Returns a lazy sequence of successive items from coll until
(pred item) returns true, including that item"
([pred]
(halt-when pred (fn [r h] (conj r h))))
([pred coll]
(transduce (take-until pred) conj [] coll)))

113
common/src/app/common/geom/bounds_map.cljc
View file

@ -11,8 +11,10 @@
[app.common.geom.shapes.common :as gco] [app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.points :as gpo] [app.common.geom.shapes.points :as gpo]
[app.common.geom.shapes.transforms :as gtr] [app.common.geom.shapes.transforms :as gtr]
[app.common.math :as mth]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.types.modifiers :as ctm])) [app.common.types.modifiers :as ctm]
[app.common.uuid :as uuid]))
(defn objects->bounds-map (defn objects->bounds-map
[objects] [objects]
@ -20,51 +22,82 @@
(keys objects) (keys objects)
#(gco/shape->points (get objects %)))) #(gco/shape->points (get objects %))))
(defn shape->bounds (defn- create-bounds
"Retrieve the shape bounds" "Create the bounds object for the current shape in this context"
([shape bounds-map objects] ([shape bounds-map objects]
(shape->bounds shape bounds-map objects nil)) (create-bounds shape bounds-map objects nil nil))
([{:keys [id] :as shape} bounds-map objects modif-tree] ([shape bounds-map objects modif-tree]
(let [shape-modifiers (create-bounds shape bounds-map objects modif-tree nil))
(if modif-tree
(-> (dm/get-in modif-tree [id :modifiers])
(ctm/select-geometry))
(ctm/empty))
children (cph/get-immediate-children objects id)] ([{:keys [id] :as shape} bounds-map objects modif-tree current-ref]
(cond
(and (cph/mask-shape? shape) (d/not-empty? (:shapes shape)))
(create-bounds (get objects (first (:shapes shape))) bounds-map objects modif-tree)
(cond (cph/group-shape? shape)
(and (cph/mask-shape? shape) (seq children)) (let [modifiers (dm/get-in modif-tree [id :modifiers])
(shape->bounds (-> children first) bounds-map objects modif-tree) children (cph/get-immediate-children objects id)
shape-bounds (if current-ref @current-ref @(get bounds-map id))
current-bounds
(cond-> shape-bounds
(not (ctm/empty? modifiers))
(gtr/transform-bounds modifiers))
(cph/group-shape? shape) children-bounds
(let [;; Transform here to then calculate the bounds relative to the transform (->> children
current-bounds (mapv #(deref (get bounds-map (:id %)))))]
(cond-> @(get bounds-map id) (gpo/merge-parent-coords-bounds children-bounds current-bounds))
(not (ctm/empty? shape-modifiers))
(gtr/transform-bounds shape-modifiers))
children-bounds :else
(->> children (let [modifiers (dm/get-in modif-tree [id :modifiers])
(mapv #(shape->bounds % bounds-map objects modif-tree)))] shape-bounds (if current-ref @current-ref @(get bounds-map id))]
(gpo/merge-parent-coords-bounds children-bounds current-bounds)) (cond-> shape-bounds
(not (ctm/empty? modifiers))
:else (gtr/transform-bounds modifiers))))))
(cond-> @(get bounds-map id)
(not (ctm/empty? shape-modifiers))
(gtr/transform-bounds shape-modifiers))))))
(defn transform-bounds-map (defn transform-bounds-map
([bounds-map objects modif-tree] [bounds-map objects modif-tree]
(transform-bounds-map bounds-map objects modif-tree (->> (keys modif-tree) (map #(get objects %))))) ;; We use the volatile in order to solve the dependencies problem. We want the groups to reference the new
;; bounds instead of the old ones. The current as last parameter is to fix a possible infinite loop
;; with self-references
(let [bm-holder (volatile! nil)
([bounds-map objects modif-tree tree-seq] ;; These are the new bounds calculated. Are the "modified" plus any groups they belong to
(->> tree-seq ids (keys modif-tree)
reverse ids (into (set ids)
(reduce (mapcat #(->> (cph/get-parent-ids-seq objects %)
(fn [bounds-map shape] (take-while (partial cph/group-like-shape? objects))))
(assoc bounds-map ids)
(:id shape)
(delay (shape->bounds shape bounds-map objects modif-tree)))) new-bounds-map
bounds-map)))) (->> ids
(reduce
(fn [tr-bounds-map shape-id]
(cond-> tr-bounds-map
(not= uuid/zero shape-id)
(assoc! shape-id
(delay (create-bounds (get objects shape-id)
@bm-holder
objects
modif-tree
(get bounds-map shape-id))))))
(transient bounds-map))
(persistent!))]
(vreset! bm-holder new-bounds-map)
new-bounds-map))
;; Tool for debugging
(defn bounds-map
[objects bounds-map]
(letfn [(parse-bound [[id bounds*]]
(let [bounds (deref bounds*)
shape (get objects id)]
(when (and shape bounds)
[(:name shape)
{:x (mth/round (:x (gpo/origin bounds)) 2)
:y (mth/round (:y (gpo/origin bounds)) 2)
:width (mth/round (gpo/width-points bounds) 2)
:height (mth/round (gpo/height-points bounds) 2)}])))]
(into {} (keep parse-bound) bounds-map)))

3
common/src/app/common/geom/modif_tree.cljc
View file

@ -12,6 +12,7 @@
[app.common.types.modifiers :as ctm])) [app.common.types.modifiers :as ctm]))
(defn add-modifiers (defn add-modifiers
"Add the given modifiers to the map of modifiers."
[modif-tree id modifiers] [modif-tree id modifiers]
(if (ctm/empty? modifiers) (if (ctm/empty? modifiers)
modif-tree modif-tree
@ -27,6 +28,7 @@
(assoc-in [id :modifiers] new-modifiers))))) (assoc-in [id :modifiers] new-modifiers)))))
(defn merge-modif-tree (defn merge-modif-tree
"Merge two maps of modifiers into a single one"
[modif-tree other-tree] [modif-tree other-tree]
(reduce (reduce
(fn [modif-tree [id {:keys [modifiers]}]] (fn [modif-tree [id {:keys [modifiers]}]]
@ -35,6 +37,7 @@
other-tree)) other-tree))
(defn apply-structure-modifiers (defn apply-structure-modifiers
"Only applies the structure modifiers to the objects tree map"
[objects modif-tree] [objects modif-tree]
(letfn [(update-children-structure-modifiers (letfn [(update-children-structure-modifiers
[objects ids modifiers] [objects ids modifiers]

8
common/src/app/common/geom/shapes/constraints.cljc
View file

@ -280,11 +280,11 @@
(/ (gpo/height-points child-bb-before) (max 0.01 (gpo/height-points child-bb-after)))) (/ (gpo/height-points child-bb-before) (max 0.01 (gpo/height-points child-bb-after))))
resize-vector (gpt/point scale-x scale-y) resize-vector (gpt/point scale-x scale-y)
resize-origin (gpo/origin transformed-child-bounds) resize-origin (gpo/origin child-bb-after)
center (gco/points->center transformed-child-bounds) center (gco/points->center child-bb-after)
selrect (gtr/calculate-selrect transformed-child-bounds center) selrect (gtr/calculate-selrect child-bb-after center)
transform (gtr/calculate-transform transformed-child-bounds center selrect) transform (gtr/calculate-transform child-bb-after center selrect)
transform-inverse (when (some? transform) (gmt/inverse transform))] transform-inverse (when (some? transform) (gmt/inverse transform))]
(ctm/resize modifiers resize-vector resize-origin transform transform-inverse))) (ctm/resize modifiers resize-vector resize-origin transform transform-inverse)))

228
common/src/app/common/geom/shapes/modifiers.cljc
View file

@ -43,36 +43,28 @@
modif-tree modif-tree
(ctm/only-move? modifiers) (ctm/only-move? modifiers)
(loop [modif-tree modif-tree (reduce #(cgt/add-modifiers %1 %2 modifiers) modif-tree children)
children (seq children)]
(if-let [current (first children)]
(recur (cgt/add-modifiers modif-tree current modifiers)
(rest children))
modif-tree))
;; Check the constraints, then resize ;; Check the constraints, then resize
:else :else
(let [parent-id (:id parent) (let [parent-id (:id parent)
parent-bounds (gtr/transform-bounds @(get bounds parent-id) (ctm/select-parent modifiers))] parent-bounds (gtr/transform-bounds @(get bounds parent-id) (ctm/select-parent modifiers))]
(loop [modif-tree modif-tree (->> children
children (seq children)] (reduce
(if (empty? children) (fn [modif-tree child-id]
modif-tree (if-let [child (get objects child-id)]
(let [child-id (first children) (let [child-bounds @(get bounds child-id)
child (get objects child-id)] child-modifiers
(if (some? child) (gct/calc-child-modifiers parent child modifiers ignore-constraints child-bounds parent-bounds transformed-parent-bounds)]
(let [child-bounds @(get bounds child-id) (cgt/add-modifiers modif-tree child-id child-modifiers))
child-modifiers modif-tree))
(gct/calc-child-modifiers parent child modifiers ignore-constraints child-bounds parent-bounds transformed-parent-bounds)] modif-tree))))))
(recur (cgt/add-modifiers modif-tree child-id child-modifiers)
(rest children)))
(recur modif-tree (rest children))))))))))
(defn- set-flex-layout-modifiers (defn- set-flex-layout-modifiers
[modif-tree children objects bounds parent transformed-parent-bounds] [modif-tree children objects bounds parent transformed-parent-bounds]
(letfn [(apply-modifiers [child] (letfn [(apply-modifiers [bounds child]
[(-> (cgb/shape->bounds child bounds objects modif-tree) [(-> @(get bounds (:id child))
(gpo/parent-coords-bounds @transformed-parent-bounds)) (gpo/parent-coords-bounds @transformed-parent-bounds))
child]) child])
@ -81,12 +73,14 @@
(gcfl/layout-child-modifiers parent transformed-parent-bounds child child-bounds layout-line)] (gcfl/layout-child-modifiers parent transformed-parent-bounds child child-bounds layout-line)]
[layout-line (cgt/add-modifiers modif-tree (:id child) modifiers)]))] [layout-line (cgt/add-modifiers modif-tree (:id child) modifiers)]))]
(let [children (let [bounds (cgb/transform-bounds-map bounds objects modif-tree)
children
(->> children (->> children
(keep (d/getf objects)) (keep (d/getf objects))
(remove :hidden) (remove :hidden)
(remove gco/invalid-geometry?) (remove gco/invalid-geometry?)
(map apply-modifiers)) (map (partial apply-modifiers bounds)))
layout-data (gcfl/calc-layout-data parent @transformed-parent-bounds children bounds objects) layout-data (gcfl/calc-layout-data parent @transformed-parent-bounds children bounds objects)
children (into [] (cond-> children (not (:reverse? layout-data)) reverse)) children (into [] (cond-> children (not (:reverse? layout-data)) reverse))
@ -109,8 +103,8 @@
(defn- set-grid-layout-modifiers (defn- set-grid-layout-modifiers
[modif-tree objects bounds parent transformed-parent-bounds] [modif-tree objects bounds parent transformed-parent-bounds]
(letfn [(apply-modifiers [child] (letfn [(apply-modifiers [bounds child]
[(-> (cgb/shape->bounds child bounds objects modif-tree) [(-> @(get bounds (:id child))
(gpo/parent-coords-bounds @transformed-parent-bounds)) (gpo/parent-coords-bounds @transformed-parent-bounds))
child]) child])
@ -119,9 +113,11 @@
(gcgl/child-modifiers parent transformed-parent-bounds child child-bounds grid-data cell-data)] (gcgl/child-modifiers parent transformed-parent-bounds child child-bounds grid-data cell-data)]
(cgt/add-modifiers modif-tree (:id child) modifiers)))] (cgt/add-modifiers modif-tree (:id child) modifiers)))]
(let [children (let [bounds (cgb/transform-bounds-map bounds objects modif-tree)
children
(->> (cph/get-immediate-children objects (:id parent) {:remove-hidden true}) (->> (cph/get-immediate-children objects (:id parent) {:remove-hidden true})
(map apply-modifiers)) (map (partial apply-modifiers bounds)))
grid-data (gcgl/calc-layout-data parent @transformed-parent-bounds children bounds objects)] grid-data (gcgl/calc-layout-data parent @transformed-parent-bounds children bounds objects)]
(loop [modif-tree modif-tree (loop [modif-tree modif-tree
bound+child (first children) bound+child (first children)
@ -134,7 +130,7 @@
(recur modif-tree (first pending) (rest pending))) (recur modif-tree (first pending) (rest pending)))
modif-tree))))) modif-tree)))))
(defn- propagate-modifiers-constraints (defn- set-modifiers-constraints
"Propagate modifiers to its children" "Propagate modifiers to its children"
[objects bounds ignore-constraints modif-tree parent] [objects bounds ignore-constraints modif-tree parent]
(let [parent-id (:id parent) (let [parent-id (:id parent)
@ -150,36 +146,34 @@
(and has-modifiers? parent? (not root?)) (and has-modifiers? parent? (not root?))
(set-children-modifiers children objects bounds parent transformed-parent-bounds ignore-constraints)))) (set-children-modifiers children objects bounds parent transformed-parent-bounds ignore-constraints))))
(defn- propagate-modifiers-layout (defn- set-modifiers-layout
"Propagate modifiers to its children" "Propagate modifiers to its children"
[objects bounds ignore-constraints [modif-tree autolayouts] parent] ([objects bounds ignore-constraints parent]
(set-modifiers-layout objects bounds ignore-constraints {} parent))
([objects bounds ignore-constraints modif-tree parent]
(let [parent-id (:id parent)
root? (= uuid/zero parent-id)
modifiers (-> (dm/get-in modif-tree [parent-id :modifiers])
(ctm/select-geometry))
has-modifiers? (ctm/child-modifiers? modifiers)
flex-layout? (ctl/flex-layout? parent)
grid-layout? (ctl/grid-layout? parent)
parent? (or (cph/group-like-shape? parent) (cph/frame-shape? parent))
(let [parent-id (:id parent) transformed-parent-bounds (delay (gtr/transform-bounds @(get bounds parent-id) modifiers))
root? (= uuid/zero parent-id)
modifiers (-> (dm/get-in modif-tree [parent-id :modifiers])
(ctm/select-geometry))
has-modifiers? (ctm/child-modifiers? modifiers)
flex-layout? (ctl/flex-layout? parent)
grid-layout? (ctl/grid-layout? parent)
auto? (ctl/auto? parent)
fill-with-grid? (and (ctl/grid-layout? objects (:parent-id parent))
(ctl/fill? parent))
parent? (or (cph/group-like-shape? parent) (cph/frame-shape? parent))
transformed-parent-bounds (delay (gtr/transform-bounds @(get bounds parent-id) modifiers)) children-modifiers
(if (or flex-layout? grid-layout?)
(->> (:shapes parent)
(filter #(ctl/layout-absolute? objects %)))
(:shapes parent))
children-modifiers children-layout
(if (or flex-layout? grid-layout?) (when (or flex-layout? grid-layout?)
(->> (:shapes parent) (->> (:shapes parent)
(filter #(ctl/layout-absolute? objects %))) (remove #(ctl/layout-absolute? objects %))))]
(:shapes parent))
children-layout (cond-> modif-tree
(when (or flex-layout? grid-layout?)
(->> (:shapes parent)
(remove #(ctl/layout-absolute? objects %))))]
[(cond-> modif-tree
(and has-modifiers? parent? (not root?)) (and has-modifiers? parent? (not root?))
(set-children-modifiers children-modifiers objects bounds parent transformed-parent-bounds ignore-constraints) (set-children-modifiers children-modifiers objects bounds parent transformed-parent-bounds ignore-constraints)
@ -187,17 +181,19 @@
(set-flex-layout-modifiers children-layout objects bounds parent transformed-parent-bounds) (set-flex-layout-modifiers children-layout objects bounds parent transformed-parent-bounds)
grid-layout? grid-layout?
(set-grid-layout-modifiers objects bounds parent transformed-parent-bounds)) (set-grid-layout-modifiers objects bounds parent transformed-parent-bounds)))))
;; Auto-width/height can change the positions in the parent so we need to recalculate
;; also if the child is fill width/height inside a grid layout
(when autolayouts
(cond-> autolayouts (or auto? fill-with-grid?) (conj (:id parent))))]))
(defn propagate-modifiers-constraints
([objects bounds ignore-constraints shapes]
(propagate-modifiers-constraints objects bounds ignore-constraints {} shapes))
([objects bounds ignore-constraints modif-tree shapes]
(reduce #(set-modifiers-constraints objects bounds ignore-constraints %1 %2) modif-tree shapes)))
(defn propagate-modifiers-layouts
([objects bounds ignore-constraints shapes]
(propagate-modifiers-layouts objects bounds ignore-constraints {} shapes))
([objects bounds ignore-constraints modif-tree shapes]
(reduce #(set-modifiers-layout objects bounds ignore-constraints %1 %2) modif-tree shapes)))
(defn- calc-auto-modifiers (defn- calc-auto-modifiers
"Calculates the modifiers to adjust the bounds for auto-width/auto-height shapes" "Calculates the modifiers to adjust the bounds for auto-width/auto-height shapes"
@ -247,46 +243,51 @@
(and (some? auto-height) (ctl/auto-height? parent)) (and (some? auto-height) (ctl/auto-height? parent))
(set-parent-auto-height auto-height)))) (set-parent-auto-height auto-height))))
(defn reflow-layout (defn find-auto-layouts
[objects old-modif-tree bounds ignore-constraints id] [objects shapes]
(let [tree-seq (cgst/get-children-seq id objects) (letfn [(mk-check-auto-layout [objects]
(fn [shape]
[modif-tree _] ;; Auto-width/height can change the positions in the parent so we need to recalculate
(reduce ;; also if the child is fill width/height inside a grid layout
#(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [{id {:modifiers (ctm/reflow-modifiers)}} #{}] (when (or (ctl/auto? shape)
tree-seq) (and (ctl/grid-layout? objects (:parent-id shape)) (ctl/fill? shape)))
(:id shape))))]
bounds (into (d/ordered-set)
(cgb/transform-bounds-map bounds objects modif-tree) (keep (mk-check-auto-layout objects))
shapes)))
modif-tree (cgt/merge-modif-tree old-modif-tree modif-tree)]
[modif-tree bounds]))
(defn sizing-auto-modifiers (defn sizing-auto-modifiers
"Recalculates the layouts to adjust the sizing: auto new sizes" "Recalculates the layouts to adjust the sizing: auto new sizes"
[modif-tree sizing-auto-layouts objects bounds ignore-constraints] [modif-tree sizing-auto-layouts objects bounds ignore-constraints]
(let [[modif-tree _] (let [calculate-modifiers
(->> sizing-auto-layouts (fn [[modif-tree bounds] layout-id]
reverse (let [layout (get objects layout-id)
(reduce auto-modifiers (calc-auto-modifiers objects bounds layout)]
(fn [[modif-tree bounds] layout-id]
(let [layout (get objects layout-id)
auto-modifiers (calc-auto-modifiers objects bounds layout)]
(if (and (ctm/empty? auto-modifiers) (not (ctl/grid-layout? layout))) (if (and (ctm/empty? auto-modifiers) (not (ctl/grid-layout? layout)))
[modif-tree bounds] [modif-tree bounds]
(let [[auto-modif-tree _] (let [from-layout
(->> (cgst/resolve-tree #{layout-id} objects) (->> (cph/get-parent-ids objects layout-id)
(reduce #(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [{layout-id {:modifiers auto-modifiers}} nil])) (d/seek sizing-auto-layouts))
bounds (cgb/transform-bounds-map bounds objects auto-modif-tree) shapes
modif-tree (cgt/merge-modif-tree modif-tree auto-modif-tree)] (if from-layout
[modif-tree bounds])))) (cgst/resolve-subtree from-layout layout-id objects)
[modif-tree bounds]))] (cgst/resolve-tree #{layout-id} objects))
modif-tree))
auto-modif-tree {layout-id {:modifiers auto-modifiers}}
auto-modif-tree (propagate-modifiers-layouts objects bounds ignore-constraints auto-modif-tree shapes)
bounds (cgb/transform-bounds-map bounds objects auto-modif-tree)
modif-tree (cgt/merge-modif-tree modif-tree auto-modif-tree)]
[modif-tree bounds]))))]
(->> sizing-auto-layouts
(reverse)
(reduce calculate-modifiers [modif-tree bounds])
(first))))
(defn set-objects-modifiers (defn set-objects-modifiers
"Applies recursively the modifiers and calculate the layouts and constraints for all the items to be placed correctly" "Applies recursively the modifiers and calculate the layouts and constraints for all the items to be placed correctly"
@ -310,38 +311,43 @@
(cgt/apply-structure-modifiers old-modif-tree)) (cgt/apply-structure-modifiers old-modif-tree))
(cgt/apply-structure-modifiers modif-tree)) (cgt/apply-structure-modifiers modif-tree))
;; Creates the sequence of shapes with the shapes that are modified
shapes-tree
(cgst/resolve-tree (-> modif-tree keys set) objects)
bounds-map
(cond-> (cgb/objects->bounds-map objects)
(some? old-modif-tree)
(cgb/transform-bounds-map objects old-modif-tree))
;; Round the transforms if the snap-to-pixel is active ;; Round the transforms if the snap-to-pixel is active
modif-tree modif-tree
(cond-> modif-tree (cond-> modif-tree
snap-pixel? snap-pixel?
(gpp/adjust-pixel-precision objects snap-precision snap-ignore-axis)) (gpp/adjust-pixel-precision objects snap-precision snap-ignore-axis))
bounds ;; Propagates the modifiers to the normal shapes with constraints
(cond-> (cgb/objects->bounds-map objects)
(some? old-modif-tree)
(cgb/transform-bounds-map objects old-modif-tree))
shapes-tree (cgst/resolve-tree (-> modif-tree keys set) objects)
;; Calculate the input transformation and constraints
modif-tree modif-tree
(->> shapes-tree (propagate-modifiers-constraints objects bounds-map ignore-constraints modif-tree shapes-tree)
(reduce #(propagate-modifiers-constraints objects bounds ignore-constraints %1 %2) modif-tree))
bounds bounds-map
(cgb/transform-bounds-map bounds objects modif-tree) (cgb/transform-bounds-map bounds-map objects modif-tree)
[modif-tree-layout sizing-auto-layouts] modif-tree-layout
(->> shapes-tree (propagate-modifiers-layouts objects bounds-map ignore-constraints shapes-tree)
(reduce #(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [{} (d/ordered-set)]))
modif-tree (cgt/merge-modif-tree modif-tree modif-tree-layout) modif-tree
(cgt/merge-modif-tree modif-tree modif-tree-layout)
;; Calculate hug layouts positions ;; Calculate hug layouts positions
bounds (cgb/transform-bounds-map bounds objects modif-tree-layout) bounds-map
(cgb/transform-bounds-map bounds-map objects modif-tree-layout)
;; Find layouts with auto width/height
sizing-auto-layouts (find-auto-layouts objects shapes-tree)
modif-tree modif-tree
(sizing-auto-modifiers modif-tree sizing-auto-layouts objects bounds ignore-constraints) (sizing-auto-modifiers modif-tree sizing-auto-layouts objects bounds-map ignore-constraints)
modif-tree modif-tree
(if old-modif-tree (if old-modif-tree

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

@ -116,45 +116,47 @@
(if (empty? child-bounds) (if (empty? child-bounds)
parent-bounds parent-bounds
(let [rh [p1 p2] (if (and (axis-aligned? child-bounds) (axis-aligned? parent-bounds))
rv [p1 p4] child-bounds
hv (gpt/to-vec p1 p2) (let [rh [p1 p2]
vv (gpt/to-vec p1 p4) rv [p1 p4]
ph #(gpt/add p1 (gpt/scale hv %)) hv (gpt/to-vec p1 p2)
pv #(gpt/add p1 (gpt/scale vv %)) vv (gpt/to-vec p1 p4)
find-boundary-ts ph #(gpt/add p1 (gpt/scale hv %))
(fn [[th-min th-max tv-min tv-max] current-point] pv #(gpt/add p1 (gpt/scale vv %))
(let [cth (project-t current-point rh vv)
ctv (project-t current-point rv hv)]
[(mth/min th-min cth)
(mth/max th-max cth)
(mth/min tv-min ctv)
(mth/max tv-max ctv)]))
[th-min th-max tv-min tv-max] find-boundary-ts
(->> child-bounds (fn [[th-min th-max tv-min tv-max] current-point]
(filter #(and (d/num? (:x %)) (d/num? (:y %)))) (let [cth (project-t current-point rh vv)
(reduce find-boundary-ts [##Inf ##-Inf ##Inf ##-Inf])) ctv (project-t current-point rv hv)]
[(mth/min th-min cth)
(mth/max th-max cth)
(mth/min tv-min ctv)
(mth/max tv-max ctv)]))
minv-start (pv tv-min) [th-min th-max tv-min tv-max]
minv-end (gpt/add minv-start hv) (->> child-bounds
minh-start (ph th-min) (filter #(and (d/num? (:x %)) (d/num? (:y %))))
minh-end (gpt/add minh-start vv) (reduce find-boundary-ts [##Inf ##-Inf ##Inf ##-Inf]))
maxv-start (pv tv-max) minv-start (pv tv-min)
maxv-end (gpt/add maxv-start hv) minv-end (gpt/add minv-start hv)
maxh-start (ph th-max) minh-start (ph th-min)
maxh-end (gpt/add maxh-start vv) minh-end (gpt/add minh-start vv)
i1 (gsi/line-line-intersect minv-start minv-end minh-start minh-end) maxv-start (pv tv-max)
i2 (gsi/line-line-intersect minv-start minv-end maxh-start maxh-end) maxv-end (gpt/add maxv-start hv)
i3 (gsi/line-line-intersect maxv-start maxv-end maxh-start maxh-end) maxh-start (ph th-max)
i4 (gsi/line-line-intersect maxv-start maxv-end minh-start minh-end)] maxh-end (gpt/add maxh-start vv)
[i1 i2 i3 i4]))) i1 (gsi/line-line-intersect minv-start minv-end minh-start minh-end)
i2 (gsi/line-line-intersect minv-start minv-end maxh-start maxh-end)
i3 (gsi/line-line-intersect maxv-start maxv-end maxh-start maxh-end)
i4 (gsi/line-line-intersect maxv-start maxv-end minh-start minh-end)]
[i1 i2 i3 i4]))))
(defn merge-parent-coords-bounds (defn merge-parent-coords-bounds
[bounds parent-bounds] [bounds parent-bounds]

6
common/src/app/common/geom/shapes/tree_seq.cljc
View file

@ -85,3 +85,9 @@
(if (contains? ids uuid/zero) (if (contains? ids uuid/zero)
(cons (get objects uuid/zero) child-seq) (cons (get objects uuid/zero) child-seq)
child-seq))) child-seq)))
(defn resolve-subtree
"Resolves the subtree but only partialy from-to the parameters"
[from-id to-id objects]
(->> (get-children-seq from-id objects)
(d/take-until #(= (:id %) to-id))))

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

@ -68,9 +68,11 @@
(= :bool (dm/get-prop shape :type)))) (= :bool (dm/get-prop shape :type))))
(defn group-like-shape? (defn group-like-shape?
[shape] ([objects id]
(or ^boolean (group-shape? shape) (group-like-shape? (get objects id)))
^boolean (bool-shape? shape))) ([shape]
(or ^boolean (group-shape? shape)
^boolean (bool-shape? shape))))
(defn text-shape? (defn text-shape?
[shape] [shape]
@ -160,6 +162,13 @@
(recur (conj result parent-id) parent-id) (recur (conj result parent-id) parent-id)
result)))) result))))
(defn get-parent-ids-seq
"Returns a vector of parents of the specified shape."
[objects shape-id]
(let [parent-id (get-parent-id objects shape-id)]
(when (and (some? parent-id) (not= parent-id shape-id))
(lazy-seq (cons parent-id (get-parent-ids-seq objects parent-id))))))
(defn get-parents (defn get-parents
"Returns a vector of parents of the specified shape." "Returns a vector of parents of the specified shape."
[objects shape-id] [objects shape-id]
@ -169,6 +178,17 @@
(recur (conj result (get objects parent-id)) parent-id) (recur (conj result (get objects parent-id)) parent-id)
result)))) result))))
(defn get-parent-seq
"Returns a vector of parents of the specified shape."
([objects shape-id]
(get-parent-seq objects (get objects shape-id) shape-id))
([objects shape shape-id]
(let [parent-id (dm/get-prop shape :parent-id)
parent (get objects parent-id)]
(when (and (some? parent) (not= parent-id shape-id))
(lazy-seq (cons parent (get-parent-seq objects parent parent-id)))))))
(defn get-parents-with-self (defn get-parents-with-self
[objects id] [objects id]
(let [lookup (d/getf objects)] (let [lookup (d/getf objects)]