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

Merge pull request #3590 from penpot/niwinz-develop-experiments-2

Browse source 
🐛 & ⚡
This commit is contained in:
Alejandro 2023-09-05 11:12:55 +02:00 • committed by GitHub
commit a4ed9e57fb
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
15 changed files with 380 additions and 335 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -146,10 +146,6 @@
(transient-concat c1 more) (transient-concat c1 more)
(transient-concat [] (cons c1 more))))) (transient-concat [] (cons c1 more)))))
(defn preconj
[coll elem]
(into [elem] coll))
(defn enumerate (defn enumerate
([items] (enumerate items 0)) ([items] (enumerate items 0))
([items start] ([items start]

18
common/src/app/common/geom/rect.cljc
View file

@ -275,21 +275,19 @@
[a b] [a b]
(mth/almost-zero? (- a b))) (mth/almost-zero? (- a b)))
;; FIXME: performance
(defn overlaps-rects? (defn overlaps-rects?
"Check for two rects to overlap. Rects won't overlap only if "Check for two rects to overlap. Rects won't overlap only if
one of them is fully to the left or the top" one of them is fully to the left or the top"
[rect-a rect-b] [rect-a rect-b]
(let [x1a (dm/get-prop rect-a :x)
y1a (dm/get-prop rect-a :y)
x2a (+ x1a (dm/get-prop rect-a :width))
y2a (+ y1a (dm/get-prop rect-a :height))
(let [x1a (:x rect-a) x1b (dm/get-prop rect-b :x)
y1a (:y rect-a) y1b (dm/get-prop rect-b :y)
x2a (+ (:x rect-a) (:width rect-a)) x2b (+ x1b (dm/get-prop rect-b :width))
y2a (+ (:y rect-a) (:height rect-a)) y2b (+ y1b (dm/get-prop rect-b :height))]
x1b (:x rect-b)
y1b (:y rect-b)
x2b (+ (:x rect-b) (:width rect-b))
y2b (+ (:y rect-b) (:height rect-b))]
(and (or (> x2a x1b) (s= x2a x1b)) (and (or (> x2a x1b) (s= x2a x1b))
(or (>= x2b x1a) (s= x2b x1a)) (or (>= x2b x1a) (s= x2b x1a))

37
common/src/app/common/geom/shapes/intersect.cljc
View file

@ -305,30 +305,27 @@
(defn overlaps? (defn overlaps?
"General case to check for overlapping between shapes and a rectangle" "General case to check for overlapping between shapes and a rectangle"
[shape rect] [shape rect]
(let [stroke-width (/ (or (:stroke-width shape) 0) 2) (let [swidth (/ (or (:stroke-width shape) 0) 2)
rect (-> rect rect (-> rect
(update :x - stroke-width) (update :x - swidth)
(update :y - stroke-width) (update :y - swidth)
(update :width + (* 2 stroke-width)) (update :width + (* 2 swidth))
(update :height + (* 2 stroke-width)))] (update :height + (* 2 swidth)))]
(or (not shape) (or (not shape)
(let [path? (= :path (:type shape)) (cond
circle? (= :circle (:type shape)) (cph/path-shape? shape)
text? (= :text (:type shape))] (and (overlaps-rect-points? rect (:points shape))
(cond (overlaps-path? shape rect))
path?
(and (overlaps-rect-points? rect (:points shape))
(overlaps-path? shape rect))
circle? (cph/circle-shape? shape)
(and (overlaps-rect-points? rect (:points shape)) (and (overlaps-rect-points? rect (:points shape))
(overlaps-ellipse? shape rect)) (overlaps-ellipse? shape rect))
text? (cph/text-shape? shape)
(overlaps-text? shape rect) (overlaps-text? shape rect)
:else :else
(overlaps-rect-points? rect (:points shape))))))) (overlaps-rect-points? rect (:points shape))))))
(defn has-point-rect? (defn has-point-rect?
[rect point] [rect point]

243
common/src/app/common/pages/changes_builder.cljc
View file

@ -16,6 +16,7 @@
[app.common.math :as mth] [app.common.math :as mth]
[app.common.pages :as cp] [app.common.pages :as cp]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.schema :as sm]
[app.common.types.component :as ctk] [app.common.types.component :as ctk]
[app.common.types.file :as ctf] [app.common.types.file :as ctf]
[app.common.types.shape.layout :as ctl] [app.common.types.shape.layout :as ctl]
@ -23,6 +24,18 @@
;; Auxiliary functions to help create a set of changes (undo + redo) ;; Auxiliary functions to help create a set of changes (undo + redo)
(def schema:changes
[:map
[:redo-changes vector?]
[:undo-changes seq?]
[:origin {:optional true} any?]
[:save-undo? {:optional true} boolean?]
[:stack-undo? {:optional true} boolean?]
[:undo-group {:optional true} any?]])
(def valid-changes?
(sm/pred-fn schema:changes))
(defn empty-changes (defn empty-changes
([origin page-id] ([origin page-id]
(let [changes (empty-changes origin)] (let [changes (empty-changes origin)]
@ -31,7 +44,7 @@
([origin] ([origin]
{:redo-changes [] {:redo-changes []
:undo-changes [] :undo-changes '()
:origin origin})) :origin origin}))
(defn set-save-undo? (defn set-save-undo?
@ -87,34 +100,45 @@
(defn concat-changes (defn concat-changes
[changes1 changes2] [changes1 changes2]
{:redo-changes (d/concat-vec (:redo-changes changes1) (:redo-changes changes2)) {:redo-changes (d/concat-vec (:redo-changes changes1)
:undo-changes (d/concat-vec (:undo-changes changes1) (:undo-changes changes2)) (:redo-changes changes2))
:undo-changes (concat (:undo-changes changes1)
(:undo-changes changes2))
:origin (:origin changes1) :origin (:origin changes1)
:undo-group (:undo-group changes1) :undo-group (:undo-group changes1)
:tags (:tags changes1)}) :tags (:tags changes1)})
; TODO: remove this when not needed ; TODO: remove this when not needed
(defn- assert-page-id (defn- assert-page-id!
[changes] [changes]
(assert (contains? (meta changes) ::page-id) "Give a page-id or call (with-page) before using this function")) (dm/assert!
"Give a page-id or call (with-page) before using this function"
(contains? (meta changes) ::page-id)))
(defn- assert-container-id (defn- assert-container-id!
[changes] [changes]
(assert (or (contains? (meta changes) ::page-id) (dm/assert!
(contains? (meta changes) ::component-id)) "Give a page-id or call (with-container) before using this function"
"Give a page-id or call (with-container) before using this function")) (or (contains? (meta changes) ::page-id)
(contains? (meta changes) ::component-id))))
(defn- assert-page (defn- assert-page!
[changes] [changes]
(assert (contains? (meta changes) ::page) "Call (with-page) before using this function")) (dm/assert!
"Call (with-page) before using this function"
(contains? (meta changes) ::page)))
(defn- assert-objects (defn- assert-objects!
[changes] [changes]
(assert (contains? (meta changes) ::file-data) "Call (with-objects) before using this function")) (dm/assert!
"Call (with-objects) before using this function"
(contains? (meta changes) ::file-data)))
(defn- assert-library (defn- assert-library!
[changes] [changes]
(assert (contains? (meta changes) ::library-data) "Call (with-library-data) before using this function")) (dm/assert!
"Call (with-library-data) before using this function"
(contains? (meta changes) ::library-data)))
(defn- lookup-objects (defn- lookup-objects
[changes] [changes]
@ -123,6 +147,10 @@
(defn- apply-changes-local (defn- apply-changes-local
[changes] [changes]
(dm/assert!
"expected valid changes"
(valid-changes? changes))
(if-let [file-data (::file-data (meta changes))] (if-let [file-data (::file-data (meta changes))]
(let [index (::applied-changes-count (meta changes)) (let [index (::applied-changes-count (meta changes))
redo-changes (:redo-changes changes) redo-changes (:redo-changes changes)
@ -143,40 +171,40 @@
[changes id name] [changes id name]
(-> changes (-> changes
(update :redo-changes conj {:type :add-page :id id :name name}) (update :redo-changes conj {:type :add-page :id id :name name})
(update :undo-changes d/preconj {:type :del-page :id id}) (update :undo-changes conj {:type :del-page :id id})
(apply-changes-local))) (apply-changes-local)))
(defn add-page (defn add-page
[changes id page] [changes id page]
(-> changes (-> changes
(update :redo-changes conj {:type :add-page :id id :page page}) (update :redo-changes conj {:type :add-page :id id :page page})
(update :undo-changes d/preconj {:type :del-page :id id}) (update :undo-changes conj {:type :del-page :id id})
(apply-changes-local))) (apply-changes-local)))
(defn mod-page (defn mod-page
[changes page new-name] [changes page new-name]
(-> changes (-> changes
(update :redo-changes conj {:type :mod-page :id (:id page) :name new-name}) (update :redo-changes conj {:type :mod-page :id (:id page) :name new-name})
(update :undo-changes d/preconj {:type :mod-page :id (:id page) :name (:name page)}) (update :undo-changes conj {:type :mod-page :id (:id page) :name (:name page)})
(apply-changes-local))) (apply-changes-local)))
(defn del-page (defn del-page
[changes page] [changes page]
(-> changes (-> changes
(update :redo-changes conj {:type :del-page :id (:id page)}) (update :redo-changes conj {:type :del-page :id (:id page)})
(update :undo-changes d/preconj {:type :add-page :id (:id page) :page page}) (update :undo-changes conj {:type :add-page :id (:id page) :page page})
(apply-changes-local))) (apply-changes-local)))
(defn move-page (defn move-page
[changes page-id index prev-index] [changes page-id index prev-index]
(-> changes (-> changes
(update :redo-changes conj {:type :mov-page :id page-id :index index}) (update :redo-changes conj {:type :mov-page :id page-id :index index})
(update :undo-changes d/preconj {:type :mov-page :id page-id :index prev-index}) (update :undo-changes conj {:type :mov-page :id page-id :index prev-index})
(apply-changes-local))) (apply-changes-local)))
(defn set-page-option (defn set-page-option
[changes option-key option-val] [changes option-key option-val]
(assert-page changes) (assert-page! changes)
(let [page-id (::page-id (meta changes)) (let [page-id (::page-id (meta changes))
page (::page (meta changes)) page (::page (meta changes))
old-val (get-in page [:options option-key])] old-val (get-in page [:options option-key])]
@ -186,7 +214,7 @@
:page-id page-id :page-id page-id
:option option-key :option option-key
:value option-val}) :value option-val})
(update :undo-changes d/preconj {:type :set-option (update :undo-changes conj {:type :set-option
:page-id page-id :page-id page-id
:option option-key :option option-key
:value old-val}) :value old-val})
@ -194,7 +222,7 @@
(defn update-page-option (defn update-page-option
[changes option-key update-fn & args] [changes option-key update-fn & args]
(assert-page changes) (assert-page! changes)
(let [page-id (::page-id (meta changes)) (let [page-id (::page-id (meta changes))
page (::page (meta changes)) page (::page (meta changes))
old-val (get-in page [:options option-key]) old-val (get-in page [:options option-key])
@ -205,7 +233,7 @@
:page-id page-id :page-id page-id
:option option-key :option option-key
:value new-val}) :value new-val})
(update :undo-changes d/preconj {:type :set-option (update :undo-changes conj {:type :set-option
:page-id page-id :page-id page-id
:option option-key :option option-key
:value old-val}) :value old-val})
@ -221,8 +249,8 @@
;; FIXME: add shape validation ;; FIXME: add shape validation
(assert-page-id changes) (assert-page-id! changes)
(assert-objects changes) (assert-objects! changes)
(let [obj (cond-> obj (let [obj (cond-> obj
(not= index ::undefined) (not= index ::undefined)
(assoc ::index index)) (assoc ::index index))
@ -256,8 +284,8 @@
(update :redo-changes conj add-change) (update :redo-changes conj add-change)
(cond-> (cond->
(and (ctk/in-component-copy? parent) (not ignore-touched)) (and (ctk/in-component-copy? parent) (not ignore-touched))
(update :undo-changes d/preconj restore-touched-change)) (update :undo-changes conj restore-touched-change))
(update :undo-changes d/preconj del-change) (update :undo-changes conj del-change)
(apply-changes-local))))) (apply-changes-local)))))
(defn add-objects (defn add-objects
@ -274,8 +302,8 @@
(change-parent changes parent-id shapes nil)) (change-parent changes parent-id shapes nil))
([changes parent-id shapes index] ([changes parent-id shapes index]
(assert-page-id changes) (assert-page-id! changes)
(assert-objects changes) (assert-objects! changes)
(let [objects (lookup-objects changes) (let [objects (lookup-objects changes)
parent (get objects parent-id) parent (get objects parent-id)
@ -289,16 +317,15 @@
(assoc :index index)) (assoc :index index))
mk-undo-change mk-undo-change
(fn [change-set shape] (fn [undo-changes shape]
(let [prev-sibling (cph/get-prev-sibling objects (:id shape))] (let [prev-sibling (cph/get-prev-sibling objects (:id shape))]
(d/preconj (conj undo-changes
change-set {:type :mov-objects
{:type :mov-objects :page-id (::page-id (meta changes))
:page-id (::page-id (meta changes)) :parent-id (:parent-id shape)
:parent-id (:parent-id shape) :shapes [(:id shape)]
:shapes [(:id shape)] :after-shape prev-sibling
:after-shape prev-sibling :index 0}))) ; index is used in case there is no after-shape (moving bottom shapes)
:index 0}))) ; index is used in case there is no after-shape (moving bottom shapes)
restore-touched-change restore-touched-change
{:type :mod-obj {:type :mod-obj
@ -311,7 +338,7 @@
(update :redo-changes conj set-parent-change) (update :redo-changes conj set-parent-change)
(cond-> (cond->
(ctk/in-component-copy? parent) (ctk/in-component-copy? parent)
(update :undo-changes d/preconj restore-touched-change)) (update :undo-changes conj restore-touched-change))
(update :undo-changes #(reduce mk-undo-change % shapes)) (update :undo-changes #(reduce mk-undo-change % shapes))
(apply-changes-local))))) (apply-changes-local)))))
@ -336,24 +363,28 @@
([changes ids update-fn {:keys [attrs ignore-geometry? ignore-touched] ([changes ids update-fn {:keys [attrs ignore-geometry? ignore-touched]
:or {ignore-geometry? false ignore-touched false}}] :or {ignore-geometry? false ignore-touched false}}]
(assert-container-id changes) (assert-container-id! changes)
(assert-objects changes) (assert-objects! changes)
(let [page-id (::page-id (meta changes)) (let [page-id (::page-id (meta changes))
component-id (::component-id (meta changes)) component-id (::component-id (meta changes))
objects (lookup-objects changes) objects (lookup-objects changes)
generate-operation generate-operations
(fn [operations attr old new ignore-geometry?] (fn [attrs old new]
(let [old-val (get old attr) (loop [rops []
new-val (get new attr)] uops '()
(if (= old-val new-val) attrs (seq attrs)]
operations (if-let [attr (first attrs)]
(-> operations (let [old-val (get old attr)
(update :rops conj {:type :set :attr attr :val new-val new-val (get new attr)]
:ignore-geometry ignore-geometry?
:ignore-touched ignore-touched}) (recur (conj rops {:type :set :attr attr :val new-val
(update :uops d/preconj {:type :set :attr attr :val old-val :ignore-geometry ignore-geometry?
:ignore-touched true}))))) :ignore-touched ignore-touched})
(conj uops {:type :set :attr attr :val old-val
:ignore-touched true})
(rest attrs)))
[rops uops])))
update-shape update-shape
(fn [changes id] (fn [changes id]
@ -361,41 +392,35 @@
new-obj (update-fn old-obj)] new-obj (update-fn old-obj)]
(if (= old-obj new-obj) (if (= old-obj new-obj)
changes changes
(let [attrs (or attrs (d/concat-set (keys old-obj) (keys new-obj))) (let [[rops uops] (-> (or attrs (d/concat-set (keys old-obj) (keys new-obj)))
(generate-operations old-obj new-obj))
{rops :rops uops :uops} uops (cond-> uops
(reduce #(generate-operation %1 %2 old-obj new-obj ignore-geometry?) (seq uops)
{:rops [] :uops []} (conj {:type :set-touched :touched (:touched old-obj)}))
attrs)
uops (cond-> uops change (cond-> {:type :mod-obj :id id}
(seq uops) (some? page-id)
(d/preconj {:type :set-touched :touched (:touched old-obj)})) (assoc :page-id page-id)
change (cond-> {:type :mod-obj (some? component-id)
:id id} (assoc :component-id component-id))]
(some? page-id)
(assoc :page-id page-id)
(some? component-id)
(assoc :component-id component-id))]
(cond-> changes (cond-> changes
(seq rops) (seq rops)
(update :redo-changes conj (assoc change :operations rops)) (update :redo-changes conj (assoc change :operations rops))
(seq uops) (seq uops)
(update :undo-changes d/preconj (assoc change :operations uops)))))))] (update :undo-changes conj (assoc change :operations (vec uops))))))))]
(-> (reduce update-shape changes ids) (-> (reduce update-shape changes ids)
(apply-changes-local))))) (apply-changes-local)))))
(defn remove-objects (defn remove-objects
([changes ids] (remove-objects changes ids nil)) ([changes ids] (remove-objects changes ids nil))
([changes ids {:keys [ignore-touched] :or {ignore-touched false}}] ([changes ids {:keys [ignore-touched] :or {ignore-touched false}}]
(assert-page-id changes) (assert-page-id! changes)
(assert-objects changes) (assert-objects! changes)
(let [page-id (::page-id (meta changes)) (let [page-id (::page-id (meta changes))
objects (lookup-objects changes) objects (lookup-objects changes)
@ -410,7 +435,7 @@
add-undo-change-shape add-undo-change-shape
(fn [change-set id] (fn [change-set id]
(let [shape (get objects id)] (let [shape (get objects id)]
(d/preconj (conj
change-set change-set
{:type :add-obj {:type :add-obj
:id id :id id
@ -426,7 +451,7 @@
(fn [change-set id] (fn [change-set id]
(let [shape (get objects id) (let [shape (get objects id)
prev-sibling (cph/get-prev-sibling objects (:id shape))] prev-sibling (cph/get-prev-sibling objects (:id shape))]
(d/preconj (conj
change-set change-set
{:type :mov-objects {:type :mov-objects
:page-id page-id :page-id page-id
@ -445,8 +470,8 @@
(defn resize-parents (defn resize-parents
[changes ids] [changes ids]
(assert-page-id changes) (assert-page-id! changes)
(assert-objects changes) (assert-objects! changes)
(let [page-id (::page-id (meta changes)) (let [page-id (::page-id (meta changes))
objects (lookup-objects changes) objects (lookup-objects changes)
@ -481,7 +506,7 @@
operations operations
(-> operations (-> operations
(update :rops conj {:type :set :attr attr :val new-val :ignore-touched true}) (update :rops conj {:type :set :attr attr :val new-val :ignore-touched true})
(update :uops d/preconj {:type :set :attr attr :val old-val :ignore-touched true}))))) (update :uops conj {:type :set :attr attr :val old-val :ignore-touched true})))))
resize-parent resize-parent
(fn [changes parent] (fn [changes parent]
@ -511,7 +536,7 @@
(if (seq rops) (if (seq rops)
(-> changes (-> changes
(update :redo-changes conj (assoc change :operations rops)) (update :redo-changes conj (assoc change :operations rops))
(update :undo-changes d/preconj (assoc change :operations uops)) (update :undo-changes conj (assoc change :operations uops))
(apply-changes-local)) (apply-changes-local))
changes)) changes))
changes)))] changes)))]
@ -530,89 +555,89 @@
[changes color] [changes color]
(-> changes (-> changes
(update :redo-changes conj {:type :add-color :color color}) (update :redo-changes conj {:type :add-color :color color})
(update :undo-changes d/preconj {:type :del-color :id (:id color)}) (update :undo-changes conj {:type :del-color :id (:id color)})
(apply-changes-local))) (apply-changes-local)))
(defn update-color (defn update-color
[changes color] [changes color]
(assert-library changes) (assert-library! changes)
(let [library-data (::library-data (meta changes)) (let [library-data (::library-data (meta changes))
prev-color (get-in library-data [:colors (:id color)])] prev-color (get-in library-data [:colors (:id color)])]
(-> changes (-> changes
(update :redo-changes conj {:type :mod-color :color color}) (update :redo-changes conj {:type :mod-color :color color})
(update :undo-changes d/preconj {:type :mod-color :color prev-color}) (update :undo-changes conj {:type :mod-color :color prev-color})
(apply-changes-local)))) (apply-changes-local))))
(defn delete-color (defn delete-color
[changes color-id] [changes color-id]
(assert-library changes) (assert-library! changes)
(let [library-data (::library-data (meta changes)) (let [library-data (::library-data (meta changes))
prev-color (get-in library-data [:colors color-id])] prev-color (get-in library-data [:colors color-id])]
(-> changes (-> changes
(update :redo-changes conj {:type :del-color :id color-id}) (update :redo-changes conj {:type :del-color :id color-id})
(update :undo-changes d/preconj {:type :add-color :color prev-color}) (update :undo-changes conj {:type :add-color :color prev-color})
(apply-changes-local)))) (apply-changes-local))))
(defn add-media (defn add-media
[changes object] [changes object]
(-> changes (-> changes
(update :redo-changes conj {:type :add-media :object object}) (update :redo-changes conj {:type :add-media :object object})
(update :undo-changes d/preconj {:type :del-media :id (:id object)}) (update :undo-changes conj {:type :del-media :id (:id object)})
(apply-changes-local))) (apply-changes-local)))
(defn update-media (defn update-media
[changes object] [changes object]
(assert-library changes) (assert-library! changes)
(let [library-data (::library-data (meta changes)) (let [library-data (::library-data (meta changes))
prev-object (get-in library-data [:media (:id object)])] prev-object (get-in library-data [:media (:id object)])]
(-> changes (-> changes
(update :redo-changes conj {:type :mod-media :object object}) (update :redo-changes conj {:type :mod-media :object object})
(update :undo-changes d/preconj {:type :mod-media :object prev-object}) (update :undo-changes conj {:type :mod-media :object prev-object})
(apply-changes-local)))) (apply-changes-local))))
(defn delete-media (defn delete-media
[changes id] [changes id]
(assert-library changes) (assert-library! changes)
(let [library-data (::library-data (meta changes)) (let [library-data (::library-data (meta changes))
prev-object (get-in library-data [:media id])] prev-object (get-in library-data [:media id])]
(-> changes (-> changes
(update :redo-changes conj {:type :del-media :id id}) (update :redo-changes conj {:type :del-media :id id})
(update :undo-changes d/preconj {:type :add-media :object prev-object}) (update :undo-changes conj {:type :add-media :object prev-object})
(apply-changes-local)))) (apply-changes-local))))
(defn add-typography (defn add-typography
[changes typography] [changes typography]
(-> changes (-> changes
(update :redo-changes conj {:type :add-typography :typography typography}) (update :redo-changes conj {:type :add-typography :typography typography})
(update :undo-changes d/preconj {:type :del-typography :id (:id typography)}) (update :undo-changes conj {:type :del-typography :id (:id typography)})
(apply-changes-local))) (apply-changes-local)))
(defn update-typography (defn update-typography
[changes typography] [changes typography]
(assert-library changes) (assert-library! changes)
(let [library-data (::library-data (meta changes)) (let [library-data (::library-data (meta changes))
prev-typography (get-in library-data [:typographies (:id typography)])] prev-typography (get-in library-data [:typographies (:id typography)])]
(-> changes (-> changes
(update :redo-changes conj {:type :mod-typography :typography typography}) (update :redo-changes conj {:type :mod-typography :typography typography})
(update :undo-changes d/preconj {:type :mod-typography :typography prev-typography}) (update :undo-changes conj {:type :mod-typography :typography prev-typography})
(apply-changes-local)))) (apply-changes-local))))
(defn delete-typography (defn delete-typography
[changes typography-id] [changes typography-id]
(assert-library changes) (assert-library! changes)
(let [library-data (::library-data (meta changes)) (let [library-data (::library-data (meta changes))
prev-typography (get-in library-data [:typographies typography-id])] prev-typography (get-in library-data [:typographies typography-id])]
(-> changes (-> changes
(update :redo-changes conj {:type :del-typography :id typography-id}) (update :redo-changes conj {:type :del-typography :id typography-id})
(update :undo-changes d/preconj {:type :add-typography :typography prev-typography}) (update :undo-changes conj {:type :add-typography :typography prev-typography})
(apply-changes-local)))) (apply-changes-local))))
(defn add-component (defn add-component
([changes id path name new-shapes updated-shapes main-instance-id main-instance-page] ([changes id path name new-shapes updated-shapes main-instance-id main-instance-page]
(add-component changes id path name new-shapes updated-shapes main-instance-id main-instance-page nil)) (add-component changes id path name new-shapes updated-shapes main-instance-id main-instance-page nil))
([changes id path name new-shapes updated-shapes main-instance-id main-instance-page annotation] ([changes id path name new-shapes updated-shapes main-instance-id main-instance-page annotation]
(assert-page-id changes) (assert-page-id! changes)
(assert-objects changes) (assert-objects! changes)
(let [page-id (::page-id (meta changes)) (let [page-id (::page-id (meta changes))
objects (lookup-objects changes) objects (lookup-objects changes)
lookupf (d/getf objects) lookupf (d/getf objects)
@ -656,7 +681,7 @@
(update :undo-changes (update :undo-changes
(fn [undo-changes] (fn [undo-changes]
(-> undo-changes (-> undo-changes
(d/preconj {:type :del-component (conj {:type :del-component
:id id :id id
:skip-undelete? true}) :skip-undelete? true})
(into (comp (map :id) (into (comp (map :id)
@ -667,7 +692,7 @@
(defn update-component (defn update-component
[changes id update-fn] [changes id update-fn]
(assert-library changes) (assert-library! changes)
(let [library-data (::library-data (meta changes)) (let [library-data (::library-data (meta changes))
prev-component (get-in library-data [:components id]) prev-component (get-in library-data [:components id])
new-component (update-fn prev-component)] new-component (update-fn prev-component)]
@ -679,7 +704,7 @@
:path (:path new-component) :path (:path new-component)
:annotation (:annotation new-component) :annotation (:annotation new-component)
:objects (:objects new-component)}) ;; this won't exist in components-v2 :objects (:objects new-component)}) ;; this won't exist in components-v2
(update :undo-changes d/preconj {:type :mod-component (update :undo-changes conj {:type :mod-component
:id id :id id
:name (:name prev-component) :name (:name prev-component)
:path (:path prev-component) :path (:path prev-component)
@ -689,23 +714,23 @@
(defn delete-component (defn delete-component
[changes id] [changes id]
(assert-library changes) (assert-library! changes)
(-> changes (-> changes
(update :redo-changes conj {:type :del-component (update :redo-changes conj {:type :del-component
:id id}) :id id})
(update :undo-changes d/preconj {:type :restore-component (update :undo-changes conj {:type :restore-component
:id id}))) :id id})))
(defn restore-component (defn restore-component
([changes id] ([changes id]
(restore-component changes id nil)) (restore-component changes id nil))
([changes id page-id] ([changes id page-id]
(assert-library changes) (assert-library! changes)
(-> changes (-> changes
(update :redo-changes conj {:type :restore-component (update :redo-changes conj {:type :restore-component
:id id :id id
:page-id page-id}) :page-id page-id})
(update :undo-changes d/preconj {:type :del-component (update :undo-changes conj {:type :del-component
:id id})))) :id id}))))
(defn ignore-remote (defn ignore-remote
@ -720,8 +745,8 @@
(defn reorder-grid-children (defn reorder-grid-children
[changes ids] [changes ids]
(assert-page-id changes) (assert-page-id! changes)
(assert-objects changes) (assert-objects! changes)
(let [page-id (::page-id (meta changes)) (let [page-id (::page-id (meta changes))
objects (lookup-objects changes) objects (lookup-objects changes)
@ -746,7 +771,7 @@
:shapes old-shapes}] :shapes old-shapes}]
(-> changes (-> changes
(update :redo-changes conj redo-change) (update :redo-changes conj redo-change)
(update :undo-changes d/preconj undo-change) (update :undo-changes conj undo-change)
(apply-changes-local)))) (apply-changes-local))))
changes changes

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

@ -178,9 +178,11 @@
[{:keys [redo-changes undo-changes [{:keys [redo-changes undo-changes
origin save-undo? file-id undo-group tags stack-undo?] origin save-undo? file-id undo-group tags stack-undo?]
:or {save-undo? true stack-undo? false tags #{} undo-group (uuid/next)}}] :or {save-undo? true stack-undo? false tags #{} undo-group (uuid/next)}}]
(let [error (volatile! nil) (let [error (volatile! nil)
page-id (:current-page-id @st/state) page-id (:current-page-id @st/state)
frames (changed-frames redo-changes (wsh/lookup-page-objects @st/state))] frames (changed-frames redo-changes (wsh/lookup-page-objects @st/state))
undo-changes (vec undo-changes)
redo-changes (vec redo-changes)]
(ptk/reify ::commit-changes (ptk/reify ::commit-changes
cljs.core/IDeref cljs.core/IDeref
(-deref [_] (-deref [_]

270
frontend/src/app/main/data/workspace/libraries_helpers.cljs
View file

@ -102,8 +102,8 @@
[(first shapes) (-> (pcb/empty-changes it page-id) [(first shapes) (-> (pcb/empty-changes it page-id)
(pcb/with-objects objects))] (pcb/with-objects objects))]
(let [root-name (if (= 1 (count shapes)) (let [root-name (if (= 1 (count shapes))
(:name (first shapes)) (:name (first shapes))
"Component 1")] "Component 1")]
(if-not components-v2 (if-not components-v2
(prepare-create-group it ; These functions needs to be passed as argument (prepare-create-group it ; These functions needs to be passed as argument
objects ; to avoid a circular dependence objects ; to avoid a circular dependence
@ -265,14 +265,14 @@
(if-let [page (first pages)] (if-let [page (first pages)]
(recur (next pages) (recur (next pages)
(pcb/concat-changes (pcb/concat-changes
changes changes
(generate-sync-container it (generate-sync-container it
asset-type asset-type
asset-id asset-id
library-id library-id
state state
(cph/make-container page :page) (cph/make-container page :page)
components-v2))) components-v2)))
changes)))) changes))))
(defn generate-sync-library (defn generate-sync-library
@ -301,14 +301,14 @@
(if-let [local-component (first local-components)] (if-let [local-component (first local-components)]
(recur (next local-components) (recur (next local-components)
(pcb/concat-changes (pcb/concat-changes
changes changes
(generate-sync-container it (generate-sync-container it
asset-type asset-type
asset-id asset-id
library-id library-id
state state
(cph/make-container local-component :component) (cph/make-container local-component :component)
components-v2))) components-v2)))
changes)))) changes))))
(defn- generate-sync-container (defn- generate-sync-container
@ -392,7 +392,7 @@
(if-let [typography (get typographies (:typography-ref-id node))] (if-let [typography (get typographies (:typography-ref-id node))]
(merge node (dissoc typography :name :id)) (merge node (dissoc typography :name :id))
(dissoc node :typography-ref-id (dissoc node :typography-ref-id
:typography-ref-file)))] :typography-ref-file)))]
(generate-sync-text-shape changes shape container update-node))) (generate-sync-text-shape changes shape container update-node)))
(defn- get-assets (defn- get-assets
@ -405,21 +405,21 @@
[changes shape container update-node] [changes shape container update-node]
(let [old-content (:content shape) (let [old-content (:content shape)
new-content (txt/transform-nodes update-node old-content) new-content (txt/transform-nodes update-node old-content)
changes' (-> changes changes' (-> changes
(update :redo-changes conj (make-change (update :redo-changes conj (make-change
container container
{:type :mod-obj {:type :mod-obj
:id (:id shape) :id (:id shape)
:operations [{:type :set :operations [{:type :set
:attr :content :attr :content
:val new-content}]})) :val new-content}]}))
(update :undo-changes d/preconj (make-change (update :undo-changes conj (make-change
container container
{:type :mod-obj {:type :mod-obj
:id (:id shape) :id (:id shape)
:operations [{:type :set :operations [{:type :set
:attr :content :attr :content
:val old-content}]})))] :val old-content}]})))]
(if (= new-content old-content) (if (= new-content old-content)
changes changes
changes'))) changes')))
@ -526,12 +526,12 @@
;; but it's not touched. ;; but it's not touched.
(defn- redirect-shaperef ;;Set the :shape-ref of a shape pointing to the :id of its remote-shape (defn- redirect-shaperef ;;Set the :shape-ref of a shape pointing to the :id of its remote-shape
([container libraries shape] ([container libraries shape]
(redirect-shaperef nil nil shape (ctf/find-remote-shape container libraries shape))) (redirect-shaperef nil nil shape (ctf/find-remote-shape container libraries shape)))
([_ _ shape remote-shape] ([_ _ shape remote-shape]
(if (some? (:shape-ref shape)) (if (some? (:shape-ref shape))
(assoc shape :shape-ref (:id remote-shape)) (assoc shape :shape-ref (:id remote-shape))
shape))) shape)))
(defn generate-sync-shape-direct (defn generate-sync-shape-direct
"Generate changes to synchronize one shape that is the root of a component "Generate changes to synchronize one shape that is the root of a component
@ -573,8 +573,8 @@
initial-root? initial-root?
redirect-shaperef redirect-shaperef
components-v2) components-v2)
; If the component is not found, because the master component has been ;; If the component is not found, because the master component has been
; deleted or the library unlinked, do nothing in v2 or detach in v1. ;; deleted or the library unlinked, do nothing in v2 or detach in v1.
(if components-v2 (if components-v2
changes changes
(generate-detach-instance changes container shape-id)))) (generate-detach-instance changes container shape-id))))
@ -827,10 +827,10 @@
(-> changes (-> changes
(update :redo-changes (partial mapv check-local)) (update :redo-changes (partial mapv check-local))
(update :undo-changes (partial mapv check-local)))))) (update :undo-changes (partial map check-local))))))
; ---- Operation generation helpers ---- ;; ---- Operation generation helpers ----
(defn- compare-children (defn- compare-children
[changes children-inst children-main only-inst-cb only-main-cb both-cb moved-cb inverse?] [changes children-inst children-main only-inst-cb only-main-cb both-cb moved-cb inverse?]
@ -911,38 +911,38 @@
[_ new-shapes _] [_ new-shapes _]
(ctst/clone-object component-shape (ctst/clone-object component-shape
(:id parent-shape) (:id parent-shape)
(get component-page :objects) (get component-page :objects)
update-new-shape update-new-shape
update-original-shape) update-original-shape)
add-obj-change (fn [changes shape'] add-obj-change (fn [changes shape']
(update changes :redo-changes conj (update changes :redo-changes conj
(make-change (make-change
container container
(as-> {:type :add-obj (as-> {:type :add-obj
:id (:id shape') :id (:id shape')
:parent-id (:parent-id shape') :parent-id (:parent-id shape')
:index index :index index
:ignore-touched true :ignore-touched true
:obj shape'} $ :obj shape'} $
(cond-> $ (cond-> $
(:frame-id shape') (:frame-id shape')
(assoc :frame-id (:frame-id shape'))))))) (assoc :frame-id (:frame-id shape')))))))
del-obj-change (fn [changes shape'] del-obj-change (fn [changes shape']
(update changes :undo-changes d/preconj (update changes :undo-changes conj
(make-change (make-change
container container
{:type :del-obj {:type :del-obj
:id (:id shape') :id (:id shape')
:ignore-touched true}))) :ignore-touched true})))
changes' (reduce add-obj-change changes new-shapes) changes' (reduce add-obj-change changes new-shapes)
changes' (update changes' :redo-changes conj (make-change changes' (update changes' :redo-changes conj (make-change
container container
{:type :reg-objects {:type :reg-objects
:shapes all-parents})) :shapes all-parents}))
changes' (reduce del-obj-change changes' new-shapes)] changes' (reduce del-obj-change changes' new-shapes)]
(if (and (cph/touched-group? parent-shape :shapes-group) omit-touched?) (if (and (cph/touched-group? parent-shape :shapes-group) omit-touched?)
@ -989,8 +989,8 @@
:ignore-touched true :ignore-touched true
:obj shape'}) :obj shape'})
(ctn/page? component-container) (ctn/page? component-container)
(assoc :frame-id (:frame-id shape'))))) (assoc :frame-id (:frame-id shape')))))
mod-obj-change (fn [changes shape'] mod-obj-change (fn [changes shape']
(update changes :redo-changes conj (update changes :redo-changes conj
@ -1014,7 +1014,7 @@
:val (:touched shape')}]})) :val (:touched shape')}]}))
del-obj-change (fn [changes shape'] del-obj-change (fn [changes shape']
(update changes :undo-changes d/preconj (update changes :undo-changes conj
{:type :del-obj {:type :del-obj
:id (:id shape') :id (:id shape')
:page-id (:id page) :page-id (:id page)
@ -1050,7 +1050,7 @@
add-undo-change (fn [changes id] add-undo-change (fn [changes id]
(let [shape' (get objects id)] (let [shape' (get objects id)]
(update changes :undo-changes d/preconj (update changes :undo-changes conj
(make-change (make-change
container container
(as-> {:type :add-obj (as-> {:type :add-obj
@ -1091,19 +1091,19 @@
changes' (-> changes changes' (-> changes
(update :redo-changes conj (make-change (update :redo-changes conj (make-change
container container
{:type :mov-objects {:type :mov-objects
:parent-id (:parent-id shape) :parent-id (:parent-id shape)
:shapes [(:id shape)] :shapes [(:id shape)]
:index index-after :index index-after
:ignore-touched true})) :ignore-touched true}))
(update :undo-changes d/preconj (make-change (update :undo-changes conj (make-change
container container
{:type :mov-objects {:type :mov-objects
:parent-id (:parent-id shape) :parent-id (:parent-id shape)
:shapes [(:id shape)] :shapes [(:id shape)]
:index index-before :index index-before
:ignore-touched true})))] :ignore-touched true})))]
(if (and (cph/touched-group? parent :shapes-group) omit-touched?) (if (and (cph/touched-group? parent :shapes-group) omit-touched?)
changes changes
@ -1127,24 +1127,24 @@
(if (:remote-synced origin-shape) (if (:remote-synced origin-shape)
nil nil
(set/union (set/union
(:touched dest-shape) (:touched dest-shape)
(:touched origin-shape))))] (:touched origin-shape))))]
(-> changes (-> changes
(update :redo-changes conj (make-change (update :redo-changes conj (make-change
container container
{:type :mod-obj {:type :mod-obj
:id (:id dest-shape) :id (:id dest-shape)
:operations :operations
[{:type :set-touched [{:type :set-touched
:touched new-touched}]})) :touched new-touched}]}))
(update :undo-changes d/preconj (make-change (update :undo-changes conj (make-change
container container
{:type :mod-obj {:type :mod-obj
:id (:id dest-shape) :id (:id dest-shape)
:operations :operations
[{:type :set-touched [{:type :set-touched
:touched (:touched dest-shape)}]}))))))) :touched (:touched dest-shape)}]})))))))
(defn- change-remote-synced (defn- change-remote-synced
[changes shape container remote-synced?] [changes shape container remote-synced?]
@ -1157,19 +1157,19 @@
:remote-synced remote-synced?) :remote-synced remote-synced?)
(-> changes (-> changes
(update :redo-changes conj (make-change (update :redo-changes conj (make-change
container container
{:type :mod-obj {:type :mod-obj
:id (:id shape) :id (:id shape)
:operations :operations
[{:type :set-remote-synced [{:type :set-remote-synced
:remote-synced remote-synced?}]})) :remote-synced remote-synced?}]}))
(update :undo-changes d/preconj (make-change (update :undo-changes conj (make-change
container container
{:type :mod-obj {:type :mod-obj
:id (:id shape) :id (:id shape)
:operations :operations
[{:type :set-remote-synced [{:type :set-remote-synced
:remote-synced (:remote-synced shape)}]})))))) :remote-synced (:remote-synced shape)}]}))))))
(defn- update-attrs (defn- update-attrs
"The main function that implements the attribute sync algorithm. Copy "The main function that implements the attribute sync algorithm. Copy
@ -1185,19 +1185,19 @@
(if (cph/page? container) "[P] " "[C] ") (if (cph/page? container) "[P] " "[C] ")
(:name dest-shape))) (:name dest-shape)))
(let [; To synchronize geometry attributes we need to make a prior (let [;; To synchronize geometry attributes we need to make a prior
; operation, because coordinates are absolute, but we need to ;; operation, because coordinates are absolute, but we need to
; sync only the position relative to the origin of the component. ;; sync only the position relative to the origin of the component.
; We solve this by moving the origin shape so it is aligned with ;; We solve this by moving the origin shape so it is aligned with
; the dest root before syncing. ;; the dest root before syncing.
; In case of subinstances, the comparison is always done with the ;; In case of subinstances, the comparison is always done with the
; near component, because this is that we are syncing with. ;; near component, because this is that we are syncing with.
origin-shape (reposition-shape origin-shape origin-root dest-root) origin-shape (reposition-shape origin-shape origin-root dest-root)
touched (get dest-shape :touched #{})] touched (get dest-shape :touched #{})]
(loop [attrs (seq (keys ctk/sync-attrs)) (loop [attrs (seq (keys ctk/sync-attrs))
roperations [] roperations []
uoperations []] uoperations '()]
(let [attr (first attrs)] (let [attr (first attrs)]
(if (nil? attr) (if (nil? attr)
@ -1207,23 +1207,23 @@
(:id dest-shape))] (:id dest-shape))]
(-> changes (-> changes
(update :redo-changes conj (make-change (update :redo-changes conj (make-change
container container
{:type :mod-obj {:type :mod-obj
:id (:id dest-shape) :id (:id dest-shape)
:operations roperations})) :operations roperations}))
(update :redo-changes conj (make-change (update :redo-changes conj (make-change
container container
{:type :reg-objects {:type :reg-objects
:shapes all-parents})) :shapes all-parents}))
(update :undo-changes d/preconj (make-change
container
{:type :mod-obj
:id (:id dest-shape)
:operations uoperations}))
(update :undo-changes conj (make-change (update :undo-changes conj (make-change
container container
{:type :reg-objects {:type :mod-obj
:shapes all-parents}))))) :id (:id dest-shape)
:operations (vec uoperations)}))
(update :undo-changes concat [(make-change
container
{:type :reg-objects
:shapes all-parents})]))))
(let [roperation {:type :set (let [roperation {:type :set
:attr attr :attr attr
:val (get origin-shape attr) :val (get origin-shape attr)
@ -1242,7 +1242,7 @@
uoperations) uoperations)
(recur (next attrs) (recur (next attrs)
(conj roperations roperation) (conj roperations roperation)
(d/preconj uoperations uoperation))))))))) (conj uoperations uoperation)))))))))
(defn- reposition-shape (defn- reposition-shape
[shape origin-root dest-root] [shape origin-root dest-root]

1
frontend/src/app/main/ui/context.cljs
View file

@ -16,6 +16,7 @@
(def current-project-id (mf/create-context nil)) (def current-project-id (mf/create-context nil))
(def current-page-id (mf/create-context nil)) (def current-page-id (mf/create-context nil))
(def current-file-id (mf/create-context nil)) (def current-file-id (mf/create-context nil))
(def current-vbox (mf/create-context nil))
(def active-frames (mf/create-context nil)) (def active-frames (mf/create-context nil))
(def render-thumbnails (mf/create-context nil)) (def render-thumbnails (mf/create-context nil))

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

@ -13,6 +13,7 @@
common." common."
(:require (:require
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.geom.rect :as grc]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.main.ui.context :as ctx] [app.main.ui.context :as ctx]
@ -54,7 +55,18 @@
;; frame changes won't affect the rendering frame ;; frame changes won't affect the rendering frame
frame-objects frame-objects
(mf/with-memo [objects] (mf/with-memo [objects]
(cph/objects-by-frame objects))] (cph/objects-by-frame objects))
vbox (mf/use-ctx ctx/current-vbox)
shapes
(mf/with-memo [shapes vbox]
(if (some? vbox)
(->> shapes
(filterv (fn [shape]
(grc/overlaps-rects? vbox (dm/get-prop shape :selrect)))))
shapes))]
[:g {:id (dm/str "shape-" uuid/zero)} [:g {:id (dm/str "shape-" uuid/zero)}
[:& (mf/provider ctx/active-frames) {:value active-frames} [:& (mf/provider ctx/active-frames) {:value active-frames}

10
frontend/src/app/main/ui/workspace/shapes/frame.cljs
View file

@ -88,6 +88,7 @@
(let [shape (unchecked-get props "shape")] (let [shape (unchecked-get props "shape")]
[:& frame-shape {:shape shape :ref node-ref}]))))) [:& frame-shape {:shape shape :ref node-ref}])))))
(defn root-frame-wrapper-factory (defn root-frame-wrapper-factory
[shape-wrapper] [shape-wrapper]
@ -101,9 +102,9 @@
thumbnail? (unchecked-get props "thumbnail?") thumbnail? (unchecked-get props "thumbnail?")
page-id (mf/use-ctx ctx/current-page-id) page-id (mf/use-ctx ctx/current-page-id)
frame-id (:id shape) frame-id (dm/get-prop shape :id)
objects (wsh/lookup-page-objects @st/state) objects (wsh/lookup-page-objects @st/state page-id)
node-ref (mf/use-ref nil) node-ref (mf/use-ref nil)
root-ref (mf/use-ref nil) root-ref (mf/use-ref nil)
@ -129,6 +130,7 @@
on-frame-load on-frame-load
(fns/use-node-store node-ref rendered-ref thumbnail? render-frame?) (fns/use-node-store node-ref rendered-ref thumbnail? render-frame?)
] ]
(fdm/use-dynamic-modifiers objects (mf/ref-val node-ref) modifiers) (fdm/use-dynamic-modifiers objects (mf/ref-val node-ref) modifiers)
@ -164,12 +166,12 @@
:key "frame-container" :key "frame-container"
:ref on-frame-load :ref on-frame-load
:opacity (when (:hidden shape) 0)} :opacity (when (:hidden shape) 0)}
[:& ff/fontfaces-style {:fonts fonts}] [:& ff/fontfaces-style {:fonts fonts}]
[:g.frame-thumbnail-wrapper [:g.frame-thumbnail-wrapper
{:id (dm/str "thumbnail-container-" frame-id) {:id (dm/str "thumbnail-container-" frame-id)
;; Hide the thumbnail when not displaying ;; Hide the thumbnail when not displaying
:opacity (when-not thumbnail? 0)} :opacity (when-not thumbnail? 0)}
children]] children]]
])))) ]))))

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

@ -88,6 +88,8 @@
show-distances? show-distances?
picking-color?]} wglobal picking-color?]} wglobal
vbox' (mf/use-debounce 100 vbox)
;; CONTEXT ;; CONTEXT
page-id (mf/use-ctx ctx/current-page-id) page-id (mf/use-ctx ctx/current-page-id)
@ -323,12 +325,13 @@
:y (:y vbox 0) :y (:y vbox 0)
:fill background}] :fill background}]
[:& (mf/provider use/include-metadata-ctx) {:value (debug? :show-export-metadata)} [:& (mf/provider ctx/current-vbox) {:value vbox'}
[:& (mf/provider embed/context) {:value true} [:& (mf/provider use/include-metadata-ctx) {:value (debug? :show-export-metadata)}
;; Render root shape [:& (mf/provider embed/context) {:value true}
[:& shapes/root-shape {:key page-id ;; Render root shape
:objects base-objects [:& shapes/root-shape {:key page-id
:active-frames @active-frames}]]]] :objects base-objects
:active-frames @active-frames}]]]]]
[:svg.viewport-controls [:svg.viewport-controls
{:xmlns "http://www.w3.org/2000/svg" {:xmlns "http://www.w3.org/2000/svg"

11
frontend/test/frontend_tests/helpers/events.cljs
View file

@ -10,19 +10,22 @@
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.pages :as cp] [app.common.pages :as cp]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.pprint :as pp]
[app.common.schema :as sm]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.main.data.workspace :as dw] [app.main.data.workspace :as dw]
[beicon.core :as rx] [beicon.core :as rx]
[cljs.pprint :refer [pprint]] [cljs.test :as t]
[cljs.test :as t :include-macros true]
[potok.core :as ptk])) [potok.core :as ptk]))
;; ---- Helpers to manage global events ;; ---- Helpers to manage global events
(defn on-error (defn on-error
[cause] [cause]
(js/console.log "[CAUSE]:" (.-stack cause))
(js/console.log "[DATA]:" (pr-str (ex-data cause)))) (js/console.log "STORE ERROR" (.-stack cause))
(when-let [data (some-> cause ex-data ::sm/explain)]
(pp/pprint (sm/humanize-data data))))
(defn prepare-store (defn prepare-store
"Create a store with the given initial state. Wait until "Create a store with the given initial state. Wait until

22
frontend/test/frontend_tests/setup.cljs
View file

@ -1,22 +0,0 @@
;; 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) KALEIDOS INC
(ns frontend-tests.setup
(:require
[cljs.test :as t :include-macros true]))
#_(enable-console-print!)
(defmethod t/report [:cljs.test/default :end-run-tests]
[m]
(if (t/successful? m)
(set! (.-exitCode js/process) 0)
(set! (.-exitCode js/process) 1)))
#_(set! *main-cli-fn*
#(t/run-tests 'frontend-tests.test-snap-data
'frontend-tests.test-simple-math
'frontend-tests.test-range-tree))

31
frontend/test/frontend_tests/setup_test.cljs Normal file
View file

@ -0,0 +1,31 @@
;; 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) KALEIDOS INC
(ns frontend-tests.setup-test
(:require
[app.common.schema :as sm]
[app.common.pprint :as pp]
[cljs.test :as t]))
(.on js/process "uncaughtException" (fn [cause]
(try
(js/console.log "EE" (.-stack cause))
(when-let [data (some-> cause ex-data ::sm/explain)]
(pp/pprint (sm/humanize-data data)))
(finally
(js/console.log "EXIT")
(.exit js/process -1)))))
(defmethod t/report [:cljs.test/default :end-run-tests]
[m]
(if (t/successful? m)
(set! (.-exitCode js/process) 0)
(set! (.-exitCode js/process) 1)))
#_(set! *main-cli-fn*
#(t/run-tests 'frontend-tests.test-snap-data
'frontend-tests.test-simple-math
'frontend-tests.test-range-tree))

