wip del gueno

This commit is contained in:
Andrés Moya 2022-11-24 16:22:31 +01:00
parent a4e36390e2
commit 8ccd9bedfa
2 changed files with 264 additions and 144 deletions

View File

@ -15,6 +15,7 @@
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.types.modifiers :as ctm] [app.common.types.modifiers :as ctm]
[app.common.types.component :as ctk]
[app.common.types.container :as ctn] [app.common.types.container :as ctn]
[app.common.types.shape :as cts] [app.common.types.shape :as cts]
[app.common.types.shape.layout :as ctl] [app.common.types.shape.layout :as ctl]
@ -28,6 +29,106 @@
[cljs.spec.alpha :as s] [cljs.spec.alpha :as s]
[potok.core :as ptk])) [potok.core :as ptk]))
;; -- copies --------------------------------------------------------
;; TBD...
(defn- get-copies
"If one or more of the shapes belongs to a component's main instance, find all copies of
the component in the same page.
Return a map {<main-root-id> [<main-root> [<copy-root> <copy-root>...]] ...}"
[shapes objects modif-tree]
(letfn [(get-copies-one [shape]
(let [root-shape (ctn/get-root-shape objects shape)]
(when (:main-instance? root-shape)
(let [children (->> root-shape
:shapes
(map #(get objects %))
(map #(gsh/transform-shape % (get-in modif-tree [(:id %) :modifiers]))))
root-shape (gsh/update-group-selrect root-shape children)]
[(:id root-shape) [root-shape (ctn/get-instances objects root-shape)]]))))]
(into {} (map get-copies-one shapes))))
(defn- reposition-shape
[shape origin-root dest-root]
(let [shape-pos (fn [shape]
(gpt/point (get-in shape [:selrect :x])
(get-in shape [:selrect :y])))
origin-root-pos (shape-pos origin-root)
dest-root-pos (shape-pos dest-root)
delta (gpt/subtract dest-root-pos origin-root-pos)]
(gsh/move shape delta)))
(defn- sync-shape
[main-shape copy-shape main-root copy-root]
(if (ctk/touched-group? copy-shape :geometry-group)
{}
(let [main-shape (reposition-shape main-shape main-root copy-root)
translation (gpt/subtract (gsh/orig-pos main-shape)
(gsh/orig-pos copy-shape))
center (gsh/orig-pos copy-shape)
mult-w (/ (gsh/width main-shape) (gsh/width copy-shape))
mult-h (/ (gsh/height main-shape) (gsh/height copy-shape))
resize (gpt/point mult-w mult-h)]
(-> (ctm/empty)
(ctm/move translation)
(ctm/resize resize center)))))
(defn- process-text-modifiers
"For texts we only use the displacement because resize
needs to recalculate the text layout"
[shape modif-tree]
modif-tree)
;; (cond-> modifiers
;; (= :text (:type shape))
;; (select-keys [:displacement :rotation])))
(defn- add-copies-modifiers
"Add modifiers to all necessary shapes inside the copies"
[copies objects modif-tree]
(letfn [(add-copy-modifiers-one [modif-tree copy-shape copy-root main-root main-shapes main-shapes-modif]
(let [main-shape-modif (d/seek #(ctk/is-main-of? % copy-shape) main-shapes-modif)
modifiers (sync-shape main-shape-modif copy-shape main-root copy-root)
;; %%(cond-> (sync-shape main-shape-modif copy-shape copy-root main-root)
;; %% (some? (:rotation (get-in modifiers [(:id main-shape-modif) :modifiers])))
;; %% (assoc :rotation (:rotation (get-in modifiers [(:id main-shape-modif) :modifiers])))
;; %% )
]
(if (seq modifiers)
(assoc-in modif-tree [(:id copy-shape) :modifiers] modifiers)
modif-tree)))
(add-copy-modifiers [modif-tree copy-root main-root main-shapes main-shapes-modif]
(let [copy-shapes (into [copy-root] (cph/get-children objects (:id copy-root)))]
(reduce #(add-copy-modifiers-one %1 %2 copy-root main-root main-shapes main-shapes-modif)
modif-tree
copy-shapes)))
(add-copies-modifiers-one [modif-tree [main-root copy-roots]]
(let [main-shapes (into [main-root] (cph/get-children objects (:id main-root)))
main-shapes-modif (map (fn [shape]
(let [; shape (cond-> shape
; (some? (:transform-inverse shape))
; (gsh/apply-transform (:transform-inverse shape)))
]
(->> (get-in modif-tree [(:id shape) :modifiers])
(process-text-modifiers shape)
(gsh/transform-shape shape))))
main-shapes)]
(reduce #(add-copy-modifiers %1 %2 main-root main-shapes main-shapes-modif)
modif-tree
copy-roots)))]
(reduce add-copies-modifiers-one
modif-tree
(vals copies))))
;; -- temporary modifiers ------------------------------------------- ;; -- temporary modifiers -------------------------------------------
;; During an interactive transformation of shapes (e.g. when resizing or rotating ;; During an interactive transformation of shapes (e.g. when resizing or rotating
@ -236,12 +337,25 @@
(wsh/lookup-page-objects state) (wsh/lookup-page-objects state)
snap-pixel? snap-pixel?
(and (not ignore-snap-pixel) (contains? (:workspace-layout state) :snap-pixel-grid))] (and (not ignore-snap-pixel) (contains? (:workspace-layout state) :snap-pixel-grid))
(as-> objects $ modif-tree
(apply-text-modifiers $ (get state :workspace-text-modifier)) (as-> objects $
;;(apply-path-modifiers $ (get-in state [:workspace-local :edit-path])) (apply-text-modifiers $ (get state :workspace-text-modifier))
(gsh/set-objects-modifiers modif-tree $ ignore-constraints snap-pixel?))))) ;;(apply-path-modifiers $ (get-in state [:workspace-local :edit-path]))
(gsh/set-objects-modifiers modif-tree $ ignore-constraints snap-pixel?))
shapes
(->> (keys modif-tree)
(map (d/getf objects)))
copies
(get-copies shapes objects modif-tree)
;; TODO: mark new modifiers to be ignored in apply-modifiers
modif-tree (add-copies-modifiers copies objects modif-tree)]
modif-tree)))
(defn set-modifiers (defn set-modifiers
([modif-tree] ([modif-tree]

View File

@ -38,110 +38,111 @@
[cljs.spec.alpha :as s] [cljs.spec.alpha :as s]
[potok.core :as ptk])) [potok.core :as ptk]))
;; --- copies --------------------------- ;; $$ ESTE ES EL BUENO que estoy moviendo a data/worskpace/modifiers
;; ;; --- copies ---------------------------
(defn- get-copies ;;
"If one or more of the shapes belongs to a component's main instance, find all copies of ;; (defn- get-copies
the component in the same page. ;; "If one or more of the shapes belongs to a component's main instance, find all copies of
;; the component in the same page.
Return a map {<main-root-id> [<main-root> [<copy-root> <copy-root>...]] ...}" ;;
[shapes objects modifiers] ;; Return a map {<main-root-id> [<main-root> [<copy-root> <copy-root>...]] ...}"
(letfn [(get-copies-one [shape] ;; [shapes objects modifiers]
(let [root-shape (ctn/get-root-shape objects shape)] ;; (letfn [(get-copies-one [shape]
(when (:main-instance? root-shape) ;; (let [root-shape (ctn/get-root-shape objects shape)]
(let [children (->> root-shape ;; (when (:main-instance? root-shape)
:shapes ;; (let [children (->> root-shape
(map #(get objects %)) ;; :shapes
;; %% (map #(gsh/apply-modifiers % (get-in modifiers [(:id %) :modifiers]))) ;; (map #(get objects %))
) ;; ;; %% (map #(gsh/apply-modifiers % (get-in modifiers [(:id %) :modifiers])))
root-shape (gsh/update-group-selrect root-shape children)] ;; )
[(:id root-shape) [root-shape (ctn/get-instances objects root-shape)]]))))] ;; root-shape (gsh/update-group-selrect root-shape children)]
;; [(:id root-shape) [root-shape (ctn/get-instances objects root-shape)]]))))]
(into {} (map get-copies-one shapes)))) ;;
;; (into {} (map get-copies-one shapes))))
(defn- reposition-shape ;;
[shape origin-root dest-root] ;; (defn- reposition-shape
(let [shape-pos (fn [shape] ;; [shape origin-root dest-root]
(gpt/point (get-in shape [:selrect :x]) ;; (let [shape-pos (fn [shape]
(get-in shape [:selrect :y]))) ;; (gpt/point (get-in shape [:selrect :x])
;; (get-in shape [:selrect :y])))
origin-root-pos (shape-pos origin-root) ;;
dest-root-pos (shape-pos dest-root) ;; origin-root-pos (shape-pos origin-root)
delta (gpt/subtract dest-root-pos origin-root-pos)] ;; dest-root-pos (shape-pos dest-root)
(gsh/move shape delta))) ;; delta (gpt/subtract dest-root-pos origin-root-pos)]
;; (gsh/move shape delta)))
(defn- sync-shape ;;
[main-shape copy-shape copy-root main-root] ;; (defn- sync-shape
;; (js/console.log "+++") ;; [main-shape copy-shape copy-root main-root]
;; (js/console.log "main-shape" (clj->js main-shape)) ;; ;; (js/console.log "+++")
;; (js/console.log "copy-shape" (clj->js copy-shape)) ;; ;; (js/console.log "main-shape" (clj->js main-shape))
(if (ctk/touched-group? copy-shape :geometry-group) ;; ;; (js/console.log "copy-shape" (clj->js copy-shape))
{} ;; (if (ctk/touched-group? copy-shape :geometry-group)
(let [main-shape (reposition-shape main-shape main-root copy-root) ;; {}
;; (let [main-shape (reposition-shape main-shape main-root copy-root)
translation (gpt/subtract (gsh/orig-pos main-shape) ;;
(gsh/orig-pos copy-shape)) ;; translation (gpt/subtract (gsh/orig-pos main-shape)
;; (gsh/orig-pos copy-shape))
center (gsh/orig-pos copy-shape) ;;
mult-w (/ (gsh/width main-shape) (gsh/width copy-shape)) ;; center (gsh/orig-pos copy-shape)
mult-h (/ (gsh/height main-shape) (gsh/height copy-shape)) ;; mult-w (/ (gsh/width main-shape) (gsh/width copy-shape))
resize (gpt/point mult-w mult-h)] ;; mult-h (/ (gsh/height main-shape) (gsh/height copy-shape))
;; resize (gpt/point mult-w mult-h)]
(cond-> {} ;;
(not (gpt/almost-zero? translation)) ;; (cond-> {}
(assoc :displacement (gmt/translate-matrix translation)) ;; (not (gpt/almost-zero? translation))
;; (assoc :displacement (gmt/translate-matrix translation))
(not (gpt/close? resize (gpt/point 1 1))) ;;
(assoc :resize-vector resize ;; (not (gpt/close? resize (gpt/point 1 1)))
:resize-origin center))))) ;; (assoc :resize-vector resize
;; :resize-origin center)))))
(defn- process-text-modifiers ;;
"For texts we only use the displacement because resize ;; (defn- process-text-modifiers
needs to recalculate the text layout" ;; "For texts we only use the displacement because resize
[shape modifiers] ;; needs to recalculate the text layout"
modifiers) ;; [shape modifiers]
;; (cond-> modifiers ;; modifiers)
;; (= :text (:type shape)) ;; ;; (cond-> modifiers
;; (select-keys [:displacement :rotation]))) ;; ;; (= :text (:type shape))
;; ;; (select-keys [:displacement :rotation])))
(defn- add-copies-modifiers ;;
"Add modifiers to all necessary shapes inside the copies" ;; (defn- add-copies-modifiers
[copies objects modifiers] ;; "Add modifiers to all necessary shapes inside the copies"
(letfn [(add-copy-modifiers-one [modifiers copy-shape copy-root main-root main-shapes main-shapes-modif] ;; [copies objects modifiers]
(let [main-shape-modif (d/seek #(ctk/is-main-of? % copy-shape) main-shapes-modif) ;; (letfn [(add-copy-modifiers-one [modifiers copy-shape copy-root main-root main-shapes main-shapes-modif]
modifier (cond-> (sync-shape main-shape-modif copy-shape copy-root main-root) ;; (let [main-shape-modif (d/seek #(ctk/is-main-of? % copy-shape) main-shapes-modif)
(some? (:rotation (get-in modifiers [(:id main-shape-modif) :modifiers]))) ;; modifier (cond-> (sync-shape main-shape-modif copy-shape copy-root main-root)
(assoc :rotation (:rotation (get-in modifiers [(:id main-shape-modif) :modifiers]))) ;; (some? (:rotation (get-in modifiers [(:id main-shape-modif) :modifiers])))
)] ;; (assoc :rotation (:rotation (get-in modifiers [(:id main-shape-modif) :modifiers])))
(if (seq modifier) ;; )]
(assoc-in modifiers [(:id copy-shape) :modifiers] modifier) ;; (if (seq modifier)
modifiers))) ;; (assoc-in modifiers [(:id copy-shape) :modifiers] modifier)
;; modifiers)))
(add-copy-modifiers [modifiers copy-root main-root main-shapes main-shapes-modif] ;;
(let [copy-shapes (into [copy-root] (cph/get-children objects (:id copy-root)))] ;; (add-copy-modifiers [modifiers copy-root main-root main-shapes main-shapes-modif]
(reduce #(add-copy-modifiers-one %1 %2 copy-root main-root main-shapes main-shapes-modif) ;; (let [copy-shapes (into [copy-root] (cph/get-children objects (:id copy-root)))]
modifiers ;; (reduce #(add-copy-modifiers-one %1 %2 copy-root main-root main-shapes main-shapes-modif)
copy-shapes))) ;; modifiers
;; copy-shapes)))
(add-copies-modifiers-one [modifiers [main-root copy-roots]] ;;
(let [main-shapes (into [main-root] (cph/get-children objects (:id main-root))) ;; (add-copies-modifiers-one [modif-tree [main-root copy-roots]]
main-shapes-modif (map (fn [shape] ;; (let [main-shapes (into [main-root] (cph/get-children objects (:id main-root)))
(let [; shape (cond-> shape ;; main-shapes-modif (map (fn [shape]
; (some? (:transform-inverse shape)) ;; (let [; shape (cond-> shape
; (gsh/apply-transform (:transform-inverse shape))) ;; ; (some? (:transform-inverse shape))
] ;; ; (gsh/apply-transform (:transform-inverse shape)))
(->> (get-in modifiers [(:id shape) :modifiers]) ;; ]
(process-text-modifiers shape) ;; (->> (get-in modifiers [(:id shape) :modifiers])
;; %% (gsh/apply-modifiers shape) ;; (process-text-modifiers shape)
))) ;; ;; %% (gsh/apply-modifiers shape)
main-shapes)] ;; )))
(reduce #(add-copy-modifiers %1 %2 main-root main-shapes main-shapes-modif) ;; main-shapes)]
modifiers ;; (reduce #(add-copy-modifiers %1 %2 main-root main-shapes main-shapes-modif)
copy-roots)))] ;; modifiers
;; copy-roots)))]
(reduce add-copies-modifiers-one ;;
modifiers ;; (reduce add-copies-modifiers-one
(vals copies)))) ;; modifiers
;; (vals copies))))
;; -- Helpers -------------------------------------------------------- ;; -- Helpers --------------------------------------------------------
@ -230,37 +231,39 @@
(declare get-ignore-tree) (declare get-ignore-tree)
(defn set-modifiers ;; $$ ESTE ES EL BUENO que estoy moviendo a data/worskpace/modifiers
([ids] ;; (defn set-modifiers
(set-modifiers ids nil false)) ;; ([ids]
;; (set-modifiers ids nil false))
([ids modifiers] ;;
(set-modifiers ids modifiers false)) ;; ([ids modifiers]
;; (set-modifiers ids modifiers false))
([ids modifiers ignore-constraints] ;;
(set-modifiers ids modifiers ignore-constraints false)) ;; ([ids modifiers ignore-constraints]
;; (set-modifiers ids modifiers ignore-constraints false))
([ids modifiers ignore-constraints ignore-snap-pixel] ;;
(us/verify (s/coll-of uuid?) ids) ;; ([ids modifiers ignore-constraints ignore-snap-pixel]
(ptk/reify ::set-modifiers ;; (us/verify (s/coll-of uuid?) ids)
ptk/UpdateEvent ;; (ptk/reify ::set-modifiers
(update [_ state] ;; ptk/UpdateEvent
(let [objects (wsh/lookup-page-objects state) ;; (update [_ state]
ids (into #{} (remove #(get-in objects [% :blocked] false)) ids) ;; (let [objects (wsh/lookup-page-objects state)
;; ids (into #{} (remove #(get-in objects [% :blocked] false)) ids)
snap-pixel? (and (not ignore-snap-pixel) ;;
(contains? (:workspace-layout state) :snap-pixel-grid)) ;; snap-pixel? (and (not ignore-snap-pixel)
;; (contains? (:workspace-layout state) :snap-pixel-grid))
modif-tree ;;
{} ;; modif-tree
;; %% (gsh/set-objects-modifiers ids objects (constantly modifiers) ignore-constraints snap-pixel?) ;; {}
;; ;; %% (gsh/set-objects-modifiers ids objects (constantly modifiers) ignore-constraints snap-pixel?)
copies (get-copies (mapv (d/getf objects) ids) objects modif-tree) ;;
;; copies (get-copies (mapv (d/getf objects) ids) objects modif-tree)
;; TODO: mark new modifiers to be ignored in apply-modifiers ;; _ (js/console.log "copies" (clj->js copies))
modif-tree (add-copies-modifiers copies objects modif-tree)] ;;
;; ;; TODO: mark new modifiers to be ignored in apply-modifiers
(update state :workspace-modifiers merge modif-tree)))))) ;; modif-tree (add-copies-modifiers copies objects modif-tree)]
;;
;; (update state :workspace-modifiers merge modif-tree))))))
;; (defn set-modifiers-raw ;; (defn set-modifiers-raw
;; [modifiers] ;; [modifiers]
@ -278,7 +281,8 @@
(ptk/reify ::set-rotation-modifiers (ptk/reify ::set-rotation-modifiers
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(let [objects (wsh/lookup-page-objects state) (let [objects (wsh/lookup-page-objects state)
ids ids
(->> shapes (->> shapes
(remove #(get % :blocked false)) (remove #(get % :blocked false))
@ -327,11 +331,13 @@
shapes (map (d/getf objects) ids) shapes (map (d/getf objects) ids)
ignore-tree (->> (map #(get-ignore-tree object-modifiers objects %) shapes) ignore-tree (->> (map #(get-ignore-tree object-modifiers objects %) shapes)
(reduce merge {}))] (reduce merge {}))
undo-id (uuid/next)]
(rx/concat (rx/concat
(if undo-transation? (if undo-transation?
(rx/of (dwu/start-undo-transaction)) (rx/of (dwu/start-undo-transaction undo-id))
(rx/empty)) (rx/empty))
(rx/of (ptk/event ::dwg/move-frame-guides ids-with-children) (rx/of (ptk/event ::dwg/move-frame-guides ids-with-children)
(ptk/event ::dwcm/move-frame-comment-threads ids-with-children) (ptk/event ::dwcm/move-frame-comment-threads ids-with-children)
@ -365,7 +371,7 @@
:grow-type]}) :grow-type]})
(clear-local-transform)) (clear-local-transform))
(if undo-transation? (if undo-transation?
(rx/of (dwu/commit-undo-transaction)) (rx/of (dwu/commit-undo-transaction undo-id))
(rx/empty)))))))) (rx/empty))))))))
(defn- check-delta (defn- check-delta