Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-04-13 15:31:26 -05:00
Code Issues Activity

Merge remote-tracking branch 'origin/library-changes-builder' into staging

Browse source
This commit is contained in:
Andrey Antukh 2022-03-22 13:14:53 +01:00
commit ad262f6fb3
21 changed files with 2384 additions and 1182 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -7,6 +7,7 @@
(ns app.common.pages.changes-builder
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.bool :as gshb]
[app.common.pages :as cp]
@ -30,18 +31,30 @@
[changes save-undo?]
(assoc changes :save-undo? save-undo?))
(defn with-page [changes page]
(defn with-page
[changes page]
(vary-meta changes assoc
::page page
::page-id (:id page)
::objects (:objects page)))
::page-id (:id page)))
(defn with-objects [changes objects]
(defn with-container
[changes container]
(if (cph/page? container)
(vary-meta changes assoc ::page-id (:id container))
(vary-meta changes assoc ::component-id (:id container))))
(defn with-objects
[changes objects]
(let [file-data (-> (cp/make-file-data (uuid/next) uuid/zero)
(assoc-in [:pages-index uuid/zero :objects] objects))]
(vary-meta changes assoc ::file-data file-data
::applied-changes-count 0)))
(defn with-library-data
[changes data]
(vary-meta changes assoc
::library-data data))
(defn amend-last-change
"Modify the last redo-changes added with an update function."
[changes f]
@ -53,10 +66,23 @@
[changes f]
(update changes :redo-changes #(mapv f %)))
(defn concat-changes
[changes1 changes2]
{:redo-changes (d/concat-vec (:redo-changes changes1) (:redo-changes changes2))
:undo-changes (d/concat-vec (:undo-changes changes1) (:undo-changes changes2))
:origin (:origin changes1)})
; TODO: remove this when not needed
(defn- assert-page-id
[changes]
(assert (contains? (meta changes) ::page-id) "Give a page-id or call (with-page) before using this function"))
(defn- assert-container-id
[changes]
(assert (or (contains? (meta changes) ::page-id)
(contains? (meta changes) ::component-id))
"Give a page-id or call (with-container) before using this function"))
(defn- assert-page
[changes]
(assert (contains? (meta changes) ::page) "Call (with-page) before using this function"))
@ -65,6 +91,15 @@
[changes]
(assert (contains? (meta changes) ::file-data) "Call (with-objects) before using this function"))
(defn- assert-library
[changes]
(assert (contains? (meta changes) ::library-data) "Call (with-library-data) before using this function"))
(defn- lookup-objects
[changes]
(let [data (::file-data (meta changes))]
(dm/get-in data [:pages-index uuid/zero :objects])))
(defn- apply-changes-local
[changes]
(if-let [file-data (::file-data (meta changes))]
@ -155,9 +190,9 @@
;; Shape tree changes
(defn add-obj
(defn add-object
([changes obj]
(add-obj changes obj nil))
(add-object changes obj nil))
([changes obj {:keys [index ignore-touched] :or {index ::undefined ignore-touched false}}]
(assert-page-id changes)
@ -192,7 +227,7 @@
([changes parent-id shapes index]
(assert-page-id changes)
(assert-objects changes)
(let [objects (get-in (meta changes) [::file-data :pages-index uuid/zero :objects])
(let [objects (lookup-objects changes)
set-parent-change
(cond-> {:type :mov-objects
@ -224,10 +259,13 @@
([changes ids update-fn]
(update-shapes changes ids update-fn nil))
([changes ids update-fn {:keys [attrs ignore-geometry?] :or {attrs nil ignore-geometry? false}}]
(assert-page-id changes)
([changes ids update-fn {:keys [attrs ignore-geometry? ignore-touched]
:or {ignore-geometry? false ignore-touched false}}]
(assert-container-id changes)
(assert-objects changes)
(let [objects (get-in (meta changes) [::file-data :pages-index uuid/zero :objects])
(let [page-id (::page-id (meta changes))
component-id (::component-id (meta changes))
objects (lookup-objects changes)
generate-operation
(fn [operations attr old new ignore-geometry?]
@ -236,8 +274,11 @@
(if (= old-val new-val)
operations
(-> operations
(update :rops conj {:type :set :attr attr :val new-val :ignore-geometry ignore-geometry?})
(update :uops conj {:type :set :attr attr :val old-val :ignore-touched true})))))
(update :rops conj {:type :set :attr attr :val new-val
:ignore-geometry ignore-geometry?
:ignore-touched ignore-touched})
(update :uops conj {:type :set :attr attr :val old-val
:ignore-touched true})))))
update-shape
(fn [changes id]
@ -255,9 +296,14 @@
(seq uops)
(conj {:type :set-touched :touched (:touched old-obj)}))
change {:type :mod-obj
:page-id (::page-id (meta changes))
:id id}]
change (cond-> {:type :mod-obj
:id id}
(some? page-id)
(assoc :page-id page-id)
(some? component-id)
(assoc :component-id component-id))]
(cond-> changes
(seq rops)
@ -274,7 +320,7 @@
(assert-page-id changes)
(assert-objects changes)
(let [page-id (::page-id (meta changes))
objects (get-in (meta changes) [::file-data :pages-index uuid/zero :objects])
objects (lookup-objects changes)
add-redo-change
(fn [change-set id]
@ -322,7 +368,7 @@
(assert-page-id changes)
(assert-objects changes)
(let [page-id (::page-id (meta changes))
objects (get-in (meta changes) [::file-data :pages-index uuid/zero :objects])
objects (lookup-objects changes)
xform (comp
(mapcat #(cons % (cph/get-parent-ids objects %)))
@ -374,3 +420,174 @@
(-> (reduce resize-parent changes all-parents)
(apply-changes-local))))
;; Library changes
(defn add-recent-color
[changes color]
(-> changes
(update :redo-changes conj {:type :add-recent-color :color color})
(apply-changes-local)))
(defn add-color
[changes color]
(-> changes
(update :redo-changes conj {:type :add-color :color color})
(update :undo-changes conj {:type :del-color :id (:id color)})
(apply-changes-local)))
(defn update-color
[changes color]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-color (get-in library-data [:colors (:id color)])]
(-> changes
(update :redo-changes conj {:type :mod-color :color color})
(update :undo-changes conj {:type :mod-color :color prev-color})
(apply-changes-local))))
(defn delete-color
[changes color-id]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-color (get-in library-data [:colors color-id])]
(-> changes
(update :redo-changes conj {:type :del-color :id color-id})
(update :undo-changes conj {:type :add-color :color prev-color})
(apply-changes-local))))
(defn add-media
[changes object]
(-> changes
(update :redo-changes conj {:type :add-media :object object})
(update :undo-changes conj {:type :del-media :id (:id object)})
(apply-changes-local)))
(defn update-media
[changes object]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-object (get-in library-data [:media (:id object)])]
(-> changes
(update :redo-changes conj {:type :mod-media :object object})
(update :undo-changes conj {:type :mod-media :object prev-object})
(apply-changes-local))))
(defn delete-media
[changes id]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-object (get-in library-data [:media id])]
(-> changes
(update :redo-changes conj {:type :del-media :id id})
(update :undo-changes conj {:type :add-media :object prev-object})
(apply-changes-local))))
(defn add-typography
[changes typography]
(-> changes
(update :redo-changes conj {:type :add-typography :typography typography})
(update :undo-changes conj {:type :del-typography :id (:id typography)})
(apply-changes-local)))
(defn update-typography
[changes typography]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-typography (get-in library-data [:typographies (:id typography)])]
(-> changes
(update :redo-changes conj {:type :mod-typography :typography typography})
(update :undo-changes conj {:type :mod-typography :typography prev-typography})
(apply-changes-local))))
(defn delete-typography
[changes typography-id]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-typography (get-in library-data [:typographies typography-id])]
(-> changes
(update :redo-changes conj {:type :del-typography :id typography-id})
(update :undo-changes conj {:type :add-typography :typography prev-typography})
(apply-changes-local))))
(defn add-component
[changes id path name new-shapes updated-shapes]
(assert-page-id changes)
(assert-objects changes)
(let [page-id (::page-id (meta changes))
objects (lookup-objects changes)
lookupf (d/getf objects)
mk-change (fn [shape]
{:type :mod-obj
:page-id page-id
:id (:id shape)
:operations [{:type :set
:attr :component-id
:val (:component-id shape)}
{:type :set
:attr :component-file
:val (:component-file shape)}
{:type :set
:attr :component-root?
:val (:component-root? shape)}
{:type :set
:attr :shape-ref
:val (:shape-ref shape)}
{:type :set
:attr :touched
:val (:touched shape)}]}) ]
(-> changes
(update :redo-changes
(fn [redo-changes]
(-> redo-changes
(conj {:type :add-component
:id id
:path path
:name name
:shapes new-shapes})
(into (map mk-change) updated-shapes))))
(update :undo-changes
(fn [undo-changes]
(-> undo-changes
(conj {:type :del-component
:id id})
(into (comp (map :id)
(map lookupf)
(map mk-change))
updated-shapes))))
(apply-changes-local))))
(defn update-component
[changes id update-fn]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-component (get-in library-data [:components id])
new-component (update-fn prev-component)]
(if new-component
(-> changes
(update :redo-changes conj {:type :mod-component
:id id
:name (:name new-component)
:path (:path new-component)
:objects (:objects new-component)})
(update :undo-changes conj {:type :mod-component
:id id
:name (:name prev-component)
:path (:path prev-component)
:objects (:objects prev-component)}))
changes)))
(defn delete-component
[changes id]
(assert-library changes)
(let [library-data (::library-data (meta changes))
prev-component (get-in library-data [:components id])]
(-> changes
(update :redo-changes conj {:type :del-component
:id id})
(update :undo-changes conj {:type :add-component
:id id
:name (:name prev-component)
:path (:path prev-component)
:shapes (vals (:objects prev-component))}))))

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

@ -307,7 +307,6 @@
(defn clean-loops
"Clean a list of ids from circular references."
[objects ids]
(let [parent-selected?
(fn [id]
(let [parents (get-parent-ids objects id)]

1
frontend/package.json
View file

@ -13,6 +13,7 @@
],
"scripts": {
"compile-test": "clojure -M:dev:shadow-cljs compile test --config-merge '{:autorun false}'",
"lint": "clj-kondo --parallel --lint src/",
"lint-scss": "yarn run prettier -c resources/styles",
"run-test": "node target/tests.js",
"test": "yarn run compile-test && yarn run run-test",

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

@ -660,8 +660,9 @@
moved-shape (assoc shape
:parent-id parent-id
:frame-id frame-id)]
(assoc shape :constraints-h (gsh/default-constraints-h moved-shape)
:constraints-v (gsh/default-constraints-v moved-shape))))
(assoc shape
:constraints-h (gsh/default-constraints-h moved-shape)
:constraints-v (gsh/default-constraints-v moved-shape))))
{:ignore-touched true})
; Resize parent containers that need to

2
frontend/src/app/main/data/workspace/bool.cljs
View file

@ -98,7 +98,7 @@
shape-id (:id boolean-data)
changes (-> (pcb/empty-changes it page-id)
(pcb/with-objects objects)
(pcb/add-obj boolean-data {:index index})
(pcb/add-object boolean-data {:index index})
(pcb/change-parent shape-id shapes))]
(rx/of (dch/commit-changes changes)
(dwc/select-shapes (d/ordered-set shape-id)))))))))

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