28
frontend/test/frontend_tests/state_components_sync_test.cljs
View file

@ -1046,10 +1046,10 @@
;; [(thp/id :frame1)]) ;; [(thp/id :frame1)])
;; (thp/instantiate-component :instance2 ;; (thp/instantiate-component :instance2
;; (thp/id :component2))) ;; (thp/id :component2)))
;; ;;
;; [instance2 instance1 _shape1' shape2'] ;; [instance2 instance1 _shape1' shape2']
;; (thl/resolve-instance state (thp/id :instance2)) ;; (thl/resolve-instance state (thp/id :instance2))
;; ;;
;; store (the/prepare-store state done ;; store (the/prepare-store state done
;; (fn [new-state] ;; (fn [new-state]
;; ;; Expected shape tree: ;; ;; Expected shape tree:
@ -1078,7 +1078,7 @@
;; (thl/resolve-instance-and-main ;; (thl/resolve-instance-and-main
;; new-state ;; new-state
;; (thp/id :instance2))] ;; (thp/id :instance2))]
;; ;;
;; (t/is (= (:name instance2) "Board")) ;; (t/is (= (:name instance2) "Board"))
;; (t/is (= (:touched instance2) nil)) ;; (t/is (= (:touched instance2) nil))
;; (t/is (= (:name instance1) "Rect 1")) ;; (t/is (= (:name instance1) "Rect 1"))
@ -1091,7 +1091,7 @@
;; (t/is (= (:touched shape2) nil)) ;; (t/is (= (:touched shape2) nil))
;; (t/is (= (:fill-color shape2) clr/white)) ;; (t/is (= (:fill-color shape2) clr/white))
;; (t/is (= (:fill-opacity shape2) 1)) ;; (t/is (= (:fill-opacity shape2) 1))
;; ;;
;; (t/is (= (:name c-instance2) "Board")) ;; (t/is (= (:name c-instance2) "Board"))
;; (t/is (= (:touched c-instance2) nil)) ;; (t/is (= (:touched c-instance2) nil))
;; (t/is (= (:name c-instance1) "Rect 1")) ;; (t/is (= (:name c-instance1) "Rect 1"))
@ -1104,7 +1104,7 @@
;; (t/is (= (:touched c-shape2) nil)) ;; (t/is (= (:touched c-shape2) nil))
;; (t/is (= (:fill-color c-shape2) clr/white)) ;; (t/is (= (:fill-color c-shape2) clr/white))
;; (t/is (= (:fill-opacity c-shape2) 1)))))] ;; (t/is (= (:fill-opacity c-shape2) 1)))))]
;; ;;
;; (ptk/emit! ;; (ptk/emit!
;; store ;; store
;; (dch/update-shapes [(:id shape2')] ;; (dch/update-shapes [(:id shape2')]
@ -1210,7 +1210,7 @@
(dwl/reset-component (:id instance1)) (dwl/reset-component (:id instance1))
:the/end)))) :the/end))))
;;; === Test update component ====================== ;; === Test update component ======================
(t/deftest test-update-component (t/deftest test-update-component
(t/async done (t/async done
@ -2180,12 +2180,12 @@
;; (thp/id :component2)) ;; (thp/id :component2))
;; (thp/instantiate-component :instance3 ;; (thp/instantiate-component :instance3
;; (thp/id :component2))) ;; (thp/id :component2)))
;; ;;
;; file (wsh/get-local-file state) ;; file (wsh/get-local-file state)
;; ;;
;; [_instance2 instance1 _shape1' shape2'] ;; [_instance2 instance1 _shape1' shape2']
;; (thl/resolve-instance state (thp/id :instance2)) ;; (thl/resolve-instance state (thp/id :instance2))
;; ;;
;; store (the/prepare-store state done ;; store (the/prepare-store state done
;; (fn [new-state] ;; (fn [new-state]
;; ;; Expected shape tree: ;; ;; Expected shape tree:
@ -2220,13 +2220,13 @@
;; (thl/resolve-instance-and-main ;; (thl/resolve-instance-and-main
;; new-state ;; new-state
;; (thp/id :instance2)) ;; (thp/id :instance2))
;; ;;
;; [[instance4 instance3 shape3 shape4] ;; [[instance4 instance3 shape3 shape4]
;; [_c-instance4 _c-instance3 _c-shape3 _c-shape4] _component2] ;; [_c-instance4 _c-instance3 _c-shape3 _c-shape4] _component2]
;; (thl/resolve-instance-and-main ;; (thl/resolve-instance-and-main
;; new-state ;; new-state
;; (thp/id :instance3))] ;; (thp/id :instance3))]
;; ;;
;; (t/is (= (:name instance2) "Board")) ;; (t/is (= (:name instance2) "Board"))
;; (t/is (= (:touched instance2) nil)) ;; (t/is (= (:touched instance2) nil))
;; (t/is (= (:name instance1) "Rect 1")) ;; (t/is (= (:name instance1) "Rect 1"))
@ -2239,7 +2239,7 @@
;; (t/is (= (:touched shape2) nil)) ;; (t/is (= (:touched shape2) nil))
;; (t/is (= (:fill-color shape2) clr/test)) ;; (t/is (= (:fill-color shape2) clr/test))
;; (t/is (= (:fill-opacity shape2) 0.5)) ;; (t/is (= (:fill-opacity shape2) 0.5))
;; ;;
;; (t/is (= (:name c-instance2) "Board")) ;; (t/is (= (:name c-instance2) "Board"))
;; (t/is (= (:touched c-instance2) nil)) ;; (t/is (= (:touched c-instance2) nil))
;; (t/is (= (:name c-instance1) "Rect 1")) ;; (t/is (= (:name c-instance1) "Rect 1"))
@ -2252,7 +2252,7 @@
;; (t/is (= (:touched c-shape2) nil)) ;; (t/is (= (:touched c-shape2) nil))
;; (t/is (= (:fill-color c-shape2) clr/test)) ;; (t/is (= (:fill-color c-shape2) clr/test))
;; (t/is (= (:fill-opacity c-shape2) 0.5)) ;; (t/is (= (:fill-opacity c-shape2) 0.5))
;; ;;
;; (t/is (= (:name instance4) "Board")) ;; (t/is (= (:name instance4) "Board"))
;; (t/is (= (:touched instance4) nil)) ;; (t/is (= (:touched instance4) nil))
;; (t/is (= (:name instance3) "Rect 1")) ;; (t/is (= (:name instance3) "Rect 1"))
@ -2265,7 +2265,7 @@
;; (t/is (= (:touched shape4) nil)) ;; (t/is (= (:touched shape4) nil))
;; (t/is (= (:fill-color shape4) clr/test)) ;; (t/is (= (:fill-color shape4) clr/test))
;; (t/is (= (:fill-opacity shape4) 0.5)))))] ;; (t/is (= (:fill-opacity shape4) 0.5)))))]
;; ;;
;; (ptk/emit! ;; (ptk/emit!
;; store ;; store
;; (dch/update-shapes [(:id shape2')] ;; (dch/update-shapes [(:id shape2')]

3
frontend/test/frontend_tests/state_components_test.cljs
View file

@ -15,9 +15,6 @@
[linked.core :as lks] [linked.core :as lks]
[potok.core :as ptk])) [potok.core :as ptk]))
(.on js/process "uncaughtException" (fn [cause]
(js/console.log "EE" cause)))
(t/use-fixtures :each (t/use-fixtures :each
{:before thp/reset-idmap!}) {:before thp/reset-idmap!})