From 99a614213425c72132aff58027fcedeb1cd7313f Mon Sep 17 00:00:00 2001 From: "alonso.torres" Date: Thu, 23 Dec 2021 15:47:36 +0100 Subject: [PATCH] :zap: Improves boolean performance --- common/src/app/common/geom/shapes.cljc | 1 + common/src/app/common/geom/shapes/bool.cljc | 20 ++- common/src/app/common/geom/shapes/path.cljc | 104 ++++++++----- common/src/app/common/path/bool.cljc | 144 ++++++++++-------- frontend/src/app/main/data/workspace.cljs | 12 +- .../data/workspace/fix_bool_contents.cljs | 94 ++++++++++++ .../main/data/workspace/state_helpers.cljs | 4 + frontend/src/app/main/ui/shapes/bool.cljs | 12 +- 8 files changed, 271 insertions(+), 120 deletions(-) create mode 100644 frontend/src/app/main/data/workspace/fix_bool_contents.cljs diff --git a/common/src/app/common/geom/shapes.cljc b/common/src/app/common/geom/shapes.cljc index 8d0e2cd91b..6df3f748ea 100644 --- a/common/src/app/common/geom/shapes.cljc +++ b/common/src/app/common/geom/shapes.cljc @@ -184,3 +184,4 @@ ;; Bool (d/export gsb/update-bool-selrect) +(d/export gsb/calc-bool-content) diff --git a/common/src/app/common/geom/shapes/bool.cljc b/common/src/app/common/geom/shapes/bool.cljc index 93b7ccc72c..99187a985b 100644 --- a/common/src/app/common/geom/shapes/bool.cljc +++ b/common/src/app/common/geom/shapes/bool.cljc @@ -6,21 +6,27 @@ (ns app.common.geom.shapes.bool (:require + [app.common.data :as d] [app.common.geom.shapes.path :as gsp] [app.common.geom.shapes.rect :as gpr] [app.common.geom.shapes.transforms :as gtr] [app.common.path.bool :as pb] [app.common.path.shapes-to-path :as stp])) +(defn calc-bool-content + [shape objects] + (->> (:shapes shape) + (map (d/getf objects)) + (filter (comp not :hidden)) + (map #(stp/convert-to-path % objects)) + (mapv :content) + (pb/content-bool (:bool-type shape)))) + (defn update-bool-selrect "Calculates the selrect+points for the boolean shape" [shape children objects] - (let [content (->> children - (map #(stp/convert-to-path % objects)) - (mapv :content) - (pb/content-bool (:bool-type shape))) - + (let [content (calc-bool-content shape objects) [points selrect] (if (empty? content) (let [selrect (gtr/selection-rect children) @@ -29,4 +35,6 @@ (gsp/content->points+selrect shape content))] (-> shape (assoc :selrect selrect) - (assoc :points points)))) + (assoc :points points) + (assoc :bool-content content)))) + diff --git a/common/src/app/common/geom/shapes/path.cljc b/common/src/app/common/geom/shapes/path.cljc index 3f28a08615..54b7f165d9 100644 --- a/common/src/app/common/geom/shapes/path.cljc +++ b/common/src/app/common/geom/shapes/path.cljc @@ -279,11 +279,18 @@ (filterv #(and (>= % 0) (<= % 1))))))) (defn command->point - ([command] (command->point command nil)) - ([{params :params} coord] - (let [prefix (if coord (name coord) "") - xkey (keyword (str prefix "x")) - ykey (keyword (str prefix "y")) + ([command] + (command->point command nil)) + + ([command coord] + (let [params (:params command) + xkey (cond (= :c1 coord) :c1x + (= :c2 coord) :c2x + :else :x) + ykey (cond (= :c1 coord) :c1y + (= :c2 coord) :c2y + :else :y) + x (get params xkey) y (get params ykey)] (when (and (some? x) (some? y)) @@ -322,7 +329,7 @@ (command->point command :c1) (command->point command :c2)]] (->> (curve-extremities curve) - (map #(curve-values curve %))))) + (mapv #(curve-values curve %))))) []) selrect (gpr/points->selrect points)] (-> selrect @@ -676,8 +683,6 @@ (curve-roots c2' :y))) - - (defn ray-line-intersect [point [a b :as line]] @@ -708,20 +713,19 @@ [[l1-t] [l2-t]]))) (defn ray-curve-intersect - [ray-line c2] + [ray-line curve] - (let [;; ray-line [point (gpt/point (inc (:x point)) (:y point))] - curve-ts (->> (line-curve-crossing ray-line c2) - (filterv #(let [curve-v (curve-values c2 %) - curve-tg (curve-tangent c2 %) + (let [curve-ts (->> (line-curve-crossing ray-line curve) + (filterv #(let [curve-v (curve-values curve %) + curve-tg (curve-tangent curve %) curve-tg-angle (gpt/angle curve-tg) ray-t (get-line-tval ray-line curve-v)] (and (> ray-t 0) (> (mth/abs (- curve-tg-angle 180)) 0.01) (> (mth/abs (- curve-tg-angle 0)) 0.01)) )))] (->> curve-ts - (mapv #(vector (curve-values c2 %) - (curve-windup c2 %)))))) + (mapv #(vector (curve-values curve %) + (curve-windup curve %)))))) (defn line-curve-intersect [l1 c2] @@ -817,32 +821,58 @@ (->> content (some inside-border?)))) -(defn is-point-in-content? - [point content] - (let [selrect (content->selrect content) - ray-line [point (gpt/point (inc (:x point)) (:y point))] +(defn close-content + [content] + (into [] + (comp (filter sp/is-closed?) + (mapcat :data)) + (->> content + (sp/close-subpaths) + (sp/get-subpaths)))) - closed-content - (into [] - (comp (filter sp/is-closed?) - (mapcat :data)) - (->> content - (sp/close-subpaths) - (sp/get-subpaths))) + +(defn ray-overlaps? + [ray-point {selrect :selrect}] + (and (>= (:y ray-point) (:y1 selrect)) + (<= (:y ray-point) (:y2 selrect)))) + +(defn content->geom-data + [content] + + (->> content + (close-content) + (filter #(not= (= :line-to (:command %)) + (= :curve-to (:command %)))) + (mapv (fn [segment] + {:command (:command segment) + :segment segment + :geom (if (= :line-to (:command segment)) + (command->line segment) + (command->bezier segment)) + :selrect (command->selrect segment)})))) + +(defn is-point-in-geom-data? + [point content-geom] + + (let [ray-line [point (gpt/point (inc (:x point)) (:y point))] cast-ray - (fn [cmd] - (case (:command cmd) - :line-to (ray-line-intersect point (command->line cmd)) - :curve-to (ray-curve-intersect ray-line (command->bezier cmd)) - #_:else []))] + (fn [data] + (case (:command data) + :line-to + (ray-line-intersect point (:geom data)) - (and (gpr/contains-point? selrect point) - (->> closed-content - (mapcat cast-ray) - (map second) - (reduce +) - (not= 0))))) + :curve-to + (ray-curve-intersect ray-line (:geom data)) + + #_:default []))] + + (->> content-geom + (filter (partial ray-overlaps? point)) + (mapcat cast-ray) + (map second) + (reduce +) + (not= 0)))) (defn split-line-to "Given a point and a line-to command will create a two new line-to commands diff --git a/common/src/app/common/path/bool.cljc b/common/src/app/common/path/bool.cljc index bb5253138c..a04e65bbbc 100644 --- a/common/src/app/common/path/bool.cljc +++ b/common/src/app/common/path/bool.cljc @@ -91,55 +91,55 @@ :else [[] []])) -(defn split - [seg-1 seg-2] - (let [r1 (gsp/command->selrect seg-1) - r2 (gsp/command->selrect seg-2)] - (if (not (gpr/overlaps-rects? r1 r2)) - [[seg-1] [seg-2]] - (let [[ts-seg-1 ts-seg-2] (split-ts seg-1 seg-2)] - [(-> (split-command seg-1 ts-seg-1) (add-previous (:prev seg-1))) - (-> (split-command seg-2 ts-seg-2) (add-previous (:prev seg-2)))])))) - (defn content-intersect-split - [content-a content-b] + [content-a content-b sr-a sr-b] - (let [cache (atom {})] - (letfn [(split-cache [seg-1 seg-2] - (cond - (contains? @cache [seg-1 seg-2]) - (first (get @cache [seg-1 seg-2])) + (let [command->selrect (memoize gsp/command->selrect)] - (contains? @cache [seg-2 seg-1]) - (second (get @cache [seg-2 seg-1])) + (letfn [(overlap-segment-selrect? + [segment selrect] + (if (= :move-to (:command segment)) + false + (let [r1 (command->selrect segment)] + (gpr/overlaps-rects? r1 selrect)))) - :else - (let [value (split seg-1 seg-2)] - (swap! cache assoc [seg-1 seg-2] value) - (first value)))) + (overlap-segments? + [seg-1 seg-2] + (if (or (= :move-to (:command seg-1)) + (= :move-to (:command seg-2))) + false + (let [r1 (command->selrect seg-1) + r2 (command->selrect seg-2)] + (gpr/overlaps-rects? r1 r2)))) + + (split + [seg-1 seg-2] + (if (not (overlap-segments? seg-1 seg-2)) + [seg-1] + (let [[ts-seg-1 _] (split-ts seg-1 seg-2)] + (-> (split-command seg-1 ts-seg-1) + (add-previous (:prev seg-1)))))) (split-segment-on-content - [segment content] + [segment content content-sr] - (loop [current (first content) - content (rest content) - result [segment]] - - (if (nil? current) - result - (let [result (->> result (into [] (mapcat #(split-cache % current))))] - (recur (first content) - (rest content) - result))))) + (if (overlap-segment-selrect? segment content-sr) + (->> content + (filter #(overlap-segments? segment %)) + (reduce + (fn [result current] + (into [] (mapcat #(split % current)) result)) + [segment])) + [segment])) (split-content - [content-a content-b] + [content-a content-b sr-b] (into [] - (mapcat #(split-segment-on-content % content-b)) + (mapcat #(split-segment-on-content % content-b sr-b)) content-a))] - [(split-content content-a content-b) - (split-content content-b content-a)]))) + [(split-content content-a content-b sr-b) + (split-content content-b content-a sr-a)]))) (defn is-segment? [cmd] @@ -147,7 +147,7 @@ (contains? #{:line-to :curve-to} (:command cmd)))) (defn contains-segment? - [segment content] + [segment content content-sr content-geom] (let [point (case (:command segment) :line-to (-> (gsp/command->line segment) @@ -156,11 +156,13 @@ :curve-to (-> (gsp/command->bezier segment) (gsp/curve-values 0.5)))] - (or (gsp/is-point-in-content? point content) - (gsp/is-point-in-border? point content)))) + (and (gpr/contains-point? content-sr point) + (or + (gsp/is-point-in-geom-data? point content-geom) + (gsp/is-point-in-border? point content))))) (defn inside-segment? - [segment content] + [segment content-sr content-geom] (let [point (case (:command segment) :line-to (-> (gsp/command->line segment) (gsp/line-values 0.5)) @@ -168,7 +170,8 @@ :curve-to (-> (gsp/command->bezier segment) (gsp/curve-values 0.5)))] - (gsp/is-point-in-content? point content))) + (and (gpr/contains-point? content-sr point) + (gsp/is-point-in-geom-data? point content-geom)))) (defn overlap-segment? "Finds if the current segment is overlapping against other @@ -209,49 +212,59 @@ (d/seek overlap-single?) (some?)))) -(defn create-union [content-a content-a-split content-b content-b-split] +(defn create-union [content-a content-a-split content-b content-b-split sr-a sr-b] ;; Pick all segments in content-a that are not inside content-b ;; Pick all segments in content-b that are not inside content-a - (let [content + (let [content-a-geom (gsp/content->geom-data content-a) + content-b-geom (gsp/content->geom-data content-b) + + content (concat - (->> content-a-split (filter #(not (contains-segment? % content-b)))) - (->> content-b-split (filter #(not (contains-segment? % content-a))))) + (->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom)))) + (->> content-b-split (filter #(not (contains-segment? % content-a sr-a content-a-geom))))) + + content-geom (gsp/content->geom-data content) + + content-sr (gsp/content->selrect content) ;; Overlapping segments should be added when they are part of the border border-content (->> content-b-split - (filter #(and (contains-segment? % content-a) + (filter #(and (contains-segment? % content-a sr-a content-a-geom) (overlap-segment? % content-a-split) - (not (inside-segment? % content)))))] + (not (inside-segment? % content-sr content-geom)))))] ;; Ensure that the output is always a vector (d/concat-vec content border-content))) -(defn create-difference [content-a content-a-split content-b content-b-split] +(defn create-difference [content-a content-a-split content-b content-b-split sr-a sr-b] ;; Pick all segments in content-a that are not inside content-b ;; Pick all segments in content b that are inside content-a ;; removing overlapping - (d/concat-vec - (->> content-a-split (filter #(not (contains-segment? % content-b)))) + (let [content-a-geom (gsp/content->geom-data content-a) + content-b-geom (gsp/content->geom-data content-b)] + (d/concat-vec + (->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom)))) - ;; Reverse second content so we can have holes inside other shapes - (->> content-b-split - (filter #(and (contains-segment? % content-a) - (not (overlap-segment? % content-a-split))))))) + ;; Reverse second content so we can have holes inside other shapes + (->> content-b-split + (filter #(and (contains-segment? % content-a sr-a content-a-geom) + (not (overlap-segment? % content-a-split)))))))) -(defn create-intersection [content-a content-a-split content-b content-b-split] +(defn create-intersection [content-a content-a-split content-b content-b-split sr-a sr-b] ;; Pick all segments in content-a that are inside content-b ;; Pick all segments in content-b that are inside content-a - (d/concat-vec - (->> content-a-split (filter #(contains-segment? % content-b))) - (->> content-b-split (filter #(contains-segment? % content-a))))) + (let [content-a-geom (gsp/content->geom-data content-a) + content-b-geom (gsp/content->geom-data content-b)] + (d/concat-vec + (->> content-a-split (filter #(contains-segment? % content-b sr-b content-b-geom))) + (->> content-b-split (filter #(contains-segment? % content-a sr-a content-a-geom)))))) (defn create-exclusion [content-a content-b] ;; Pick all segments (d/concat-vec content-a content-b)) - (defn fix-move-to [content] ;; Remove the field `:prev` and makes the necessaries `move-to` @@ -284,16 +297,19 @@ (ups/reverse-content)) (add-previous)) + sr-a (gsp/content->selrect content-a) + sr-b (gsp/content->selrect content-b) + ;; Split content in new segments in the intersection with the other path - [content-a-split content-b-split] (content-intersect-split content-a content-b) + [content-a-split content-b-split] (content-intersect-split content-a content-b sr-a sr-b) content-a-split (->> content-a-split add-previous (filter is-segment?)) content-b-split (->> content-b-split add-previous (filter is-segment?)) bool-content (case bool-type - :union (create-union content-a content-a-split content-b content-b-split) - :difference (create-difference content-a content-a-split content-b content-b-split) - :intersection (create-intersection content-a content-a-split content-b content-b-split) + :union (create-union content-a content-a-split content-b content-b-split sr-a sr-b) + :difference (create-difference content-a content-a-split content-b content-b-split sr-a sr-b) + :intersection (create-intersection content-a content-a-split content-b content-b-split sr-a sr-b) :exclude (create-exclusion content-a-split content-b-split))] (->> (fix-move-to bool-content) diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs index 68a40ab7ec..b587e3437e 100644 --- a/frontend/src/app/main/data/workspace.cljs +++ b/frontend/src/app/main/data/workspace.cljs @@ -28,6 +28,7 @@ [app.main.data.workspace.changes :as dch] [app.main.data.workspace.common :as dwc] [app.main.data.workspace.drawing :as dwd] + [app.main.data.workspace.fix-bool-contents :as fbc] [app.main.data.workspace.groups :as dwg] [app.main.data.workspace.interactions :as dwi] [app.main.data.workspace.libraries :as dwl] @@ -213,8 +214,11 @@ (or (not ignore-until) (> (:modified-at %) ignore-until))) libraries)] - (when needs-update? - (rx/of (dwl/notify-sync-file file-id))))))) + (rx/merge + (rx/of (fbc/fix-bool-contents)) + (if needs-update? + (rx/of (dwl/notify-sync-file file-id)) + (rx/empty))))))) (defn finalize-file [_project-id file-id] @@ -307,7 +311,7 @@ [page-id] (ptk/reify ::duplicate-page ptk/WatchEvent - (watch [this state _] + (watch [it state _] (let [id (uuid/next) pages (get-in state [:workspace-data :pages-index]) unames (dwc/retrieve-used-names pages) @@ -322,7 +326,7 @@ :id id}] (rx/of (dch/commit-changes {:redo-changes [rchange] :undo-changes [uchange] - :origin this})))))) + :origin it})))))) (s/def ::rename-page (s/keys :req-un [::id ::name])) diff --git a/frontend/src/app/main/data/workspace/fix_bool_contents.cljs b/frontend/src/app/main/data/workspace/fix_bool_contents.cljs new file mode 100644 index 0000000000..b59bc401a6 --- /dev/null +++ b/frontend/src/app/main/data/workspace/fix_bool_contents.cljs @@ -0,0 +1,94 @@ +;; 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/. +;; +;; Copyright (c) UXBOX Labs SL + +(ns app.main.data.workspace.fix-bool-contents + (:require + [app.common.data :as d] + [app.common.geom.shapes :as gsh] + [app.main.data.workspace.changes :as dch] + [app.main.data.workspace.state-helpers :as wsh] + [beicon.core :as rx] + [potok.core :as ptk])) + +;; This event will update the file so the boolean data has a pre-generated path data +;; to increase performance. +;; For new shapes this will be generated in the :reg-objects but we need to do this for +;; old files. + +;; FIXME: Remove me after June 2022 + +(defn fix-bool-contents + "This event will calculate the bool content and update the page. This is kind of a 'addhoc' migration + to fill the optional value 'bool-content'" + [] + + (letfn [(should-migrate-shape? [shape] + (and (= :bool (:type shape)) (not (contains? shape :bool-content)))) + + (should-migrate-component? [component] + (->> (:objects component) + (vals) + (d/seek should-migrate-shape?))) + + (update-shape [shape objects] + (cond-> shape + (should-migrate-shape? shape) + (assoc :bool-content (gsh/calc-bool-content shape objects)))) + + (migrate-component [component] + (-> component + (update + :objects + (fn [objects] + (d/mapm #(update-shape %2 objects) objects))))) + + (update-library + [library] + (-> library + (d/update-in-when + [:data :components] + (fn [components] + (d/mapm #(migrate-component %2) components)))))] + + (ptk/reify ::fix-bool-contents + ptk/UpdateEvent + (update [_ state] + ;; Update (only-local) the imported libraries + (-> state + (d/update-when + :workspace-libraries + (fn [libraries] (d/mapm #(update-library %2) libraries))))) + + ptk/WatchEvent + (watch [it state _] + (let [objects (wsh/lookup-page-objects state) + + ids (into #{} + (comp (filter should-migrate-shape?) (map :id)) + (vals objects)) + + components (->> (wsh/lookup-local-components state) + (vals) + (filter should-migrate-component?)) + + component-changes + (into [] + (map (fn [component] + {:type :mod-component + :id (:id component) + :objects (-> component migrate-component :objects)})) + components)] + + (rx/of (dch/update-shapes ids #(update-shape % objects) {:reg-objects? false + :save-undo? false + :ignore-tree true})) + + (if (empty? component-changes) + (rx/empty) + (rx/of (dch/commit-changes {:origin it + :redo-changes component-changes + :undo-changes [] + :save-undo? false})))))))) diff --git a/frontend/src/app/main/data/workspace/state_helpers.cljs b/frontend/src/app/main/data/workspace/state_helpers.cljs index 0710aba559..f144670bac 100644 --- a/frontend/src/app/main/data/workspace/state_helpers.cljs +++ b/frontend/src/app/main/data/workspace/state_helpers.cljs @@ -25,6 +25,10 @@ ([state component-id] (get-in state [:workspace-data :components component-id :objects]))) +(defn lookup-local-components + ([state] + (get-in state [:workspace-data :components]))) + (defn lookup-selected ([state] (lookup-selected state nil)) diff --git a/frontend/src/app/main/ui/shapes/bool.cljs b/frontend/src/app/main/ui/shapes/bool.cljs index 88a48feefd..04e4c7ca0c 100644 --- a/frontend/src/app/main/ui/shapes/bool.cljs +++ b/frontend/src/app/main/ui/shapes/bool.cljs @@ -6,8 +6,7 @@ (ns app.main.ui.shapes.bool (:require - [app.common.path.bool :as pb] - [app.common.path.shapes-to-path :as stp] + [app.common.geom.shapes :as gsh] [app.main.ui.hooks :refer [use-equal-memo]] [app.main.ui.shapes.export :as use] [app.main.ui.shapes.path :refer [path-shape]] @@ -27,13 +26,8 @@ bool-content (mf/use-memo (mf/deps shape childs) - (fn [] - (->> (:shapes shape) - (map #(get childs %)) - (filter #(not (:hidden %))) - (map #(stp/convert-to-path % childs)) - (mapv :content) - (pb/content-bool (:bool-type shape)))))] + #(or (:bool-content shape) + (gsh/calc-bool-content shape childs)))] [:* [:& path-shape {:shape (assoc shape :content bool-content)}]