@ -102,10 +102,6 @@
(us/assert ::spec.change/changes redo-changes)
(us/assert ::spec.change/changes undo-changes)
;; (prn "====== commit-changes ======" path)
;; (cljs.pprint/pprint redo-changes)
;; (cljs.pprint/pprint undo-changes)
(update-in state path cp/process-changes redo-changes false)
(catch :default e

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

@ -325,7 +325,7 @@
selected)
changes (-> (pcb/empty-changes it page-id)
(pcb/add-obj shape))]
(pcb/add-object shape))]
(rx/concat
(rx/of (dch/commit-changes changes)

2
frontend/src/app/main/data/workspace/groups.cljs
View file

@ -88,7 +88,7 @@
changes (-> (pcb/empty-changes it page-id)
(pcb/with-objects objects)
(pcb/add-obj group)
(pcb/add-object group)
(pcb/change-parent (:id group) shapes)
(pcb/remove-objects ids-to-delete))]

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

@ -8,9 +8,9 @@
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as geom]
[app.common.logging :as log]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.spec.change :as spec.change]
@ -57,7 +57,7 @@
prefix (if (:component-id change) "[C] " "[P] ")
extract (cond-> {:type (:type change)
:change change}
:raw-change change}
shape
(assoc :shape (str prefix (:name shape)))
(:operations change)
@ -100,25 +100,20 @@
ptk/WatchEvent
(watch [it _ _]
(let [rchg {:type :add-color
:color color}
uchg {:type :del-color
:id id}]
(let [changes (-> (pcb/empty-changes it)
(pcb/add-color color))]
(rx/of #(assoc-in % [:workspace-local :color-for-rename] id)
(dch/commit-changes {:redo-changes [rchg]
:undo-changes [uchg]
:origin it})))))))
(dch/commit-changes changes)))))))
(defn add-recent-color
[color]
(us/assert ::spec.color/recent-color color)
(ptk/reify ::add-recent-color
ptk/WatchEvent
(watch [it _ _]
(let [rchg {:type :add-recent-color
:color color}]
(rx/of (dch/commit-changes {:redo-changes [rchg]
:undo-changes []
:origin it}))))))
(let [changes (-> (pcb/empty-changes it)
(pcb/add-recent-color color))]
(rx/of (dch/commit-changes changes))))))
(def clear-color-for-rename
(ptk/reify ::clear-color-for-rename
@ -127,23 +122,20 @@
(assoc-in state [:workspace-local :color-for-rename] nil))))
(defn update-color
[{:keys [id] :as color} file-id]
[color file-id]
(us/assert ::spec.color/color color)
(us/assert ::us/uuid file-id)
(ptk/reify ::update-color
ptk/WatchEvent
(watch [it state _]
(let [[path name] (cph/parse-path-name (:name color))
color (assoc color :path path :name name)
prev (get-in state [:workspace-data :colors id])
rchg {:type :mod-color
:color color}
uchg {:type :mod-color
:color prev}]
(let [data (get state :workspace-data)
[path name] (cph/parse-path-name (:name color))
color (assoc color :path path :name name)
changes (-> (pcb/empty-changes it)
(pcb/with-library-data data)
(pcb/update-color color))]
(rx/of (dwu/start-undo-transaction)
(dch/commit-changes {:redo-changes [rchg]
:undo-changes [uchg]
:origin it})
(dch/commit-changes changes)
(sync-file (:current-file-id state) file-id)
(dwu/commit-undo-transaction))))))
@ -153,29 +145,22 @@
(ptk/reify ::delete-color
ptk/WatchEvent
(watch [it state _]
(let [prev (get-in state [:workspace-data :colors id])
rchg {:type :del-color
:id id}
uchg {:type :add-color
:color prev}]
(rx/of (dch/commit-changes {:redo-changes [rchg]
:undo-changes [uchg]
:origin it}))))))
(let [data (get state :workspace-data)
changes (-> (pcb/empty-changes it)
(pcb/with-library-data data)
(pcb/delete-color id))]
(rx/of (dch/commit-changes changes))))))
(defn add-media
[{:keys [id] :as media}]
[media]
(us/assert ::spec.file/media-object media)
(ptk/reify ::add-media
ptk/WatchEvent
(watch [it _ _]
(let [obj (select-keys media [:id :name :width :height :mtype])
rchg {:type :add-media
:object obj}
uchg {:type :del-media
:id id}]
(rx/of (dch/commit-changes {:redo-changes [rchg]
:undo-changes [uchg]
:origin it}))))))
(let [obj (select-keys media [:id :name :width :height :mtype])
changes (-> (pcb/empty-changes it)
(pcb/add-media obj))]
(rx/of (dch/commit-changes changes))))))
(defn rename-media
[id new-name]
@ -184,22 +169,14 @@
(ptk/reify ::rename-media
ptk/WatchEvent
(watch [it state _]
(let [object (get-in state [:workspace-data :media id])
(let [data (get state :workspace-data)
[path name] (cph/parse-path-name new-name)
rchanges [{:type :mod-media
:object {:id id
:name name
:path path}}]
uchanges [{:type :mod-media
:object {:id id
:name (:name object)
:path (:path object)}}]]
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it}))))))
object (get-in data [:media id])
new-object (assoc object :path path :name name)
changes (-> (pcb/empty-changes it)
(pcb/with-library-data data)
(pcb/update-media new-object))]
(rx/of (dch/commit-changes changes))))))
(defn delete-media
[{:keys [id] :as params}]
@ -207,14 +184,11 @@
(ptk/reify ::delete-media
ptk/WatchEvent
(watch [it state _]
(let [prev (get-in state [:workspace-data :media id])
rchg {:type :del-media
:id id}
uchg {:type :add-media
:object prev}]
(rx/of (dch/commit-changes {:redo-changes [rchg]
:undo-changes [uchg]
:origin it}))))))
(let [data (get state :workspace-data)
changes (-> (pcb/empty-changes it)
(pcb/with-library-data data)
(pcb/delete-media id))]
(rx/of (dch/commit-changes changes))))))
(defn add-typography
([typography] (add-typography typography true))
@ -227,13 +201,9 @@
ptk/WatchEvent
(watch [it _ _]
(let [rchg {:type :add-typography
:typography typography}
uchg {:type :del-typography
:id (:id typography)}]
(rx/of (dch/commit-changes {:redo-changes [rchg]
:undo-changes [uchg]
:origin it})
(let [changes (-> (pcb/empty-changes it)
(pcb/add-typography typography))]
(rx/of (dch/commit-changes changes)
#(cond-> %
edit?
(assoc-in [:workspace-global :rename-typography] (:id typography))))))))))
@ -245,15 +215,12 @@
(ptk/reify ::update-typography
ptk/WatchEvent
(watch [it state _]
(let [prev (get-in state [:workspace-data :typographies (:id typography)])
rchg {:type :mod-typography
:typography typography}
uchg {:type :mod-typography
:typography prev}]
(let [data (get state :workspace-data)
changes (-> (pcb/empty-changes it)
(pcb/with-library-data data)
(pcb/update-typography typography))]
(rx/of (dwu/start-undo-transaction)
(dch/commit-changes {:redo-changes [rchg]
:undo-changes [uchg]
:origin it})
(dch/commit-changes changes)
(sync-file (:current-file-id state) file-id)
(dwu/commit-undo-transaction))))))
@ -263,15 +230,11 @@
(ptk/reify ::delete-typography
ptk/WatchEvent
(watch [it state _]
(let [prev (get-in state [:workspace-data :typographies id])
rchg {:type :del-typography
:id id}
uchg {:type :add-typography
:typography prev}]
(rx/of (dch/commit-changes {:redo-changes [rchg]
:undo-changes [uchg]
:origin it}))))))
(let [data (get state :workspace-data)
changes (-> (pcb/empty-changes it)
(pcb/with-library-data data)
(pcb/delete-typography id))]
(rx/of (dch/commit-changes changes))))))
(defn- add-component2
"This is the second step of the component creation."
@ -287,12 +250,10 @@
objects (wsh/lookup-page-objects state page-id)
shapes (dwg/shapes-for-grouping objects selected)]
(when-not (empty? shapes)
(let [[group rchanges uchanges]
(let [[group _ changes]
(dwlh/generate-add-component it shapes objects page-id file-id)]
(when-not (empty? rchanges)
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it})
(when-not (empty? (:redo-changes changes))
(rx/of (dch/commit-changes changes)
(dwc/select-shapes (d/ordered-set (:id group)))))))))))
(defn add-component
@ -317,31 +278,27 @@
(ptk/reify ::rename-component
ptk/WatchEvent
(watch [it state _]
;; NOTE: we need to ensure the component exists, because there
;; are small posibilities of race conditions with component
;; deletion.
(when-let [component (get-in state [:workspace-data :components id])]
(let [[path name] (cph/parse-path-name new-name)
objects (get component :objects)
;; Give the same name to the root shape
new-objects (assoc-in objects
[(:id component) :name]
name)
(let [data (get state :workspace-data)
[path name] (cph/parse-path-name new-name)
rchanges [{:type :mod-component
:id id
:name name
:path path
:objects new-objects}]
update-fn
(fn [component]
;; NOTE: we need to ensure the component exists,
;; because there are small posibilities of race
;; conditions with component deletion.
(when component
(-> component
(assoc :path path)
(assoc :name name)
(update :objects
;; Give the same name to the root shape
#(assoc-in % [id :name] name)))))
uchanges [{:type :mod-component
:id id
:name (:name component)
:path (:path component)
:objects objects}]]
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it})))))))
changes (-> (pcb/empty-changes it)
(pcb/with-library-data data)
(pcb/update-component id update-fn))]
(rx/of (dch/commit-changes changes))))))
(defn duplicate-component
"Create a new component copied from the one with the given id."
@ -349,7 +306,7 @@
(ptk/reify ::duplicate-component
ptk/WatchEvent
(watch [it state _]
(let [libraries (dwlh/get-libraries state)
(let [libraries (wsh/get-libraries state)
component (cph/get-component libraries id)
all-components (-> state :workspace-data :components vals)
unames (into #{} (map :name) all-components)
@ -358,18 +315,15 @@
[new-shape new-shapes _updated-shapes]
(dwlh/duplicate-component component)
rchanges [{:type :add-component
:id (:id new-shape)
:name new-name
:path (:path component)
:shapes new-shapes}]
changes (-> (pcb/empty-changes it nil) ;; no objects are changed
(pcb/with-objects nil) ;; in the current page
(pcb/add-component (:id new-shape)
(:path component)
new-name
new-shapes
[]))]
uchanges [{:type :del-component
:id (:id new-shape)}]]
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it}))))))
(rx/of (dch/commit-changes changes))))))
(defn delete-component
"Delete the component with the given id, from the current file library."
@ -378,20 +332,12 @@
(ptk/reify ::delete-component
ptk/WatchEvent
(watch [it state _]
(let [component (get-in state [:workspace-data :components id])
(let [data (get state :workspace-data)
changes (-> (pcb/empty-changes it)
(pcb/with-library-data data)
(pcb/delete-component id))]
rchanges [{:type :del-component
:id id}]
uchanges [{:type :add-component
:id id
:name (:name component)
:path (:path component)
:shapes (vals (:objects component))}]]
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it}))))))
(rx/of (dch/commit-changes changes))))))
(defn instantiate-component
"Create a new shape in the current page, from the component with the given id
@ -403,73 +349,17 @@
(ptk/reify ::instantiate-component
ptk/WatchEvent
(watch [it state _]
(let [libraries (dwlh/get-libraries state)
component (cph/get-component libraries file-id component-id)
component-shape (cph/get-shape component component-id)
(let [page (wsh/lookup-page state)
libraries (wsh/get-libraries state)
orig-pos (gpt/point (:x component-shape) (:y component-shape))
delta (gpt/subtract position orig-pos)
page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
unames (volatile! (dwc/retrieve-used-names objects))
frame-id (cph/frame-id-by-position objects (gpt/add orig-pos delta))
update-new-shape
(fn [new-shape original-shape]
(let [new-name (dwc/generate-unique-name @unames (:name new-shape))]
(when (nil? (:parent-id original-shape))
(vswap! unames conj new-name))
(cond-> new-shape
true
(as-> $
(geom/move $ delta)
(assoc $ :frame-id frame-id)
(assoc $ :parent-id
(or (:parent-id $) (:frame-id $)))
(dissoc $ :touched))
(nil? (:shape-ref original-shape))
(assoc :shape-ref (:id original-shape))
(nil? (:parent-id original-shape))
(assoc :component-id (:id original-shape)
:component-file file-id
:component-root? true
:name new-name)
(some? (:parent-id original-shape))
(dissoc :component-root?))))
[new-shape new-shapes _]
(cph/clone-object component-shape
nil
(get component :objects)
update-new-shape)
rchanges (mapv (fn [obj]
{:type :add-obj
:id (:id obj)
:page-id page-id
:frame-id (:frame-id obj)
:parent-id (:parent-id obj)
:ignore-touched true
:obj obj})
new-shapes)
uchanges (mapv (fn [obj]
{:type :del-obj
:id (:id obj)
:page-id page-id
:ignore-touched true})
new-shapes)]
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it})
[new-shape changes]
(dwlh/generate-instantiate-component it
file-id
component-id
position
page
libraries)]
(rx/of (dch/commit-changes changes)
(dwc/select-shapes (d/ordered-set (:id new-shape))))))))
(defn detach-component
@ -480,16 +370,16 @@
(ptk/reify ::detach-component
ptk/WatchEvent
(watch [it state _]
(let [file (dwlh/get-local-file state)
(let [file (wsh/get-local-file state)
page-id (get state :current-page-id)
container (cph/get-container file :page page-id)
[rchanges uchanges]
(dwlh/generate-detach-instance container id)]
changes (-> (pcb/empty-changes it)
(pcb/with-container container)
(pcb/with-objects (:objects container))
(dwlh/generate-detach-instance container id))]
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it}))))))
(rx/of (dch/commit-changes changes))))))
(def detach-selected-components
(ptk/reify ::detach-selected-components
@ -497,23 +387,21 @@
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
file (dwlh/get-local-file state)
file (wsh/get-local-file state)
container (cph/get-container file :page page-id)
selected (->> state
(wsh/lookup-selected)
(cph/clean-loops objects))
[rchanges uchanges]
(reduce (fn [changes id]
(dwlh/concat-changes
changes
(dwlh/generate-detach-instance container id)))
dwlh/empty-changes
selected)]
changes (reduce
(fn [changes id]
(dwlh/generate-detach-instance changes container id))
(-> (pcb/empty-changes it)
(pcb/with-container container)
(pcb/with-objects objects))
selected)]
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it}))))))
(rx/of (dch/commit-changes changes))))))
(defn nav-to-component-file
[file-id]
@ -553,21 +441,22 @@
ptk/WatchEvent
(watch [it state _]
(log/info :msg "RESET-COMPONENT of shape" :id (str id))
(let [file (dwlh/get-local-file state)
libraries (dwlh/get-libraries state)
(let [file (wsh/get-local-file state)
libraries (wsh/get-libraries state)
page-id (:current-page-id state)
container (cph/get-container file :page page-id)
[rchanges uchanges]
(dwlh/generate-sync-shape-direct libraries container id true)]
changes
(-> (pcb/empty-changes it)
(pcb/with-container container)
(pcb/with-objects (:objects container))
(dwlh/generate-sync-shape-direct libraries container id true))]
(log/debug :msg "RESET-COMPONENT finished" :js/rchanges (log-changes
rchanges
file))
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it}))))))
(:redo-changes changes)
file))
(rx/of (dch/commit-changes changes))))))
(defn update-component
"Modify the component linked to the shape with the given id, in the
@ -586,51 +475,51 @@
(log/info :msg "UPDATE-COMPONENT of shape" :id (str id))
(let [page-id (get state :current-page-id)
local-file (dwlh/get-local-file state)
libraries (dwlh/get-libraries state)
local-file (wsh/get-local-file state)
libraries (wsh/get-libraries state)
container (cph/get-container local-file :page page-id)
shape (cph/get-shape container id)
[rchanges uchanges]
(dwlh/generate-sync-shape-inverse libraries container id)
changes
(-> (pcb/empty-changes it)
(pcb/with-container container)
(dwlh/generate-sync-shape-inverse libraries container id))
file-id (:component-file shape)
file (dwlh/get-file state file-id)
file (wsh/get-file state file-id)
xf-filter (comp
(filter :local-change?)
(map #(dissoc % :local-change?)))
local-rchanges (into [] xf-filter rchanges)
local-uchanges (into [] xf-filter uchanges)
local-changes (-> changes
(update :redo-changes #(into [] xf-filter %))
(update :undo-changes #(into [] xf-filter %)))
xf-remove (comp
(remove :local-change?)
(map #(dissoc % :local-change?)))
rchanges (into [] xf-remove rchanges)
uchanges (into [] xf-remove uchanges)]
nonlocal-changes (-> changes
(update :redo-changes #(into [] xf-remove %))
(update :undo-changes #(into [] xf-remove %)))]
(log/debug :msg "UPDATE-COMPONENT finished"
:js/local-rchanges (log-changes
local-rchanges
:js/local-changes (log-changes
(:redo-changes local-changes)
file)
:js/rchanges (log-changes
rchanges
file))
:js/nonlocal-changes (log-changes
(:redo-changes nonlocal-changes)
file))
(rx/of
(when (seq local-rchanges)
(dch/commit-changes {:redo-changes local-rchanges
:undo-changes local-uchanges
:origin it
:file-id (:id local-file)}))
(when (seq rchanges)
(dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it
:file-id file-id})))))))
(when (seq (:redo-changes local-changes))
(dch/commit-changes (assoc local-changes
:file-id (:id local-file))))
(when (seq (:redo-changes nonlocal-changes))
(dch/commit-changes (assoc nonlocal-changes
:file-id file-id))))))))
(defn update-component-sync
[shape-id file-id]
@ -678,34 +567,31 @@
(log/info :msg "SYNC-FILE"
:file (dwlh/pretty-file file-id state)
:library (dwlh/pretty-file library-id state))
(let [file (dwlh/get-file state file-id)
library-changes [(dwlh/generate-sync-library file-id :components library-id state)
(dwlh/generate-sync-library file-id :colors library-id state)
(dwlh/generate-sync-library file-id :typographies library-id state)]
file-changes [(dwlh/generate-sync-file file-id :components library-id state)
(dwlh/generate-sync-file file-id :colors library-id state)
(dwlh/generate-sync-file file-id :typographies library-id state)]
(let [file (wsh/get-file state file-id)
xf-fcat (comp (remove nil?) (map first) (mapcat identity))
rchanges (d/concat-vec
(sequence xf-fcat library-changes)
(sequence xf-fcat file-changes))
library-changes (reduce
pcb/concat-changes
(pcb/empty-changes it)
[(dwlh/generate-sync-library it file-id :components library-id state)
(dwlh/generate-sync-library it file-id :colors library-id state)
(dwlh/generate-sync-library it file-id :typographies library-id state)])
file-changes (reduce
pcb/concat-changes
(pcb/empty-changes it)
[(dwlh/generate-sync-file it file-id :components library-id state)
(dwlh/generate-sync-file it file-id :colors library-id state)
(dwlh/generate-sync-file it file-id :typographies library-id state)])
xf-scat (comp (remove nil?) (map second) (mapcat identity))
uchanges (d/concat-vec
(sequence xf-scat library-changes)
(sequence xf-scat file-changes))]
changes (pcb/concat-changes library-changes file-changes)]
(log/debug :msg "SYNC-FILE finished" :js/rchanges (log-changes
rchanges
(:redo-changes changes)
file))
(rx/concat
(rx/of (dm/hide-tag :sync-dialog))
(when rchanges
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it
:file-id file-id})))
(when (seq (:redo-changes changes))
(rx/of (dch/commit-changes (assoc changes ;; TODO a ver qué pasa con esto
:file-id file-id))))
(when (not= file-id library-id)
;; When we have just updated the library file, give some time for the
;; update to finish, before marking this file as synced.
@ -717,7 +603,7 @@
(rp/mutation :update-sync
{:file-id file-id
:library-id library-id})))
(when (some? library-changes)
(when (seq (:redo-changes library-changes))
(rx/of (sync-file-2nd-stage file-id library-id))))))))
(defn sync-file-2nd-stage
@ -738,19 +624,17 @@
(log/info :msg "SYNC-FILE (2nd stage)"
:file (dwlh/pretty-file file-id state)
:library (dwlh/pretty-file library-id state))
(let [file (dwlh/get-file state file-id)
[rchanges1 uchanges1] (dwlh/generate-sync-file file-id :components library-id state)
[rchanges2 uchanges2] (dwlh/generate-sync-library file-id :components library-id state)
rchanges (d/concat-vec rchanges1 rchanges2)
uchanges (d/concat-vec uchanges1 uchanges2)]
(when rchanges
(let [file (wsh/get-file state file-id)
changes (reduce
pcb/concat-changes
(pcb/empty-changes it)
[(dwlh/generate-sync-file it file-id :components library-id state)
(dwlh/generate-sync-library it file-id :components library-id state)])]
(when (seq (:redo-changes changes))
(log/debug :msg "SYNC-FILE (2nd stage) finished" :js/rchanges (log-changes
rchanges
(:redo-changes changes)
file))
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it
:file-id file-id})))))))
(rx/of (dch/commit-changes (assoc changes :file-id file-id))))))))
(def ignore-sync
(ptk/reify ::ignore-sync

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

File diff suppressed because it is too large Load diff

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

@ -314,7 +314,7 @@
(geom/move delta)
(d/update-when :interactions #(cti/remap-interactions % ids-map objects)))
changes (-> (pcb/add-obj changes new-frame)
changes (-> (pcb/add-object changes new-frame)
(pcb/amend-last-change #(assoc % :old-id (:id obj))))
changes (reduce (fn [changes child]
@ -349,8 +349,8 @@
(geom/move delta)
(d/update-when :interactions #(cti/remap-interactions % ids-map objects)))
changes (pcb/add-obj changes new-obj {:ignore-touched true})
changes (-> (pcb/add-obj changes new-obj {:ignore-touched true})
changes (pcb/add-object changes new-obj {:ignore-touched true})
changes (-> (pcb/add-object changes new-obj {:ignore-touched true})
(pcb/amend-last-change #(assoc % :old-id (:id obj))))]
(reduce (fn [changes child]

22
frontend/src/app/main/data/workspace/state_helpers.cljs
View file

@ -37,7 +37,6 @@
(get-in state [:workspace-data :components])))
;; TODO: improve performance of this
(defn lookup-selected
([state]
(lookup-selected state nil))
@ -68,3 +67,24 @@
([state page-id filter-fn]
(let [objects (lookup-page-objects state page-id)]
(into [] (filter filter-fn) (vals objects)))))
(defn get-local-file
"Get the data content of the file you are currently working with."
[state]
(get state :workspace-data))
(defn get-file
"Get the data content of the given file (it may be the current file
or one library)."
[state file-id]
(if (= file-id (:current-file-id state))
(get state :workspace-data)
(get-in state [:workspace-libraries file-id :data])))
(defn get-libraries
"Retrieve all libraries, including the local file."
[state]
(let [{:keys [id] :as local} (:workspace-data state)]
(-> (:workspace-libraries state)
(assoc id {:id id
:data local}))))

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

@ -399,7 +399,7 @@
new-shape (dwc/make-new-shape shape objects selected)
changes (-> changes
(pcb/with-objects objects)
(pcb/add-obj new-shape)
(pcb/add-object new-shape)
(pcb/change-parent parent-id [new-shape] index))
unames (conj unames (:name new-shape))
@ -480,7 +480,7 @@
;; Creates the root shape
new-shape (dwc/make-new-shape root-shape objects selected)
changes (-> (pcb/empty-changes it page-id)
(pcb/add-obj new-shape))
(pcb/add-object new-shape))
root-attrs (-> (:attrs svg-data)
(usvg/format-styles))

13
frontend/src/app/main/ui/workspace/context_menu.cljs
View file

@ -395,12 +395,13 @@
:shortcut (sc/get-tooltip :create-component)
:on-click do-add-component}]
(when has-component?
[:& menu-entry {:title (tr "workspace.shape.menu.detach-instances-in-bulk")
:shortcut (sc/get-tooltip :detach-component)
:on-click do-detach-component-in-bulk}]
(when (not single?)
[:& menu-entry {:title (tr "workspace.shape.menu.update-components-in-bulk")
:on-click do-update-in-bulk}]))])
[:*
[:& menu-entry {:title (tr "workspace.shape.menu.detach-instances-in-bulk")
:shortcut (sc/get-tooltip :detach-component)
:on-click do-detach-component-in-bulk}]
(when (not single?)
[:& menu-entry {:title (tr "workspace.shape.menu.update-components-in-bulk")
:on-click do-update-in-bulk}])])])
(when is-component?
;; WARNING: this menu is the same as the context menu at the sidebar.

57
frontend/src/debug.cljs
View file

@ -148,36 +148,51 @@
(clj->js (get-in @st/state path)))
nil)
(defn ^:export dump-objects []
(let [page-id (get @st/state :current-page-id)
objects (get-in @st/state [:workspace-data :pages-index page-id :objects])]
(defn dump-objects'
[state]
(let [page-id (get state :current-page-id)
objects (get-in state [:workspace-data :pages-index page-id :objects])]
(logjs "objects" objects)
nil))
(defn ^:export dump-object [name]
(let [page-id (get @st/state :current-page-id)
objects (get-in @st/state [:workspace-data :pages-index page-id :objects])
(defn ^:export dump-objects
[]
(dump-objects' @st/state))
(defn dump-object'
[state name]
(let [page-id (get state :current-page-id)
objects (get-in state [:workspace-data :pages-index page-id :objects])
result (or (d/seek (fn [[_ shape]] (= name (:name shape))) objects)
(get objects (uuid/uuid name)))]
(logjs name result)
nil))
(defn ^:export dump-selected []
(let [page-id (get @st/state :current-page-id)
objects (get-in @st/state [:workspace-data :pages-index page-id :objects])
selected (get-in @st/state [:workspace-local :selected])
(defn ^:export dump-object
[name]
(dump-object' @st/state name))
(defn dump-selected'
[state]
(let [page-id (get state :current-page-id)
objects (get-in state [:workspace-data :pages-index page-id :objects])
selected (get-in state [:workspace-local :selected])
result (->> selected (map (d/getf objects)))]
(logjs "selected" result)
nil))
(defn ^:export dump-tree
([] (dump-tree false false))
([show-ids] (dump-tree show-ids false))
([show-ids show-touched]
(let [page-id (get @st/state :current-page-id)
objects (get-in @st/state [:workspace-data :pages-index page-id :objects])
components (get-in @st/state [:workspace-data :components])
libraries (get @st/state :workspace-libraries)
(defn ^:export dump-selected
[]
(dump-selected' @st/state))
(defn dump-tree'
([state ] (dump-tree' state false false))
([state show-ids] (dump-tree' state show-ids false))
([state show-ids show-touched]
(let [page-id (get state :current-page-id)
objects (get-in state [:workspace-data :pages-index page-id :objects])
components (get-in state [:workspace-data :components])
libraries (get state :workspace-libraries)
root (d/seek #(nil? (:parent-id %)) (vals objects))]
(letfn [(show-shape [shape-id level objects]
@ -243,6 +258,11 @@
(println (str/format "[%s]" (:name component)))
(show-shape (:id component) 0 (:objects component)))))))))
(defn ^:export dump-tree
([] (dump-tree' @st/state))
([show-ids] (dump-tree' @st/state show-ids))
([show-ids show-touched] (dump-tree' @st/state show-ids show-touched)))
(when *assert*
(defonce debug-subscription
(->> st/stream
@ -274,7 +294,6 @@
dw/reset-zoom
(dw/update-viewport-position {:x (constantly 0) :y (constantly 0)})))
(defn ^:export hide-ui
[]
(st/emit!

746
frontend/test/app/components_basic_test.cljs
View file

@ -1,76 +1,80 @@
(ns app.components-basic-test
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.pages.helpers :as cph]
[app.main.data.workspace :as dw]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.libraries-helpers :as dwlh]
[app.main.data.workspace.state-helpers :as wsh]
[app.test-helpers.events :as the]
[app.test-helpers.libraries :as thl]
[app.test-helpers.pages :as thp]
[beicon.core :as rx]
[cljs.pprint :refer [pprint]]
[cljs.test :as t :include-macros true]
[clojure.stacktrace :as stk]
[linked.core :as lks]))
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.pages.helpers :as cph]
[app.main.data.workspace :as dw]
[app.main.data.workspace.groups :as dwg]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.libraries-helpers :as dwlh]
[app.main.data.workspace.state-helpers :as wsh]
[app.test-helpers.events :as the]
[app.test-helpers.libraries :as thl]
[app.test-helpers.pages :as thp]
[beicon.core :as rx]
[cljs.pprint :refer [pprint]]
[cljs.test :as t :include-macros true]
[clojure.stacktrace :as stk]
[linked.core :as lks]
[potok.core :as ptk]))
(t/use-fixtures :each
{:before thp/reset-idmap!})
;; Test using potok
#_(t/deftest test-add-component-from-single-shape
(t/testing "test-add-component-from-single-shape"
(t/async
done
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"}))
store (ptk/store {:state state})
stream (ptk/input-stream store)
end? (->> stream (rx/filter #(= ::end %)))]
(t/deftest test-add-component-from-single-shape
(t/testing "test-add-component-from-single-shape"
(t/async
done
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect-1"}))
(->> stream
(rx/take-until end?)
(rx/last)
(rx/do
(fn []
(let [new-state @store
shape1 (thp/get-shape new-state :shape1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2 #--> Rect-2
; Rect-1 ---> Rect-1
;
; [Rect-1]
; Rect-2
; Rect-1
;
(let [shape1 (thp/get-shape new-state :shape1)
[[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main
new-state
(:parent-id shape1))
[[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main
new-state
(:parent-id shape1))
file (dwlh/get-local-file new-state)]
file (wsh/get-local-file new-state)]
(t/is (= (:name shape1) "Rect 1"))
(t/is (= (:name group) "Component-1"))
(t/is (= (:name component) "Component-1"))
(t/is (= (:name c-shape1) "Rect 1"))
(t/is (= (:name c-group) "Component-1"))
(t/is (= (:name shape1) "Rect-1"))
(t/is (= (:name group) "Rect-2"))
(t/is (= (:name component) "Rect-1"))
(t/is (= (:name c-shape1) "Rect-1"))
(t/is (= (:name c-group) "Rect-2"))
(thl/is-from-file group file))))
(thl/is-from-file group file))))]
(rx/subs done #(throw %)))
(ptk/emit!
(ptk/emit!
store
(dw/select-shape (thp/id :shape1))
(dwl/add-component)
::end)))))
:the/end)))))
;; FAILING
;; Remove definitely when we ensure that the other method works
;; well in more advanced tests.
#_(t/deftest test-add-component-from-single-shape
(t/async
done
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"}))]
{:name "Rect-1"}))]
(->> state
(the/do-update (dw/select-shape (thp/id :shape1)))
@ -84,100 +88,123 @@
new-state
(:parent-id shape1))
file (dwlh/get-local-file new-state)]
file (wsh/get-local-file new-state)]
(t/is (= (:name shape1) "Rect 1"))
(t/is (= (:name shape1) "Rect-1"))
(t/is (= (:name group) "Component-1"))
(t/is (= (:name component) "Component-1"))
(t/is (= (:name c-shape1) "Rect 1"))
(t/is (= (:name c-shape1) "Rect-1"))
(t/is (= (:name c-group) "Component-1"))
(thl/is-from-file group file))))
(rx/subs done #(throw %))))))
;; FAILING
#_(t/deftest test-add-component-from-several-shapes
(t/deftest test-add-component-from-several-shapes
(t/async
done
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
{:name "Rect-1"})
(thp/sample-shape :shape2 :rect
{:name "Rect 2"}))]
{:name "Rect-2"}))
(->> state
(the/do-update (dw/select-shapes (lks/set
(thp/id :shape1)
(thp/id :shape2))))
(the/do-watch-update dwl/add-component)
(rx/do
(fn [new-state]
(let [shape1 (thp/get-shape new-state :shape1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Component-1 #--> Component-1
; Rect-1 ---> Rect-1
; Rect-2 ---> Rect-2
;
; [Component-1]
; Component-1
; Rect-1
; Rect-2
;
(let [shape1 (thp/get-shape new-state :shape1)
[[group shape1 shape2]
[c-group c-shape1 c-shape2]
component]
(thl/resolve-instance-and-main
new-state
(:parent-id shape1))
[[group shape1 shape2]
[c-group c-shape1 c-shape2]
component]
(thl/resolve-instance-and-main
new-state
(:parent-id shape1))
file (dwlh/get-local-file new-state)]
file (wsh/get-local-file new-state)]
;; NOTE: the group name depends on having executed
;; the previous test.
(t/is (= (:name group) "Component-1"))
(t/is (= (:name shape1) "Rect 1"))
(t/is (= (:name shape2) "Rect 2"))
(t/is (= (:name component) "Component-1"))
(t/is (= (:name c-group) "Component-1"))
(t/is (= (:name c-shape1) "Rect 1"))
(t/is (= (:name c-shape2) "Rect 2"))
(t/is (= (:name group) "Component-1"))
(t/is (= (:name shape1) "Rect-1"))
(t/is (= (:name shape2) "Rect-2"))
(t/is (= (:name component) "Component-1"))
(t/is (= (:name c-group) "Component-1"))
(t/is (= (:name c-shape1) "Rect-1"))
(t/is (= (:name c-shape2) "Rect-2"))
(thl/is-from-file group file))))
(thl/is-from-file group file))))]
(rx/subs done #(throw %))))))
(ptk/emit!
store
(dw/select-shapes (lks/set (thp/id :shape1)
(thp/id :shape2)))
(dwl/add-component)
:the/end))))
#_(t/deftest test-add-component-from-group
(t/deftest test-add-component-from-group
(t/async
done
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
{:name "Rect-1"})
(thp/sample-shape :shape2 :rect
{:name "Rect 2"})
{:name "Rect-2"})
(thp/group-shapes :group1
[(thp/id :shape1)
(thp/id :shape2)]))]
(thp/id :shape2)]))
(->> state
(the/do-update (dw/select-shape (thp/id :group1)))
(the/do-watch-update dwl/add-component)
(rx/do
(fn [new-state]
(let [[[group shape1 shape2]
[c-group c-shape1 c-shape2]
component]
(thl/resolve-instance-and-main
new-state
(thp/id :group1))
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Group-1 #--> Group-1
; Rect-1 ---> Rect-1
; Rect-2 ---> Rect-2
;
; [Group-1]
; Group-1
; Rect-1
; Rect-2
;
(let [[[group shape1 shape2]
[c-group c-shape1 c-shape2]
component]
(thl/resolve-instance-and-main
new-state
(thp/id :group1))
file (dwlh/get-local-file new-state)]
file (wsh/get-local-file new-state)]
(t/is (= (:name shape1) "Rect 1"))
(t/is (= (:name shape2) "Rect 2"))
(t/is (= (:name group) "Group-1"))
(t/is (= (:name component) "Group-1"))
(t/is (= (:name c-shape1) "Rect 1"))
(t/is (= (:name c-shape2) "Rect 2"))
(t/is (= (:name c-group) "Group-1"))
(t/is (= (:name shape1) "Rect-1"))
(t/is (= (:name shape2) "Rect-2"))
(t/is (= (:name group) "Group-1"))
(t/is (= (:name component) "Group-1"))
(t/is (= (:name c-shape1) "Rect-1"))
(t/is (= (:name c-shape2) "Rect-2"))
(t/is (= (:name c-group) "Group-1"))
(thl/is-from-file group file))))
(thl/is-from-file group file))))]
(rx/subs done #(throw %))))))
(ptk/emit!
store
(dw/select-shape (thp/id :group1))
(dwl/add-component)
:the/end))))
(t/deftest test-rename-component
(t/async
@ -185,26 +212,35 @@
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/make-component :instance1
{:name "Rect-1"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)]))
instance1 (thp/get-shape state :instance1)]
instance1 (thp/get-shape state :instance1)
(->> state
(the/do-watch-update (dwl/rename-component
(:component-id instance1)
"Renamed component"))
(rx/do
(fn [new-state]
(let [libs (dwlh/get-libraries new-state)
component (cph/get-component libs
(:component-file instance1)
(:component-id instance1))]
(t/is (= (:name component)
"Renamed component")))))
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2 #--> Renamed component
; Rect-1 ---> Rect-1
;
; [Renamed]
; Renamed component
; Rect-1
(let [libs (wsh/get-libraries new-state)
component (cph/get-component libs
(:component-file instance1)
(:component-id instance1))]
(t/is (= (:name component)
"Renamed component")))))]
(rx/subs done #(throw %))))))
(ptk/emit!
store
(dwl/rename-component (:component-id instance1) "Renamed component")
:the/end))))
(t/deftest test-duplicate-component
(t/async
@ -213,40 +249,55 @@
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect-1"})
(thp/make-component :instance1
(thp/make-component :instance1 :component-1
[(thp/id :shape1)]))
instance1 (thp/get-shape state :instance1)
component-id (:component-id instance1)]
component-id (:component-id instance1)
(->> state
(the/do-watch-update (dwl/duplicate-component
{:id component-id}))
(rx/do
(fn [new-state]
(let [new-component-id (->> (get-in new-state
[:workspace-data
:components])
(keys)
(filter #(not= % component-id))
(first))
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2 #--> Rect-2
; Rect-1 ---> Rect-1
;
; [Rect-1]
; Rect-2
; Rect-1
;
; [Rect-2]
; Rect-2
; Rect-1
;
(let [new-component-id (->> (get-in new-state
[:workspace-data
:components])
(keys)
(filter #(not= % component-id))
(first))
[[instance1 shape1]
[c-instance1 c-shape1]
component1]
(thl/resolve-instance-and-main
new-state
(:id instance1))
[[instance1 shape1]
[c-instance1 c-shape1]
component1]
(thl/resolve-instance-and-main
new-state
(:id instance1))
[[c-component2 c-shape2]
component2]
(thl/resolve-component
new-state
new-component-id)]
[[c-component2 c-shape2]
component2]
(thl/resolve-component
new-state
new-component-id)]
(t/is (= (:name component2) "Rect-2")))))
(t/is (= (:name component2) "Rect-2")))))]
(rx/subs done #(throw %))))))
(ptk/emit!
store
(dwl/duplicate-component {:id component-id})
:the/end))))
(t/deftest test-delete-component
(t/async
@ -254,30 +305,43 @@
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/make-component :instance1
{:name "Rect-1"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)]))
file (wsh/get-local-file state)
instance1 (thp/get-shape state :instance1)
component-id (:component-id instance1)]
component-id (:component-id instance1)
(->> state
(the/do-watch-update (dwl/delete-component
{:id component-id}))
(rx/do
(fn [new-state]
(let [[instance1 shape1]
(thl/resolve-instance
new-state
(:id instance1))
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2
; Rect-1
;
(let [[instance1 shape1]
(thl/resolve-noninstance
new-state
(:id instance1))
libs (dwlh/get-libraries new-state)
component (cph/get-component libs
(:component-file instance1)
(:component-id instance1))]
(t/is (nil? component)))))
libs (wsh/get-libraries new-state)
component (cph/get-component libs
(:component-file instance1)
(:component-id instance1))]
(rx/subs done #(throw %))))))
(t/is (some? instance1))
(t/is (some? shape1))
(t/is (nil? component)))))]
(ptk/emit!
store
(dwl/delete-component {:id component-id})
(dwl/sync-file (:id file) (:id file))
:the/end))))
(t/deftest test-instantiate-component
(t/async
@ -286,39 +350,103 @@
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect-1"})
(thp/make-component :instance1
(thp/make-component :instance1 :component-1
[(thp/id :shape1)]))
file (dwlh/get-local-file state)
file (wsh/get-local-file state)
component-id (thp/id :component-1)
instance1 (thp/get-shape state :instance1)
component-id (:component-id instance1)]
(->> state
(the/do-watch-update (dwl/instantiate-component
(:id file)
(:component-id instance1)
(gpt/point 100 100)))
(rx/do
(fn [new-state]
(let [new-instance-id (-> new-state
wsh/lookup-selected
first)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2 #--> Rect-2
; Rect-1 ---> Rect-1
; Rect-3 #--> Rect-2
; Rect-1 ---> Rect-1
;
; [Rect-2]
; Rect-2
; Rect-1
;
(let [new-instance-id (-> new-state
wsh/lookup-selected
first)
[[instance2 shape2]
[c-instance2 c-shape2]
component]
(thl/resolve-instance-and-main
new-state
new-instance-id)]
[[instance2 shape2]
[c-instance2 c-shape2]
component]
(thl/resolve-instance-and-main
new-state
new-instance-id)]
(t/is (not= (:id instance1) (:id instance2)))
(t/is (= (:id component) component-id))
(t/is (= (:name instance2) "Rect-3"))
(t/is (= (:name shape2) "Rect-1"))
(t/is (= (:name c-instance2) "Rect-2"))
(t/is (= (:name c-shape2) "Rect-1")))))
(t/is (not= (:id instance1) (:id instance2)))
(t/is (= (:id component) component-id))
(t/is (= (:name instance2) "Rect-3"))
(t/is (= (:name shape2) "Rect-1"))
(t/is (= (:name c-instance2) "Rect-2"))
(t/is (= (:name c-shape2) "Rect-1"))
(t/is (= (:component-file instance2)
thp/current-file-id)))))]
(rx/subs done #(throw %))))))
(ptk/emit!
store
(dwl/instantiate-component (:id file)
component-id
(gpt/point 100 100))
:the/end))))
(t/deftest test-instantiate-component-from-lib
(t/async
done
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect-1"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/move-to-library :lib1 "Library 1")
(thp/sample-page))
library-id (thp/id :lib1)
component-id (thp/id :component-1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2 #--> <Library 1> Rect-2
; Rect-1 ---> <Library 1> Rect-1
;
(let [new-instance-id (-> new-state
wsh/lookup-selected
first)
[[instance2 shape2]
[c-instance2 c-shape2]
component]
(thl/resolve-instance-and-main
new-state
new-instance-id)]
(t/is (= (:id component) component-id))
(t/is (= (:name instance2) "Rect-2"))
(t/is (= (:name shape2) "Rect-1"))
(t/is (= (:name c-instance2) "Rect-2"))
(t/is (= (:name c-shape2) "Rect-1"))
(t/is (= (:component-file instance2) library-id)))))]
(ptk/emit!
store
(dwl/instantiate-component library-id
component-id
(gpt/point 100 100))
:the/end))))
(t/deftest test-detach-component
(t/async
@ -326,24 +454,222 @@
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/make-component :instance1
{:name "Rect-1"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)]))
instance1 (thp/get-shape state :instance1)
component-id (:component-id instance1)]
component-id (:component-id instance1)
(->> state
(the/do-watch-update (dwl/detach-component
(:id instance1)))
(rx/do
(fn [new-state]
(let [[instance1 shape1]
(thl/resolve-noninstance
new-state
(:id instance1))]
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2
; Rect-1
;
; [Rect-2]
; Rect-2
; Rect-1
;
(let [[instance1 shape1]
(thl/resolve-noninstance
new-state
(:id instance1))]
(t/is (= (:name "Rect 1"))))))
(t/is (some? instance1))
(t/is (some? shape1)))))]
(rx/subs done #(throw %))))))
(ptk/emit!
store
(dwl/detach-component (:id instance1))
:the/end))))
(t/deftest test-add-nested-component
(t/async
done
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect-1"}))
file (wsh/get-local-file state)
instance1 (thp/get-shape state :instance1)
component-id (:component-id instance1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Group-1 #--> Group-1
; Rect-2 @--> Rect-2
; Rect-1 ---> Rect-1
;
; [Rect-1]
; Rect-2
; Rect-1
;
; [Group-1]
; Group-1
; Rect-2 @--> Rect-2
; Rect-1 ---> Rect-1
;
(let [page (thp/current-page new-state)
shape1 (thp/get-shape new-state :shape1)
parent1 (cph/get-shape page (:parent-id shape1))
[[group shape1 shape2]
[c-group c-shape1 c-shape2]
component]
(thl/resolve-instance-and-main
new-state
(:parent-id parent1))]
(t/is (= (:name group) "Group-1"))
(t/is (= (:name shape1) "Rect-2"))
(t/is (= (:name shape2) "Rect-1"))
(t/is (= (:name component) "Group-1"))
(t/is (= (:name c-group) "Group-1"))
(t/is (= (:name c-shape1) "Rect-2"))
(t/is (= (:name c-shape2) "Rect-1")))))]
(ptk/emit!
store
(dw/select-shape (thp/id :shape1))
(dwl/add-component)
dwg/group-selected
(dwl/add-component)
:the/end))))
(t/deftest test-instantiate-nested-component
(t/async
done
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect-1"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/group-shapes :group1
[(thp/id :instance1)])
(thp/make-component :instance2 :component-2
[(thp/id :group1)]))
file (wsh/get-local-file state)
instance1 (thp/get-shape state :instance1)
instance2 (thp/get-shape state :instance2)
component-id (:component-id instance2)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect-2 #--> Rect-2
; Rect-2 @--> Rect-2
; Rect-1 ---> Rect-1
; Rect-3 #--> Rect-2
; Rect-2 @--> Rect-2
; Rect-1 ---> Rect-1
;
; [Rect-1]
; Rect-2
; Rect-1
;
; [Rect-2]
; Rect-2
; Rect-2 @--> Rect-2
; Rect-1 ---> Rect-1
;
(let [new-instance-id (-> new-state
wsh/lookup-selected
first)
[[instance3 shape3 shape4]
[c-instance3 c-shape3 c-shape4]
component]
(thl/resolve-instance-and-main
new-state
new-instance-id)]
(t/is (not= (:id instance1) (:id instance3)))
(t/is (= (:id component) component-id))
(t/is (= (:name instance3) "Rect-3"))
(t/is (= (:name shape3) "Rect-2"))
(t/is (= (:name shape4) "Rect-1"))
(t/is (= (:name c-instance3) "Rect-2"))
(t/is (= (:name c-shape3) "Rect-2"))
(t/is (= (:name c-shape4) "Rect-1")))))]
(ptk/emit!
store
(dwl/instantiate-component (:id file)
(:component-id instance2)
(gpt/point 100 100))
:the/end))))
(t/deftest test-instantiate-nested-component-from-lib
(t/async
done
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect-1"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/move-to-library :lib1 "Library 1")
(thp/sample-page)
(thp/instantiate-component :instance2
(thp/id :component-1)
(thp/id :lib1)))
library-id (thp/id :lib1)
component-id (thp/id :component-1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Group-1 #--> Group-1
; Rect-2 @--> <Library 1> Rect-2
; Rect-1 ---> <Library 1> Rect-1
;
; [Group-1]
; Group-1
; Rect-2 @--> <Library 1> Rect-2
; Rect-1 ---> <Library 1> Rect-1
;
(let [instance2 (thp/get-shape new-state :instance2)
[[group1 shape1 shape2] [c-group1 c-shape1 c-shape2] component]
(thl/resolve-instance-and-main
new-state
(:parent-id instance2))]
(t/is (= (:name group1) "Group-1"))
(t/is (= (:name shape1) "Rect-2"))
(t/is (= (:name shape2) "Rect-1"))
(t/is (= (:name c-group1) "Group-1"))
(t/is (= (:name c-shape1) "Rect-2"))
(t/is (= (:name c-shape2) "Rect-1"))
(t/is (= (:component-file group1) thp/current-file-id))
(t/is (= (:component-file shape1) library-id))
(t/is (= (:component-file shape2) nil))
(t/is (= (:component-file c-group1) nil))
(t/is (= (:component-file c-shape1) library-id))
(t/is (= (:component-file c-shape2) nil)))))]
(ptk/emit!
store
(dw/select-shape (thp/id :instance2))
dwg/group-selected
(dwl/add-component)
:the/end))))

845
frontend/test/app/components_sync_test.cljs
View file

@ -1,18 +1,23 @@
(ns app.components-sync-test
(:require
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.main.data.workspace.changes :as dwc]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.libraries-helpers :as dwlh]
[app.test-helpers.events :as the]
[app.test-helpers.libraries :as thl]
[app.test-helpers.pages :as thp]
[beicon.core :as rx]
[cljs.pprint :refer [pprint]]
[cljs.test :as t :include-macros true]
[linked.core :as lks]))
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.pages.helpers :as cph]
[app.main.data.workspace :as dw]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.libraries-helpers :as dwlh]
[app.main.data.workspace.state-helpers :as wsh]
[app.test-helpers.events :as the]
[app.test-helpers.libraries :as thl]
[app.test-helpers.pages :as thp]
[beicon.core :as rx]
[cljs.pprint :refer [pprint]]
[cljs.test :as t :include-macros true]
[linked.core :as lks]
[potok.core :as ptk]))
(t/use-fixtures :each
{:before thp/reset-idmap!})
@ -26,46 +31,221 @@
{:name "Rect 1"
:fill-color clr/white
:fill-opacity 1})
(thp/make-component :instance1
(thp/make-component :instance1 :component-1
[(thp/id :shape1)]))
shape1 (thp/get-shape state :shape1)
update-fn (fn [shape]
(merge shape {:fill-color clr/test
:fill-opacity 0.5}))
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Rect 1* ---> Rect 1
; #{:fill-group}
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [instance1 (thp/get-shape new-state :instance1)
shape1 (thp/get-shape new-state :shape1)
[[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (= (:touched instance1) nil))
(t/is (= (:touched shape1) #{:fill-group}))
(t/is (= (:fill-color shape1) clr/test))
(t/is (= (:fill-opacity shape1) 0.5))
(t/is (= (:touched c-group) nil))
(t/is (= (:touched c-shape1) nil))
(t/is (= (:fill-color c-shape1) clr/white))
(t/is (= (:fill-opacity c-shape1) 1)))))]
(ptk/emit!
store
(dch/update-shapes [(:id shape1)] update-fn)
:the/end)))))
(t/deftest test-touched-children-add
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"
:fill-color clr/white
:fill-opacity 1})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/sample-shape :shape2 :circle
{:name "Circle 1"}))
instance1 (thp/get-shape state :instance1)
shape2 (thp/get-shape state :shape2)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1* #--> Rect 1-1
; #{:shapes-group}
; Circle 1
; Rect 1 ---> Rect 1
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape1 shape2] [c-group c-shape1] component]
(thl/resolve-instance-and-main-allow-dangling
new-state
(:id instance1))]
(t/is (= (:touched group) #{:shapes-group}))
(t/is (nil? (:touched shape1)))
(t/is (= (:name shape1) "Circle 1"))
(t/is (nil? (:shape-ref shape1)))
(t/is (nil? (:touched shape2)))
(t/is (= (:name shape2) "Rect 1"))
(t/is (some? (:shape-ref shape2)))
(t/is (nil? (:touched c-group)))
(t/is (nil? (:touched c-shape1))))))]
(ptk/emit!
store
(dw/relocate-shapes #{(:id shape2)} (:id instance1) 0)
:the/end)))))
(t/deftest test-touched-children-delete
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/sample-shape :shape2 :rect
{:name "Rect 2"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)
(thp/id :shape2)]))
shape1 (thp/get-shape state :shape1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Component-1* #--> Component-1
; #{:shapes-group}
; Rect 2 ---> Rect 2
;
; [Component-1]
; Component-1
; Rect 1
; Rect 2
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape2] [c-group c-shape2] component]
(thl/resolve-instance-and-main-allow-dangling
new-state
(:id instance1))]
(t/is (= (:touched group) #{:shapes-group}))
(t/is (nil? (:touched shape2)))
(t/is (= (:name shape2) "Rect 2"))
(t/is (some? (:shape-ref shape2)))
(t/is (nil? (:touched c-group)))
(t/is (nil? (:touched c-shape2))))))]
(ptk/emit!
store
(dwc/delete-shapes #{(:id shape1)})
:the/end)))))
(t/deftest test-touched-children-move
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/sample-shape :shape2 :rect
{:name "Rect 2"})
(thp/sample-shape :shape3 :rect
{:name "Rect 3"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)
(thp/id :shape2)
(thp/id :shape3)]))
shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1)
update-shape (fn [shape]
(merge shape {:fill-color clr/test
:fill-opacity 0.5}))]
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Component-1* #--> Component-1
; #{:shapes-group}
; Rect 2 ---> Rect 2
; Rect 1 ---> Rect 1
; Rect 3 ---> Rect 3
;
; [Component-1]
; Component-1
; Rect 1
; Rect 2
; Rect 3
;
(let [instance1 (thp/get-shape new-state :instance1)
(->> state
(the/do-watch-update (dwc/update-shapes [(:id shape1)]
update-shape))
(rx/do
(fn [new-state]
(let [shape1 (thp/get-shape new-state :shape1)
[[group shape1 shape2 shape3]
[c-group c-shape1 c-shape2 c-shape3] component]
(thl/resolve-instance-and-main-allow-dangling
new-state
(:id instance1))]
[[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))
(t/is (= (:touched group) #{:shapes-group}))
(t/is (nil? (:touched shape1)))
(t/is (some? (:shape-ref shape1)))
(t/is (= (:name shape1) "Rect 2"))
(t/is (nil? (:touched shape2)))
(t/is (some? (:shape-ref shape2)))
(t/is (= (:name shape2) "Rect 1"))
(t/is (nil? (:touched shape3)))
(t/is (some? (:shape-ref shape3)))
(t/is (= (:name shape3) "Rect 3"))
(t/is (nil? (:touched c-group)))
(t/is (nil? (:touched c-shape1)))
(t/is (= (:name c-shape1) "Rect 1"))
(t/is (nil? (:touched c-shape2)))
(t/is (= (:name c-shape2) "Rect 2"))
(t/is (nil? (:touched c-shape3)))
(t/is (= (:name c-shape3) "Rect 3")))))]
file (dwlh/get-local-file new-state)]
(t/is (= (:fill-color shape1) clr/test))
(t/is (= (:fill-opacity shape1) 0.5))
(t/is (= (:touched shape1) #{:fill-group}))
(t/is (= (:fill-color c-shape1) clr/white))
(t/is (= (:fill-opacity c-shape1) 1))
(t/is (= (:touched c-shape1) nil)))))
(rx/subs
done
#(do
(println (.-stack %))
(done)))))
(catch :default e
(println (.-stack e))
(done)))))
(ptk/emit!
store
(dw/relocate-shapes #{(:id shape1)} (:id instance1) 2)
:the/end)))))
(t/deftest test-reset-changes
(t/async done
@ -76,48 +256,561 @@
{:name "Rect 1"
:fill-color clr/white
:fill-opacity 1})
(thp/make-component :instance1
(thp/make-component :instance1 :component-1
[(thp/id :shape1)]))
shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1)
update-shape (fn [shape]
(merge shape {:fill-color clr/test
:fill-opacity 0.5}))]
update-fn (fn [shape]
(merge shape {:fill-color clr/test
:fill-opacity 0.5}))
(->> state
(the/do-watch-update (dwc/update-shapes [(:id shape1)]
update-shape))
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Rect 1 ---> Rect 1
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [shape1 (thp/get-shape new-state :shape1)
(rx/mapcat #(the/do-watch-update
(dwl/reset-component (:id instance1)) %))
[[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(rx/do
(fn [new-state]
(let [shape1 (thp/get-shape new-state :shape1)
(t/is (= (:fill-color shape1) clr/white))
(t/is (= (:fill-opacity shape1) 1))
(t/is (= (:touched shape1) nil))
(t/is (= (:fill-color c-shape1) clr/white))
(t/is (= (:fill-opacity c-shape1) 1))
(t/is (= (:touched c-shape1) nil)))))]
[[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))
(ptk/emit!
store
(dch/update-shapes [(:id shape1)] update-fn)
(dwl/reset-component (:id instance1))
:the/end)))))
file (dwlh/get-local-file new-state)]
(t/deftest test-reset-children-add
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"
:fill-color clr/white
:fill-opacity 1})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/sample-shape :shape2 :circle
{:name "Circle 1"}))
(t/is (= (:fill-color shape1) clr/white))
(t/is (= (:fill-opacity shape1) 1))
(t/is (= (:touched shape1) nil))
(t/is (= (:fill-color c-shape1) clr/white))
(t/is (= (:fill-opacity c-shape1) 1))
(t/is (= (:touched c-shape1) nil)))))
instance1 (thp/get-shape state :instance1)
shape2 (thp/get-shape state :shape2)
(rx/subs
done
#(do
(println (.-stack %))
(done)))))
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Rect 1 ---> Rect 1
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [instance1 (thp/get-shape new-state :instance1)
(catch :default e
(println (.-stack e))
(done)))))
[[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (nil? (:touched instance1)))
(t/is (= (:name shape1) "Rect 1"))
(t/is (some? (:shape-ref shape1))))))]
(ptk/emit!
store
(dw/relocate-shapes #{(:id shape2)} (:id instance1) 0)
(dwl/reset-component (:id instance1))
:the/end)))))
(t/deftest test-reset-children-delete
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/sample-shape :shape2 :rect
{:name "Rect 2"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)
(thp/id :shape2)]))
instance1 (thp/get-shape state :instance1)
shape1 (thp/get-shape state :shape1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Rect 1 ---> Rect 1
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (nil? (:touched instance1)))
(t/is (= (:name shape1) "Rect 1"))
(t/is (some? (:shape-ref shape1))))))]
(ptk/emit!
store
(dwc/delete-shapes #{(:id shape1)})
(dwl/reset-component (:id instance1))
:the/end)))))
(t/deftest test-reset-children-move
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/sample-shape :shape2 :rect
{:name "Rect 2"})
(thp/sample-shape :shape3 :rect
{:name "Rect 3"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)
(thp/id :shape2)
(thp/id :shape3)]))
shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Component-1 #--> Component-1
; Rect 1 ---> Rect 1
; Rect 2 ---> Rect 2
; Rect 3 ---> Rect 3
;
; [Component-1]
; Component-1
; Rect 1
; Rect 2
; Rect 3
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape1 shape2 shape3] [c-group c-shape1 c-shape2 c-shape3] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (nil? (:touched group)))
(t/is (nil? (:touched shape1)))
(t/is (some? (:shape-ref shape1)))
(t/is (= (:name shape1) "Rect 1"))
(t/is (nil? (:touched shape2)))
(t/is (some? (:shape-ref shape2)))
(t/is (= (:name shape2) "Rect 2"))
(t/is (nil? (:touched shape3)))
(t/is (some? (:shape-ref shape3)))
(t/is (= (:name shape3) "Rect 3"))
(t/is (nil? (:touched c-group)))
(t/is (nil? (:touched c-shape1)))
(t/is (= (:name c-shape1) "Rect 1"))
(t/is (nil? (:touched c-shape2)))
(t/is (= (:name c-shape2) "Rect 2"))
(t/is (nil? (:touched c-shape3)))
(t/is (= (:name c-shape3) "Rect 3")))))]
(ptk/emit!
store
(dw/relocate-shapes #{(:id shape1)} (:id instance1) 2)
(dwl/reset-component (:id instance1))
:the/end)))))
(t/deftest test-update-component
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"
:fill-color clr/white
:fill-opacity 1})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)]))
shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1)
update-fn (fn [shape]
(merge shape {:fill-color clr/test
:fill-opacity 0.5}))
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Rect 1 ---> Rect 1
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [[[group shape1] [c-group c-shape1] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (= (:fill-color shape1) clr/test))
(t/is (= (:fill-opacity shape1) 0.5))
(t/is (= (:touched shape1) nil))
(t/is (= (:fill-color c-shape1) clr/test))
(t/is (= (:fill-opacity c-shape1) 0.5))
(t/is (= (:touched c-shape1) nil)))))]
(ptk/emit!
store
(dch/update-shapes [(:id shape1)] update-fn)
(dwl/update-component (:id instance1))
:the/end)))))
(t/deftest test-update-component-and-sync
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"
:fill-color clr/white
:fill-opacity 1})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/instantiate-component :instance2
(thp/id :component-1)))
file (wsh/get-local-file state)
shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1)
update-fn (fn [shape]
(merge shape {:fill-color clr/test
:fill-opacity 0.5}))
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Rect 1 ---> Rect 1
; Rect 1-2 #--> Rect 1-1
; Rect 1 ---> Rect 1
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [instance2 (thp/get-shape state :instance2)
[[group shape2] [c-group c-shape2] component]
(thl/resolve-instance-and-main
new-state
(:id instance2))]
(t/is (= (:fill-color shape2) clr/test))
(t/is (= (:fill-opacity shape2) 0.5))
(t/is (= (:touched shape2) nil))
(t/is (= (:fill-color c-shape2) clr/test))
(t/is (= (:fill-opacity c-shape2) 0.5))
(t/is (= (:touched c-shape2) nil)))))]
(ptk/emit!
store
(dch/update-shapes [(:id shape1)] update-fn)
(dwl/update-component-sync (:id instance1) (:id file))
:the/end)))))
(t/deftest test-update-preserve-touched
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"
:fill-color clr/white
:fill-opacity 1})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/instantiate-component :instance2
(thp/id :component-1)))
file (wsh/get-local-file state)
shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1)
instance2 (thp/get-shape state :instance2)
shape2 (cph/get-shape (wsh/lookup-page state)
(first (:shapes instance2)))
update-fn1 (fn [shape]
(merge shape {:fill-color clr/test
:stroke-width 0.5}))
update-fn2 (fn [shape]
(merge shape {:stroke-width 0.2}))
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Rect 1 ---> Rect 1
; Rect 1-2 #--> Rect 1-1
; Rect 1* ---> Rect 1
; #{:stroke-group}
;
; [Rect 1]
; Rect 1-1
; Rect 1
;
(let [instance2 (thp/get-shape state :instance2)
[[group shape2] [c-group c-shape2] component]
(thl/resolve-instance-and-main
new-state
(:id instance2))]
(t/is (= (:fill-color shape2) clr/test))
(t/is (= (:stroke-width shape2) 0.2))
(t/is (= (:touched shape2 #{:stroke-group})))
(t/is (= (:fill-color c-shape2) clr/test))
(t/is (= (:stroke-width c-shape2) 0.5))
(t/is (= (:touched c-shape2) nil)))))]
(ptk/emit!
store
(dch/update-shapes [(:id shape1)] update-fn1)
(dch/update-shapes [(:id shape2)] update-fn2)
(dwl/update-component-sync (:id instance1) (:id file))
:the/end)))))
(t/deftest test-update-children-add
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"
:fill-color clr/white
:fill-opacity 1})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)])
(thp/sample-shape :shape2 :circle
{:name "Circle 1"}))
file (wsh/get-local-file state)
instance1 (thp/get-shape state :instance1)
shape2 (thp/get-shape state :shape2)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Rect 1-1 #--> Rect 1-1
; Circle 1 ---> Circle 1
; Rect 1 ---> Rect 1
;
; [Rect 1]
; Rect 1-1
; Circle 1
; Rect 1
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape1 shape2] [c-group c-shape1 c-shape2] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (nil? (:touched group)))
(t/is (nil? (:touched shape1)))
(t/is (= (:name shape1) "Circle 1"))
(t/is (some? (:shape-ref shape1)))
(t/is (nil? (:touched shape2)))
(t/is (= (:name shape2) "Rect 1"))
(t/is (some? (:shape-ref shape2)))
(t/is (nil? (:touched c-group)))
(t/is (nil? (:touched c-shape1)))
(t/is (= (:name c-shape1) "Circle 1"))
(t/is (nil? (:touched c-shape2)))
(t/is (= (:name c-shape2) "Rect 1")))))]
(ptk/emit!
store
(dw/relocate-shapes #{(:id shape2)} (:id instance1) 0)
(dwl/update-component-sync (:id instance1) (:id file))
:the/end)))))
(t/deftest test-update-children-delete
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/sample-shape :shape2 :rect
{:name "Rect 2"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)
(thp/id :shape2)]))
file (wsh/get-local-file state)
instance1 (thp/get-shape state :instance1)
shape1 (thp/get-shape state :shape1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Component-1 #--> Component-1
; Rect 2 ---> Rect 2
;
; [Component-1]
; Component-1
; Rect 2
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape2] [c-group c-shape2] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (nil? (:touched group)))
(t/is (nil? (:touched shape2)))
(t/is (= (:name shape2) "Rect 2"))
(t/is (some? (:shape-ref shape2)))
(t/is (nil? (:touched c-group)))
(t/is (nil? (:touched c-shape2)))
(t/is (= (:name c-shape2) "Rect 2")))))]
(ptk/emit!
store
(dwc/delete-shapes #{(:id shape1)})
(dwl/update-component-sync (:id instance1) (:id file))
:the/end)))))
(t/deftest test-update-children-move
(t/async done
(try
(let [state (-> thp/initial-state
(thp/sample-page)
(thp/sample-shape :shape1 :rect
{:name "Rect 1"})
(thp/sample-shape :shape2 :rect
{:name "Rect 2"})
(thp/sample-shape :shape3 :rect
{:name "Rect 3"})
(thp/make-component :instance1 :component-1
[(thp/id :shape1)
(thp/id :shape2)
(thp/id :shape3)]))
file (wsh/get-local-file state)
shape1 (thp/get-shape state :shape1)
instance1 (thp/get-shape state :instance1)
store (the/prepare-store state done
(fn [new-state]
; Expected shape tree:
;
; [Page]
; Root Frame
; Component-1 #--> Component-1
; Rect 2 ---> Rect 2
; Rect 1 ---> Rect 1
; Rect 3 ---> Rect 3
;
; [Component-1]
; Component-1
; Rect 2
; Rect 1
; Rect 3
;
(let [instance1 (thp/get-shape new-state :instance1)
[[group shape1 shape2 shape3] [c-group c-shape1 c-shape2 c-shape3] component]
(thl/resolve-instance-and-main
new-state
(:id instance1))]
(t/is (nil? (:touched group)))
(t/is (nil? (:touched shape1)))
(t/is (some? (:shape-ref shape1)))
(t/is (= (:name shape1) "Rect 2"))
(t/is (nil? (:touched shape2)))
(t/is (some? (:shape-ref shape2)))
(t/is (= (:name shape2) "Rect 1"))
(t/is (nil? (:touched shape3)))
(t/is (some? (:shape-ref shape3)))
(t/is (= (:name shape3) "Rect 3"))
(t/is (nil? (:touched c-group)))
(t/is (nil? (:touched c-shape1)))
(t/is (= (:name c-shape1) "Rect 2"))
(t/is (nil? (:touched c-shape2)))
(t/is (= (:name c-shape2) "Rect 1"))
(t/is (nil? (:touched c-shape3)))
(t/is (= (:name c-shape3) "Rect 3")))))]
(ptk/emit!
store
(dw/relocate-shapes #{(:id shape1)} (:id instance1) 2)
(dwl/update-component-sync (:id instance1) (:id file))
:the/end)))))

34
frontend/test/app/shapes_test.cljs
View file

@ -12,7 +12,8 @@
[cljs.pprint :refer [pprint]]
[cljs.test :as t :include-macros true]
[clojure.stacktrace :as stk]
[linked.core :as lks]))
[linked.core :as lks]
[potok.core :as ptk]))
(t/use-fixtures :each
{:before thp/reset-idmap!})
@ -33,27 +34,20 @@
shape (thp/get-shape state :shape1)]
(t/is (= (:name shape) "Rect 1")))))
(t/deftest synctest
(t/testing "synctest"
(let [state {:workspace-local {:color-for-rename "something"}}
new-state (->> state
(the/do-update
dwl/clear-color-for-rename))]
(t/is (= (get-in new-state [:workspace-local :color-for-rename])
nil)))))
(t/deftest asynctest
(t/testing "asynctest"
(t/async done
(let [state {}
color {:color clr/white}]
(->> state
(the/do-watch-update
(dwl/add-recent-color color))
(rx/map
(fn [new-state]
(t/is (= (get-in new-state [:workspace-data
:recent-colors])
[color]))))
(rx/subs done done))))))
color {:color clr/white}
store (the/prepare-store state done
(fn [new-state]
(t/is (= (get-in new-state [:workspace-data
:recent-colors])
[color]))))]
(ptk/emit!
store
(dwl/add-recent-color color)
:the/end)))))

35
frontend/test/app/test_helpers/events.cljs
View file

@ -1,31 +1,50 @@
(ns app.test-helpers.events
(:require
[cljs.test :as t :include-macros true]
[cljs.pprint :refer [pprint]]
[beicon.core :as rx]
[potok.core :as ptk]
[app.common.uuid :as uuid]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.pages :as cp]
[app.common.pages.helpers :as cph]
[app.main.data.workspace :as dw]))
[app.main.data.workspace :as dw]
[cljs.test :as t :include-macros true]
[cljs.pprint :refer [pprint]]
[beicon.core :as rx]
[potok.core :as ptk]))
;; ---- Helpers to manage global events
(defn do-update
(defn prepare-store
"Create a store with the given initial state. Wait until
a :the/end event occurs, and then call the function with
the final state at this point."
[state done completed-cb]
(let [store (ptk/store {:state state})
stream (ptk/input-stream store)
stream (->> stream
(rx/take-until (rx/filter #(= :the/end %) stream))
(rx/last)
(rx/do
(fn []
(completed-cb @store)))
(rx/subs done #(throw %)))]
store))
;; Remove definitely when we ensure that the above method works
;; well in more advanced tests.
#_(defn do-update
"Execute an update event and returns the new state."
[event state]
(ptk/update event state))
(defn do-watch
#_(defn do-watch
"Execute a watch event and return an observable, that
emits once a list with all new events."
[event state]
(->> (ptk/watch event state nil)
(rx/reduce conj [])))
(defn do-watch-update
#_(defn do-watch-update
"Execute a watch event and return an observable, that
emits once the new state, after all new events applied
in sequence (considering they are all update events)."

73
frontend/test/app/test_helpers/libraries.cljs
View file

@ -10,6 +10,7 @@
[app.common.pages.helpers :as cph]
[app.main.data.workspace :as dw]
[app.main.data.workspace.libraries-helpers :as dwlh]
[app.main.data.workspace.state-helpers :as wsh]
[app.test-helpers.pages :as thp]))
;; ---- Helpers to manage libraries and synchronization
@ -26,11 +27,6 @@
(t/is (some? (:component-id shape)))
(t/is (nil? (:component-root? shape))))
(defn is-instance-head
[shape]
(t/is (some? (:shape-ref shape)))
(t/is (some? (:component-id shape))))
(defn is-instance-child
[shape]
(t/is (some? (:shape-ref shape)))
@ -38,6 +34,12 @@
(t/is (nil? (:component-file shape)))
(t/is (nil? (:component-root? shape))))
(defn is-instance-inner
[shape]
(if (some? (:component-id shape))
(is-instance-subroot shape)
(is-instance-child shape)))
(defn is-noninstance
[shape]
(t/is (nil? (:shape-ref shape)))
@ -53,34 +55,38 @@
(:id file))))
(defn resolve-instance
"Get the shape with the given id and all its children, and
verify that they are a well constructed instance tree."
[state root-inst-id]
(let [page (thp/current-page state)
root-inst (cph/get-shape page root-inst-id)
shapes-inst (cph/get-children-with-self (:objects page)
root-inst-id)]
;; Validate that the instance tree is well constructed
(is-instance-root (first shapes-inst))
(run! is-instance-child (rest shapes-inst))
shapes-inst))
(defn resolve-noninstance
"Get the shape with the given id and all its children, and
verify that they are not a component instance."
[state root-inst-id]
(let [page (thp/current-page state)
root-inst (cph/get-shape page root-inst-id)
shapes-inst (cph/get-children-with-self (:objects page)
root-inst-id)]
;; Validate that the tree is not an instance
(run! is-noninstance shapes-inst)
shapes-inst))
(defn resolve-instance-and-main
"Get the shape with the given id and all its children, and also
the main component and all its shapes."
[state root-inst-id]
(let [page (thp/current-page state)
root-inst (cph/get-shape page root-inst-id)
libs (dwlh/get-libraries state)
libs (wsh/get-libraries state)
component (cph/get-component libs (:component-id root-inst))
shapes-inst (cph/get-children-with-self (:objects page) root-inst-id)
@ -89,13 +95,20 @@
unique-refs (into #{} (map :shape-ref) shapes-inst)
main-exists? (fn [shape]
(t/is (some #(= (:id %) (:shape-ref shape))
shapes-main)))]
(let [component-shape
(cph/get-component-shape (:objects page) shape)
component
(cph/get-component libs (:component-id component-shape))
main-shape
(cph/get-shape component (:shape-ref shape))]
(t/is (some? main-shape))))]
;; Validate that the instance tree is well constructed
(is-instance-root (first shapes-inst))
(run! is-instance-child (rest shapes-inst))
(run! is-noninstance shapes-main)
(run! is-instance-inner (rest shapes-inst))
(t/is (= (count shapes-inst)
(count shapes-main)
(count unique-refs)))
@ -103,10 +116,44 @@
[shapes-inst shapes-main component]))
(defn resolve-instance-and-main-allow-dangling
"Get the shape with the given id and all its children, and also
the main component and all its shapes. Allows shapes with the
corresponding component shape missing."
[state root-inst-id]
(let [page (thp/current-page state)
root-inst (cph/get-shape page root-inst-id)
libs (wsh/get-libraries state)
component (cph/get-component libs (:component-id root-inst))
shapes-inst (cph/get-children-with-self (:objects page) root-inst-id)
shapes-main (cph/get-children-with-self (:objects component) (:shape-ref root-inst))
unique-refs (into #{} (map :shape-ref) shapes-inst)
main-exists? (fn [shape]
(let [component-shape
(cph/get-component-shape (:objects page) shape)
component
(cph/get-component libs (:component-id component-shape))
main-shape
(cph/get-shape component (:shape-ref shape))]
(t/is (some? main-shape))))]
;; Validate that the instance tree is well constructed
(is-instance-root (first shapes-inst))
[shapes-inst shapes-main component]))
(defn resolve-component
"Get the component with the given id and all its shapes."
[state component-id]
(let [page (thp/current-page state)
libs (dwlh/get-libraries state)
libs (wsh/get-libraries state)
component (cph/get-component libs component-id)
root-main (cph/get-component-root component)
shapes-main (cph/get-children-with-self (:objects component) (:id root-main))]

48
frontend/test/app/test_helpers/pages.cljs
View file

@ -10,10 +10,10 @@
[app.common.pages :as cp]
[app.common.pages.helpers :as cph]
[app.main.data.workspace :as dw]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.groups :as dwg]
[app.main.data.workspace.layout :as layout]
[app.main.data.workspace.libraries-helpers :as dwlh]))
[app.main.data.workspace.libraries-helpers :as dwlh]
[app.main.data.workspace.state-helpers :as wsh]))
;; ---- Helpers to manage pages and objects
@ -96,19 +96,53 @@
cp/process-changes (:redo-changes changes)))))))
(defn make-component
[state label ids]
[state instance-label component-label shape-ids]
(let [page (current-page state)
objects (wsh/lookup-page-objects state (:id page))
shapes (dwg/shapes-for-grouping objects ids)
shapes (dwg/shapes-for-grouping objects shape-ids)
[group rchanges uchanges]
[group component-root changes]
(dwlh/generate-add-component nil
shapes
(:objects page)
(:id page)
current-file-id)]
(swap! idmap assoc label (:id group))
(swap! idmap assoc instance-label (:id group)
component-label (:id component-root))
(update state :workspace-data
cp/process-changes rchanges)))
cp/process-changes (:redo-changes changes))))
(defn instantiate-component
([state label component-id]
(instantiate-component state label component-id current-file-id))
([state label component-id file-id]
(let [page (current-page state)
libraries (wsh/get-libraries state)
[new-shape changes]
(dwlh/generate-instantiate-component nil
file-id
component-id
(gpt/point 100 100)
page
libraries)]
(swap! idmap assoc label (:id new-shape))
(update state :workspace-data
cp/process-changes (:redo-changes changes)))))
(defn move-to-library
[state label name]
(let [library-id (uuid/next)
data (get state :workspace-data)]
(swap! idmap assoc label library-id)
(-> state
(update :workspace-libraries
assoc library-id {:id library-id
:name name
:data {:id library-id
:components (:components data)}})
(update :workspace-data
assoc :components {} :pages [] :pages-index {}))))