mirror of
https://github.com/penpot/penpot.git
synced 2026-02-24 02:36:45 -05:00
Compare commits
248 Commits
azazeln28-
...
revert-646
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
6703402207 | ||
|
|
f93059412a | ||
|
|
294ce7bb1b | ||
|
|
a558bfdb2f | ||
|
|
86bcd1b681 | ||
|
|
33c260c35b | ||
|
|
94312bb35c | ||
|
|
70b1989f10 | ||
|
|
c0eaa75232 | ||
|
|
dbb9971482 | ||
|
|
0828994840 | ||
|
|
e6b5618bd3 | ||
|
|
9c24d3a521 | ||
|
|
480e0887e3 | ||
|
|
e0e381bdfc | ||
|
|
5199b306aa | ||
|
|
8febfaa21e | ||
|
|
69062f03ee | ||
|
|
eb04fa19e1 | ||
|
|
03b4fe3558 | ||
|
|
b349d08155 | ||
|
|
15e9d92094 | ||
|
|
5e675dbf0b | ||
|
|
a5660819de | ||
|
|
d277fefc87 | ||
|
|
1383010826 | ||
|
|
59982c9056 | ||
|
|
afcff84e38 | ||
|
|
fc5d9659d6 | ||
|
|
8fa7fa8c4b | ||
|
|
23bde76192 | ||
|
|
ca7a80fb83 | ||
|
|
cf0d9a433d | ||
|
|
bc20598b3d | ||
|
|
9de8ebb52c | ||
|
|
568af52ebc | ||
|
|
eddabc0d68 | ||
|
|
6b300d516b | ||
|
|
e271caa32b | ||
|
|
9be569c54c | ||
|
|
7e6a621484 | ||
|
|
66b47f9444 | ||
|
|
694a2084e2 | ||
|
|
fef19a3c80 | ||
|
|
3da8b945ca | ||
|
|
8f27b82edd | ||
|
|
8b529d308c | ||
|
|
71aa8e5a86 | ||
|
|
ab01f0b274 | ||
|
|
e203536506 | ||
|
|
b71b9edee7 | ||
|
|
bd514c0594 | ||
|
|
36e1ad287c | ||
|
|
92f5b5f92b | ||
|
|
0b7b6e2c23 | ||
|
|
46709fb02e | ||
|
|
61eb2f4a19 | ||
|
|
3fe16bd8f9 | ||
|
|
a9725a1aac | ||
|
|
8f9298fac8 | ||
|
|
c3e76817cd | ||
|
|
8bdec66927 | ||
|
|
66ee9edaf8 | ||
|
|
ffd7bc883d | ||
|
|
1bcfa4b8dc | ||
|
|
99e325acaf | ||
|
|
8badd1f2eb | ||
|
|
44bf276c49 | ||
|
|
a65aa5ea44 | ||
|
|
689063cfb2 | ||
|
|
e146ce7be4 | ||
|
|
0fbd9812b3 | ||
|
|
ccd7b3bdce | ||
|
|
60f8cfd492 | ||
|
|
7359b800ce | ||
|
|
0032639831 | ||
|
|
d9cdd020e6 | ||
|
|
10d021b15e | ||
|
|
3be750410e | ||
|
|
47552830b1 | ||
|
|
0fb41f54b0 | ||
|
|
5b777921a6 | ||
|
|
42dcc81767 | ||
|
|
0f3a4db71e | ||
|
|
751bed4117 | ||
|
|
ea095a98ba | ||
|
|
348a9c82bf | ||
|
|
e2918f4148 | ||
|
|
c45187eedd | ||
|
|
eeea5f2cc8 | ||
|
|
05b6aeef3e | ||
|
|
6323031b40 | ||
|
|
6ccb6cafaa | ||
|
|
be26985ca5 | ||
|
|
2aa2525d0e | ||
|
|
7cb2f307d8 | ||
|
|
f1a557c372 | ||
|
|
202337b135 | ||
|
|
4e3abcbd45 | ||
|
|
122e5a4b57 | ||
|
|
1981946480 | ||
|
|
7d327d23a2 | ||
|
|
500c27859b | ||
|
|
c6f68e6ed1 | ||
|
|
b48faf8fe0 | ||
|
|
fa24ced3a3 | ||
|
|
b9ea2425b9 | ||
|
|
1abaff9c52 | ||
|
|
6f2ccabaa2 | ||
|
|
1c77126fe6 | ||
|
|
7196be2a23 | ||
|
|
d509b840dc | ||
|
|
61c23877c1 | ||
|
|
0e61398d67 | ||
|
|
f12656463d | ||
|
|
ba9fc37226 | ||
|
|
60f754f172 | ||
|
|
3a22545158 | ||
|
|
1d0020f6e6 | ||
|
|
f3c3f3e2d8 | ||
|
|
9ba0ae5532 | ||
|
|
db73c2eea0 | ||
|
|
753823c0b3 | ||
|
|
44e8eacb8d | ||
|
|
33bcbd89f1 | ||
|
|
b0cbe3cec8 | ||
|
|
3ca76c9ef7 | ||
|
|
93199e1a70 | ||
|
|
93a601a1e7 | ||
|
|
3d864c4ff1 | ||
|
|
da2f519805 | ||
|
|
230e330eb2 | ||
|
|
4f6dffabb4 | ||
|
|
09c3490cae | ||
|
|
1fc0203c38 | ||
|
|
f545d7b3ea | ||
|
|
b242eb5b32 | ||
|
|
be9e3fa355 | ||
|
|
fac93e4ff8 | ||
|
|
8609db2182 | ||
|
|
ec73bd640c | ||
|
|
cba65972dd | ||
|
|
e62231cfed | ||
|
|
3249fb43c3 | ||
|
|
ee0ba15f9e | ||
|
|
784aecd1a1 | ||
|
|
173d6c23b0 | ||
|
|
abc1241402 | ||
|
|
f30441626e | ||
|
|
5ae125db94 | ||
|
|
093fa18839 | ||
|
|
81f18ad7f4 | ||
|
|
875e019d4f | ||
|
|
8e18a0880e | ||
|
|
36b78e5e21 | ||
|
|
86a498fc29 | ||
|
|
aae81b8a04 | ||
|
|
486f036a11 | ||
|
|
a2c9d307df | ||
|
|
e52fd90963 | ||
|
|
f8602810eb | ||
|
|
219ddfabaf | ||
|
|
d8b3b216e9 | ||
|
|
88e5209856 | ||
|
|
c2b13a6d5d | ||
|
|
9eefe13e8b | ||
|
|
7eab6a2f1d | ||
|
|
2306df5fb7 | ||
|
|
56ecacee21 | ||
|
|
a60b3d4b08 | ||
|
|
b14798b405 | ||
|
|
8382a88efe | ||
|
|
53057c4bf2 | ||
|
|
3e0f38e8c3 | ||
|
|
a5bbe765b9 | ||
|
|
4455adc813 | ||
|
|
abca763aa5 | ||
|
|
5c74349de0 | ||
|
|
4a7b72dae1 | ||
|
|
23e17d7f30 | ||
|
|
37cf829188 | ||
|
|
f213ffabe1 | ||
|
|
a1921bb767 | ||
|
|
213c04bc8a | ||
|
|
916eb530a0 | ||
|
|
1f0644ea91 | ||
|
|
b20147255a | ||
|
|
38728eb342 | ||
|
|
18c7890f65 | ||
|
|
1c224609b9 | ||
|
|
4b81468c9c | ||
|
|
cffac2a56a | ||
|
|
05c0f8d69f | ||
|
|
5db5bc65de | ||
|
|
952ab032f9 | ||
|
|
2df6f2b8b1 | ||
|
|
62a12a64a3 | ||
|
|
6935d54870 | ||
|
|
049427c6ca | ||
|
|
65e8526ee2 | ||
|
|
8ce71e792e | ||
|
|
202762027f | ||
|
|
d95551e651 | ||
|
|
44d68ad723 | ||
|
|
9e4c9d3101 | ||
|
|
050692952e | ||
|
|
c96fbfdcd6 | ||
|
|
ab90d9d01c | ||
|
|
281c0068d9 | ||
|
|
e7b74939cb | ||
|
|
c2ae58bf08 | ||
|
|
14e8026e30 | ||
|
|
eb29a42209 | ||
|
|
6fdaad1bf4 | ||
|
|
dfa6c502dc | ||
|
|
b958dcb891 | ||
|
|
6e5d64d403 | ||
|
|
3e0c2bf1a1 | ||
|
|
9c4896d72b | ||
|
|
283cdee5d6 | ||
|
|
ab5e01e54a | ||
|
|
01fec1a0cf | ||
|
|
caf13eb774 | ||
|
|
373248e304 | ||
|
|
fef342b489 | ||
|
|
6e9adece1f | ||
|
|
80308ceafa | ||
|
|
f65518f865 | ||
|
|
c0315e2c30 | ||
|
|
2f20ccf289 | ||
|
|
1a7d60bb88 | ||
|
|
90b1895f19 | ||
|
|
7945a95522 | ||
|
|
40fe6369cb | ||
|
|
f155042958 | ||
|
|
1dd23a3f47 | ||
|
|
55da3ee275 | ||
|
|
1194e40222 | ||
|
|
05fac41534 | ||
|
|
3f85e89f62 | ||
|
|
ee0f8ad19a | ||
|
|
b7d7cf233a | ||
|
|
38a708e12b | ||
|
|
bd208c31e2 | ||
|
|
151dc352c8 | ||
|
|
ccbf17106d | ||
|
|
95c4d95fd3 | ||
|
|
e004671346 |
72
CHANGES.md
72
CHANGES.md
@@ -1,5 +1,50 @@
|
||||
# CHANGELOG
|
||||
|
||||
## 2.8.0 (Next / Unreleased)
|
||||
|
||||
### :rocket: Epics and highlights
|
||||
|
||||
### :boom: Breaking changes & Deprecations
|
||||
|
||||
**Breaking changes on penpot library:**
|
||||
|
||||
- Change the signature of the `addPage` method: it now accepts an object (as a single argument) where you can pass `id`,
|
||||
`name`, and `background` props (instead of the previous positional arguments)
|
||||
- Rename the `file.createRect` method to `file.addRect`
|
||||
- Rename the `file.createCircle` method to `file.addCircle`
|
||||
- Rename the `file.createPath` method to `file.addPath`
|
||||
- Rename the `file.createText` method to `file.addText`
|
||||
- Rename `file.startComponent` to `file.addComponent` (to preserve the naming style)
|
||||
- Rename `file.createComponentInstance` to `file.addComponentInstance` (to preserve the naming style)
|
||||
- Rename `file.lookupShape` to `file.getShape`
|
||||
- Rename `file.asMap` to `file.toMap`
|
||||
- Remove `file.updateLibraryColor` (use `file.addLibraryColor` if you just need to replace a color)
|
||||
- Remove `file.deleteLibraryColor` (this library is intended to build files)
|
||||
- Remove `file.updateLibraryTypography` (use `file.addLibraryTypography` if you just need to replace a typography)
|
||||
- Remove `file.deleteLibraryTypography` (this library is intended to build files)
|
||||
- Remove `file.add/update/deleteLibraryMedia` (they are no longer supported by Penpot and have been replaced by components)
|
||||
- Remove `file.deleteObject` (this library is intended to build files)
|
||||
- Remove `file.updateObject` (this library is intended to build files)
|
||||
- Remove `file.finishComponent` (it is no longer necessary; see below for more details on component creation changes)
|
||||
- Change the `file.getCurrentPageId` function to a read-only `file.currentPageId` property
|
||||
- Add `file.currentFrameId` read-only property
|
||||
- Add `file.lastId` read-only property
|
||||
|
||||
There are also relevant semantic changes in how components should be created: this refactor removes
|
||||
all notions of the old components (v1). Since v2, the shapes that are part of a component live on a
|
||||
page. So, from now on, to create a component, you should first create a frame, then add shapes
|
||||
and/or groups to that frame, and then create a component by declaring that frame as the component
|
||||
root.
|
||||
|
||||
### :heart: Community contributions (Thank you!)
|
||||
|
||||
### :sparkles: New features
|
||||
|
||||
- Optimize profile setup flow for better user experience [Taiga #10028](https://tree.taiga.io/project/penpot/us/10028)
|
||||
|
||||
### :bug: Bugs fixed
|
||||
|
||||
|
||||
## 2.7.0 (Unreleased)
|
||||
|
||||
### :rocket: Epics and highlights
|
||||
@@ -8,14 +53,24 @@
|
||||
|
||||
### :heart: Community contributions (Thank you!)
|
||||
|
||||
- Design improvements to the Invitations page with an empty state [GitHub #2608](https://github.com/penpot/penpot/issues/2608) by [@iprithvitharun](https://github.com/iprithvitharun)
|
||||
|
||||
### :sparkles: New features
|
||||
|
||||
- Update board presets with a newer devices [Taiga #10610](https://tree.taiga.io/project/penpot/us/10610)
|
||||
- Propagate "sharing a prototype" to editors and viewers [Taiga #8853](https://tree.taiga.io/project/penpot/us/8853)
|
||||
- Design improvements to the Invitations page with an empty state [Taiga #4554](https://tree.taiga.io/project/penpot/us/4554)
|
||||
- Duplicate token sets [Taiga #10694](https://tree.taiga.io/project/penpot/issue/10694)
|
||||
- Add set selection in create Token themes flow [Taiga #10746](https://tree.taiga.io/project/penpot/issue/10746)
|
||||
- Display indicator on not active sets [Taiga #10668](https://tree.taiga.io/project/penpot/issue/10668)
|
||||
- Create `input*` wrapper component, and `label*`, `input-field*` and `hint-message*` components [Taiga #10713](https://tree.taiga.io/project/penpot/us/10713)
|
||||
|
||||
### :bug: Bugs fixed
|
||||
|
||||
- Fix problem in viewer with the back button [Taiga #10907](https://tree.taiga.io/project/penpot/issue/10907)
|
||||
- Fix resize bar background on tokens panel [Taiga #10811](https://tree.taiga.io/project/penpot/issue/10811)
|
||||
- Fix shortcut for history version panel [Taiga #11006](https://tree.taiga.io/project/penpot/issue/11006)
|
||||
- Fix positioning of comment drafts when near the right / bottom edges of viewport [Taiga #10534](https://tree.taiga.io/project/penpot/issue/10534)
|
||||
- Fix path having a wrong selrect [Taiga #10257](https://tree.taiga.io/project/penpot/issue/10257)
|
||||
- Fix SVG `stroke-linecap` property when importing SVGs [Taiga #9489](https://tree.taiga.io/project/penpot/issue/9489)
|
||||
- Fix position problems cutting-pasting a component [Taiga #10677](https://tree.taiga.io/project/penpot/issue/10677)
|
||||
@@ -27,19 +82,34 @@
|
||||
- Fix problem with import errors [Taiga #10040](https://tree.taiga.io/project/penpot/issue/10040)
|
||||
- Fix color gradient on texts [Taiga Issue #7488](https://tree.taiga.io/project/penpot/issue/7488)
|
||||
- Add support for self mentions [Taiga #10809](https://tree.taiga.io/project/penpot/issue/10809)
|
||||
- Fix team info settings alignment [Taiga #10869](https://tree.taiga.io/project/penpot/issue/10869)
|
||||
- Fix left sidebar horizontal scroll on nested layers [Taiga #10791](https://tree.taiga.io/project/penpot/issue/10791)
|
||||
- Improve error message details importing tokens [Taiga Issue #10772](https://tree.taiga.io/project/penpot/issue/10772)
|
||||
- Fix no selected set after Drag & Drop [Github #71](https://github.com/tokens-studio/penpot/issues/71)
|
||||
- Styledictionary v5 Update [Github #6283](https://github.com/penpot/penpot/pull/6283)
|
||||
- Fix Rename a set throws an internal error [Github #78](https://github.com/tokens-studio/penpot/issues/78)
|
||||
- Fix Out of Sync Token Value & Color Picker [Github #102](https://github.com/tokens-studio/penpot/issues/102)
|
||||
- Fix Color should preserve color space [Github #69](https://github.com/tokens-studio/penpot/issues/69)
|
||||
- Fix cannot rename Design Token Sets when group of same name exists [Taiga Issue #10773](https://tree.taiga.io/project/penpot/issue/10773)
|
||||
- Fix problem when duplicating grid layout [Github #6391](https://github.com/penpot/penpot/issues/6391)
|
||||
- Fix issue that makes workspace shortcuts stop working [Taiga #11062](https://tree.taiga.io/project/penpot/issue/11062)
|
||||
|
||||
## 2.6.2 (Unreleased)
|
||||
## 2.6.2
|
||||
|
||||
### :bug: Bugs fixed
|
||||
|
||||
- Increase the height of the right sidebar dropdowns [Taiga #10615](https://tree.taiga.io/project/penpot/issue/10615)
|
||||
- Fix scroll on token themes modal [Taiga #10745](https://tree.taiga.io/project/penpot/issue/10745)
|
||||
- Fix collapsing grouped sets in "edit Theme" closes the dialog [Taiga #10771](https://tree.taiga.io/project/penpot/issue/10771)
|
||||
- Fix unexpected exception on path editor on merge segments when undo stack is empty
|
||||
- Fix pricing CTA to be under a config flag [Taiga #10808](https://tree.taiga.io/project/penpot/issue/10808)
|
||||
- Fix allow moving a main component into another [Taiga #10818](https://tree.taiga.io/project/penpot/issue/10818)
|
||||
- Fix several issues with internal srepl helpers
|
||||
- Fix unexpected exception on template import from libraries
|
||||
- Fix incorrect uuid parsing from different parts of code
|
||||
- Fix update layout on component restore [Taiga #10637](https://tree.taiga.io/project/penpot/issue/10637)
|
||||
- Fix horizontal scroll in viewer [Github #6290](https://github.com/penpot/penpot/issues/6290)
|
||||
- Fix detach component in a particular case [Taiga #10837](https://tree.taiga.io/project/penpot/issue/10837)
|
||||
|
||||
## 2.6.1
|
||||
|
||||
|
||||
@@ -35,40 +35,35 @@ def get_prepl_conninfo():
|
||||
|
||||
return host, port
|
||||
|
||||
def send_eval(expr):
|
||||
def send(data):
|
||||
host, port = get_prepl_conninfo()
|
||||
with socket.create_connection((host, port)) as s:
|
||||
f = s.makefile(mode="rw")
|
||||
|
||||
with socket.socket(socket.AF_INET, socket.SOCK_STREAM) as s:
|
||||
s.connect((host, port))
|
||||
s.send(expr.encode("utf-8"))
|
||||
s.send(b":repl/quit\n\n")
|
||||
json.dump(data, f)
|
||||
f.write("\n")
|
||||
f.flush()
|
||||
|
||||
with s.makefile() as f:
|
||||
while True:
|
||||
line = f.readline()
|
||||
result = json.loads(line)
|
||||
tag = result.get("tag", None)
|
||||
if tag == "ret":
|
||||
return result.get("val", None), result.get("exception", None)
|
||||
elif tag == "out":
|
||||
print(result.get("val"), end="")
|
||||
else:
|
||||
raise RuntimeError("unexpected response from PREPL")
|
||||
while True:
|
||||
line = f.readline()
|
||||
result = json.loads(line)
|
||||
tag = result.get("tag", None)
|
||||
|
||||
def encode(val):
|
||||
return json.dumps(json.dumps(val))
|
||||
if tag == "ret":
|
||||
return result.get("val", None), result.get("err", None)
|
||||
elif tag == "out":
|
||||
print(result.get("val"), end="")
|
||||
else:
|
||||
raise RuntimeError("unexpected response from PREPL")
|
||||
|
||||
def print_error(res):
|
||||
for error in res["via"]:
|
||||
print("ERR:", error["message"])
|
||||
break
|
||||
def print_error(error):
|
||||
print("ERR:", error["hint"])
|
||||
|
||||
def run_cmd(params):
|
||||
try:
|
||||
expr = "(app.srepl.cli/exec {})".format(encode(params))
|
||||
res, failed = send_eval(expr)
|
||||
if failed:
|
||||
print_error(res)
|
||||
res, err = send(params)
|
||||
if err:
|
||||
print_error(err)
|
||||
sys.exit(-1)
|
||||
|
||||
return res
|
||||
@@ -96,7 +91,7 @@ def update_profile(email, fullname, password, is_active):
|
||||
"email": email,
|
||||
"fullname": fullname,
|
||||
"password": password,
|
||||
"is_active": is_active
|
||||
"isActive": is_active
|
||||
}
|
||||
}
|
||||
|
||||
@@ -138,7 +133,7 @@ def derive_password(password):
|
||||
params = {
|
||||
"cmd": "derive-password",
|
||||
"params": {
|
||||
"password": password,
|
||||
"password": password
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
107
backend/src/app/binfile/cleaner.clj
Normal file
107
backend/src/app/binfile/cleaner.clj
Normal file
@@ -0,0 +1,107 @@
|
||||
;; 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 app.binfile.cleaner
|
||||
"A collection of helpers for perform cleaning of artifacts; mainly
|
||||
for recently imported shapes."
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.uuid :as uuid]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PRE DECODE
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn clean-shape-pre-decode
|
||||
"Applies a pre-decode phase migration to the shape"
|
||||
[shape]
|
||||
(if (= "bool" (:type shape))
|
||||
(if-let [content (get shape :bool-content)]
|
||||
(-> shape
|
||||
(assoc :content content)
|
||||
(dissoc :bool-content))
|
||||
shape)
|
||||
shape))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; POST DECODE
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn- fix-shape-shadow-color
|
||||
"Some shapes can come with invalid `id` property on shadow colors
|
||||
caused by incorrect uuid parsing bug that should be already fixed;
|
||||
this function removes the invalid id from the data structure."
|
||||
[shape]
|
||||
(let [fix-color
|
||||
(fn [{:keys [id] :as color}]
|
||||
(if (uuid? id)
|
||||
color
|
||||
(if (and (string? id)
|
||||
(re-matches uuid/regex id))
|
||||
(assoc color :id (uuid/uuid id))
|
||||
(dissoc color :id))))
|
||||
|
||||
fix-shadow
|
||||
(fn [shadow]
|
||||
(d/update-when shadow :color fix-color))
|
||||
|
||||
xform
|
||||
(map fix-shadow)]
|
||||
|
||||
(d/update-when shape :shadow
|
||||
(fn [shadows]
|
||||
(into [] xform shadows)))))
|
||||
|
||||
(defn- fix-root-shape
|
||||
"Ensure all root objects are well formed shapes"
|
||||
[shape]
|
||||
(if (= (:id shape) uuid/zero)
|
||||
(-> shape
|
||||
(assoc :parent-id uuid/zero)
|
||||
(assoc :frame-id uuid/zero)
|
||||
;; We explicitly dissoc them and let the shape-setup
|
||||
;; to regenerate it with valid values.
|
||||
(dissoc :selrect)
|
||||
(dissoc :points)
|
||||
(cts/setup-shape))
|
||||
shape))
|
||||
|
||||
(defn- fix-legacy-flex-dir
|
||||
"This operation is only relevant to old data and it is fixed just
|
||||
for convenience."
|
||||
[shape]
|
||||
(d/update-when shape :layout-flex-dir
|
||||
(fn [dir]
|
||||
(case dir
|
||||
:reverse-row :row-reverse
|
||||
:reverse-column :column-reverse
|
||||
dir))))
|
||||
|
||||
(defn clean-shape-post-decode
|
||||
"A shape procesor that expected to be executed after schema decoding
|
||||
process but before validation."
|
||||
[shape]
|
||||
(-> shape
|
||||
(fix-shape-shadow-color)
|
||||
(fix-root-shape)
|
||||
(fix-legacy-flex-dir)))
|
||||
|
||||
(defn- fix-container
|
||||
[container]
|
||||
(-> container
|
||||
;; Remove possible `nil` keys on objects
|
||||
(d/update-when :objects dissoc nil)
|
||||
(d/update-when :objects d/update-vals clean-shape-post-decode)))
|
||||
|
||||
(defn clean-file
|
||||
[file & {:as _opts}]
|
||||
(update file :data
|
||||
(fn [data]
|
||||
(-> data
|
||||
(d/update-when :pages-index d/update-vals fix-container)
|
||||
(d/update-when :components d/update-vals fix-container)
|
||||
(d/without-nils)))))
|
||||
@@ -431,15 +431,21 @@
|
||||
(update :components relink-shapes)
|
||||
(update :media relink-media)
|
||||
(update :colors relink-colors)
|
||||
(d/without-nils))))))
|
||||
(d/without-nils))))
|
||||
|
||||
;; NOTE: this is necessary because when we just creating a new
|
||||
;; file from imported artifact or cloned file there are no
|
||||
;; migrations registered on the database, so we need to persist
|
||||
;; all of them, not only the applied
|
||||
(vary-meta dissoc ::fmg/migrated)))
|
||||
|
||||
(defn encode-file
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
|
||||
(let [file (if (contains? (:features file) "fdata/objects-map")
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id features] :as file}]
|
||||
(let [file (if (contains? features "fdata/objects-map")
|
||||
(feat.fdata/enable-objects-map file)
|
||||
file)
|
||||
|
||||
file (if (contains? (:features file) "fdata/pointer-map")
|
||||
file (if (contains? features "fdata/pointer-map")
|
||||
(binding [pmap/*tracked* (pmap/create-tracked)]
|
||||
(let [file (feat.fdata/enable-pointer-map file)]
|
||||
(feat.fdata/persist-pointers! cfg id)
|
||||
|
||||
@@ -8,12 +8,14 @@
|
||||
"A ZIP based binary file exportation"
|
||||
(:refer-clojure :exclude [read])
|
||||
(:require
|
||||
[app.binfile.cleaner :as bfl]
|
||||
[app.binfile.common :as bfc]
|
||||
[app.binfile.migrations :as bfm]
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.features :as cfeat]
|
||||
[app.common.files.migrations :as-alias fmg]
|
||||
[app.common.json :as json]
|
||||
[app.common.logging :as l]
|
||||
[app.common.schema :as sm]
|
||||
@@ -592,6 +594,38 @@
|
||||
{})
|
||||
(not-empty)))
|
||||
|
||||
(defn- read-file-components
|
||||
[{:keys [::bfc/input ::file-id ::entries]}]
|
||||
(let [clean-component-post-decode
|
||||
(fn [component]
|
||||
(d/update-when component :objects
|
||||
(fn [objects]
|
||||
(reduce-kv (fn [objects id shape]
|
||||
(assoc objects id (bfl/clean-shape-post-decode shape)))
|
||||
objects
|
||||
objects))))
|
||||
clean-component-pre-decode
|
||||
(fn [component]
|
||||
(d/update-when component :objects
|
||||
(fn [objects]
|
||||
(reduce-kv (fn [objects id shape]
|
||||
(assoc objects id (bfl/clean-shape-pre-decode shape)))
|
||||
objects
|
||||
objects))))]
|
||||
|
||||
(->> (keep (match-component-entry-fn file-id) entries)
|
||||
(reduce (fn [result {:keys [id entry]}]
|
||||
(let [object (->> (read-entry input entry)
|
||||
(clean-component-pre-decode)
|
||||
(decode-component)
|
||||
(clean-component-post-decode)
|
||||
(validate-component))]
|
||||
(if (= id (:id object))
|
||||
(assoc result id object)
|
||||
result)))
|
||||
{})
|
||||
(not-empty))))
|
||||
|
||||
(defn- read-file-typographies
|
||||
[{:keys [::bfc/input ::file-id ::entries]}]
|
||||
(->> (keep (match-typography-entry-fn file-id) entries)
|
||||
@@ -612,49 +646,15 @@
|
||||
(decode-tokens-lib)
|
||||
(validate-tokens-lib))))
|
||||
|
||||
(defn- pre-decode-migrate-shape
|
||||
"Applies a pre-decode phase migration to the shape"
|
||||
[shape]
|
||||
(if (= "bool" (:type shape))
|
||||
(if-let [content (get shape :bool-content)]
|
||||
(-> shape
|
||||
(assoc :content content)
|
||||
(dissoc :bool-content))
|
||||
shape)
|
||||
shape))
|
||||
|
||||
(defn- pre-decode-migrate-component
|
||||
"Applies a pre-decode phase migration to component"
|
||||
[component]
|
||||
(d/update-when component :objects
|
||||
(fn [objects]
|
||||
(reduce-kv (fn [objects id shape]
|
||||
(assoc objects id (pre-decode-migrate-shape shape)))
|
||||
objects
|
||||
objects))))
|
||||
|
||||
(defn- read-file-components
|
||||
[{:keys [::bfc/input ::file-id ::entries]}]
|
||||
(->> (keep (match-component-entry-fn file-id) entries)
|
||||
(reduce (fn [result {:keys [id entry]}]
|
||||
(let [object (->> (read-entry input entry)
|
||||
(pre-decode-migrate-component)
|
||||
(decode-component)
|
||||
(validate-component))]
|
||||
(if (= id (:id object))
|
||||
(assoc result id object)
|
||||
result)))
|
||||
{})
|
||||
(not-empty)))
|
||||
|
||||
(defn- read-file-shapes
|
||||
[{:keys [::bfc/input ::file-id ::page-id ::entries] :as cfg}]
|
||||
(->> (keep (match-shape-entry-fn file-id page-id) entries)
|
||||
(reduce (fn [result {:keys [id entry]}]
|
||||
(let [object (-> (read-entry input entry)
|
||||
(pre-decode-migrate-shape)
|
||||
(decode-shape)
|
||||
(validate-shape))]
|
||||
(let [object (->> (read-entry input entry)
|
||||
(bfl/clean-shape-pre-decode)
|
||||
(decode-shape)
|
||||
(bfl/clean-shape-post-decode)
|
||||
(validate-shape))]
|
||||
(if (= id (:id object))
|
||||
(assoc result id object)
|
||||
result)))
|
||||
|
||||
@@ -42,6 +42,8 @@
|
||||
org.postgresql.util.PGInterval
|
||||
org.postgresql.util.PGobject))
|
||||
|
||||
(def ^:dynamic *conn* nil)
|
||||
|
||||
(declare open)
|
||||
(declare create-pool)
|
||||
|
||||
|
||||
@@ -20,7 +20,6 @@
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.geom.shapes.path :as gshp]
|
||||
[app.common.logging :as l]
|
||||
[app.common.logic.libraries :as cll]
|
||||
[app.common.math :as mth]
|
||||
@@ -36,9 +35,9 @@
|
||||
[app.common.types.modifiers :as ctm]
|
||||
[app.common.types.page :as ctp]
|
||||
[app.common.types.pages-list :as ctpl]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.types.shape-tree :as ctst]
|
||||
[app.common.types.shape.path :as ctsp]
|
||||
[app.common.types.shape.text :as ctsx]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.config :as cf]
|
||||
@@ -127,10 +126,10 @@
|
||||
(sm/lazy-validator ::ctsx/content))
|
||||
|
||||
(def valid-path-content?
|
||||
(sm/lazy-validator ::ctsp/content))
|
||||
(sm/lazy-validator ::path/segments))
|
||||
|
||||
(def valid-path-segment?
|
||||
(sm/lazy-validator ::ctsp/segment))
|
||||
(sm/lazy-validator ::path/segment))
|
||||
|
||||
(def valid-rgb-color-string?
|
||||
(sm/lazy-validator ::ctc/rgb-color))
|
||||
@@ -580,12 +579,10 @@
|
||||
(let [shape (update shape :content fix-path-content)]
|
||||
(if (not (valid-path-content? (:content shape)))
|
||||
shape
|
||||
(let [[points selrect] (gshp/content->points+selrect shape (:content shape))]
|
||||
(-> shape
|
||||
(dissoc :bool-content)
|
||||
(dissoc :bool-type)
|
||||
(assoc :points points)
|
||||
(assoc :selrect selrect)))))
|
||||
(-> shape
|
||||
(dissoc :bool-content)
|
||||
(dissoc :bool-type)
|
||||
(path/update-geometry))))
|
||||
|
||||
;; When we fount a bool shape with no content,
|
||||
;; we convert it to a simple rect
|
||||
|
||||
@@ -9,7 +9,10 @@
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.files.migrations :as fmg]
|
||||
[app.common.logging :as l]
|
||||
[app.common.types.path :as path]
|
||||
[app.db :as db]
|
||||
[app.db.sql :as-alias sql]
|
||||
[app.storage :as sto]
|
||||
@@ -30,7 +33,7 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn enable-objects-map
|
||||
[file]
|
||||
[file & _opts]
|
||||
(let [update-page
|
||||
(fn [page]
|
||||
(if (and (pmap/pointer-map? page)
|
||||
@@ -136,10 +139,56 @@
|
||||
|
||||
(defn enable-pointer-map
|
||||
"Enable the fdata/pointer-map feature on the file."
|
||||
[file]
|
||||
[file & _opts]
|
||||
(-> file
|
||||
(update :data (fn [fdata]
|
||||
(-> fdata
|
||||
(update :pages-index d/update-vals pmap/wrap)
|
||||
(d/update-when :components pmap/wrap))))
|
||||
(update :features conj "fdata/pointer-map")))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PATH-DATA
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn enable-path-data
|
||||
"Enable the fdata/path-data feature on the file."
|
||||
[file & _opts]
|
||||
(letfn [(update-object [object]
|
||||
(if (or (cfh/path-shape? object)
|
||||
(cfh/bool-shape? object))
|
||||
(update object :content path/content)
|
||||
object))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> file
|
||||
(update :data (fn [data]
|
||||
(-> data
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
(update :features conj "fdata/path-data"))))
|
||||
|
||||
(defn disable-path-data
|
||||
[file & _opts]
|
||||
(letfn [(update-object [object]
|
||||
(if (or (cfh/path-shape? object)
|
||||
(cfh/bool-shape? object))
|
||||
(update object :content vec)
|
||||
object))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(when-let [conn db/*conn*]
|
||||
(db/delete! conn :file-migration {:file-id (:id file)
|
||||
:name "0003-convert-path-content"}))
|
||||
(-> file
|
||||
(update :data (fn [data]
|
||||
(-> data
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
(update :features disj "fdata/path-data")
|
||||
(update :migrations disj "0003-convert-path-content")
|
||||
(vary-meta update ::fmg/migrated disj "0003-convert-path-content"))))
|
||||
|
||||
@@ -108,6 +108,7 @@
|
||||
[::ip-addr {:optional true} ::sm/text]
|
||||
[::props {:optional true} [:map-of :keyword :any]]
|
||||
[::context {:optional true} [:map-of :keyword :any]]
|
||||
[::tracked-at {:optional true} ::sm/inst]
|
||||
[::webhooks/event? {:optional true} ::sm/boolean]
|
||||
[::webhooks/batch-timeout {:optional true} ::dt/duration]
|
||||
[::webhooks/batch-key {:optional true}
|
||||
@@ -118,12 +119,12 @@
|
||||
|
||||
(defn prepare-event
|
||||
[cfg mdata params result]
|
||||
(let [resultm (meta result)
|
||||
request (-> params meta ::http/request)
|
||||
profile-id (or (::profile-id resultm)
|
||||
(:profile-id result)
|
||||
(::rpc/profile-id params)
|
||||
uuid/zero)
|
||||
(let [resultm (meta result)
|
||||
request (-> params meta ::http/request)
|
||||
profile-id (or (::profile-id resultm)
|
||||
(:profile-id result)
|
||||
(::rpc/profile-id params)
|
||||
uuid/zero)
|
||||
|
||||
session-id (get params ::rpc/external-session-id)
|
||||
event-origin (get params ::rpc/external-event-origin)
|
||||
@@ -135,14 +136,14 @@
|
||||
|
||||
(clean-props))
|
||||
|
||||
token-id (::actoken/id request)
|
||||
context (-> (::context resultm)
|
||||
(assoc :external-session-id session-id)
|
||||
(assoc :external-event-origin event-origin)
|
||||
(assoc :access-token-id (some-> token-id str))
|
||||
(d/without-nils))
|
||||
token-id (::actoken/id request)
|
||||
context (-> (::context resultm)
|
||||
(assoc :external-session-id session-id)
|
||||
(assoc :external-event-origin event-origin)
|
||||
(assoc :access-token-id (some-> token-id str))
|
||||
(d/without-nils))
|
||||
|
||||
ip-addr (inet/parse-request request)]
|
||||
ip-addr (inet/parse-request request)]
|
||||
|
||||
{::type (or (::type resultm)
|
||||
(::rpc/type cfg))
|
||||
|
||||
@@ -15,6 +15,7 @@
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.http.client :as http]
|
||||
[app.loggers.audit :as audit]
|
||||
[app.util.time :as dt]
|
||||
[app.worker :as wrk]
|
||||
[clojure.data.json :as json]
|
||||
@@ -67,18 +68,27 @@
|
||||
(defmethod ig/init-key ::process-event-handler
|
||||
[_ cfg]
|
||||
(fn [{:keys [props] :as task}]
|
||||
(l/dbg :hint "process webhook event" :name (:name props))
|
||||
|
||||
(when-let [items (lookup-webhooks cfg props)]
|
||||
(l/trc :hint "webhooks found for event" :total (count items))
|
||||
(db/tx-run! cfg (fn [cfg]
|
||||
(doseq [item items]
|
||||
(wrk/submit! (-> cfg
|
||||
(assoc ::wrk/task :run-webhook)
|
||||
(assoc ::wrk/queue :webhooks)
|
||||
(assoc ::wrk/max-retries 3)
|
||||
(assoc ::wrk/params {:event props
|
||||
:config item})))))))))
|
||||
(let [items (lookup-webhooks cfg props)
|
||||
event {::audit/profile-id (:profile-id props)
|
||||
::audit/name "webhook"
|
||||
::audit/type "trigger"
|
||||
::audit/props {:name (get props :name)
|
||||
:event-id (get props :id)
|
||||
:total-affected (count items)}}]
|
||||
|
||||
(audit/insert! cfg event)
|
||||
|
||||
(when items
|
||||
(l/trc :hint "webhooks found for event" :total (count items))
|
||||
(db/tx-run! cfg (fn [cfg]
|
||||
(doseq [item items]
|
||||
(wrk/submit! (-> cfg
|
||||
(assoc ::wrk/task :run-webhook)
|
||||
(assoc ::wrk/queue :webhooks)
|
||||
(assoc ::wrk/max-retries 3)
|
||||
(assoc ::wrk/params {:event props
|
||||
:config item}))))))))))
|
||||
;; --- RUN
|
||||
|
||||
(declare interpret-exception)
|
||||
|
||||
@@ -231,7 +231,7 @@
|
||||
:hint "email has complaint reports")))
|
||||
|
||||
(defn prepare-register
|
||||
[{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
|
||||
[{:keys [::db/pool] :as cfg} {:keys [email accept-newsletter-updates] :as params}]
|
||||
|
||||
(validate-register-attempt! cfg params)
|
||||
|
||||
@@ -243,7 +243,8 @@
|
||||
:backend "penpot"
|
||||
:iss :prepared-register
|
||||
:profile-id (:id profile)
|
||||
:exp (dt/in-future {:days 7})}
|
||||
:exp (dt/in-future {:days 7})
|
||||
:props {:newsletter-updates (or accept-newsletter-updates false)}}
|
||||
|
||||
params (d/without-nils params)
|
||||
token (tokens/generate (::setup/props cfg) params)]
|
||||
|
||||
@@ -208,7 +208,7 @@
|
||||
[:project-id {:optional true} ::sm/uuid]])
|
||||
|
||||
(defn- migrate-file
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id] :as file} {:keys [read-only?]}]
|
||||
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
|
||||
pmap/*tracked* (pmap/create-tracked)]
|
||||
(let [;; For avoid unnecesary overhead of creating multiple pointers and
|
||||
@@ -219,43 +219,45 @@
|
||||
file (-> file
|
||||
(update :data feat.fdata/process-pointers deref)
|
||||
(update :data feat.fdata/process-objects (partial into {}))
|
||||
(fmg/migrate-file))
|
||||
(fmg/migrate-file))]
|
||||
|
||||
;; When file is migrated, we break the rule of no perform
|
||||
;; mutations on get operations and update the file with all
|
||||
;; migrations applied
|
||||
;;
|
||||
;; WARN: he following code will not work on read-only mode,
|
||||
;; it is a known issue; we keep is not implemented until we
|
||||
;; really need this.
|
||||
file (if (contains? (:features file) "fdata/objects-map")
|
||||
(feat.fdata/enable-objects-map file)
|
||||
file)
|
||||
file (if (contains? (:features file) "fdata/pointer-map")
|
||||
(feat.fdata/enable-pointer-map file)
|
||||
file)]
|
||||
(if (or read-only? (db/read-only? conn))
|
||||
file
|
||||
(let [;; When file is migrated, we break the rule of no perform
|
||||
;; mutations on get operations and update the file with all
|
||||
;; migrations applied
|
||||
file (if (contains? (:features file) "fdata/objects-map")
|
||||
(feat.fdata/enable-objects-map file)
|
||||
file)
|
||||
file (if (contains? (:features file) "fdata/pointer-map")
|
||||
(feat.fdata/enable-pointer-map file)
|
||||
file)]
|
||||
|
||||
(db/update! conn :file
|
||||
{:data (blob/encode (:data file))
|
||||
:version (:version file)
|
||||
:features (db/create-array conn "text" (:features file))}
|
||||
{:id id})
|
||||
(db/update! conn :file
|
||||
{:data (blob/encode (:data file))
|
||||
:version (:version file)
|
||||
:features (db/create-array conn "text" (:features file))}
|
||||
{:id id}
|
||||
{::db/return-keys false})
|
||||
|
||||
(when (contains? (:features file) "fdata/pointer-map")
|
||||
(feat.fdata/persist-pointers! cfg id))
|
||||
(when (contains? (:features file) "fdata/pointer-map")
|
||||
(feat.fdata/persist-pointers! cfg id))
|
||||
|
||||
(feat.fmigr/upsert-migrations! conn file)
|
||||
(feat.fmigr/resolve-applied-migrations cfg file))))
|
||||
(feat.fmigr/upsert-migrations! conn file)
|
||||
(feat.fmigr/resolve-applied-migrations cfg file))))))
|
||||
|
||||
(defn get-file
|
||||
[{:keys [::db/conn ::wrk/executor] :as cfg} id
|
||||
& {:keys [project-id
|
||||
migrate?
|
||||
include-deleted?
|
||||
lock-for-update?]
|
||||
lock-for-update?
|
||||
preload-pointers?]
|
||||
:or {include-deleted? false
|
||||
lock-for-update? false
|
||||
migrate? true}}]
|
||||
migrate? true
|
||||
preload-pointers? false}
|
||||
:as options}]
|
||||
|
||||
(assert (db/connection? conn) "expected cfg with valid connection")
|
||||
|
||||
@@ -273,10 +275,16 @@
|
||||
;; because it has heavy and synchronous operations for
|
||||
;; decoding file body that are not very friendly with virtual
|
||||
;; threads.
|
||||
file (px/invoke! executor #(decode-row file))]
|
||||
file (px/invoke! executor #(decode-row file))
|
||||
|
||||
file (if (and migrate? (fmg/need-migration? file))
|
||||
(migrate-file cfg file options)
|
||||
file)]
|
||||
|
||||
(if preload-pointers?
|
||||
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
|
||||
(update file :data feat.fdata/process-pointers deref))
|
||||
|
||||
(if (and migrate? (fmg/need-migration? file))
|
||||
(migrate-file cfg file)
|
||||
file)))
|
||||
|
||||
(defn get-minimal-file
|
||||
@@ -292,7 +300,7 @@
|
||||
|
||||
(defn get-file-etag
|
||||
[{:keys [::rpc/profile-id]} {:keys [modified-at revn vern permissions]}]
|
||||
(str profile-id "/" revn "/" vern "/"
|
||||
(str profile-id "/" revn "/" vern "/" (hash fmg/available-migrations) "/"
|
||||
(dt/format-instant modified-at :iso)
|
||||
"/"
|
||||
(uri/map->query-string permissions)))
|
||||
@@ -484,7 +492,7 @@
|
||||
|
||||
(let [perms (get-permissions conn profile-id file-id share-id)
|
||||
|
||||
file (get-file cfg file-id)
|
||||
file (get-file cfg file-id :read-only? true)
|
||||
|
||||
proj (db/get conn :project {:id (:project-id file)})
|
||||
|
||||
@@ -741,7 +749,9 @@
|
||||
:project-id project-id
|
||||
:file-id id)
|
||||
|
||||
file (get-file cfg id :project-id project-id)]
|
||||
file (get-file cfg id
|
||||
:project-id project-id
|
||||
:read-only? true)]
|
||||
|
||||
(-> (cfeat/get-team-enabled-features cf/flags team)
|
||||
(cfeat/check-client-features! (:features params))
|
||||
|
||||
@@ -55,8 +55,8 @@
|
||||
:features features
|
||||
:ignore-sync-until ignore-sync-until
|
||||
:modified-at modified-at
|
||||
:deleted-at deleted-at
|
||||
:create-page create-page
|
||||
:deleted-at deleted-at}
|
||||
{:create-page create-page
|
||||
:page-id page-id})
|
||||
file (-> (bfc/insert-file! cfg file)
|
||||
(bfc/decode-row))]
|
||||
@@ -111,18 +111,21 @@
|
||||
::quotes/profile-id profile-id
|
||||
::quotes/project-id project-id})
|
||||
|
||||
;; FIXME: IMPORTANT: this code can have race
|
||||
;; conditions, because we have no locks for updating
|
||||
;; team so, creating two files concurrently can lead
|
||||
;; to lost team features updating
|
||||
;; FIXME: IMPORTANT: this code can have race conditions, because
|
||||
;; we have no locks for updating team so, creating two files
|
||||
;; concurrently can lead to lost team features updating
|
||||
|
||||
;; When newly computed features does not match exactly with
|
||||
;; the features defined on team row, we update it
|
||||
(when (not= features (:features team))
|
||||
(let [features (db/create-array conn "text" features)]
|
||||
(when-let [features (-> features
|
||||
(set/difference (:features team))
|
||||
(set/difference cfeat/no-team-inheritable-features)
|
||||
(not-empty))]
|
||||
(let [features (->> features
|
||||
(set/union (:features team))
|
||||
(db/create-array conn "text"))]
|
||||
(db/update! conn :team
|
||||
{:features features}
|
||||
{:id team-id})))
|
||||
{:id (:id team)}
|
||||
{::db/return-keys false})))
|
||||
|
||||
(-> (create-file cfg params)
|
||||
(vary-meta assoc ::audit/props {:team-id team-id}))))
|
||||
|
||||
@@ -10,7 +10,6 @@
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.features :as cfeat]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.files.migrations :as fmg]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.thumbnails :as thc]
|
||||
@@ -18,7 +17,6 @@
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.db.sql :as-alias sql]
|
||||
[app.features.fdata :as feat.fdata]
|
||||
[app.loggers.audit :as-alias audit]
|
||||
[app.loggers.webhooks :as-alias webhooks]
|
||||
[app.media :as media]
|
||||
@@ -180,8 +178,7 @@
|
||||
(def ^:private
|
||||
schema:get-file-data-for-thumbnail
|
||||
[:map {:title "get-file-data-for-thumbnail"}
|
||||
[:file-id ::sm/uuid]
|
||||
[:features {:optional true} ::cfeat/features]])
|
||||
[:file-id ::sm/uuid]])
|
||||
|
||||
(def ^:private
|
||||
schema:partial-file
|
||||
@@ -201,17 +198,15 @@
|
||||
(db/run! cfg (fn [{:keys [::db/conn] :as cfg}]
|
||||
(files/check-read-permissions! conn profile-id file-id)
|
||||
|
||||
(let [team (teams/get-team conn
|
||||
:profile-id profile-id
|
||||
:file-id file-id)
|
||||
(let [team (teams/get-team conn
|
||||
:profile-id profile-id
|
||||
:file-id file-id)
|
||||
|
||||
file (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
|
||||
(-> (files/get-file cfg file-id :migrate? false)
|
||||
(update :data feat.fdata/process-pointers deref)
|
||||
(fmg/migrate-file)))]
|
||||
file (files/get-file cfg file-id
|
||||
:preload-pointers? true
|
||||
:read-only? true)]
|
||||
|
||||
(-> (cfeat/get-team-enabled-features cf/flags team)
|
||||
(cfeat/check-client-features! (:features params))
|
||||
(cfeat/check-file-features! (:features file)))
|
||||
|
||||
{:file-id file-id
|
||||
|
||||
@@ -177,12 +177,19 @@
|
||||
:stored-revn (:revn file)}))
|
||||
|
||||
;; When newly computed features does not match exactly with
|
||||
;; the features defined on team row, we update it.
|
||||
(when (not= features (:features team))
|
||||
(let [features (db/create-array conn "text" features)]
|
||||
;; the features defined on team row, we update it
|
||||
(when-let [features (-> features
|
||||
(set/difference (:features team))
|
||||
(set/difference cfeat/no-team-inheritable-features)
|
||||
(not-empty))]
|
||||
(let [features (->> features
|
||||
(set/union (:features team))
|
||||
(db/create-array conn "text"))]
|
||||
(db/update! conn :team
|
||||
{:features features}
|
||||
{:id (:id team)})))
|
||||
{:id (:id team)}
|
||||
{::db/return-keys false})))
|
||||
|
||||
|
||||
(mtx/run! metrics {:id :update-file-changes :inc (count changes)})
|
||||
|
||||
|
||||
@@ -76,9 +76,10 @@
|
||||
(perms/make-check-fn has-read-permissions?))
|
||||
|
||||
(defn decode-row
|
||||
[{:keys [features] :as row}]
|
||||
[{:keys [features subscription] :as row}]
|
||||
(cond-> row
|
||||
(some? features) (assoc :features (db/decode-pgarray features #{}))))
|
||||
(some? features) (assoc :features (db/decode-pgarray features #{}))
|
||||
(some? subscription) (assoc :subscription (db/decode-transit-pgobject subscription))))
|
||||
|
||||
;; FIXME: move
|
||||
|
||||
@@ -126,16 +127,40 @@
|
||||
(get-teams conn profile-id)))
|
||||
|
||||
(def sql:get-teams-with-permissions
|
||||
"select t.*,
|
||||
"SELECT t.*,
|
||||
tp.is_owner,
|
||||
tp.is_admin,
|
||||
tp.can_edit,
|
||||
(t.id = ?) as is_default
|
||||
from team_profile_rel as tp
|
||||
join team as t on (t.id = tp.team_id)
|
||||
where t.deleted_at is null
|
||||
and tp.profile_id = ?
|
||||
order by tp.created_at asc")
|
||||
(t.id = ?) AS is_default
|
||||
FROM team_profile_rel AS tp
|
||||
JOIN team AS t ON (t.id = tp.team_id)
|
||||
WHERE t.deleted_at IS null
|
||||
AND tp.profile_id = ?
|
||||
ORDER BY tp.created_at ASC")
|
||||
|
||||
(def sql:get-teams-with-permissions-and-subscription
|
||||
"SELECT t.*,
|
||||
tp.is_owner,
|
||||
tp.is_admin,
|
||||
tp.can_edit,
|
||||
(t.id = ?) AS is_default,
|
||||
|
||||
jsonb_build_object(
|
||||
'~:type', COALESCE(p.props->'~:subscription'->>'~:type', 'professional'),
|
||||
'~:status', CASE COALESCE(p.props->'~:subscription'->>'~:type', 'professional')
|
||||
WHEN 'professional' THEN 'active'
|
||||
ELSE COALESCE(p.props->'~:subscription'->>'~:status', 'incomplete')
|
||||
END
|
||||
) AS subscription
|
||||
FROM team_profile_rel AS tp
|
||||
JOIN team AS t ON (t.id = tp.team_id)
|
||||
JOIN team_profile_rel AS tpr
|
||||
ON (tpr.team_id = t.id AND tpr.is_owner IS true)
|
||||
JOIN profile AS p
|
||||
ON (tpr.profile_id = p.id)
|
||||
WHERE t.deleted_at IS null
|
||||
AND tp.profile_id = ?
|
||||
ORDER BY tp.created_at ASC;")
|
||||
|
||||
(defn process-permissions
|
||||
[team]
|
||||
@@ -150,13 +175,21 @@
|
||||
(dissoc :is-owner :is-admin :can-edit)
|
||||
(assoc :permissions permissions))))
|
||||
|
||||
(def ^:private
|
||||
xform:process-teams
|
||||
(comp
|
||||
(map decode-row)
|
||||
(map process-permissions)))
|
||||
|
||||
(defn get-teams
|
||||
[conn profile-id]
|
||||
(let [profile (profile/get-profile conn profile-id)]
|
||||
(->> (db/exec! conn [sql:get-teams-with-permissions (:default-team-id profile) profile-id])
|
||||
(map decode-row)
|
||||
(map process-permissions)
|
||||
(vec))))
|
||||
(let [profile (profile/get-profile conn profile-id)
|
||||
sql (if (contains? cf/flags :subscriptions)
|
||||
sql:get-teams-with-permissions-and-subscription
|
||||
sql:get-teams-with-permissions)]
|
||||
|
||||
(->> (db/exec! conn [sql (:default-team-id profile) profile-id])
|
||||
(into [] xform:process-teams))))
|
||||
|
||||
;; --- Query: Team (by ID)
|
||||
|
||||
|
||||
@@ -6,13 +6,17 @@
|
||||
|
||||
(ns app.srepl
|
||||
"Server Repl."
|
||||
(:refer-clojure :exclude [read-line])
|
||||
(:require
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.json :as json]
|
||||
[app.common.logging :as l]
|
||||
[app.config :as cf]
|
||||
[app.srepl.cli]
|
||||
[app.srepl.cli :as cli]
|
||||
[app.srepl.main]
|
||||
[app.util.json :as json]
|
||||
[app.util.locks :as locks]
|
||||
[app.util.time :as dt]
|
||||
[clojure.core :as c]
|
||||
[clojure.core.server :as ccs]
|
||||
[clojure.main :as cm]
|
||||
[integrant.core :as ig]))
|
||||
@@ -28,17 +32,80 @@
|
||||
:init repl-init
|
||||
:read ccs/repl-read))
|
||||
|
||||
(defn- ex->data
|
||||
[cause phase]
|
||||
(let [data (ex-data cause)
|
||||
explain (ex/explain data)]
|
||||
(cond-> {:phase phase
|
||||
:code (get data :code :unknown)
|
||||
:type (get data :type :unknown)
|
||||
:hint (or (get data :hint) (ex-message cause))}
|
||||
(some? explain)
|
||||
(assoc :explain explain))))
|
||||
|
||||
(defn read-line
|
||||
[]
|
||||
(if-let [line (c/read-line)]
|
||||
(try
|
||||
(l/dbg :hint "decode" :data line)
|
||||
(json/decode line :key-fn json/read-kebab-key)
|
||||
(catch Throwable _cause
|
||||
(l/warn :hint "unable to decode data" :data line)
|
||||
nil))
|
||||
::eof))
|
||||
|
||||
(defn json-repl
|
||||
[]
|
||||
(let [out *out*
|
||||
lock (locks/create)]
|
||||
(ccs/prepl *in*
|
||||
(fn [m]
|
||||
(binding [*out* out,
|
||||
*flush-on-newline* true,
|
||||
*print-readably* true]
|
||||
(locks/locking lock
|
||||
(println (json/encode-str m))))))))
|
||||
(let [lock (locks/create)
|
||||
out *out*
|
||||
|
||||
out-fn
|
||||
(fn [m]
|
||||
(locks/locking lock
|
||||
(binding [*out* out]
|
||||
(l/warn :hint "write" :data m)
|
||||
(println (json/encode m :key-fn json/write-camel-key)))))
|
||||
|
||||
tapfn
|
||||
(fn [val]
|
||||
(out-fn {:tag :tap :val val}))]
|
||||
|
||||
(binding [*out* (PrintWriter-on #(out-fn {:tag :out :val %1}) nil true)
|
||||
*err* (PrintWriter-on #(out-fn {:tag :err :val %1}) nil true)]
|
||||
(try
|
||||
(add-tap tapfn)
|
||||
(loop []
|
||||
(when (try
|
||||
(let [data (read-line)
|
||||
tpoint (dt/tpoint)]
|
||||
|
||||
(l/dbg :hint "received" :data (if (= data ::eof) "EOF" data))
|
||||
|
||||
(try
|
||||
(when-not (= data ::eof)
|
||||
(when-not (nil? data)
|
||||
(let [result (cli/exec data)
|
||||
elapsed (tpoint)]
|
||||
(l/warn :hint "result" :data result)
|
||||
(out-fn {:tag :ret
|
||||
:val (if (instance? Throwable result)
|
||||
(Throwable->map result)
|
||||
result)
|
||||
:elapsed (inst-ms elapsed)})))
|
||||
true)
|
||||
(catch Throwable cause
|
||||
(let [elapsed (tpoint)]
|
||||
(out-fn {:tag :ret
|
||||
:err (ex->data cause :eval)
|
||||
:elapsed (inst-ms elapsed)})
|
||||
true))))
|
||||
(catch Throwable cause
|
||||
(out-fn {:tag :ret
|
||||
:err (ex->data cause :read)})
|
||||
true))
|
||||
(recur)))
|
||||
(finally
|
||||
(remove-tap tapfn))))))
|
||||
|
||||
;; --- State initialization
|
||||
|
||||
|
||||
@@ -9,14 +9,23 @@
|
||||
(:require
|
||||
[app.auth :as auth]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.db :as db]
|
||||
[app.rpc.commands.auth :as cmd.auth]
|
||||
[app.rpc.commands.profile :as cmd.profile]
|
||||
[app.util.json :as json]
|
||||
[app.setup :as-alias setup]
|
||||
[app.tokens :as tokens]
|
||||
[app.util.time :as dt]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(defn coercer
|
||||
[schema & {:as opts}]
|
||||
(let [decode-fn (sm/decoder schema sm/json-transformer)
|
||||
check-fn (sm/check-fn schema opts)]
|
||||
(fn [data]
|
||||
(-> data decode-fn check-fn))))
|
||||
|
||||
(defn- get-current-system
|
||||
[]
|
||||
(or (deref (requiring-resolve 'app.main/system))
|
||||
@@ -24,16 +33,21 @@
|
||||
|
||||
(defmulti ^:private exec-command ::cmd)
|
||||
|
||||
(defmethod exec-command :default
|
||||
[{:keys [::cmd]}]
|
||||
(ex/raise :type :internal
|
||||
:code :not-implemented
|
||||
:hint (str/ffmt "command '%' not implemented" cmd)))
|
||||
|
||||
(defn exec
|
||||
"Entry point with external tools integrations that uses PREPL
|
||||
interface for interacting with running penpot backend."
|
||||
[data]
|
||||
(let [data (json/decode data)]
|
||||
(-> {::cmd (keyword (:cmd data "default"))}
|
||||
(merge (:params data))
|
||||
(exec-command))))
|
||||
(-> {::cmd (get data :cmd)}
|
||||
(merge (:params data))
|
||||
(exec-command)))
|
||||
|
||||
(defmethod exec-command :create-profile
|
||||
(defmethod exec-command "create-profile"
|
||||
[{:keys [fullname email password is-active]
|
||||
:or {is-active true}}]
|
||||
(some-> (get-current-system)
|
||||
@@ -49,7 +63,7 @@
|
||||
(->> (cmd.auth/create-profile! conn params)
|
||||
(cmd.auth/create-profile-rels! conn)))))))
|
||||
|
||||
(defmethod exec-command :update-profile
|
||||
(defmethod exec-command "update-profile"
|
||||
[{:keys [fullname email password is-active]}]
|
||||
(some-> (get-current-system)
|
||||
(db/tx-run!
|
||||
@@ -70,7 +84,12 @@
|
||||
:deleted-at nil})]
|
||||
(pos? (db/get-update-count res)))))))))
|
||||
|
||||
(defmethod exec-command :delete-profile
|
||||
(defmethod exec-command "echo"
|
||||
[params]
|
||||
params)
|
||||
|
||||
|
||||
(defmethod exec-command "delete-profile"
|
||||
[{:keys [email soft]}]
|
||||
(when-not email
|
||||
(ex/raise :type :assertion
|
||||
@@ -88,7 +107,7 @@
|
||||
{:email email}))]
|
||||
(pos? (db/get-update-count res)))))))
|
||||
|
||||
(defmethod exec-command :search-profile
|
||||
(defmethod exec-command "search-profile"
|
||||
[{:keys [email]}]
|
||||
(when-not email
|
||||
(ex/raise :type :assertion
|
||||
@@ -102,12 +121,130 @@
|
||||
" where email similar to ? order by created_at desc limit 100")]
|
||||
(db/exec! conn [sql email]))))))
|
||||
|
||||
(defmethod exec-command :derive-password
|
||||
(defmethod exec-command "derive-password"
|
||||
[{:keys [password]}]
|
||||
(auth/derive-password password))
|
||||
|
||||
(defmethod exec-command :default
|
||||
[{:keys [::cmd]}]
|
||||
(ex/raise :type :internal
|
||||
:code :not-implemented
|
||||
:hint (str/ffmt "command '%' not implemented" (name cmd))))
|
||||
(defmethod exec-command "authenticate"
|
||||
[{:keys [token]}]
|
||||
(when-let [system (get-current-system)]
|
||||
(let [props (get system ::setup/props)]
|
||||
(tokens/verify props {:token token :iss "authentication"}))))
|
||||
|
||||
(def ^:private schema:get-customer
|
||||
[:map [:id ::sm/uuid]])
|
||||
|
||||
(def coerce-get-customer-params
|
||||
(coercer schema:get-customer
|
||||
:type :validation
|
||||
:hint "invalid data provided for `get-customer` rpc call"))
|
||||
|
||||
(def sql:get-customer-slots
|
||||
"WITH teams AS (
|
||||
SELECT tpr.team_id AS id,
|
||||
tpr.profile_id AS profile_id
|
||||
FROM team_profile_rel AS tpr
|
||||
WHERE tpr.is_owner IS true
|
||||
AND tpr.profile_id = ?
|
||||
), teams_with_slots AS (
|
||||
SELECT tpr.team_id AS id,
|
||||
count(*) AS total
|
||||
FROM team_profile_rel AS tpr
|
||||
WHERE tpr.team_id IN (SELECT id FROM teams)
|
||||
AND tpr.can_edit IS true
|
||||
GROUP BY 1
|
||||
ORDER BY 2
|
||||
)
|
||||
SELECT max(total) AS total FROM teams_with_slots;")
|
||||
|
||||
(defn- get-customer-slots
|
||||
[system profile-id]
|
||||
(let [result (db/exec-one! system [sql:get-customer-slots profile-id])]
|
||||
(:total result)))
|
||||
|
||||
(defmethod exec-command "get-customer"
|
||||
[params]
|
||||
(when-let [system (get-current-system)]
|
||||
(let [{:keys [id] :as params} (coerce-get-customer-params params)
|
||||
{:keys [props] :as profile} (cmd.profile/get-profile system id)]
|
||||
{:id (get profile :id)
|
||||
:name (get profile :fullname)
|
||||
:email (get profile :email)
|
||||
:num-editors (get-customer-slots system id)
|
||||
:subscription (get props :subscription)})))
|
||||
|
||||
(def ^:private schema:customer-subscription
|
||||
[:map {:title "CustomerSubscription"}
|
||||
[:id ::sm/text]
|
||||
[:customer-id ::sm/text]
|
||||
[:type [:enum
|
||||
"unlimited"
|
||||
"professional"
|
||||
"enterprise"]]
|
||||
[:status [:enum
|
||||
"active"
|
||||
"canceled"
|
||||
"incomplete"
|
||||
"incomplete_expired"
|
||||
"pass_due"
|
||||
"paused"
|
||||
"trialing"
|
||||
"unpaid"]]
|
||||
|
||||
[:billing-period [:enum
|
||||
"month"
|
||||
"day"
|
||||
"week"
|
||||
"year"]]
|
||||
[:quantity :int]
|
||||
[:description [:maybe ::sm/text]]
|
||||
[:created-at ::sm/timestamp]
|
||||
[:start-date [:maybe ::sm/timestamp]]
|
||||
[:ended-at [:maybe ::sm/timestamp]]
|
||||
[:trial-end [:maybe ::sm/timestamp]]
|
||||
[:trial-start [:maybe ::sm/timestamp]]
|
||||
[:cancel-at [:maybe ::sm/timestamp]]
|
||||
[:canceled-at [:maybe ::sm/timestamp]]
|
||||
|
||||
[:current-period-end ::sm/timestamp]
|
||||
[:current-period-start ::sm/timestamp]
|
||||
[:cancel-at-period-end :boolean]
|
||||
|
||||
[:cancellation-details
|
||||
[:map {:title "CancellationDetails"}
|
||||
[:comment [:maybe ::sm/text]]
|
||||
[:reason [:maybe ::sm/text]]
|
||||
[:feedback [:maybe
|
||||
[:enum
|
||||
"customer_service"
|
||||
"low_quality"
|
||||
"missing_feature"
|
||||
"other"
|
||||
"switched_service"
|
||||
"too_complex"
|
||||
"too_expensive"
|
||||
"unused"]]]]]])
|
||||
|
||||
(def ^:private schema:update-customer-subscription
|
||||
[:map
|
||||
[:id ::sm/uuid]
|
||||
[:subscription [:maybe schema:customer-subscription]]])
|
||||
|
||||
(def coerce-update-customer-subscription-params
|
||||
(coercer schema:update-customer-subscription
|
||||
:type :validation
|
||||
:hint "invalid data provided for `update-customer-subscription` rpc call"))
|
||||
|
||||
(defmethod exec-command "update-customer-subscription"
|
||||
[params]
|
||||
(when-let [system (get-current-system)]
|
||||
(let [{:keys [id subscription]} (coerce-update-customer-subscription-params params)
|
||||
;; FIXME: locking
|
||||
{:keys [props] :as profile} (cmd.profile/get-profile system id)
|
||||
props (assoc props :subscription subscription)]
|
||||
|
||||
(db/update! system :profile
|
||||
{:props (db/tjson props)}
|
||||
{:id id}
|
||||
{::db/return-keys false})
|
||||
true)))
|
||||
|
||||
@@ -156,6 +156,10 @@
|
||||
[file-id & {:as opts}]
|
||||
(process-file! file-id feat.fdata/enable-pointer-map opts))
|
||||
|
||||
(defn enable-path-data-feature-on-file!
|
||||
[file-id & {:as opts}]
|
||||
(process-file! file-id feat.fdata/enable-path-data opts))
|
||||
|
||||
(defn enable-storage-features-on-file!
|
||||
[file-id & {:as opts}]
|
||||
(enable-objects-map-feature-on-file! file-id opts)
|
||||
@@ -416,10 +420,12 @@
|
||||
"Apply a function to the file. Optionally save the changes or not.
|
||||
The function receives the decoded and migrated file data."
|
||||
[file-id update-fn & {:keys [rollback?] :or {rollback? true} :as opts}]
|
||||
(db/tx-run! (assoc main/system ::db/rollback rollback?)
|
||||
(fn [system]
|
||||
(binding [h/*system* system]
|
||||
(h/process-file! system file-id update-fn opts)))))
|
||||
(let [file-id (h/parse-uuid file-id)]
|
||||
(db/tx-run! (assoc main/system ::db/rollback rollback?)
|
||||
(fn [system]
|
||||
(binding [h/*system* system
|
||||
db/*conn* (db/get-connection system)]
|
||||
(h/process-file! system file-id update-fn opts))))))
|
||||
|
||||
(defn process-team-files!
|
||||
"Apply a function to each file of the specified team."
|
||||
@@ -431,7 +437,8 @@
|
||||
(when (string? label)
|
||||
(h/take-team-snapshot! system team-id label))
|
||||
|
||||
(binding [h/*system* system]
|
||||
(binding [h/*system* system
|
||||
db/*conn* (db/get-connection system)]
|
||||
(->> (feat.comp-v2/get-and-lock-team-files conn team-id)
|
||||
(reduce (fn [result file-id]
|
||||
(if (h/process-file! system file-id update-fn opts)
|
||||
|
||||
@@ -10,6 +10,7 @@
|
||||
file is eligible to be garbage collected after some period of
|
||||
inactivity (the default threshold is 72h)."
|
||||
(:require
|
||||
[app.binfile.cleaner :as bfl]
|
||||
[app.binfile.common :as bfc]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.files.validate :as cfv]
|
||||
@@ -258,6 +259,7 @@
|
||||
(if-let [file (get-file cfg file-id)]
|
||||
(let [file (->> file
|
||||
(bfc/decode-file cfg)
|
||||
(bfl/clean-file)
|
||||
(clean-media! cfg)
|
||||
(clean-fragments! cfg))
|
||||
file (assoc file :has-media-trimmed true)]
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
{org.clojure/clojure {:mvn/version "1.12.0"}
|
||||
org.clojure/data.json {:mvn/version "2.5.1"}
|
||||
org.clojure/tools.cli {:mvn/version "1.1.230"}
|
||||
org.clojure/clojurescript {:mvn/version "1.11.132"}
|
||||
org.clojure/clojurescript {:mvn/version "1.12.38"}
|
||||
org.clojure/test.check {:mvn/version "1.1.1"}
|
||||
org.clojure/data.fressian {:mvn/version "1.1.0"}
|
||||
|
||||
@@ -59,7 +59,7 @@
|
||||
{:dev
|
||||
{:extra-deps
|
||||
{org.clojure/tools.namespace {:mvn/version "RELEASE"}
|
||||
thheller/shadow-cljs {:mvn/version "2.28.20"}
|
||||
thheller/shadow-cljs {:mvn/version "3.0.3"}
|
||||
com.clojure-goes-fast/clj-async-profiler {:mvn/version "RELEASE"}
|
||||
com.bhauman/rebel-readline {:mvn/version "RELEASE"}
|
||||
criterium/criterium {:mvn/version "RELEASE"}
|
||||
|
||||
@@ -17,7 +17,7 @@
|
||||
"devDependencies": {
|
||||
"concurrently": "^9.0.1",
|
||||
"nodemon": "^3.1.7",
|
||||
"shadow-cljs": "2.28.20",
|
||||
"shadow-cljs": "3.0.3",
|
||||
"source-map-support": "^0.5.21",
|
||||
"ws": "^8.17.0"
|
||||
},
|
||||
|
||||
@@ -2,16 +2,20 @@
|
||||
|
||||
export PENPOT_FLAGS="enable-asserts enable-audit-log $PENPOT_FLAGS"
|
||||
|
||||
export OPTIONS="
|
||||
-A:dev \
|
||||
-J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
|
||||
-J-Djdk.attach.allowAttachSelf \
|
||||
-J-Dpolyglot.engine.WarnInterpreterOnly=false \
|
||||
-J-XX:+EnableDynamicAgentLoading \
|
||||
-J-XX:-OmitStackTraceInFastThrow \
|
||||
-J-XX:+UnlockDiagnosticVMOptions \
|
||||
-J-XX:+DebugNonSafepoints \
|
||||
-J-Djdk.tracePinnedThreads=full"
|
||||
export JAVA_OPTS="\
|
||||
-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
|
||||
-Djdk.attach.allowAttachSelf \
|
||||
-Dlog4j2.configurationFile=log4j2-devenv-repl.xml \
|
||||
-Djdk.tracePinnedThreads=full \
|
||||
-XX:+EnableDynamicAgentLoading \
|
||||
-XX:-OmitStackTraceInFastThrow \
|
||||
-XX:+UnlockDiagnosticVMOptions \
|
||||
-XX:+DebugNonSafepoints \
|
||||
--sun-misc-unsafe-memory-access=allow \
|
||||
--enable-preview \
|
||||
--enable-native-access=ALL-UNNAMED";
|
||||
|
||||
export OPTIONS="-A:dev"
|
||||
|
||||
export OPTIONS_EVAL="nil"
|
||||
# export OPTIONS_EVAL="(set! *warn-on-reflection* true)"
|
||||
|
||||
@@ -46,6 +46,7 @@
|
||||
#{"fdata/objects-map"
|
||||
"fdata/pointer-map"
|
||||
"fdata/shape-data-type"
|
||||
"fdata/path-data"
|
||||
"components/v2"
|
||||
"styles/v2"
|
||||
"layout/grid"
|
||||
@@ -58,12 +59,18 @@
|
||||
;; A set of features enabled by default
|
||||
(def default-features
|
||||
#{"fdata/shape-data-type"
|
||||
"fdata/path-data"
|
||||
"styles/v2"
|
||||
"layout/grid"
|
||||
"components/v2"
|
||||
"plugins/runtime"
|
||||
"design-tokens/v1"})
|
||||
|
||||
;; A set of features that should not be propagated to team on creating
|
||||
;; or modifying a file
|
||||
(def no-team-inheritable-features
|
||||
#{"fdata/path-data"})
|
||||
|
||||
;; A set of features which only affects on frontend and can be enabled
|
||||
;; and disabled freely by the user any time. This features does not
|
||||
;; persist on file features field but can be permanently enabled on
|
||||
@@ -86,8 +93,9 @@
|
||||
;; without migration applied)
|
||||
(def no-migration-features
|
||||
(-> #{"layout/grid"
|
||||
"design-tokens/v1"
|
||||
"fdata/shape-data-type"
|
||||
"design-tokens/v1"}
|
||||
"fdata/path-data"}
|
||||
(into frontend-only-features)
|
||||
(into backend-only-features)))
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -26,8 +26,6 @@
|
||||
[app.common.types.pages-list :as ctpl]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.types.shape-tree :as ctst]
|
||||
[app.common.types.token :as cto]
|
||||
[app.common.types.token-theme :as ctot]
|
||||
[app.common.types.tokens-lib :as ctob]
|
||||
[app.common.types.typographies-list :as ctyl]
|
||||
[app.common.types.typography :as ctt]
|
||||
@@ -408,7 +406,7 @@
|
||||
[:type [:= :set-token-theme]]
|
||||
[:theme-name :string]
|
||||
[:group :string]
|
||||
[:theme [:maybe ::ctot/token-theme]]]]
|
||||
[:theme [:maybe ctob/schema:token-theme-attrs]]]]
|
||||
|
||||
[:set-tokens-lib
|
||||
[:map {:title "SetTokensLib"}
|
||||
@@ -420,14 +418,14 @@
|
||||
[:type [:= :set-token-set]]
|
||||
[:set-name :string]
|
||||
[:group? :boolean]
|
||||
[:token-set [:maybe ::ctot/token-set]]]]
|
||||
[:token-set [:maybe ctob/schema:token-set-attrs]]]]
|
||||
|
||||
[:set-token
|
||||
[:map {:title "SetTokenChange"}
|
||||
[:type [:= :set-token]]
|
||||
[:set-name :string]
|
||||
[:token-name :string]
|
||||
[:token [:maybe ::cto/token]]]]]])
|
||||
[:token [:maybe ctob/schema:token-attrs]]]]]])
|
||||
|
||||
(def schema:changes
|
||||
[:sequential {:gen/max 5 :gen/min 1} schema:change])
|
||||
@@ -734,20 +732,22 @@
|
||||
|
||||
(update-group [group objects]
|
||||
(let [lookup (d/getf objects)
|
||||
children (->> group :shapes (map lookup))]
|
||||
children (get group :shapes)]
|
||||
(cond
|
||||
;; If the group is empty we don't make any changes. Will be removed by a later process
|
||||
(empty? children)
|
||||
group
|
||||
|
||||
(= :bool (:type group))
|
||||
(gsh/update-bool-selrect group children objects)
|
||||
(gsh/update-bool group objects)
|
||||
|
||||
(:masked-group group)
|
||||
(set-mask-selrect group children)
|
||||
(->> (map lookup children)
|
||||
(set-mask-selrect group))
|
||||
|
||||
:else
|
||||
(gsh/update-group-selrect group children))))]
|
||||
(->> (map lookup children)
|
||||
(gsh/update-group-selrect group)))))]
|
||||
|
||||
(if page-id
|
||||
(d/update-in-when data [:pages-index page-id :objects] reg-objects)
|
||||
|
||||
@@ -8,7 +8,6 @@
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.features :as cfeat]
|
||||
[app.common.files.changes :as cfc]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
@@ -84,8 +83,7 @@
|
||||
|
||||
(defn with-objects
|
||||
[changes objects]
|
||||
(let [fdata (binding [cfeat/*current* #{"components/v2"}]
|
||||
(ctf/make-file-data (uuid/next) uuid/zero))
|
||||
(let [fdata (ctf/make-file-data (uuid/next) uuid/zero)
|
||||
fdata (assoc-in fdata [:pages-index uuid/zero :objects] objects)]
|
||||
(vary-meta changes assoc
|
||||
::file-data fdata
|
||||
@@ -480,9 +478,12 @@
|
||||
(let [old-val (get old attr)
|
||||
new-val (get new attr)]
|
||||
(not= old-val new-val)))
|
||||
new-obj (if with-objects?
|
||||
(update-fn object objects)
|
||||
(update-fn object))]
|
||||
|
||||
new-obj
|
||||
(if with-objects?
|
||||
(update-fn object objects)
|
||||
(update-fn object))]
|
||||
|
||||
(when-not (= object new-obj)
|
||||
(let [attrs (or attrs (d/concat-set (keys object) (keys new-obj)))]
|
||||
(filter (partial changed? object new-obj) attrs)))))
|
||||
@@ -659,9 +660,13 @@
|
||||
nil ;; so it does not need resize
|
||||
|
||||
(= (:type parent) :bool)
|
||||
(gsh/update-bool-selrect parent children objects)
|
||||
(gsh/update-bool parent objects)
|
||||
|
||||
(= (:type parent) :group)
|
||||
;; FIXME: this functions should be
|
||||
;; normalized in the same way as
|
||||
;; update-bool in order to make all
|
||||
;; this code consistent
|
||||
(if (:masked-group parent)
|
||||
(gsh/update-mask-selrect parent children)
|
||||
(gsh/update-group-selrect parent children)))]
|
||||
@@ -1049,6 +1054,33 @@
|
||||
:id id
|
||||
:delta delta})))
|
||||
|
||||
(defn reorder-children
|
||||
[changes id children]
|
||||
(assert-page-id! changes)
|
||||
(assert-objects! changes)
|
||||
|
||||
(let [page-id (::page-id (meta changes))
|
||||
objects (lookup-objects changes)
|
||||
shape (get objects id)
|
||||
old-children (:shapes shape)
|
||||
|
||||
redo-change
|
||||
{:type :reorder-children
|
||||
:parent-id (:id shape)
|
||||
:page-id page-id
|
||||
:shapes children}
|
||||
|
||||
undo-change
|
||||
{:type :reorder-children
|
||||
:parent-id (:id shape)
|
||||
:page-id page-id
|
||||
:shapes old-children}]
|
||||
|
||||
(-> changes
|
||||
(update :redo-changes conj redo-change)
|
||||
(update :undo-changes conj undo-change)
|
||||
(apply-changes-local))))
|
||||
|
||||
(defn reorder-grid-children
|
||||
[changes ids]
|
||||
(assert-page-id! changes)
|
||||
|
||||
@@ -16,7 +16,6 @@
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.geom.shapes.text :as gsht]
|
||||
[app.common.logging :as l]
|
||||
[app.common.math :as mth]
|
||||
@@ -27,7 +26,10 @@
|
||||
[app.common.types.component :as ctk]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.path.segment :as path.segment]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.types.shape.interactions :as ctsi]
|
||||
[app.common.types.shape.shadow :as ctss]
|
||||
[app.common.uuid :as uuid]
|
||||
[clojure.set :as set]
|
||||
@@ -35,9 +37,7 @@
|
||||
|
||||
#?(:cljs (l/set-level! :info))
|
||||
|
||||
(declare ^:private available-migrations)
|
||||
(declare ^:private migration-up-index)
|
||||
(declare ^:private migration-down-index)
|
||||
(declare available-migrations)
|
||||
|
||||
(def version cfd/version)
|
||||
|
||||
@@ -49,7 +49,10 @@
|
||||
[file]
|
||||
(or (nil? (:version file))
|
||||
(not= cfd/version (:version file))
|
||||
(not= available-migrations (:migrations file))))
|
||||
(boolean
|
||||
(->> (:migrations file #{})
|
||||
(set/difference available-migrations)
|
||||
(not-empty)))))
|
||||
|
||||
(def xf:map-name
|
||||
(map :name))
|
||||
@@ -96,13 +99,13 @@
|
||||
(if (nil? migrations)
|
||||
(generate-migrations-from-version version)
|
||||
migrations)))
|
||||
(update :features (fnil into #{}) (deref cfeat/*new*))
|
||||
;; NOTE: in some future we can consider to apply
|
||||
;; a migration to the whole database and remove
|
||||
;; this code from this function that executes on
|
||||
;; each file migration operation
|
||||
(update :features cfeat/migrate-legacy-features)
|
||||
(migrate)))))
|
||||
(migrate)
|
||||
(update :features (fnil into #{}) (deref cfeat/*new*))))))
|
||||
|
||||
(defn migrated?
|
||||
[file]
|
||||
@@ -119,16 +122,16 @@
|
||||
(into [] shapes)
|
||||
shapes))))
|
||||
(update-page [page]
|
||||
(update page :objects update-vals update-object))]
|
||||
(update page :objects d/update-vals update-object))]
|
||||
|
||||
(update data :pages-index update-vals update-page)))
|
||||
(update data :pages-index d/update-vals update-page)))
|
||||
|
||||
(defmethod migrate-data "legacy-3"
|
||||
[data _]
|
||||
(letfn [(migrate-path [shape]
|
||||
(if-not (contains? shape :content)
|
||||
(let [content (gsp/segments->content (:segments shape) (:close? shape))
|
||||
selrect (gsh/content->selrect content)
|
||||
(let [content (path.segment/points->content (:segments shape) :close (:close? shape))
|
||||
selrect (path.segment/content->selrect content)
|
||||
points (grc/rect->points selrect)]
|
||||
(-> shape
|
||||
(dissoc :segments)
|
||||
@@ -172,9 +175,9 @@
|
||||
(fix-empty-points)))
|
||||
|
||||
(update-page [page]
|
||||
(update page :objects update-vals update-object))]
|
||||
(update page :objects d/update-vals update-object))]
|
||||
|
||||
(update data :pages-index update-vals update-page)))
|
||||
(update data :pages-index d/update-vals update-page)))
|
||||
|
||||
;; Put the id of the local file in :component-file in instances of
|
||||
;; local components
|
||||
@@ -187,9 +190,9 @@
|
||||
object))
|
||||
|
||||
(update-page [page]
|
||||
(update page :objects update-vals update-object))]
|
||||
(update page :objects d/update-vals update-object))]
|
||||
|
||||
(update data :pages-index update-vals update-page)))
|
||||
(update data :pages-index d/update-vals update-page)))
|
||||
|
||||
;; Fixes issues with selrect/points for shapes with width/height =
|
||||
;; 0 (line-like paths)
|
||||
@@ -199,7 +202,7 @@
|
||||
(if (= (:type shape) :path)
|
||||
(let [{:keys [width height]} (grc/points->rect (:points shape))]
|
||||
(if (or (mth/almost-zero? width) (mth/almost-zero? height))
|
||||
(let [selrect (gsh/content->selrect (:content shape))
|
||||
(let [selrect (path.segment/content->selrect (:content shape))
|
||||
points (grc/rect->points selrect)
|
||||
transform (gmt/matrix)
|
||||
transform-inv (gmt/matrix)]
|
||||
@@ -212,11 +215,11 @@
|
||||
shape))
|
||||
|
||||
(update-container [container]
|
||||
(update container :objects update-vals fix-line-paths))]
|
||||
(update container :objects d/update-vals fix-line-paths))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
;; Remove interactions pointing to deleted frames
|
||||
(defmethod migrate-data "legacy-7"
|
||||
@@ -227,9 +230,9 @@
|
||||
(filterv #(get-in page [:objects (:destination %)]) interactions))))
|
||||
|
||||
(update-page [page]
|
||||
(update page :objects update-vals (partial update-object page)))]
|
||||
(update page :objects d/update-vals (partial update-object page)))]
|
||||
|
||||
(update data :pages-index update-vals update-page)))
|
||||
(update data :pages-index d/update-vals update-page)))
|
||||
|
||||
;; Remove groups without any shape, both in pages and components
|
||||
(defmethod migrate-data "legacy-8"
|
||||
@@ -269,8 +272,8 @@
|
||||
(assoc container :objects objects)))))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals clean-container)
|
||||
(update :components update-vals clean-container))))
|
||||
(update :pages-index d/update-vals clean-container)
|
||||
(d/update-when :components d/update-vals clean-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-9"
|
||||
[data _]
|
||||
@@ -304,7 +307,7 @@
|
||||
[data _]
|
||||
(letfn [(update-page [page]
|
||||
(d/update-in-when page [:objects uuid/zero] dissoc :points :selrect))]
|
||||
(update data :pages-index update-vals update-page)))
|
||||
(update data :pages-index d/update-vals update-page)))
|
||||
|
||||
(defmethod migrate-data "legacy-11"
|
||||
[data _]
|
||||
@@ -318,7 +321,7 @@
|
||||
(update page :objects (fn [objects]
|
||||
(update-vals objects (partial update-object objects)))))]
|
||||
|
||||
(update data :pages-index update-vals update-page)))
|
||||
(update data :pages-index d/update-vals update-page)))
|
||||
|
||||
(defmethod migrate-data "legacy-12"
|
||||
[data _]
|
||||
@@ -328,9 +331,9 @@
|
||||
(assoc :size nil)))
|
||||
|
||||
(update-page [page]
|
||||
(d/update-in-when page [:options :saved-grids] update-vals update-grid))]
|
||||
(d/update-in-when page [:options :saved-grids] d/update-vals update-grid))]
|
||||
|
||||
(update data :pages-index update-vals update-page)))
|
||||
(update data :pages-index d/update-vals update-page)))
|
||||
|
||||
;; Add rx and ry to images
|
||||
(defmethod migrate-data "legacy-13"
|
||||
@@ -348,9 +351,9 @@
|
||||
(fix-radius)))
|
||||
|
||||
(update-page [page]
|
||||
(update page :objects update-vals update-object))]
|
||||
(update page :objects d/update-vals update-object))]
|
||||
|
||||
(update data :pages-index update-vals update-page)))
|
||||
(update data :pages-index d/update-vals update-page)))
|
||||
|
||||
(defmethod migrate-data "legacy-14"
|
||||
[data _]
|
||||
@@ -380,8 +383,8 @@
|
||||
container))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-16"
|
||||
[data _]
|
||||
@@ -423,11 +426,11 @@
|
||||
(assign-fills)))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-17"
|
||||
[data _]
|
||||
@@ -452,11 +455,11 @@
|
||||
(assoc :fills [])))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
;; Remove position-data to solve a bug with the text positioning
|
||||
(defmethod migrate-data "legacy-18"
|
||||
@@ -467,11 +470,11 @@
|
||||
(dissoc :position-data)))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-19"
|
||||
[data _]
|
||||
@@ -483,11 +486,11 @@
|
||||
(dissoc :position-data)))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-25"
|
||||
[data _]
|
||||
@@ -499,10 +502,10 @@
|
||||
(update :selrect grc/make-rect)
|
||||
(cts/create-shape))))
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-26"
|
||||
[data _]
|
||||
@@ -515,11 +518,11 @@
|
||||
(assoc :transform-inverse (gmt/matrix))))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-27"
|
||||
[data _]
|
||||
@@ -546,11 +549,11 @@
|
||||
(dissoc :saved-component-root?))))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-28"
|
||||
[data _]
|
||||
@@ -575,8 +578,8 @@
|
||||
(d/update-when container :objects #(update-vals % (partial update-object %))))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-29"
|
||||
[data _]
|
||||
@@ -607,11 +610,11 @@
|
||||
(update :content #(txt/transform-nodes invalid-node? fix-node %)))))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-31"
|
||||
[data _]
|
||||
@@ -622,10 +625,10 @@
|
||||
(dissoc :use-for-thumbnail?))))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-32"
|
||||
[data _]
|
||||
@@ -640,11 +643,11 @@
|
||||
object)))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-33"
|
||||
[data _]
|
||||
@@ -662,9 +665,9 @@
|
||||
object))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-34"
|
||||
[data _]
|
||||
@@ -674,10 +677,10 @@
|
||||
(dissoc object :x :y :width :height)
|
||||
object))
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-36"
|
||||
[data _]
|
||||
@@ -687,8 +690,8 @@
|
||||
(dissoc objects nil)
|
||||
objects))))]
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-37"
|
||||
[data _]
|
||||
@@ -716,11 +719,11 @@
|
||||
shape)))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-shape))]
|
||||
(d/update-when container :objects d/update-vals update-shape))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-39"
|
||||
[data _]
|
||||
@@ -738,11 +741,11 @@
|
||||
shape))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-shape))]
|
||||
(d/update-when container :objects d/update-vals update-shape))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-40"
|
||||
[data _]
|
||||
@@ -762,11 +765,11 @@
|
||||
shape))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-shape))]
|
||||
(d/update-when container :objects d/update-vals update-shape))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-41"
|
||||
[data _]
|
||||
@@ -795,11 +798,11 @@
|
||||
shape))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-shape))]
|
||||
(d/update-when container :objects d/update-vals update-shape))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-42"
|
||||
[data _]
|
||||
@@ -812,11 +815,11 @@
|
||||
object))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(def ^:private valid-fill?
|
||||
(sm/lazy-validator ::cts/fill))
|
||||
@@ -841,14 +844,11 @@
|
||||
object))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
|
||||
(def ^:private valid-shadow?
|
||||
(sm/lazy-validator ::ctss/shadow))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-44"
|
||||
[data _]
|
||||
@@ -861,14 +861,14 @@
|
||||
|
||||
(update-object [object]
|
||||
(let [xform (comp (map fix-shadow)
|
||||
(filter valid-shadow?))]
|
||||
(filter ctss/valid-shadow?))]
|
||||
(d/update-when object :shadow #(into [] xform %))))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-45"
|
||||
[data _]
|
||||
@@ -881,9 +881,9 @@
|
||||
:parent-id parent-id)))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals fix-shape))]
|
||||
(d/update-when container :objects d/update-vals fix-shape))]
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-46"
|
||||
[data _]
|
||||
@@ -891,10 +891,10 @@
|
||||
(dissoc object :thumbnail))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-47"
|
||||
[data _]
|
||||
@@ -915,9 +915,9 @@
|
||||
shape)))
|
||||
|
||||
(update-page [page]
|
||||
(d/update-when page :objects update-vals (partial fix-shape page)))]
|
||||
(d/update-when page :objects d/update-vals (partial fix-shape page)))]
|
||||
(-> data
|
||||
(update :pages-index update-vals update-page))))
|
||||
(update :pages-index d/update-vals update-page))))
|
||||
|
||||
(defmethod migrate-data "legacy-48"
|
||||
[data _]
|
||||
@@ -929,9 +929,9 @@
|
||||
shape)))
|
||||
|
||||
(update-page [page]
|
||||
(d/update-when page :objects update-vals fix-shape))]
|
||||
(d/update-when page :objects d/update-vals fix-shape))]
|
||||
(-> data
|
||||
(update :pages-index update-vals update-page))))
|
||||
(update :pages-index d/update-vals update-page))))
|
||||
|
||||
;; Remove hide-in-viewer for shapes that are origin or destination of an interaction
|
||||
(defmethod migrate-data "legacy-49"
|
||||
@@ -949,9 +949,9 @@
|
||||
(mapcat :interactions)
|
||||
(map :destination)
|
||||
(set))]
|
||||
(update page :objects update-vals (partial update-object destinations))))]
|
||||
(update page :objects d/update-vals (partial update-object destinations))))]
|
||||
|
||||
(update data :pages-index update-vals update-page)))
|
||||
(update data :pages-index d/update-vals update-page)))
|
||||
|
||||
;; This migration mainly fixes paths with curve-to segments
|
||||
;; without :c1x :c1y :c2x :c2y properties. Additionally, we found a
|
||||
@@ -994,11 +994,11 @@
|
||||
|
||||
update-container
|
||||
(fn [page]
|
||||
(d/update-when page :objects update-vals update-shape))]
|
||||
(d/update-when page :objects d/update-vals update-shape))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(def ^:private valid-color?
|
||||
(sm/lazy-validator ::ctc/color))
|
||||
@@ -1018,9 +1018,9 @@
|
||||
shape))
|
||||
|
||||
(update-page [page]
|
||||
(d/update-when page :objects update-vals update-shape))]
|
||||
(d/update-when page :objects d/update-vals update-shape))]
|
||||
|
||||
(update data :pages-index update-vals update-page)))
|
||||
(update data :pages-index d/update-vals update-page)))
|
||||
|
||||
|
||||
(defmethod migrate-data "legacy-53"
|
||||
@@ -1036,15 +1036,15 @@
|
||||
|
||||
(update-shape [shape]
|
||||
(let [xform (comp (map fix-shadow)
|
||||
(filter valid-shadow?))]
|
||||
(filter ctss/valid-shadow?))]
|
||||
(d/update-when shape :shadow #(into [] xform %))))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-shape))]
|
||||
(d/update-when container :objects d/update-vals update-shape))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
;; This migration moves page options to the page level
|
||||
(defmethod migrate-data "legacy-55"
|
||||
@@ -1096,11 +1096,11 @@
|
||||
(update :content (partial txt/transform-nodes identity fix-fills)))))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
|
||||
(defmethod migrate-data "legacy-57"
|
||||
@@ -1127,7 +1127,7 @@
|
||||
(-> data
|
||||
(update :pages (fn [pages] (into [] (remove nil?) pages)))
|
||||
(update :pages-index dissoc nil)
|
||||
(update :pages-index update-vals update-page))))
|
||||
(update :pages-index d/update-vals update-page))))
|
||||
|
||||
(defmethod migrate-data "legacy-59"
|
||||
[data _]
|
||||
@@ -1138,11 +1138,11 @@
|
||||
(d/update-when shape :touched #(into #{} (map fix-touched) %)))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-shape))]
|
||||
(d/update-when container :objects d/update-vals update-shape))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-62"
|
||||
[data _]
|
||||
@@ -1175,7 +1175,7 @@
|
||||
;; so the relevant objects are inside the component
|
||||
(d/update-when component :objects remove-cycles))]
|
||||
|
||||
(update data :components update-vals update-component)))
|
||||
(d/update-when data :components d/update-vals update-component)))
|
||||
|
||||
(defmethod migrate-data "legacy-65"
|
||||
[data _]
|
||||
@@ -1186,14 +1186,14 @@
|
||||
update-page
|
||||
(fn [page]
|
||||
(-> (update-object page)
|
||||
(update :objects update-vals update-object)))]
|
||||
(update :objects d/update-vals update-object)))]
|
||||
|
||||
(-> data
|
||||
(update-object)
|
||||
(d/update-when :pages-index update-vals update-page)
|
||||
(d/update-when :colors update-vals update-object)
|
||||
(d/update-when :typographies update-vals update-object)
|
||||
(d/update-when :components update-vals update-object))))
|
||||
(update :pages-index d/update-vals update-page)
|
||||
(d/update-when :colors d/update-vals update-object)
|
||||
(d/update-when :typographies d/update-vals update-object)
|
||||
(d/update-when :components d/update-vals update-object))))
|
||||
|
||||
(defmethod migrate-data "legacy-66"
|
||||
[data _]
|
||||
@@ -1207,11 +1207,11 @@
|
||||
object))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "legacy-67"
|
||||
[data _]
|
||||
@@ -1219,11 +1219,11 @@
|
||||
(d/update-when object :shadow #(into [] (reverse %))))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "0001-remove-tokens-from-groups"
|
||||
[data _]
|
||||
@@ -1237,8 +1237,33 @@
|
||||
(dissoc :applied-tokens)))
|
||||
|
||||
(update-page [page]
|
||||
(d/update-when page :objects update-vals update-object))]
|
||||
(update data :pages-index update-vals update-page)))
|
||||
(d/update-when page :objects d/update-vals update-object))]
|
||||
|
||||
(update data :pages-index d/update-vals update-page)))
|
||||
|
||||
(defmethod migrate-data "0002-clean-shape-interactions"
|
||||
[data _]
|
||||
(let [decode-fn (sm/decoder ctsi/schema:interaction sm/json-transformer)
|
||||
validate-fn (sm/validator ctsi/schema:interaction)
|
||||
|
||||
xform
|
||||
(comp
|
||||
(map decode-fn)
|
||||
(filter validate-fn))
|
||||
|
||||
update-object
|
||||
(fn [object]
|
||||
(d/update-when object :interactions
|
||||
(fn [interactions]
|
||||
(into [] xform interactions))))
|
||||
|
||||
update-container
|
||||
(fn [container]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "0002-normalize-bool-content"
|
||||
[data _]
|
||||
@@ -1257,8 +1282,47 @@
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "0003-fix-root-shape"
|
||||
[data _]
|
||||
(letfn [(update-object [shape]
|
||||
(if (= (:id shape) uuid/zero)
|
||||
(-> shape
|
||||
(assoc :parent-id uuid/zero)
|
||||
(assoc :frame-id uuid/zero)
|
||||
;; We explicitly dissoc them and let the shape-setup
|
||||
;; to regenerate it with valid values.
|
||||
(dissoc :selrect)
|
||||
(dissoc :points)
|
||||
(cts/setup-shape))
|
||||
shape))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects d/update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container)
|
||||
(d/without-nils))))
|
||||
|
||||
(defmethod migrate-data "0003-convert-path-content"
|
||||
[data _]
|
||||
(some-> cfeat/*new* (swap! conj "fdata/path-data"))
|
||||
|
||||
(letfn [(update-object [object]
|
||||
(if (or (cfh/bool-shape? object)
|
||||
(cfh/path-shape? object))
|
||||
(update object :content path/content)
|
||||
object))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(def available-migrations
|
||||
(into (d/ordered-set)
|
||||
@@ -1315,4 +1379,7 @@
|
||||
"legacy-66"
|
||||
"legacy-67"
|
||||
"0001-remove-tokens-from-groups"
|
||||
"0002-normalize-bool-content"]))
|
||||
"0002-normalize-bool-content"
|
||||
"0002-clean-shape-interactions"
|
||||
"0003-fix-root-shape"
|
||||
"0003-convert-path-content"]))
|
||||
|
||||
@@ -15,6 +15,8 @@
|
||||
[app.common.types.shape.layout :as ctl]
|
||||
[app.common.uuid :as uuid]))
|
||||
|
||||
;; FIXME: move to logic?
|
||||
|
||||
(defn prepare-add-shape
|
||||
[changes shape objects]
|
||||
(let [index (:index (meta shape))
|
||||
@@ -35,6 +37,7 @@
|
||||
(pcb/update-shapes [(:parent-id shape)] #(ctl/push-into-cell % [id] row column)))
|
||||
(cond-> (ctl/grid-layout? objects (:parent-id shape))
|
||||
(pcb/update-shapes [(:parent-id shape)] ctl/assign-cells {:with-objects? true})))]
|
||||
|
||||
[shape changes]))
|
||||
|
||||
(defn prepare-move-shapes-into-frame
|
||||
@@ -44,6 +47,7 @@
|
||||
to-move (->> shapes
|
||||
(map (d/getf objects))
|
||||
(not-empty))]
|
||||
|
||||
(if to-move
|
||||
(-> changes
|
||||
(cond-> (and remove-layout-data?
|
||||
|
||||
@@ -1,8 +1,13 @@
|
||||
(ns app.main.ui.workspace.tokens.token
|
||||
;; 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 app.common.files.tokens
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.main.ui.workspace.tokens.tinycolor :as tinycolor]
|
||||
[clojure.set :as set]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
@@ -128,18 +133,6 @@
|
||||
(defn color-token? [token]
|
||||
(= (:type token) :color))
|
||||
|
||||
|
||||
;; FIXME: this should be precalculated ?
|
||||
(defn is-reference? [token]
|
||||
(str/includes? (:value token) "{"))
|
||||
|
||||
(defn color-bullet-color [token-color-value]
|
||||
(when-let [tc (tinycolor/valid-color token-color-value)]
|
||||
(if (tinycolor/alpha tc)
|
||||
{:color (tinycolor/->hex-string tc)
|
||||
:opacity (tinycolor/alpha tc)}
|
||||
(tinycolor/->hex-string tc))))
|
||||
|
||||
(defn resolved-token-bullet-color [{:keys [resolved-value] :as token}]
|
||||
(when (and resolved-value (color-token? token))
|
||||
(color-bullet-color resolved-value)))
|
||||
@@ -126,21 +126,20 @@
|
||||
o)))
|
||||
|
||||
(def schema:matrix
|
||||
{:type :map
|
||||
:pred valid-matrix?
|
||||
:type-properties
|
||||
{:title "matrix"
|
||||
:description "Matrix instance"
|
||||
:error/message "expected a valid matrix instance"
|
||||
:gen/gen (matrix-generator)
|
||||
:decode/json decode-matrix
|
||||
:decode/string decode-matrix
|
||||
:encode/json matrix->json
|
||||
:encode/string matrix->str
|
||||
::oapi/type "string"
|
||||
::oapi/format "matrix"}})
|
||||
|
||||
(sm/register! ::matrix schema:matrix)
|
||||
(sm/register!
|
||||
{:type ::matrix
|
||||
:pred valid-matrix?
|
||||
:type-properties
|
||||
{:title "matrix"
|
||||
:description "Matrix instance"
|
||||
:error/message "expected a valid matrix instance"
|
||||
:gen/gen (matrix-generator)
|
||||
:decode/json decode-matrix
|
||||
:decode/string decode-matrix
|
||||
:encode/json matrix->json
|
||||
:encode/string matrix->str
|
||||
::oapi/type "string"
|
||||
::oapi/format "matrix"}}))
|
||||
|
||||
;; FIXME: deprecated
|
||||
(s/def ::a ::us/safe-float)
|
||||
|
||||
@@ -5,7 +5,7 @@
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.geom.point
|
||||
(:refer-clojure :exclude [divide min max abs])
|
||||
(:refer-clojure :exclude [divide min max abs zero?])
|
||||
(:require
|
||||
#?(:clj [app.common.fressian :as fres])
|
||||
#?(:cljs [cljs.core :as c]
|
||||
@@ -85,24 +85,22 @@
|
||||
(into {} p)
|
||||
p))
|
||||
|
||||
;; FIXME: make like matrix
|
||||
(def schema:point
|
||||
{:type ::point
|
||||
:pred valid-point?
|
||||
:type-properties
|
||||
{:title "point"
|
||||
:description "Point"
|
||||
:error/message "expected a valid point"
|
||||
:gen/gen (->> (sg/tuple (sg/small-int) (sg/small-int))
|
||||
(sg/fmap #(apply pos->Point %)))
|
||||
::oapi/type "string"
|
||||
::oapi/format "point"
|
||||
:decode/json decode-point
|
||||
:decode/string decode-point
|
||||
:encode/json point->json
|
||||
:encode/string point->str}})
|
||||
|
||||
(sm/register! schema:point)
|
||||
(sm/register!
|
||||
{:type ::point
|
||||
:pred valid-point?
|
||||
:type-properties
|
||||
{:title "point"
|
||||
:description "Point"
|
||||
:error/message "expected a valid point"
|
||||
:gen/gen (->> (sg/tuple (sg/small-int) (sg/small-int))
|
||||
(sg/fmap #(apply pos->Point %)))
|
||||
::oapi/type "string"
|
||||
::oapi/format "point"
|
||||
:decode/json decode-point
|
||||
:decode/string decode-point
|
||||
:encode/json point->json
|
||||
:encode/string point->str}}))
|
||||
|
||||
(defn point-like?
|
||||
[{:keys [x y] :as v}]
|
||||
@@ -470,6 +468,13 @@
|
||||
(and ^boolean (mth/almost-zero? (dm/get-prop p :x))
|
||||
^boolean (mth/almost-zero? (dm/get-prop p :y))))
|
||||
|
||||
(defn zero?
|
||||
[p]
|
||||
(let [x (dm/get-prop p :x)
|
||||
y (dm/get-prop p :y)]
|
||||
(and ^boolean (== 0 x)
|
||||
^boolean (== 0 y))))
|
||||
|
||||
(defn lerp
|
||||
"Calculates a linear interpolation between two points given a tvalue"
|
||||
[p1 p2 t]
|
||||
|
||||
@@ -10,13 +10,11 @@
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes.bool :as gsb]
|
||||
[app.common.geom.shapes.common :as gco]
|
||||
[app.common.geom.shapes.constraints :as gct]
|
||||
[app.common.geom.shapes.corners :as gsc]
|
||||
[app.common.geom.shapes.fit-frame :as gsff]
|
||||
[app.common.geom.shapes.intersect :as gsi]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.geom.shapes.transforms :as gtr]
|
||||
[app.common.math :as mth]))
|
||||
|
||||
@@ -166,7 +164,7 @@
|
||||
(dm/export gtr/calculate-geometry)
|
||||
(dm/export gtr/update-group-selrect)
|
||||
(dm/export gtr/update-mask-selrect)
|
||||
(dm/export gtr/update-bool-selrect)
|
||||
(dm/export gtr/update-bool)
|
||||
(dm/export gtr/apply-transform)
|
||||
(dm/export gtr/transform-shape)
|
||||
(dm/export gtr/transform-selrect)
|
||||
@@ -180,12 +178,6 @@
|
||||
;; Constratins
|
||||
(dm/export gct/calc-child-modifiers)
|
||||
|
||||
;; PATHS
|
||||
;; FIXME: rename
|
||||
(dm/export gsp/content->selrect)
|
||||
(dm/export gsp/transform-content)
|
||||
(dm/export gsp/open-path?)
|
||||
|
||||
;; Intersection
|
||||
(dm/export gsi/overlaps?)
|
||||
(dm/export gsi/overlaps-path?)
|
||||
@@ -193,9 +185,6 @@
|
||||
(dm/export gsi/has-point-rect?)
|
||||
(dm/export gsi/rect-contains-shape?)
|
||||
|
||||
;; Bool
|
||||
(dm/export gsb/calc-bool-content)
|
||||
|
||||
;; Constraints
|
||||
(dm/export gct/default-constraints-h)
|
||||
(dm/export gct/default-constraints-v)
|
||||
|
||||
@@ -1,29 +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 app.common.geom.shapes.bool
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.files.helpers :as cpf]
|
||||
[app.common.svg.path.bool :as pb]
|
||||
[app.common.svg.path.shapes-to-path :as stp]))
|
||||
|
||||
(defn calc-bool-content
|
||||
[shape objects]
|
||||
|
||||
(let [extract-content-xf
|
||||
(comp (map (d/getf objects))
|
||||
(filter (comp not :hidden))
|
||||
(remove cpf/svg-raw-shape?)
|
||||
(map #(stp/convert-to-path % objects))
|
||||
(map :content))
|
||||
|
||||
shapes-content
|
||||
(into [] extract-content-xf (:shapes shape))]
|
||||
(pb/content-bool (:bool-type shape) shapes-content)))
|
||||
|
||||
|
||||
|
||||
@@ -10,8 +10,8 @@
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.math :as mth]))
|
||||
[app.common.math :as mth]
|
||||
[app.common.types.path :as path]))
|
||||
|
||||
(defn shape-stroke-margin
|
||||
[shape stroke-width]
|
||||
@@ -104,7 +104,7 @@
|
||||
(let [strokes (:strokes shape)
|
||||
|
||||
open-path? (and ^boolean (cfh/path-shape? shape)
|
||||
^boolean (gsp/open-path? shape))
|
||||
^boolean (path/shape-with-open-path? shape))
|
||||
|
||||
stroke-width
|
||||
(->> strokes
|
||||
|
||||
@@ -13,9 +13,9 @@
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes.common :as gco]
|
||||
[app.common.geom.shapes.path :as gpp]
|
||||
[app.common.geom.shapes.text :as gte]
|
||||
[app.common.math :as mth]))
|
||||
[app.common.math :as mth]
|
||||
[app.common.types.path.segment :as path.segm]))
|
||||
|
||||
(defn orientation
|
||||
"Given three ordered points gives the orientation
|
||||
@@ -186,7 +186,7 @@
|
||||
rect-lines (points->lines rect-points)
|
||||
path-lines (if simple?
|
||||
(points->lines (:points shape))
|
||||
(gpp/path->lines shape))
|
||||
(path.segm/path->lines shape))
|
||||
start-point (-> shape :content (first) :params (gpt/point))]
|
||||
|
||||
(or (intersects-lines? rect-lines path-lines)
|
||||
|
||||
@@ -12,11 +12,10 @@
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes.bool :as gshb]
|
||||
[app.common.geom.shapes.common :as gco]
|
||||
[app.common.geom.shapes.path :as gpa]
|
||||
[app.common.math :as mth]
|
||||
[app.common.types.modifiers :as ctm]))
|
||||
[app.common.types.modifiers :as ctm]
|
||||
[app.common.types.path :as path]))
|
||||
|
||||
#?(:clj (set! *warn-on-reflection* true))
|
||||
|
||||
@@ -77,7 +76,11 @@
|
||||
position-data)
|
||||
position-data))))
|
||||
|
||||
;; FIXME: revist usage of mutability
|
||||
;; FIXME: review performance of this; this function is executing too
|
||||
;; many times, including when the point vector is 0,0. This function
|
||||
;; can be implemented in function of transform which is already mor
|
||||
;; performant
|
||||
|
||||
(defn move
|
||||
"Move the shape relatively to its current
|
||||
position applying the provided delta."
|
||||
@@ -96,7 +99,7 @@
|
||||
(d/update-when :y d/safe+ dy)
|
||||
(d/update-when :position-data move-position-data mvec)
|
||||
(cond-> (or (= :bool type) (= :path type))
|
||||
(update :content gpa/move-content mvec)))))
|
||||
(update :content path/move-content mvec)))))
|
||||
|
||||
;; --- Absolute Movement
|
||||
|
||||
@@ -321,7 +324,7 @@
|
||||
(update shape :position-data transform-position-data transform-mtx)
|
||||
shape)
|
||||
shape (if (or (= type :path) (= type :bool))
|
||||
(update shape :content gpa/transform-content transform-mtx)
|
||||
(update shape :content path/transform-content transform-mtx)
|
||||
(assoc shape
|
||||
:x (dm/get-prop selrect :x)
|
||||
:y (dm/get-prop selrect :y)
|
||||
@@ -354,7 +357,7 @@
|
||||
360)
|
||||
|
||||
shape (if (or (= type :path) (= type :bool))
|
||||
(update shape :content gpa/transform-content transform-mtx)
|
||||
(update shape :content path/transform-content transform-mtx)
|
||||
(assoc shape
|
||||
:x (dm/get-prop selrect :x)
|
||||
:y (dm/get-prop selrect :y)
|
||||
@@ -371,8 +374,14 @@
|
||||
"Given a new set of points transformed, set up the rectangle so it keeps
|
||||
its properties. We adjust de x,y,width,height and create a custom transform"
|
||||
[shape transform-mtx]
|
||||
(if ^boolean (gmt/move? transform-mtx)
|
||||
(cond
|
||||
(nil? transform-mtx)
|
||||
shape
|
||||
|
||||
^boolean (gmt/move? transform-mtx)
|
||||
(apply-transform-move shape transform-mtx)
|
||||
|
||||
:else
|
||||
(apply-transform-generic shape transform-mtx)))
|
||||
|
||||
(defn- update-group-viewbox
|
||||
@@ -444,25 +453,14 @@
|
||||
(assoc :flip-x (-> mask :flip-x))
|
||||
(assoc :flip-y (-> mask :flip-y)))))
|
||||
|
||||
(defn update-bool-selrect
|
||||
(defn update-bool
|
||||
"Calculates the selrect+points for the boolean shape"
|
||||
[shape children objects]
|
||||
|
||||
(let [content
|
||||
(gshb/calc-bool-content shape objects)
|
||||
|
||||
shape
|
||||
(assoc shape :content content)
|
||||
|
||||
[points selrect]
|
||||
(gpa/content->points+selrect shape content)]
|
||||
|
||||
(if (and (some? selrect) (d/not-empty? points))
|
||||
(-> shape
|
||||
(assoc :selrect selrect)
|
||||
(assoc :points points))
|
||||
(update-group-selrect shape children))))
|
||||
[shape objects]
|
||||
(let [content (path/calc-bool-content shape objects)
|
||||
shape (assoc shape :content content)]
|
||||
(path/update-geometry shape)))
|
||||
|
||||
;; FIXME: revisit
|
||||
(defn update-shapes-geometry
|
||||
[objects ids]
|
||||
(->> ids
|
||||
@@ -476,7 +474,7 @@
|
||||
(update-mask-selrect shape children)
|
||||
|
||||
(cfh/bool-shape? shape)
|
||||
(update-bool-selrect shape children objects)
|
||||
(update-bool shape objects)
|
||||
|
||||
(cfh/group-shape? shape)
|
||||
(update-group-selrect shape children)
|
||||
|
||||
@@ -25,11 +25,13 @@
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.types.page :as ctp]
|
||||
[app.common.types.pages-list :as ctpl]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.types.shape-tree :as ctst]
|
||||
[app.common.types.shape.interactions :as ctsi]
|
||||
[app.common.types.shape.layout :as ctl]
|
||||
[app.common.types.token :as cto]
|
||||
[app.common.types.typography :as cty]
|
||||
[app.common.types.variant :as ctv]
|
||||
[app.common.uuid :as uuid]
|
||||
[clojure.set :as set]
|
||||
[clojure.spec.alpha :as s]))
|
||||
@@ -37,9 +39,17 @@
|
||||
;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default
|
||||
(log/set-level! :warn)
|
||||
|
||||
;; Add uuids here to filter logs to only show specific shapes or containers (and all shapes
|
||||
;; contained in them).
|
||||
(def log-shape-ids #{})
|
||||
(def log-container-ids #{})
|
||||
|
||||
(def updatable-attrs (->> (seq (keys ctk/sync-attrs))
|
||||
;; We don't update the flex-child attrs
|
||||
(remove ctk/swap-keep-attrs)
|
||||
;; We don't do automatic update of the `layout-grid-cells` property.
|
||||
(remove #(= :layout-grid-cells %))))
|
||||
|
||||
(defn enabled-shape?
|
||||
[id container]
|
||||
(or (empty? log-shape-ids)
|
||||
@@ -144,7 +154,6 @@
|
||||
:update-new-shape update-new-shape
|
||||
:update-original-shape update-original-shape
|
||||
:force-id force-id)
|
||||
|
||||
remap-frame
|
||||
(fn [shape]
|
||||
; Remap all frame-ids internal to the component to the new shapes
|
||||
@@ -174,18 +183,20 @@
|
||||
|
||||
(defn generate-duplicate-component
|
||||
"Create a new component copied from the one with the given id."
|
||||
[changes library component-id new-component-id & {:keys [new-shape-id apply-changes-local-library? delta new-variant-id]}]
|
||||
[changes library component-id new-component-id & {:keys [new-shape-id apply-changes-local-library? delta new-variant-id page-id]}]
|
||||
(let [component (ctkl/get-component (:data library) component-id)
|
||||
new-name (:name component)
|
||||
|
||||
main-instance-page (ctf/get-component-page (:data library) component)
|
||||
;; Since variants, we can duplicate a component into another page
|
||||
target-page-id (or page-id (:id main-instance-page))
|
||||
|
||||
[new-main-instance-shape new-main-instance-shapes]
|
||||
(duplicate-component component new-component-id (:data library) new-shape-id delta new-variant-id)]
|
||||
|
||||
[new-main-instance-shape
|
||||
(-> changes
|
||||
(pcb/with-page main-instance-page)
|
||||
(pcb/with-page-id target-page-id)
|
||||
(pcb/with-objects (:objects main-instance-page))
|
||||
(pcb/add-objects new-main-instance-shapes {:ignore-touched true})
|
||||
(pcb/add-component new-component-id
|
||||
@@ -193,7 +204,7 @@
|
||||
new-name
|
||||
[]
|
||||
(:id new-main-instance-shape)
|
||||
(:id main-instance-page)
|
||||
target-page-id
|
||||
(:annotation component)
|
||||
(or new-variant-id (:variant-id component))
|
||||
(:variant-properties component)
|
||||
@@ -212,10 +223,12 @@
|
||||
"Generate changes to create a new instance from a component."
|
||||
([changes objects file-id component-id position page libraries]
|
||||
(generate-instantiate-component changes objects file-id component-id position page libraries nil nil nil {}))
|
||||
|
||||
([changes objects file-id component-id position page libraries old-id parent-id frame-id
|
||||
([changes objects file-id component-id position page libraries old-id parent-id frame-id params]
|
||||
(generate-instantiate-component changes objects file-id component-id position page libraries old-id parent-id frame-id {} params))
|
||||
([changes objects file-id component-id position page libraries old-id parent-id frame-id ids-map
|
||||
{:keys [force-frame?]
|
||||
:or {force-frame? false}}]
|
||||
|
||||
(let [component (ctf/get-component libraries file-id component-id)
|
||||
library (get libraries file-id)
|
||||
parent (when parent-id (get objects parent-id))
|
||||
@@ -235,6 +248,9 @@
|
||||
(:data library)
|
||||
position
|
||||
(cond-> {}
|
||||
(contains? ids-map old-id)
|
||||
(assoc :force-id (get ids-map old-id))
|
||||
|
||||
force-frame?
|
||||
(assoc :force-frame-id frame-id)))
|
||||
|
||||
@@ -256,8 +272,11 @@
|
||||
(cond-> (pcb/add-object changes first-shape {:ignore-touched true})
|
||||
(some? old-id) (pcb/amend-last-change #(assoc % :old-id old-id)))
|
||||
|
||||
duplicated-parent?
|
||||
(->> ids-map vals (some #(= % (:parent-id first-shape))))
|
||||
|
||||
changes
|
||||
(if (ctl/grid-layout? objects (:parent-id first-shape))
|
||||
(if (and (ctl/grid-layout? objects (:parent-id first-shape)) (not duplicated-parent?))
|
||||
(let [target-cell (-> position meta :cell)
|
||||
|
||||
[row column]
|
||||
@@ -285,6 +304,7 @@
|
||||
|
||||
(declare generate-detach-recursive)
|
||||
(declare generate-advance-nesting-level)
|
||||
(declare generate-detach-immediate)
|
||||
|
||||
(defn generate-detach-instance
|
||||
"Generate changes to remove the links between a shape and all its children
|
||||
@@ -298,60 +318,84 @@
|
||||
(defn- generate-detach-recursive
|
||||
[changes container libraries shape-id first component-root?]
|
||||
(let [shape (ctn/get-shape container shape-id)]
|
||||
(shape-log :trace shape-id container
|
||||
:msg " Processing" :shape-id shape-id)
|
||||
(if (and (ctk/instance-head? shape) (not first))
|
||||
; Subinstances are not detached
|
||||
(cond-> changes
|
||||
component-root?
|
||||
; If the initial shape was component-root, first level subinstances are converted in top instances
|
||||
(pcb/update-shapes [shape-id] #(assoc % :component-root true))
|
||||
(pcb/update-shapes [shape-id] #(do (log/trace :msg " -> promote to root")
|
||||
(assoc % :component-root true)))
|
||||
|
||||
:always
|
||||
; First level subinstances of a detached component can't have swap-slot
|
||||
(pcb/update-shapes [shape-id] ctk/remove-swap-slot)
|
||||
(pcb/update-shapes [shape-id] #(do (log/trace :msg " -> remove swap-slot")
|
||||
(ctk/remove-swap-slot %)))
|
||||
|
||||
(nil? (ctk/get-swap-slot shape))
|
||||
; Near shape-refs need to be advanced one level (except if the head is already swapped)
|
||||
; Near shape-ref of shape and children need to be advanced one level
|
||||
; (except if the head is already swapped)
|
||||
(generate-advance-nesting-level nil container libraries (:id shape)))
|
||||
|
||||
;; Otherwise, detach the shape and all children
|
||||
(let [children-ids (:shapes shape)]
|
||||
(log/trace :msg " -> detach")
|
||||
(reduce #(generate-detach-recursive %1 container libraries %2 false component-root?)
|
||||
(pcb/update-shapes changes [(:id shape)] ctk/detach-shape)
|
||||
children-ids)))))
|
||||
|
||||
(defn- generate-advance-nesting-level
|
||||
[changes file container libraries shape-id]
|
||||
(let [children (cfh/get-children-with-self (:objects container) shape-id)
|
||||
skip-near (fn [changes shape]
|
||||
(let [ref-shape (ctf/find-ref-shape file container libraries shape {:include-deleted? true})]
|
||||
(cond-> changes
|
||||
(some? (:shape-ref ref-shape))
|
||||
(pcb/update-shapes [(:id shape)] #(assoc % :shape-ref (:shape-ref ref-shape)))
|
||||
(log/trace :msg " -> advance-nesting-level")
|
||||
(let [detached-ids (atom #{})
|
||||
children (cfh/get-children-with-self (:objects container) shape-id) ;; TODO: this function should be refactored to be a recursive tree traversal.
|
||||
skip-near (fn [changes shape] ;; this way we could shake the tree more easily when detaching shapes
|
||||
(shape-log :trace (:id shape) container ;; and perhaps even allow to recover nested instances that have been
|
||||
:msg " * advancing" :shape-id (:id shape)) ;; swapped and so we can access the main instance again.
|
||||
(if (contains? @detached-ids (:id shape))
|
||||
(do (log/trace :msg " (detached)")
|
||||
changes)
|
||||
(let [ref-shape (ctf/find-ref-shape file container libraries shape {:include-deleted? true})]
|
||||
(cond-> changes
|
||||
(some? (:shape-ref ref-shape))
|
||||
(pcb/update-shapes [(:id shape)] #(do (log/trace :msg " (advanced)")
|
||||
(assoc % :shape-ref (:shape-ref ref-shape))))
|
||||
|
||||
;; When advancing level, the normal touched groups (not swap slots) of the
|
||||
;; ref-shape must be merged into the current shape, because they refer to
|
||||
;; the new referenced shape.
|
||||
(some? ref-shape)
|
||||
(pcb/update-shapes
|
||||
[(:id shape)]
|
||||
#(assoc % :touched
|
||||
(clojure.set/union (:touched shape)
|
||||
(ctk/normal-touched-groups ref-shape))))
|
||||
;; When advancing level, the normal touched groups (not swap slots) of the
|
||||
;; ref-shape must be merged into the current shape, because they refer to
|
||||
;; the new referenced shape.
|
||||
(some? ref-shape)
|
||||
(pcb/update-shapes
|
||||
[(:id shape)]
|
||||
#(do (log/trace :msg " (merge touched)")
|
||||
(assoc % :touched
|
||||
(clojure.set/union (:touched shape)
|
||||
(ctk/normal-touched-groups ref-shape)))))
|
||||
|
||||
;; Swap slot must also be copied if the current shape has not any,
|
||||
;; except if this is the first level subcopy.
|
||||
(and (some? (ctk/get-swap-slot ref-shape))
|
||||
(nil? (ctk/get-swap-slot shape))
|
||||
(not= (:id shape) shape-id))
|
||||
(pcb/update-shapes [(:id shape)] #(ctk/set-swap-slot % (ctk/get-swap-slot ref-shape)))
|
||||
;; Swap slot must also be copied if the current shape has not any,
|
||||
;; except if this is the first level subcopy.
|
||||
(and (some? (ctk/get-swap-slot ref-shape))
|
||||
(nil? (ctk/get-swap-slot shape))
|
||||
(not= (:id shape) shape-id))
|
||||
(pcb/update-shapes [(:id shape)] #(do (log/trace :msg " (got swap-slot)")
|
||||
(ctk/set-swap-slot % (ctk/get-swap-slot ref-shape))))
|
||||
|
||||
;; If we can't get the ref-shape (e.g. it's in an external library not linked),
|
||||
;: we can't do a suitable advance. So it's better to detach the shape
|
||||
(nil? ref-shape)
|
||||
(pcb/update-shapes [(:id shape)] ctk/detach-shape))))]
|
||||
;; If we can't get the ref-shape (e.g. it's in an external library not linked),
|
||||
;: we can't do a suitable advance. So it's better to detach the shape and all its
|
||||
;; children (and add to detached-ids so they are not processed again).
|
||||
(nil? ref-shape)
|
||||
(generate-detach-immediate container (:id shape) detached-ids)))))]
|
||||
|
||||
(reduce skip-near changes children)))
|
||||
|
||||
(defn- generate-detach-immediate
|
||||
[changes container shape-id detached-ids]
|
||||
(let [shape-and-children (cfh/get-children-ids-with-self (:objects container) shape-id)]
|
||||
(log/trace :msg " (cannot advance; detach shape and children)")
|
||||
(swap! detached-ids #(into % shape-and-children))
|
||||
(pcb/update-shapes changes shape-and-children ctk/detach-shape)))
|
||||
|
||||
(defn prepare-restore-component
|
||||
([changes library-data component-id current-page]
|
||||
(let [component (ctkl/get-deleted-component library-data component-id)
|
||||
@@ -394,6 +438,8 @@
|
||||
(not inside-component?)
|
||||
(assoc :component-root true))
|
||||
|
||||
restoring-into-parent (get objects (:parent-id first-shape))
|
||||
|
||||
changes (-> changes
|
||||
(pcb/with-page page)
|
||||
(pcb/with-objects (:objects page))
|
||||
@@ -404,12 +450,15 @@
|
||||
changes
|
||||
(rest moved-shapes))
|
||||
changes (cond-> changes
|
||||
;; Remove variant info when restoring into a parent that is not a variant-container
|
||||
(and is-variant? parent (not (ctk/is-variant-container? parent)))
|
||||
;; Transform variant info into name when restoring into a parent that is not a variant-container,
|
||||
;; or when restoring into a variant-container that doesn't exists anymore
|
||||
(and is-variant?
|
||||
(or (and parent (not (ctk/is-variant-container? parent)))
|
||||
(nil? restoring-into-parent)))
|
||||
(clvp/generate-make-shapes-no-variant [first-shape])
|
||||
;; Add variant info and rename when restoring into a variant-container
|
||||
(ctk/is-variant-container? parent)
|
||||
(clvp/generate-make-shapes-variant [first-shape] parent))]
|
||||
(ctk/is-variant-container? restoring-into-parent)
|
||||
(clvp/generate-make-shapes-variant [first-shape] restoring-into-parent))]
|
||||
{:changes (pcb/restore-component changes component-id (:id page) minusdelta)
|
||||
:shape (first moved-shapes)})))
|
||||
|
||||
@@ -1571,6 +1620,75 @@
|
||||
:val dest-tokens
|
||||
:ignore-touched true}]}))))))
|
||||
|
||||
(defn- generate-update-tokens
|
||||
[changes container dest-shape origin-shape touched omit-touched?]
|
||||
(let [attrs (->> (seq (keys ctk/sync-attrs))
|
||||
;; We don't update the flex-child attrs
|
||||
(remove #(= :layout-grid-cells %)))
|
||||
|
||||
applied-tokens (reduce (fn [applied-tokens attr]
|
||||
(let [attr-group (get ctk/sync-attrs attr)
|
||||
token-attrs (cto/shape-attr->token-attrs attr)]
|
||||
(if (not (and (touched attr-group)
|
||||
omit-touched?))
|
||||
(into applied-tokens token-attrs)
|
||||
applied-tokens)))
|
||||
#{}
|
||||
attrs)]
|
||||
(cond-> changes
|
||||
(seq applied-tokens)
|
||||
(update-tokens container dest-shape origin-shape applied-tokens))))
|
||||
|
||||
(defn- add-update-attr-changes
|
||||
[changes dest-shape container roperations uoperations]
|
||||
(let [all-parents (cfh/get-parent-ids (:objects container)
|
||||
(:id dest-shape))]
|
||||
(-> changes
|
||||
(update :redo-changes conj (make-change
|
||||
container
|
||||
{:type :mod-obj
|
||||
:id (:id dest-shape)
|
||||
:operations roperations}))
|
||||
(update :redo-changes conj (make-change
|
||||
container
|
||||
{:type :reg-objects
|
||||
:shapes all-parents}))
|
||||
(update :undo-changes conj (make-change
|
||||
container
|
||||
{:type :mod-obj
|
||||
:id (:id dest-shape)
|
||||
:operations (vec uoperations)}))
|
||||
(update :undo-changes concat [(make-change
|
||||
container
|
||||
{:type :reg-objects
|
||||
:shapes all-parents})]))))
|
||||
|
||||
(defn- add-update-attr-operations
|
||||
[attr dest-shape origin-shape roperations uoperations touched]
|
||||
(let [;; position-data is a special case because can be affected by :geometry-group and :content-group
|
||||
;; so, if the position-data changes but the geometry is touched we need to reset the position-data
|
||||
;; so it's calculated again
|
||||
reset-pos-data?
|
||||
(and (cfh/text-shape? origin-shape)
|
||||
(= attr :position-data)
|
||||
(not= (get origin-shape attr) (get dest-shape attr))
|
||||
(touched :geometry-group))
|
||||
|
||||
roperation {:type :set
|
||||
:attr attr
|
||||
:val (cond
|
||||
;; If position data changes and the geometry group is touched
|
||||
;; we need to put to nil so we can regenerate it
|
||||
reset-pos-data? nil
|
||||
:else (get origin-shape attr))
|
||||
:ignore-touched true}
|
||||
uoperation {:type :set
|
||||
:attr attr
|
||||
:val (get dest-shape attr)
|
||||
:ignore-touched true}]
|
||||
[(conj roperations roperation)
|
||||
(conj uoperations uoperation)]))
|
||||
|
||||
(defn- update-attrs
|
||||
"The main function that implements the attribute sync algorithm. Copy
|
||||
attributes that have changed in the origin shape to the dest shape.
|
||||
@@ -1601,97 +1719,68 @@
|
||||
origin-shape (reposition-shape origin-shape origin-root dest-root)
|
||||
touched (get dest-shape :touched #{})]
|
||||
|
||||
(loop [attrs (->> (seq (keys ctk/sync-attrs))
|
||||
;; We don't update the flex-child attrs
|
||||
(remove ctk/swap-keep-attrs)
|
||||
;; We don't do automatic update of the `layout-grid-cells` property.
|
||||
(remove #(= :layout-grid-cells %)))
|
||||
applied-tokens #{}
|
||||
(loop [attrs updatable-attrs
|
||||
roperations []
|
||||
uoperations '()]
|
||||
|
||||
(let [attr (first attrs)]
|
||||
(if (nil? attr)
|
||||
(if (and (empty? roperations) (empty? applied-tokens))
|
||||
changes
|
||||
(let [all-parents (cfh/get-parent-ids (:objects container)
|
||||
(:id dest-shape))
|
||||
(cond-> changes
|
||||
(seq roperations)
|
||||
(add-update-attr-changes dest-shape container roperations uoperations)
|
||||
:always
|
||||
(generate-update-tokens container dest-shape origin-shape touched omit-touched?))
|
||||
|
||||
;; Sync tokens of attributes ignored above.
|
||||
;; FIXME: this probably may be merged with the other calculation
|
||||
;; of applied tokens, below, and to the calculation only once
|
||||
;; for all sync-attrs.
|
||||
applied-tokens (reduce (fn [applied-tokens attr]
|
||||
(let [attr-group (get ctk/sync-attrs attr)
|
||||
token-attrs (cto/shape-attr->token-attrs attr)]
|
||||
(if (not (and (touched attr-group)
|
||||
omit-touched?))
|
||||
(into applied-tokens token-attrs)
|
||||
applied-tokens)))
|
||||
applied-tokens
|
||||
ctk/swap-keep-attrs)]
|
||||
(cond-> changes
|
||||
(seq roperations)
|
||||
(-> (update :redo-changes conj (make-change
|
||||
container
|
||||
{:type :mod-obj
|
||||
:id (:id dest-shape)
|
||||
:operations roperations}))
|
||||
(update :redo-changes conj (make-change
|
||||
container
|
||||
{:type :reg-objects
|
||||
:shapes all-parents}))
|
||||
(update :undo-changes conj (make-change
|
||||
container
|
||||
{:type :mod-obj
|
||||
:id (:id dest-shape)
|
||||
:operations (vec uoperations)}))
|
||||
(update :undo-changes concat [(make-change
|
||||
container
|
||||
{:type :reg-objects
|
||||
:shapes all-parents})]))
|
||||
(seq applied-tokens)
|
||||
(update-tokens container dest-shape origin-shape applied-tokens))))
|
||||
(let [attr-group (get ctk/sync-attrs attr)
|
||||
[roperations' uoperations']
|
||||
(if (or (= (get origin-shape attr) (get dest-shape attr))
|
||||
(and (touched attr-group) omit-touched?))
|
||||
[roperations uoperations]
|
||||
(add-update-attr-operations attr dest-shape origin-shape roperations uoperations touched))]
|
||||
(recur (next attrs)
|
||||
roperations'
|
||||
uoperations')))))))
|
||||
|
||||
(let [;; position-data is a special case because can be affected by :geometry-group and :content-group
|
||||
;; so, if the position-data changes but the geometry is touched we need to reset the position-data
|
||||
;; so it's calculated again
|
||||
reset-pos-data?
|
||||
(and (cfh/text-shape? origin-shape)
|
||||
(= attr :position-data)
|
||||
(not= (get origin-shape attr) (get dest-shape attr))
|
||||
(touched :geometry-group))
|
||||
(defn update-attrs-on-switch
|
||||
"Copy attributes that have changed in the origin shape to the dest shape. Used on variants switch"
|
||||
[changes dest-shape origin-shape dest-root origin-root origin-ref-shape container]
|
||||
(let [;; We need to sync only the position relative to the origin of the component.
|
||||
;; (see update-attrs for a full explanation)
|
||||
origin-shape (reposition-shape origin-shape origin-root dest-root)
|
||||
touched (get dest-shape :touched #{})
|
||||
touched-origin (get origin-shape :touched #{})]
|
||||
|
||||
roperation {:type :set
|
||||
:attr attr
|
||||
:val (cond
|
||||
;; If position data changes and the geometry group is touched
|
||||
;; we need to put to nil so we can regenerate it
|
||||
reset-pos-data? nil
|
||||
:else (get origin-shape attr))
|
||||
:ignore-touched true}
|
||||
uoperation {:type :set
|
||||
:attr attr
|
||||
:val (get dest-shape attr)
|
||||
:ignore-touched true}
|
||||
(loop [attrs updatable-attrs
|
||||
roperations [{:type :set-touched :touched (:touched origin-shape)}]
|
||||
uoperations (list {:type :set-touched :touched (:touched dest-shape)})]
|
||||
(if-let [attr (first attrs)]
|
||||
(let [attr-group (get ctk/sync-attrs attr)
|
||||
[roperations' uoperations']
|
||||
(if (or
|
||||
;; If the attribute is not valid for the destiny, don't copy it
|
||||
(not (cts/is-allowed-attr? attr (:type dest-shape)))
|
||||
;; If the values are already equal, don't copy it
|
||||
(= (get origin-shape attr) (get dest-shape attr))
|
||||
;; If the referenced shape on the original component doesn't have the same value, don't copy it
|
||||
;; Exceptions: :points :selrect and :content can be different
|
||||
(and
|
||||
(not (contains? #{:points :selrect :content} attr))
|
||||
(not= (get origin-ref-shape attr) (get dest-shape attr)))
|
||||
;; The :content attr cant't be copied to elements of different type
|
||||
(and (= attr :content) (not= (:type origin-shape) (:type dest-shape)))
|
||||
;; If the attr is not touched in the origin shape, don't copy it
|
||||
(not (touched-origin attr-group)))
|
||||
[roperations uoperations]
|
||||
(add-update-attr-operations attr dest-shape origin-shape roperations uoperations touched))]
|
||||
(recur (next attrs)
|
||||
roperations'
|
||||
uoperations'))
|
||||
(cond-> changes
|
||||
(> (count roperations) 1)
|
||||
(add-update-attr-changes dest-shape container roperations uoperations)
|
||||
|
||||
attr-group (get ctk/sync-attrs attr)
|
||||
|
||||
token-attrs (cto/shape-attr->token-attrs attr)
|
||||
applied-tokens' (cond-> applied-tokens
|
||||
(not (and (touched attr-group)
|
||||
omit-touched?))
|
||||
(into token-attrs))]
|
||||
(if (or (= (get origin-shape attr) (get dest-shape attr))
|
||||
(and (touched attr-group) omit-touched?))
|
||||
(recur (next attrs)
|
||||
applied-tokens'
|
||||
roperations
|
||||
uoperations)
|
||||
(recur (next attrs)
|
||||
applied-tokens'
|
||||
(conj roperations roperation)
|
||||
(conj uoperations uoperation)))))))))
|
||||
:always
|
||||
(generate-update-tokens container dest-shape origin-shape touched false))))))
|
||||
|
||||
(defn- propagate-attrs
|
||||
"Helper that puts the origin attributes (attrs) into dest but only if
|
||||
@@ -1947,17 +2036,26 @@
|
||||
[changes library-data component-id library-id current-page objects]
|
||||
(let [{:keys [changes shape]} (prepare-restore-component changes library-data component-id current-page)
|
||||
parent-id (:parent-id shape)
|
||||
objects (cond-> (assoc objects (:id shape) shape)
|
||||
(not (nil? parent-id))
|
||||
(update-in [parent-id :shapes]
|
||||
#(conj % (:id shape))))
|
||||
|
||||
insert-before?
|
||||
(and (ctl/flex-layout? objects parent-id)
|
||||
(not (ctl/reverse? objects parent-id)))
|
||||
|
||||
objects
|
||||
(-> objects
|
||||
(assoc (:id shape) shape)
|
||||
(cond-> (and (some? parent-id) insert-before?)
|
||||
(update-in [parent-id :shapes] #(d/concat-vec [(:id shape)] %)))
|
||||
(cond-> (and (some? parent-id) (not insert-before?))
|
||||
(update-in [parent-id :shapes] conj (:id shape))))
|
||||
|
||||
;; Adds a resize-parents operation so the groups are updated. We add all the new objects
|
||||
new-objects-ids (->> changes :redo-changes (filter #(= (:type %) :add-obj)) (mapv :id))
|
||||
changes (-> changes
|
||||
(pcb/with-objects objects)
|
||||
(pcb/resize-parents new-objects-ids))]
|
||||
|
||||
(pcb/resize-parents new-objects-ids)
|
||||
;; Fix the order of the children inside the parent
|
||||
(pcb/reorder-children parent-id (get-in objects [parent-id :shapes])))]
|
||||
(assoc changes :file-id library-id)))
|
||||
|
||||
(defn generate-detach-component
|
||||
@@ -2130,7 +2228,7 @@
|
||||
frames)))
|
||||
|
||||
(defn- duplicate-variant
|
||||
[changes library component base-pos parent-id]
|
||||
[changes library component base-pos parent-id page-id]
|
||||
(let [component-page (ctpl/get-page (:data library) (:main-instance-page component))
|
||||
component-shape (dm/get-in component-page [:objects (:main-instance-id component)])
|
||||
orig-pos (gpt/point (:x component-shape) (:y component-shape))
|
||||
@@ -2138,11 +2236,12 @@
|
||||
new-component-id (uuid/next)
|
||||
[shape changes] (generate-duplicate-component changes
|
||||
library
|
||||
(:component-id component-shape)
|
||||
(:id component)
|
||||
new-component-id
|
||||
{:apply-changes-local-library? true
|
||||
:delta delta
|
||||
:new-variant-id parent-id})]
|
||||
:new-variant-id parent-id
|
||||
:page-id page-id})]
|
||||
[shape
|
||||
(-> changes
|
||||
(pcb/change-parent parent-id [shape]))]))
|
||||
@@ -2182,7 +2281,8 @@
|
||||
(get libraries file-id)
|
||||
component
|
||||
pos
|
||||
parent-id)
|
||||
parent-id
|
||||
(:id page))
|
||||
|
||||
(generate-instantiate-component changes
|
||||
objects
|
||||
@@ -2194,6 +2294,7 @@
|
||||
main-id
|
||||
parent-id
|
||||
frame-id
|
||||
ids-map
|
||||
{})))]
|
||||
changes))
|
||||
|
||||
@@ -2283,8 +2384,9 @@
|
||||
(cond-> (ctk/is-variant-container? parent)
|
||||
(assoc :variant-id parent-id))
|
||||
|
||||
(cond-> (not (ctk/is-variant-container? parent))
|
||||
(dissoc :variant-id)))
|
||||
(cond-> (and (ctk/is-variant? obj) (not (ctk/is-variant-container? parent)))
|
||||
(-> (assoc :name (ctv/variant-name-to-name obj))
|
||||
(dissoc :variant-id))))
|
||||
|
||||
new-obj (cond-> new-obj
|
||||
(not duplicating-component?)
|
||||
|
||||
@@ -95,10 +95,7 @@
|
||||
|
||||
(defn- generate-make-shape-no-variant
|
||||
[changes shape]
|
||||
(let [data (pcb/get-library-data changes)
|
||||
component (ctcl/get-component data (:component-id shape) true)
|
||||
full-name (cfh/merge-path-item (:path component) (:name component))
|
||||
new-name (cfh/merge-path-item full-name (str/replace (:variant-name shape) #", " " / "))
|
||||
(let [new-name (ctv/variant-name-to-name shape)
|
||||
[cpath cname] (cfh/parse-path-name new-name)]
|
||||
(-> changes
|
||||
(pcb/update-component (:component-id shape)
|
||||
@@ -115,9 +112,10 @@
|
||||
(reduce generate-make-shape-no-variant changes shapes))
|
||||
|
||||
|
||||
(defn- generate-new-properties-from-variant
|
||||
(defn- create-new-properties-from-variant
|
||||
[shape min-props data container-name base-properties]
|
||||
(let [component (ctcl/get-component data (:component-id shape) true)
|
||||
|
||||
add-name? (not= (:name component) container-name)
|
||||
props (ctv/merge-properties base-properties
|
||||
(:variant-properties component))
|
||||
@@ -130,7 +128,7 @@
|
||||
(ctv/add-new-prop props (:name component))
|
||||
props)))
|
||||
|
||||
(defn- generate-new-properties-from-non-variant
|
||||
(defn- create-new-properties-from-non-variant
|
||||
[shape min-props container-name base-properties]
|
||||
(let [;; Remove container name from shape name if present
|
||||
shape-name (ctv/remove-prefix (:name shape) container-name)]
|
||||
@@ -158,14 +156,14 @@
|
||||
[cpath cname] (cfh/parse-path-name (:name variant-container))
|
||||
container-name (:name variant-container)
|
||||
|
||||
generate-new-properties
|
||||
create-new-properties
|
||||
(fn [shape min-props]
|
||||
(if (ctk/is-variant? shape)
|
||||
(generate-new-properties-from-variant shape min-props data container-name base-props)
|
||||
(generate-new-properties-from-non-variant shape min-props container-name base-props)))
|
||||
(create-new-properties-from-variant shape min-props data container-name base-props)
|
||||
(create-new-properties-from-non-variant shape min-props container-name base-props)))
|
||||
|
||||
total-props (reduce (fn [m shape]
|
||||
(max m (count (generate-new-properties shape num-base-props))))
|
||||
(max m (count (create-new-properties shape num-base-props))))
|
||||
0
|
||||
shapes)
|
||||
|
||||
@@ -183,19 +181,21 @@
|
||||
:name (:name variant-container)))]
|
||||
(reduce
|
||||
(fn [changes shape]
|
||||
(if (or (zero? num-base-props)
|
||||
(= variant-id (:variant-id shape)))
|
||||
changes ;; do nothing more if we aren't changing the parent or there are no base props
|
||||
(let [props (generate-new-properties shape total-props)
|
||||
variant-name (ctv/properties-to-name props)]
|
||||
(-> (pcb/update-component changes
|
||||
(:component-id shape)
|
||||
#(assoc % :variant-id variant-id
|
||||
:variant-properties props
|
||||
:name cname
|
||||
:path cpath)
|
||||
{:apply-changes-local-library? true})
|
||||
(pcb/update-shapes [(:id shape)]
|
||||
#(assoc % :variant-name variant-name))))))
|
||||
(let [component (ctcl/get-component data (:component-id shape) true)]
|
||||
(if (or (zero? num-base-props) ;; do nothing if there are no base props
|
||||
(and (= variant-id (:variant-id shape)) ;; or we are only moving the shape inside its parent (it is
|
||||
(not (:deleted component)))) ;; the same parent and the component isn't deleted)
|
||||
changes
|
||||
(let [props (create-new-properties shape total-props)
|
||||
variant-name (ctv/properties-to-name props)]
|
||||
(-> (pcb/update-component changes
|
||||
(:component-id shape)
|
||||
#(assoc % :variant-id variant-id
|
||||
:variant-properties props
|
||||
:name cname
|
||||
:path cpath)
|
||||
{:apply-changes-local-library? true})
|
||||
(pcb/update-shapes [(:id shape)]
|
||||
#(assoc % :variant-name variant-name)))))))
|
||||
changes
|
||||
shapes)))
|
||||
shapes)))
|
||||
|
||||
@@ -1,12 +1,29 @@
|
||||
(ns app.common.logic.variants
|
||||
(:require
|
||||
[app.common.files.changes-builder :as pcb]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.files.variant :as cfv]
|
||||
[app.common.logic.libraries :as cll]
|
||||
[app.common.logic.variant-properties :as clvp]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.types.variant :as ctv]))
|
||||
|
||||
|
||||
(defn- generate-path
|
||||
[path objects base-id shape]
|
||||
(let [get-type #(case %
|
||||
:frame :container
|
||||
:group :container
|
||||
:rect :shape
|
||||
:circle :shape
|
||||
:bool :shape
|
||||
:path :shape
|
||||
%)]
|
||||
(if (= base-id (:id shape))
|
||||
path
|
||||
(generate-path (str path " " (:name shape) (get-type (:type shape))) objects base-id (get objects (:parent-id shape))))))
|
||||
|
||||
(defn generate-add-new-variant
|
||||
[changes shape variant-id new-component-id new-shape-id prop-num]
|
||||
(let [data (pcb/get-library-data changes)
|
||||
@@ -28,3 +45,26 @@
|
||||
(-> changes
|
||||
(clvp/generate-update-property-value new-component-id prop-num value)
|
||||
(pcb/change-parent (:parent-id shape) [new-shape] 0))))
|
||||
|
||||
(defn generate-keep-touched
|
||||
[changes new-shape original-shape original-shapes page libraries]
|
||||
(let [objects (pcb/get-objects changes)
|
||||
new-path-map (into {}
|
||||
(map (fn [shape] {(generate-path "" objects (:id new-shape) shape) shape}))
|
||||
(cfh/get-children-with-self objects (:id new-shape)))
|
||||
|
||||
orig-touched (filter (comp seq :touched) original-shapes)
|
||||
orig-objects (into {} (map (juxt :id identity) original-shapes))
|
||||
container (ctn/make-container page :page)]
|
||||
(reduce
|
||||
(fn [changes touched-shape]
|
||||
(let [path (generate-path "" orig-objects (:id original-shape) touched-shape)
|
||||
related-shape (get new-path-map path)
|
||||
orig-ref-shape (ctf/find-ref-shape nil container libraries touched-shape)]
|
||||
(if related-shape
|
||||
(cll/update-attrs-on-switch
|
||||
changes related-shape touched-shape new-shape original-shape orig-ref-shape container)
|
||||
changes)))
|
||||
changes
|
||||
orig-touched)))
|
||||
|
||||
|
||||
@@ -9,6 +9,7 @@
|
||||
#?(:cljs (:require-macros [app.common.schema :refer [ignoring]]))
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.math :as mth]
|
||||
[app.common.pprint :as pp]
|
||||
[app.common.schema.generators :as sg]
|
||||
[app.common.schema.openapi :as-alias oapi]
|
||||
@@ -27,10 +28,6 @@
|
||||
[malli.transform :as mt]
|
||||
[malli.util :as mu]))
|
||||
|
||||
(defprotocol ILazySchema
|
||||
(-validate [_ o])
|
||||
(-explain [_ o]))
|
||||
|
||||
(def default-options
|
||||
{:registry sr/default-registry})
|
||||
|
||||
@@ -50,10 +47,6 @@
|
||||
[s]
|
||||
(m/type-properties s))
|
||||
|
||||
(defn- lazy-schema?
|
||||
[s]
|
||||
(satisfies? ILazySchema s))
|
||||
|
||||
(defn schema
|
||||
[s]
|
||||
(if (schema? s)
|
||||
@@ -110,8 +103,16 @@
|
||||
(malli.error/error-value exp {:malli.error/mask-valid-values '...}))
|
||||
|
||||
(defn optional-keys
|
||||
[schema]
|
||||
(mu/optional-keys schema default-options))
|
||||
([schema]
|
||||
(mu/optional-keys schema nil default-options))
|
||||
([schema keys]
|
||||
(mu/optional-keys schema keys default-options)))
|
||||
|
||||
(defn required-keys
|
||||
([schema]
|
||||
(mu/required-keys schema nil default-options))
|
||||
([schema keys]
|
||||
(mu/required-keys schema keys default-options)))
|
||||
|
||||
(defn transformer
|
||||
[& transformers]
|
||||
@@ -145,11 +146,30 @@
|
||||
;; :else
|
||||
;; o))
|
||||
|
||||
(defn -transform-map-keys
|
||||
([f]
|
||||
(let [xform (map (fn [[k v]] [(f k) v]))]
|
||||
#(cond->> % (map? %) (into (empty %) xform))))
|
||||
([ks f]
|
||||
(let [xform (map (fn [[k v]] [(cond-> k (contains? ks k) f) v]))]
|
||||
#(cond->> % (map? %) (into (empty %) xform)))))
|
||||
|
||||
(defn json-transformer
|
||||
[]
|
||||
(mt/transformer
|
||||
(mt/json-transformer)
|
||||
(mt/collection-transformer)))
|
||||
(let [map-of-key-decoders (mt/-string-decoders)]
|
||||
(mt/transformer
|
||||
{:name :json
|
||||
:decoders (-> (mt/-json-decoders)
|
||||
(assoc :map-of {:compile (fn [schema _]
|
||||
(let [key-schema (some-> schema (m/children) (first))]
|
||||
(or (some-> key-schema (m/type) map-of-key-decoders
|
||||
(mt/-interceptor schema {}) (m/-intercepting)
|
||||
(m/-comp m/-keyword->string)
|
||||
(mt/-transform-if-valid key-schema)
|
||||
(-transform-map-keys))
|
||||
(-transform-map-keys m/-keyword->string))))}))
|
||||
:encoders (mt/-json-encoders)}
|
||||
(mt/collection-transformer))))
|
||||
|
||||
(defn string-transformer
|
||||
[]
|
||||
@@ -205,6 +225,11 @@
|
||||
(let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))]
|
||||
(fn [v] (@vfn v))))
|
||||
|
||||
(defn decode-fn
|
||||
[s transformer]
|
||||
(let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))]
|
||||
(fn [v] (@vfn v))))
|
||||
|
||||
(defn humanize-explain
|
||||
"Returns a string representation of the explain data structure"
|
||||
[{:keys [errors value]} & {:keys [length level]}]
|
||||
@@ -250,38 +275,36 @@
|
||||
([s] (lookup sr/default-registry s))
|
||||
([registry s] (schema (mr/schema registry s))))
|
||||
|
||||
(defn- fast-check
|
||||
"A fast path for checking process, assumes the ILazySchema protocol
|
||||
implemented on the provided `s` schema. Sould not be used directly."
|
||||
[s type code hint value]
|
||||
(when-not ^boolean (-validate s value)
|
||||
(let [explain (-explain s value)]
|
||||
(throw (ex-info hint {:type type
|
||||
:code code
|
||||
:hint hint
|
||||
::explain explain}))))
|
||||
value)
|
||||
|
||||
(declare ^:private lazy-schema)
|
||||
|
||||
(defn check-fn
|
||||
"Create a predefined check function"
|
||||
[s & {:keys [hint type code]}]
|
||||
(let [schema (if (lazy-schema? s) s (lazy-schema s))
|
||||
hint (or ^boolean hint "check error")
|
||||
type (or ^boolean type :assertion)
|
||||
code (or ^boolean code :data-validation)]
|
||||
(partial fast-check schema type code hint)))
|
||||
(let [s (schema s)
|
||||
validator* (delay (m/validator s))
|
||||
explainer* (delay (m/explainer s))
|
||||
hint (or ^boolean hint "check error")
|
||||
type (or ^boolean type :assertion)
|
||||
code (or ^boolean code :data-validation)]
|
||||
|
||||
(fn [value]
|
||||
(let [validate-fn @validator*]
|
||||
(when-not ^boolean (validate-fn value)
|
||||
(let [explain-fn @explainer*
|
||||
explain (explain-fn value)]
|
||||
(throw (ex-info hint {:type type
|
||||
:code code
|
||||
:hint hint
|
||||
::explain explain}))))
|
||||
value))))
|
||||
|
||||
(defn check
|
||||
"A helper intended to be used on assertions for validate/check the
|
||||
schema over provided data. Raises an assertion exception."
|
||||
[s value & {:keys [hint type code]}]
|
||||
(let [s (if (lazy-schema? s) s (lazy-schema s))
|
||||
hint (or ^boolean hint "check error")
|
||||
type (or ^boolean type :assertion)
|
||||
code (or ^boolean code :data-validation)]
|
||||
(fast-check s type code hint value)))
|
||||
schema over provided data. Raises an assertion exception.
|
||||
|
||||
Use only on non-performance sensitive code, because it creates the
|
||||
check-fn instance all the time it is invoked."
|
||||
[s value & {:as opts}]
|
||||
(let [check-fn (check-fn s opts)]
|
||||
(check-fn value)))
|
||||
|
||||
(defn type-schema
|
||||
[& {:as params}]
|
||||
@@ -295,11 +318,14 @@
|
||||
([params]
|
||||
(cond
|
||||
(map? params)
|
||||
(let [type (get params :type)]
|
||||
(let [mdata (meta params)
|
||||
type (or (get mdata ::id)
|
||||
(get mdata ::type)
|
||||
(get params :type))]
|
||||
(assert (qualified-keyword? type) "expected qualified keyword for `type`")
|
||||
(let [s (m/-simple-schema params)]
|
||||
(swap! sr/registry assoc type s)
|
||||
nil))
|
||||
s))
|
||||
|
||||
(vector? params)
|
||||
(let [mdata (meta params)
|
||||
@@ -307,83 +333,19 @@
|
||||
(get mdata ::type))]
|
||||
(assert (qualified-keyword? type) "expected qualified keyword to be on metadata")
|
||||
(swap! sr/registry assoc type params)
|
||||
nil)
|
||||
params)
|
||||
|
||||
(m/into-schema? params)
|
||||
(let [type (m/-type params)]
|
||||
(swap! sr/registry assoc type params))
|
||||
(swap! sr/registry assoc type params)
|
||||
params)
|
||||
|
||||
:else
|
||||
(throw (ex-info "Invalid Arguments" {}))))
|
||||
|
||||
([type params]
|
||||
(let [s (if (map? params)
|
||||
(cond
|
||||
(= :set (:type params))
|
||||
(m/-collection-schema params)
|
||||
|
||||
(= :vector (:type params))
|
||||
(m/-collection-schema params)
|
||||
|
||||
:else
|
||||
(m/-simple-schema params))
|
||||
params)]
|
||||
|
||||
(swap! sr/registry assoc type s)
|
||||
nil)))
|
||||
|
||||
(defn- lazy-schema
|
||||
"Create ans instance of ILazySchema"
|
||||
[s]
|
||||
(let [schema (schema s)
|
||||
validator (delay (m/validator schema))
|
||||
explainer (delay (m/explainer schema))]
|
||||
|
||||
(reify
|
||||
m/AST
|
||||
(-to-ast [_ options] (m/-to-ast schema options))
|
||||
|
||||
m/EntrySchema
|
||||
(-entries [_] (m/-entries schema))
|
||||
(-entry-parser [_] (m/-entry-parser schema))
|
||||
|
||||
m/Cached
|
||||
(-cache [_] (m/-cache schema))
|
||||
|
||||
m/LensSchema
|
||||
(-keep [_] (m/-keep schema))
|
||||
(-get [_ key default] (m/-get schema key default))
|
||||
(-set [_ key value] (m/-set schema key value))
|
||||
|
||||
m/Schema
|
||||
(-validator [_]
|
||||
(m/-validator schema))
|
||||
(-explainer [_ path]
|
||||
(m/-explainer schema path))
|
||||
(-parser [_]
|
||||
(m/-parser schema))
|
||||
(-unparser [_]
|
||||
(m/-unparser schema))
|
||||
(-transformer [_ transformer method options]
|
||||
(m/-transformer schema transformer method options))
|
||||
(-walk [_ walker path options]
|
||||
(m/-walk schema walker path options))
|
||||
(-properties [_]
|
||||
(m/-properties schema))
|
||||
(-options [_]
|
||||
(m/-options schema))
|
||||
(-children [_]
|
||||
(m/-children schema))
|
||||
(-parent [_]
|
||||
(m/-parent schema))
|
||||
(-form [_]
|
||||
(m/-form schema))
|
||||
|
||||
ILazySchema
|
||||
(-validate [_ o]
|
||||
(@validator o))
|
||||
(-explain [_ o]
|
||||
(@explainer o)))))
|
||||
(swap! sr/registry assoc type params)
|
||||
params))
|
||||
|
||||
;; --- BUILTIN SCHEMAS
|
||||
|
||||
@@ -809,7 +771,8 @@
|
||||
|
||||
gen (sg/one-of
|
||||
(sg/small-int :max max :min min)
|
||||
(sg/small-double :max max :min min))]
|
||||
(->> (sg/small-double :max max :min min)
|
||||
(sg/fmap #(mth/precision % 2))))]
|
||||
|
||||
{:pred pred
|
||||
:type-properties
|
||||
@@ -864,7 +827,7 @@
|
||||
choices))]
|
||||
{:pred pred
|
||||
:type-properties
|
||||
{:title "contains"
|
||||
{:title "contains any"
|
||||
:description "contains predicate"}}))})
|
||||
|
||||
(register!
|
||||
@@ -874,7 +837,7 @@
|
||||
{:title "inst"
|
||||
:description "Satisfies Inst protocol"
|
||||
:error/message "should be an instant"
|
||||
:gen/gen (->> (sg/small-int)
|
||||
:gen/gen (->> (sg/small-int :min 0 :max 100000)
|
||||
(sg/fmap (fn [v] (tm/parse-instant v))))
|
||||
|
||||
:decode/string tm/parse-instant
|
||||
@@ -884,6 +847,22 @@
|
||||
::oapi/type "string"
|
||||
::oapi/format "iso"}})
|
||||
|
||||
(register!
|
||||
{:type ::timestamp
|
||||
:pred inst?
|
||||
:type-properties
|
||||
{:title "inst"
|
||||
:description "Satisfies Inst protocol"
|
||||
:error/message "should be an instant"
|
||||
:gen/gen (->> (sg/small-int)
|
||||
(sg/fmap (fn [v] (tm/parse-instant v))))
|
||||
:decode/string tm/parse-instant
|
||||
:encode/string inst-ms
|
||||
:decode/json tm/parse-instant
|
||||
:encode/json inst-ms
|
||||
::oapi/type "string"
|
||||
::oapi/format "number"}})
|
||||
|
||||
(register!
|
||||
{:type ::fn
|
||||
:pred fn?})
|
||||
|
||||
@@ -5,7 +5,7 @@
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.schema.generators
|
||||
(:refer-clojure :exclude [set subseq uuid filter map let boolean])
|
||||
(:refer-clojure :exclude [set subseq uuid filter map let boolean vector])
|
||||
#?(:cljs (:require-macros [app.common.schema.generators]))
|
||||
(:require
|
||||
[app.common.schema.registry :as sr]
|
||||
@@ -126,3 +126,7 @@
|
||||
(defn tuple
|
||||
[& opts]
|
||||
(apply tg/tuple opts))
|
||||
|
||||
(defn vector
|
||||
[& opts]
|
||||
(apply tg/vector opts))
|
||||
|
||||
@@ -56,13 +56,8 @@
|
||||
(str "(pass=TRUE, tests=" (:num-tests params) ", seed=" (:seed params) ", elapsed=" time "ms)"))))
|
||||
|
||||
(defmethod ct/report #?(:clj ::thrunk :cljs [:cljs.test/default ::thrunk])
|
||||
[{:keys [::params] :as m}]
|
||||
(let [smallest (-> params :shrunk :smallest vec)]
|
||||
(println)
|
||||
(println "Condition failed with the following params:")
|
||||
(println "Seed:" (:seed params))
|
||||
(println)
|
||||
(pp/pprint smallest)))
|
||||
[_]
|
||||
nil)
|
||||
|
||||
(defmethod ct/report #?(:clj ::trial :cljs [:cljs.test/default ::trial])
|
||||
[_]
|
||||
@@ -76,9 +71,12 @@
|
||||
(let [tvar (get-testing-var)
|
||||
tsym (get-testing-sym tvar)
|
||||
res (:result params)]
|
||||
(println)
|
||||
|
||||
(println "---------------------------------------------------------")
|
||||
(println "Generative test:" (str "'" tsym "'")
|
||||
(str "(pass=FALSE, tests=" (:num-tests params) ", seed=" (:seed params) ")"))
|
||||
(pp/pprint (:fail params))
|
||||
(println "---------------------------------------------------------")
|
||||
|
||||
(when (ex/exception? res)
|
||||
#?(:clj (ex/print-throwable res)
|
||||
|
||||
@@ -1,204 +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 app.common.svg.path.command
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]))
|
||||
|
||||
(defn command->point
|
||||
([prev-pos {:keys [relative params] :as command}]
|
||||
(let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params]
|
||||
(if relative
|
||||
(-> prev-pos (update :x + x) (update :y + y))
|
||||
(command->point command))))
|
||||
|
||||
([command]
|
||||
(when command
|
||||
(let [{:keys [x y]} (:params command)]
|
||||
(gpt/point x y)))))
|
||||
|
||||
|
||||
(defn make-move-to [to]
|
||||
{:command :move-to
|
||||
:relative false
|
||||
:params {:x (:x to)
|
||||
:y (:y to)}})
|
||||
|
||||
(defn make-line-to [to]
|
||||
{:command :line-to
|
||||
:relative false
|
||||
:params {:x (:x to)
|
||||
:y (:y to)}})
|
||||
|
||||
(defn make-curve-params
|
||||
([point]
|
||||
(make-curve-params point point point))
|
||||
|
||||
([point handler] (make-curve-params point handler point))
|
||||
|
||||
([point h1 h2]
|
||||
{:x (:x point)
|
||||
:y (:y point)
|
||||
:c1x (:x h1)
|
||||
:c1y (:y h1)
|
||||
:c2x (:x h2)
|
||||
:c2y (:y h2)}))
|
||||
|
||||
(defn update-curve-to
|
||||
[command h1 h2]
|
||||
(let [params {:x (-> command :params :x)
|
||||
:y (-> command :params :y)
|
||||
:c1x (:x h1)
|
||||
:c1y (:y h1)
|
||||
:c2x (:x h2)
|
||||
:c2y (:y h2)}]
|
||||
(-> command
|
||||
(assoc :command :curve-to)
|
||||
(assoc :params params))))
|
||||
|
||||
(defn make-curve-to
|
||||
[to h1 h2]
|
||||
{:command :curve-to
|
||||
:relative false
|
||||
:params (make-curve-params to h1 h2)})
|
||||
|
||||
(defn update-handler
|
||||
[command prefix point]
|
||||
(let [[cox coy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])]
|
||||
(-> command
|
||||
(assoc-in [:params cox] (:x point))
|
||||
(assoc-in [:params coy] (:y point)))))
|
||||
|
||||
(defn apply-content-modifiers
|
||||
"Apply to content a map with point translations"
|
||||
[content modifiers]
|
||||
(letfn [(apply-to-index [content [index params]]
|
||||
(if (contains? content index)
|
||||
(cond-> content
|
||||
(and
|
||||
(or (:c1x params) (:c1y params) (:c2x params) (:c2y params))
|
||||
(= :line-to (get-in content [index :command])))
|
||||
|
||||
(-> (assoc-in [index :command] :curve-to)
|
||||
(assoc-in [index :params]
|
||||
(make-curve-params
|
||||
(get-in content [index :params])
|
||||
(get-in content [(dec index) :params]))))
|
||||
|
||||
(:x params) (update-in [index :params :x] + (:x params))
|
||||
(:y params) (update-in [index :params :y] + (:y params))
|
||||
|
||||
(:c1x params) (update-in [index :params :c1x] + (:c1x params))
|
||||
(:c1y params) (update-in [index :params :c1y] + (:c1y params))
|
||||
|
||||
(:c2x params) (update-in [index :params :c2x] + (:c2x params))
|
||||
(:c2y params) (update-in [index :params :c2y] + (:c2y params)))
|
||||
content))]
|
||||
(let [content (if (vector? content) content (into [] content))]
|
||||
(reduce apply-to-index content modifiers))))
|
||||
|
||||
(defn get-handler [{:keys [params] :as command} prefix]
|
||||
(let [cx (d/prefix-keyword prefix :x)
|
||||
cy (d/prefix-keyword prefix :y)]
|
||||
(when (and command
|
||||
(contains? params cx)
|
||||
(contains? params cy))
|
||||
(gpt/point (get params cx)
|
||||
(get params cy)))))
|
||||
|
||||
(defn content->handlers
|
||||
"Retrieve a map where for every point will retrieve a list of
|
||||
the handlers that are associated with that point.
|
||||
point -> [[index, prefix]]"
|
||||
[content]
|
||||
(->> (d/with-prev content)
|
||||
(d/enumerate)
|
||||
(mapcat (fn [[index [cur-cmd pre-cmd]]]
|
||||
(if (and pre-cmd (= :curve-to (:command cur-cmd)))
|
||||
(let [cur-pos (command->point cur-cmd)
|
||||
pre-pos (command->point pre-cmd)]
|
||||
(-> [[pre-pos [index :c1]]
|
||||
[cur-pos [index :c2]]]))
|
||||
[])))
|
||||
|
||||
(group-by first)
|
||||
(d/mapm #(mapv second %2))))
|
||||
|
||||
(defn point-indices
|
||||
[content point]
|
||||
(->> (d/enumerate content)
|
||||
(filter (fn [[_ cmd]] (= point (command->point cmd))))
|
||||
(mapv (fn [[index _]] index))))
|
||||
|
||||
(defn handler-indices
|
||||
"Return an index where the key is the positions and the values the handlers"
|
||||
[content point]
|
||||
(->> (d/with-prev content)
|
||||
(d/enumerate)
|
||||
(mapcat (fn [[index [cur-cmd pre-cmd]]]
|
||||
(if (and (some? pre-cmd) (= :curve-to (:command cur-cmd)))
|
||||
(let [cur-pos (command->point cur-cmd)
|
||||
pre-pos (command->point pre-cmd)]
|
||||
(cond-> []
|
||||
(= pre-pos point) (conj [index :c1])
|
||||
(= cur-pos point) (conj [index :c2])))
|
||||
[])))))
|
||||
|
||||
(defn opposite-index
|
||||
"Calculates the opposite index given a prefix and an index"
|
||||
[content index prefix]
|
||||
|
||||
(let [point (if (= prefix :c2)
|
||||
(command->point (nth content index))
|
||||
(command->point (nth content (dec index))))
|
||||
|
||||
point->handlers (content->handlers content)
|
||||
|
||||
handlers (->> point
|
||||
(point->handlers)
|
||||
(filter (fn [[ci cp]] (and (not= index ci) (not= prefix cp)))))]
|
||||
|
||||
(cond
|
||||
(= (count handlers) 1)
|
||||
(->> handlers first)
|
||||
|
||||
(and (= :c1 prefix) (= (count content) index))
|
||||
[(dec index) :c2]
|
||||
|
||||
:else nil)))
|
||||
|
||||
|
||||
(defn get-commands
|
||||
"Returns the commands involving a point with its indices"
|
||||
[content point]
|
||||
(->> (d/enumerate content)
|
||||
(filterv (fn [[_ cmd]] (= (command->point cmd) point)))))
|
||||
|
||||
|
||||
(defn prefix->coords [prefix]
|
||||
(case prefix
|
||||
:c1 [:c1x :c1y]
|
||||
:c2 [:c2x :c2y]
|
||||
nil))
|
||||
|
||||
(defn handler->point [content index prefix]
|
||||
(when (and (some? index)
|
||||
(some? prefix)
|
||||
(contains? content index))
|
||||
(let [[cx cy] (prefix->coords prefix)]
|
||||
(if (= :curve-to (get-in content [index :command]))
|
||||
(gpt/point (get-in content [index :params cx])
|
||||
(get-in content [index :params cy]))
|
||||
|
||||
(gpt/point (get-in content [index :params :x])
|
||||
(get-in content [index :params :y]))))))
|
||||
|
||||
(defn handler->node [content index prefix]
|
||||
(if (= prefix :c1)
|
||||
(command->point (get content (dec index)))
|
||||
(command->point (get content index))))
|
||||
|
||||
@@ -1,324 +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 app.common.svg.path.legacy-parser1
|
||||
"The first SVG Path parser implementation.
|
||||
|
||||
Written in a mix of CLJS and JS code and used in production until
|
||||
1.19, used mainly for tests."
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as upg]
|
||||
[app.common.svg :as csvg]
|
||||
[app.common.svg.path.arc-to-bezier :as a2b]
|
||||
[app.common.svg.path.command :as upc]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*")
|
||||
|
||||
;; Matches numbers for path values allows values like... -.01, 10, +12.22
|
||||
;; 0 and 1 are special because can refer to flags
|
||||
(def num-regex #"[+-]?(\d+(\.\d+)?|\.\d+)(e[+-]?\d+)?")
|
||||
|
||||
(def flag-regex #"[01]")
|
||||
|
||||
(defn extract-params [cmd-str extract-commands]
|
||||
(loop [result []
|
||||
extract-idx 0
|
||||
current {}
|
||||
remain (-> cmd-str (subs 1) (str/trim))]
|
||||
|
||||
(let [[param type] (nth extract-commands extract-idx)
|
||||
regex (case type
|
||||
:flag flag-regex
|
||||
#_:number num-regex)
|
||||
match (re-find regex remain)]
|
||||
|
||||
(if match
|
||||
(let [value (-> match first csvg/fix-dot-number d/read-string)
|
||||
remain (str/replace-first remain regex "")
|
||||
current (assoc current param value)
|
||||
extract-idx (inc extract-idx)
|
||||
[result current extract-idx]
|
||||
(if (>= extract-idx (count extract-commands))
|
||||
[(conj result current) {} 0]
|
||||
[result current extract-idx])]
|
||||
(recur result
|
||||
extract-idx
|
||||
current
|
||||
remain))
|
||||
(cond-> result
|
||||
(seq current) (conj current))))))
|
||||
|
||||
;; Path specification
|
||||
;; https://www.w3.org/TR/SVG11/paths.html
|
||||
(defmulti parse-command (comp str/upper first))
|
||||
|
||||
(defmethod parse-command "M" [cmd]
|
||||
(let [relative (str/starts-with? cmd "m")
|
||||
param-list (extract-params cmd [[:x :number]
|
||||
[:y :number]])]
|
||||
|
||||
(into [{:command :move-to
|
||||
:relative relative
|
||||
:params (first param-list)}]
|
||||
|
||||
(for [params (rest param-list)]
|
||||
{:command :line-to
|
||||
:relative relative
|
||||
:params params}))))
|
||||
|
||||
(defmethod parse-command "Z" [_]
|
||||
[{:command :close-path}])
|
||||
|
||||
(defmethod parse-command "L" [cmd]
|
||||
(let [relative (str/starts-with? cmd "l")
|
||||
param-list (extract-params cmd [[:x :number]
|
||||
[:y :number]])]
|
||||
(for [params param-list]
|
||||
{:command :line-to
|
||||
:relative relative
|
||||
:params params})))
|
||||
|
||||
(defmethod parse-command "H" [cmd]
|
||||
(let [relative (str/starts-with? cmd "h")
|
||||
param-list (extract-params cmd [[:value :number]])]
|
||||
(for [params param-list]
|
||||
{:command :line-to-horizontal
|
||||
:relative relative
|
||||
:params params})))
|
||||
|
||||
(defmethod parse-command "V" [cmd]
|
||||
(let [relative (str/starts-with? cmd "v")
|
||||
param-list (extract-params cmd [[:value :number]])]
|
||||
(for [params param-list]
|
||||
{:command :line-to-vertical
|
||||
:relative relative
|
||||
:params params})))
|
||||
|
||||
(defmethod parse-command "C" [cmd]
|
||||
(let [relative (str/starts-with? cmd "c")
|
||||
param-list (extract-params cmd [[:c1x :number]
|
||||
[:c1y :number]
|
||||
[:c2x :number]
|
||||
[:c2y :number]
|
||||
[:x :number]
|
||||
[:y :number]])]
|
||||
(for [params param-list]
|
||||
{:command :curve-to
|
||||
:relative relative
|
||||
:params params})))
|
||||
|
||||
(defmethod parse-command "S" [cmd]
|
||||
(let [relative (str/starts-with? cmd "s")
|
||||
param-list (extract-params cmd [[:cx :number]
|
||||
[:cy :number]
|
||||
[:x :number]
|
||||
[:y :number]])]
|
||||
(for [params param-list]
|
||||
{:command :smooth-curve-to
|
||||
:relative relative
|
||||
:params params})))
|
||||
|
||||
(defmethod parse-command "Q" [cmd]
|
||||
(let [relative (str/starts-with? cmd "q")
|
||||
param-list (extract-params cmd [[:cx :number]
|
||||
[:cy :number]
|
||||
[:x :number]
|
||||
[:y :number]])]
|
||||
(for [params param-list]
|
||||
{:command :quadratic-bezier-curve-to
|
||||
:relative relative
|
||||
:params params})))
|
||||
|
||||
(defmethod parse-command "T" [cmd]
|
||||
(let [relative (str/starts-with? cmd "t")
|
||||
param-list (extract-params cmd [[:x :number]
|
||||
[:y :number]])]
|
||||
(for [params param-list]
|
||||
{:command :smooth-quadratic-bezier-curve-to
|
||||
:relative relative
|
||||
:params params})))
|
||||
|
||||
(defmethod parse-command "A" [cmd]
|
||||
(let [relative (str/starts-with? cmd "a")
|
||||
param-list (extract-params cmd [[:rx :number]
|
||||
[:ry :number]
|
||||
[:x-axis-rotation :number]
|
||||
[:large-arc-flag :flag]
|
||||
[:sweep-flag :flag]
|
||||
[:x :number]
|
||||
[:y :number]])]
|
||||
(for [params param-list]
|
||||
{:command :elliptical-arc
|
||||
:relative relative
|
||||
:params params})))
|
||||
|
||||
(defn smooth->curve
|
||||
[{:keys [params]} pos handler]
|
||||
(let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)]
|
||||
{:c1x c1x
|
||||
:c1y c1y
|
||||
:c2x (:cx params)
|
||||
:c2y (:cy params)}))
|
||||
|
||||
(defn quadratic->curve
|
||||
[sp ep cp]
|
||||
(let [cp1 (-> (gpt/to-vec sp cp)
|
||||
(gpt/scale (/ 2 3))
|
||||
(gpt/add sp))
|
||||
|
||||
cp2 (-> (gpt/to-vec ep cp)
|
||||
(gpt/scale (/ 2 3))
|
||||
(gpt/add ep))]
|
||||
|
||||
{:c1x (:x cp1)
|
||||
:c1y (:y cp1)
|
||||
:c2x (:x cp2)
|
||||
:c2y (:y cp2)}))
|
||||
|
||||
(defn arc->beziers*
|
||||
[from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation]
|
||||
(a2b/calculateBeziers from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation))
|
||||
|
||||
(defn arc->beziers [from-p command]
|
||||
(let [to-command
|
||||
(fn [[_ _ c1x c1y c2x c2y x y]]
|
||||
{:command :curve-to
|
||||
:relative (:relative command)
|
||||
:params {:c1x c1x :c1y c1y
|
||||
:c2x c2x :c2y c2y
|
||||
:x x :y y}})
|
||||
|
||||
{from-x :x from-y :y} from-p
|
||||
{:keys [rx ry x-axis-rotation large-arc-flag sweep-flag x y]} (:params command)
|
||||
result (arc->beziers* from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation)]
|
||||
(mapv to-command result)))
|
||||
|
||||
(defn simplify-commands
|
||||
"Removes some commands and convert relative to absolute coordinates"
|
||||
[commands]
|
||||
(let [simplify-command
|
||||
;; prev-pos : previous position for the current path. Necessary for relative commands
|
||||
;; prev-start : previous move-to necessary for Z commands
|
||||
;; prev-cc : previous command control point for cubic beziers
|
||||
;; prev-qc : previous command control point for quadratic curves
|
||||
(fn [[result prev-pos prev-start prev-cc prev-qc] [command _prev]]
|
||||
(let [command (assoc command :prev-pos prev-pos)
|
||||
|
||||
command
|
||||
(cond-> command
|
||||
(:relative command)
|
||||
(-> (assoc :relative false)
|
||||
(d/update-in-when [:params :c1x] + (:x prev-pos))
|
||||
(d/update-in-when [:params :c1y] + (:y prev-pos))
|
||||
|
||||
(d/update-in-when [:params :c2x] + (:x prev-pos))
|
||||
(d/update-in-when [:params :c2y] + (:y prev-pos))
|
||||
|
||||
(d/update-in-when [:params :cx] + (:x prev-pos))
|
||||
(d/update-in-when [:params :cy] + (:y prev-pos))
|
||||
|
||||
(d/update-in-when [:params :x] + (:x prev-pos))
|
||||
(d/update-in-when [:params :y] + (:y prev-pos))
|
||||
|
||||
(cond->
|
||||
(= :line-to-horizontal (:command command))
|
||||
(d/update-in-when [:params :value] + (:x prev-pos))
|
||||
|
||||
(= :line-to-vertical (:command command))
|
||||
(d/update-in-when [:params :value] + (:y prev-pos)))))
|
||||
|
||||
params (:params command)
|
||||
orig-command command
|
||||
|
||||
command
|
||||
(cond-> command
|
||||
(= :line-to-horizontal (:command command))
|
||||
(-> (assoc :command :line-to)
|
||||
(update :params dissoc :value)
|
||||
(assoc-in [:params :x] (:value params))
|
||||
(assoc-in [:params :y] (:y prev-pos)))
|
||||
|
||||
(= :line-to-vertical (:command command))
|
||||
(-> (assoc :command :line-to)
|
||||
(update :params dissoc :value)
|
||||
(assoc-in [:params :y] (:value params))
|
||||
(assoc-in [:params :x] (:x prev-pos)))
|
||||
|
||||
(= :smooth-curve-to (:command command))
|
||||
(-> (assoc :command :curve-to)
|
||||
(update :params dissoc :cx :cy)
|
||||
(update :params merge (smooth->curve command prev-pos prev-cc)))
|
||||
|
||||
(= :quadratic-bezier-curve-to (:command command))
|
||||
(-> (assoc :command :curve-to)
|
||||
(update :params dissoc :cx :cy)
|
||||
(update :params merge (quadratic->curve prev-pos (gpt/point params) (gpt/point (:cx params) (:cy params)))))
|
||||
|
||||
(= :smooth-quadratic-bezier-curve-to (:command command))
|
||||
(-> (assoc :command :curve-to)
|
||||
(update :params merge (quadratic->curve prev-pos (gpt/point params) (upg/calculate-opposite-handler prev-pos prev-qc)))))
|
||||
|
||||
result (if (= :elliptical-arc (:command command))
|
||||
(into result (arc->beziers prev-pos command))
|
||||
(conj result command))
|
||||
|
||||
next-cc (case (:command orig-command)
|
||||
:smooth-curve-to
|
||||
(gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
|
||||
|
||||
:curve-to
|
||||
(gpt/point (get-in orig-command [:params :c2x]) (get-in orig-command [:params :c2y]))
|
||||
|
||||
(:line-to-horizontal :line-to-vertical)
|
||||
(gpt/point (get-in command [:params :x]) (get-in command [:params :y]))
|
||||
|
||||
(gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
|
||||
|
||||
next-qc (case (:command orig-command)
|
||||
:quadratic-bezier-curve-to
|
||||
(gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
|
||||
|
||||
:smooth-quadratic-bezier-curve-to
|
||||
(upg/calculate-opposite-handler prev-pos prev-qc)
|
||||
|
||||
(gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
|
||||
|
||||
next-pos (if (= :close-path (:command command))
|
||||
prev-start
|
||||
(upc/command->point prev-pos command))
|
||||
|
||||
next-start (if (= :move-to (:command command)) next-pos prev-start)]
|
||||
|
||||
[result next-pos next-start next-cc next-qc]))
|
||||
|
||||
start (first commands)
|
||||
start (cond-> start
|
||||
(:relative start)
|
||||
(assoc :relative false))
|
||||
|
||||
start-pos (gpt/point (:params start))]
|
||||
|
||||
(->> (map vector (rest commands) commands)
|
||||
(reduce simplify-command [[start] start-pos start-pos start-pos start-pos])
|
||||
(first))))
|
||||
|
||||
(defn parse [path-str]
|
||||
(if (empty? path-str)
|
||||
path-str
|
||||
(let [clean-path-str
|
||||
(-> path-str
|
||||
(str/trim)
|
||||
;; Change "commas" for spaces
|
||||
(str/replace #"," " ")
|
||||
;; Remove all consecutive spaces
|
||||
(str/replace #"\s+" " "))
|
||||
commands (re-seq commands-regex clean-path-str)]
|
||||
(-> (mapcat parse-command commands)
|
||||
(simplify-commands)))))
|
||||
|
||||
@@ -12,15 +12,23 @@
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as upg]
|
||||
[app.common.math :as mth]
|
||||
[app.common.svg :as csvg]
|
||||
[app.common.svg.path.command :as upc]
|
||||
[app.common.types.path.helpers :as path.helpers]
|
||||
[app.common.types.path.segment :as path.segment]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*")
|
||||
(def regex #"[+-]?(\d+(\.\d+)?|\.\d+)(e[+-]?\d+)?")
|
||||
|
||||
(defn- get-point
|
||||
"Get a point for a segment"
|
||||
[prev-pos {:keys [relative params] :as segment}]
|
||||
(let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params]
|
||||
(if relative
|
||||
(-> prev-pos (update :x + x) (update :y + y))
|
||||
(path.helpers/segment->point segment))))
|
||||
|
||||
(defn extract-params
|
||||
[data pattern]
|
||||
(loop [result []
|
||||
@@ -185,7 +193,7 @@
|
||||
|
||||
(defn smooth->curve
|
||||
[{:keys [params]} pos handler]
|
||||
(let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)]
|
||||
(let [{c1x :x c1y :y} (path.segment/calculate-opposite-handler pos handler)]
|
||||
{:c1x c1x
|
||||
:c1y c1y
|
||||
:c2x (:cx params)
|
||||
@@ -413,7 +421,7 @@
|
||||
|
||||
(= :smooth-quadratic-bezier-curve-to (:command command))
|
||||
(-> (assoc :command :curve-to)
|
||||
(update :params merge (quadratic->curve prev-pos (gpt/point params) (upg/calculate-opposite-handler prev-pos prev-qc)))))
|
||||
(update :params merge (quadratic->curve prev-pos (gpt/point params) (path.segment/calculate-opposite-handler prev-pos prev-qc)))))
|
||||
|
||||
result (if (= :elliptical-arc (:command command))
|
||||
(into result (arc->beziers prev-pos command))
|
||||
@@ -436,13 +444,13 @@
|
||||
(gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
|
||||
|
||||
:smooth-quadratic-bezier-curve-to
|
||||
(upg/calculate-opposite-handler prev-pos prev-qc)
|
||||
(path.segment/calculate-opposite-handler prev-pos prev-qc)
|
||||
|
||||
(gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
|
||||
|
||||
next-pos (if (= :close-path (:command command))
|
||||
prev-start
|
||||
(upc/command->point prev-pos command))
|
||||
(get-point prev-pos command))
|
||||
|
||||
next-start (if (= :move-to (:command command)) next-pos prev-start)]
|
||||
|
||||
|
||||
@@ -22,6 +22,7 @@
|
||||
[app.common.schema :as sm :refer [max-safe-int min-safe-int]]
|
||||
[app.common.svg :as csvg]
|
||||
[app.common.svg.path :as path]
|
||||
[app.common.types.path.segment :as path.segm]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.uuid :as uuid]
|
||||
[cuerdas.core :as str]))
|
||||
@@ -220,9 +221,9 @@
|
||||
(let [transform (csvg/parse-transform (:transform attrs))
|
||||
content (cond-> (path/parse (:d attrs))
|
||||
(some? transform)
|
||||
(gsh/transform-content transform))
|
||||
(path.segm/transform-content transform))
|
||||
|
||||
selrect (gsh/content->selrect content)
|
||||
selrect (path.segm/content->selrect content)
|
||||
points (grc/rect->points selrect)
|
||||
origin (gpt/negate (gpt/point svg-data))
|
||||
attrs (-> (dissoc attrs :d :transform)
|
||||
|
||||
@@ -23,28 +23,32 @@
|
||||
|
||||
(defn sample-file
|
||||
[label & {:keys [page-label name view-only?] :as params}]
|
||||
(binding [ffeat/*current* #{"components/v2"}]
|
||||
(let [params (cond-> params
|
||||
label
|
||||
(assoc :id (thi/new-id! label))
|
||||
(let [params
|
||||
(cond-> params
|
||||
label
|
||||
(assoc :id (thi/new-id! label))
|
||||
|
||||
page-label
|
||||
(assoc :page-id (thi/new-id! page-label))
|
||||
(nil? name)
|
||||
(assoc :name "Test file")
|
||||
|
||||
(nil? name)
|
||||
(assoc :name "Test file"))
|
||||
:always
|
||||
(assoc :features ffeat/default-features))
|
||||
|
||||
file (-> (ctf/make-file (dissoc params :page-label))
|
||||
(assoc :features #{"components/v2"})
|
||||
(assoc :permissions {:can-edit (not (true? view-only?))}))
|
||||
opts
|
||||
(cond-> {}
|
||||
page-label
|
||||
(assoc :page-id (thi/new-id! page-label)))
|
||||
|
||||
page (-> file
|
||||
:data
|
||||
(ctpl/pages-seq)
|
||||
(first))]
|
||||
file (-> (ctf/make-file params opts)
|
||||
(assoc :permissions {:can-edit (not (true? view-only?))}))
|
||||
|
||||
(with-meta file
|
||||
{:current-page-id (:id page)}))))
|
||||
page (-> file
|
||||
:data
|
||||
(ctpl/pages-seq)
|
||||
(first))]
|
||||
|
||||
(with-meta file
|
||||
{:current-page-id (:id page)})))
|
||||
|
||||
(defn validate-file!
|
||||
([file] (validate-file! file {}))
|
||||
|
||||
@@ -41,17 +41,18 @@
|
||||
[o]
|
||||
(and (string? o) (some? (re-matches rgb-color-re o))))
|
||||
|
||||
(def ^:private type:rgb-color
|
||||
{:type :string
|
||||
:pred rgb-color-string?
|
||||
:type-properties
|
||||
{:title "rgb-color"
|
||||
:description "RGB Color String"
|
||||
:error/message "expected a valid RGB color"
|
||||
:error/code "errors.invalid-rgb-color"
|
||||
:gen/gen (generate-rgb-color)
|
||||
::oapi/type "integer"
|
||||
::oapi/format "int64"}})
|
||||
(def schema:rgb-color
|
||||
(sm/register!
|
||||
{:type ::rgb-color
|
||||
:pred rgb-color-string?
|
||||
:type-properties
|
||||
{:title "rgb-color"
|
||||
:description "RGB Color String"
|
||||
:error/message "expected a valid RGB color"
|
||||
:error/code "errors.invalid-rgb-color"
|
||||
:gen/gen (generate-rgb-color)
|
||||
::oapi/type "integer"
|
||||
::oapi/format "int64"}}))
|
||||
|
||||
(def schema:image-color
|
||||
[:map {:title "ImageColor"}
|
||||
@@ -76,7 +77,7 @@
|
||||
[:stops
|
||||
[:vector {:min 1 :gen/max 2}
|
||||
[:map {:title "GradientStop"}
|
||||
[:color ::rgb-color]
|
||||
[:color schema:rgb-color]
|
||||
[:opacity {:optional true} [:maybe ::sm/safe-number]]
|
||||
[:offset ::sm/safe-number]]]]])
|
||||
|
||||
@@ -86,7 +87,7 @@
|
||||
[:name {:optional true} :string]
|
||||
[:path {:optional true} [:maybe :string]]
|
||||
[:value {:optional true} [:maybe :string]]
|
||||
[:color {:optional true} [:maybe ::rgb-color]]
|
||||
[:color {:optional true} [:maybe schema:rgb-color]]
|
||||
[:opacity {:optional true} [:maybe ::sm/safe-number]]
|
||||
[:modified-at {:optional true} ::sm/inst]
|
||||
[:ref-id {:optional true} ::sm/uuid]
|
||||
@@ -103,12 +104,17 @@
|
||||
[:and
|
||||
[:map {:title "RecentColor"}
|
||||
[:opacity {:optional true} [:maybe ::sm/safe-number]]
|
||||
[:color {:optional true} [:maybe ::rgb-color]]
|
||||
[:color {:optional true} [:maybe schema:rgb-color]]
|
||||
[:gradient {:optional true} [:maybe schema:gradient]]
|
||||
[:image {:optional true} [:maybe schema:image-color]]]
|
||||
[::sm/contains-any {:strict true} [:color :gradient :image]]])
|
||||
|
||||
(sm/register! ::rgb-color type:rgb-color)
|
||||
;; Same as color but with :id prop required
|
||||
(def schema:library-color
|
||||
[:and
|
||||
(sm/required-keys schema:color-attrs [:id])
|
||||
[::sm/contains-any {:strict true} [:color :gradient :image]]])
|
||||
|
||||
(sm/register! ::color schema:color)
|
||||
(sm/register! ::gradient schema:gradient)
|
||||
(sm/register! ::image-color schema:image-color)
|
||||
@@ -119,10 +125,13 @@
|
||||
(sm/lazy-validator schema:color))
|
||||
|
||||
(def check-color
|
||||
(sm/check-fn schema:color :hint "expected valid color struct"))
|
||||
(sm/check-fn schema:color :hint "expected valid color"))
|
||||
|
||||
(def check-library-color
|
||||
(sm/check-fn schema:library-color :hint "expected valid library color"))
|
||||
|
||||
(def check-recent-color
|
||||
(sm/check-fn schema:recent-color))
|
||||
(sm/check-fn schema:recent-color :hint "expected valid recent color"))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; HELPERS
|
||||
|
||||
@@ -18,19 +18,19 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def schema:component
|
||||
[:merge
|
||||
[:map
|
||||
[:id ::sm/uuid]
|
||||
[:name :string]
|
||||
[:path {:optional true} [:maybe :string]]
|
||||
[:modified-at {:optional true} ::sm/inst]
|
||||
[:objects {:gen/max 10 :optional true} ::ctp/objects]
|
||||
[:main-instance-id ::sm/uuid]
|
||||
[:main-instance-page ::sm/uuid]
|
||||
[:plugin-data {:optional true} ::ctpg/plugin-data]]
|
||||
::ctv/variant-component])
|
||||
|
||||
(sm/register! ::component schema:component)
|
||||
(sm/register!
|
||||
^{::sm/type ::component}
|
||||
[:merge
|
||||
[:map
|
||||
[:id ::sm/uuid]
|
||||
[:name :string]
|
||||
[:path {:optional true} [:maybe :string]]
|
||||
[:modified-at {:optional true} ::sm/inst]
|
||||
[:objects {:gen/max 10 :optional true} ctp/schema:objects]
|
||||
[:main-instance-id ::sm/uuid]
|
||||
[:main-instance-page ::sm/uuid]
|
||||
[:plugin-data {:optional true} ctpg/schema:plugin-data]]
|
||||
ctv/schema:variant-component]))
|
||||
|
||||
(def check-component
|
||||
(sm/check-fn schema:component))
|
||||
@@ -287,7 +287,7 @@
|
||||
|
||||
(defn get-component-root
|
||||
[component]
|
||||
(if (true? (:main-instance-id component))
|
||||
(if (some? (:main-instance-id component))
|
||||
(get-in component [:objects (:main-instance-id component)])
|
||||
(get-in component [:objects (:id component)])))
|
||||
|
||||
|
||||
@@ -41,7 +41,7 @@
|
||||
[:map-of {:gen/max 10} ::sm/uuid :map]]
|
||||
[:plugin-data {:optional true} ::ctpg/plugin-data]])
|
||||
|
||||
(def check-container!
|
||||
(def check-container
|
||||
(sm/check-fn ::container))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -62,9 +62,9 @@
|
||||
|
||||
(defn get-container
|
||||
[file type id]
|
||||
(dm/assert! (map? file))
|
||||
(dm/assert! (contains? valid-container-types type))
|
||||
(dm/assert! (uuid? id))
|
||||
(assert (map? file))
|
||||
(assert (contains? valid-container-types type))
|
||||
(assert (uuid? id))
|
||||
|
||||
(-> (if (= type :page)
|
||||
(ctpl/get-page file id)
|
||||
@@ -74,13 +74,9 @@
|
||||
(defn get-shape
|
||||
[container shape-id]
|
||||
|
||||
(dm/assert!
|
||||
"expected valid container"
|
||||
(check-container! container))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid uuid for `shape-id`"
|
||||
(uuid? shape-id))
|
||||
(assert (check-container container))
|
||||
(assert (uuid? shape-id)
|
||||
"expected valid uuid for `shape-id`")
|
||||
|
||||
(-> container
|
||||
(get :objects)
|
||||
|
||||
@@ -83,6 +83,7 @@
|
||||
because sometimes we want to validate file without the data."
|
||||
[:map {:title "file"}
|
||||
[:id ::sm/uuid]
|
||||
[:name :string]
|
||||
[:revn {:optional true} :int]
|
||||
[:vern {:optional true} :int]
|
||||
[:created-at {:optional true} ::sm/inst]
|
||||
@@ -101,13 +102,15 @@
|
||||
(sm/register! ::media schema:media)
|
||||
(sm/register! ::colors schema:colors)
|
||||
(sm/register! ::typographies schema:typographies)
|
||||
|
||||
(sm/register! ::media-object schema:media)
|
||||
|
||||
(def check-file-data!
|
||||
(sm/check-fn ::data))
|
||||
(def check-file
|
||||
(sm/check-fn schema:file :hint "check error on validating file"))
|
||||
|
||||
(def check-media-object!
|
||||
(def check-file-data
|
||||
(sm/check-fn schema:data))
|
||||
|
||||
(def check-media-object
|
||||
(sm/check-fn schema:media))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -127,40 +130,43 @@
|
||||
(ctp/make-empty-page {:id page-id :name "Page 1"}))]
|
||||
|
||||
(cond-> (assoc empty-file-data :id file-id)
|
||||
(some? page-id)
|
||||
(some? page)
|
||||
(ctpl/add-page page)
|
||||
|
||||
:always
|
||||
(assoc-in [:options :components-v2] true)))))
|
||||
(update :options assoc :components-v2 true)))))
|
||||
|
||||
(defn make-file
|
||||
[{:keys [id project-id name revn is-shared features
|
||||
ignore-sync-until modified-at deleted-at
|
||||
create-page page-id]
|
||||
:or {is-shared false revn 0 create-page true}}]
|
||||
[{:keys [id project-id name revn is-shared features migrations
|
||||
ignore-sync-until modified-at deleted-at]
|
||||
:or {is-shared false revn 0}}
|
||||
|
||||
& {:keys [create-page page-id]
|
||||
:or {create-page true}}]
|
||||
|
||||
(let [id (or id (uuid/next))
|
||||
|
||||
data (if create-page
|
||||
(if page-id
|
||||
(make-file-data id page-id)
|
||||
(make-file-data id))
|
||||
(make-file-data id nil))
|
||||
|
||||
file {:id id
|
||||
:project-id project-id
|
||||
:name name
|
||||
:revn revn
|
||||
:vern 0
|
||||
:is-shared is-shared
|
||||
:version version
|
||||
:data data
|
||||
:features features
|
||||
:ignore-sync-until ignore-sync-until
|
||||
:modified-at modified-at
|
||||
:deleted-at deleted-at}]
|
||||
file (d/without-nils
|
||||
{:id id
|
||||
:project-id project-id
|
||||
:name name
|
||||
:revn revn
|
||||
:vern 0
|
||||
:is-shared is-shared
|
||||
:version version
|
||||
:data data
|
||||
:features features
|
||||
:migrations migrations
|
||||
:ignore-sync-until ignore-sync-until
|
||||
:modified-at modified-at
|
||||
:deleted-at deleted-at})]
|
||||
|
||||
(d/without-nils file)))
|
||||
(check-file file)))
|
||||
|
||||
;; Helpers
|
||||
|
||||
|
||||
@@ -70,7 +70,7 @@
|
||||
(def valid-guide?
|
||||
(sm/lazy-validator schema:guide))
|
||||
|
||||
(def check-page!
|
||||
(def check-page
|
||||
(sm/check-fn schema:page))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -82,8 +82,7 @@
|
||||
(def root uuid/zero)
|
||||
|
||||
(def empty-page-data
|
||||
{:options {}
|
||||
:objects {root
|
||||
{:objects {root
|
||||
(cts/setup-shape {:id root
|
||||
:type :frame
|
||||
:parent-id root
|
||||
@@ -91,10 +90,12 @@
|
||||
:name "Root Frame"})}})
|
||||
|
||||
(defn make-empty-page
|
||||
[{:keys [id name]}]
|
||||
[{:keys [id name background]}]
|
||||
(-> empty-page-data
|
||||
(assoc :id (or id (uuid/next)))
|
||||
(assoc :name (or name "Page 1"))))
|
||||
(assoc :name (d/nilv name "Page 1"))
|
||||
(cond-> background
|
||||
(assoc :background background))))
|
||||
|
||||
(defn get-frame-flow
|
||||
[flows frame-id]
|
||||
|
||||
215
common/src/app/common/types/path.cljc
Normal file
215
common/src/app/common/types/path.cljc
Normal file
@@ -0,0 +1,215 @@
|
||||
;; 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 app.common.types.path
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.files.helpers :as cpf]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes.common :as gco]
|
||||
[app.common.types.path.bool :as bool]
|
||||
[app.common.types.path.helpers :as helpers]
|
||||
[app.common.types.path.impl :as impl]
|
||||
[app.common.types.path.segment :as segment]
|
||||
[app.common.types.path.shape-to-path :as stp]
|
||||
[app.common.types.path.subpath :as subpath]))
|
||||
|
||||
#?(:clj (set! *warn-on-reflection* true))
|
||||
|
||||
(defn content?
|
||||
[o]
|
||||
(impl/path-data? o))
|
||||
|
||||
(defn content
|
||||
"Create path content from plain data or bytes, returns itself if it
|
||||
is already PathData instance"
|
||||
[data]
|
||||
(impl/path-data data))
|
||||
|
||||
(defn from-bytes
|
||||
[data]
|
||||
(impl/from-bytes data))
|
||||
|
||||
(defn check-path-content
|
||||
[content]
|
||||
(impl/check-content-like content))
|
||||
|
||||
(defn get-byte-size
|
||||
"Get byte size of a path content"
|
||||
[content]
|
||||
(impl/-get-byte-size content))
|
||||
|
||||
(defn write-to
|
||||
[content buffer offset]
|
||||
(impl/-write-to content buffer offset))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; TRANSFORMATIONS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn close-subpaths
|
||||
"Given a content, searches a path for possible subpaths that can
|
||||
create closed loops and merge them; then return the transformed path
|
||||
conten as PathData instance"
|
||||
[content]
|
||||
(-> (subpath/close-subpaths content)
|
||||
(impl/from-plain)))
|
||||
|
||||
(defn apply-content-modifiers
|
||||
"Apply delta modifiers over the path content"
|
||||
[content modifiers]
|
||||
(assert (impl/check-content-like content))
|
||||
|
||||
(letfn [(apply-to-index [content [index params]]
|
||||
(if (contains? content index)
|
||||
(cond-> content
|
||||
(and
|
||||
(or (:c1x params) (:c1y params) (:c2x params) (:c2y params))
|
||||
(= :line-to (get-in content [index :command])))
|
||||
|
||||
(-> (assoc-in [index :command] :curve-to)
|
||||
(assoc-in [index :params]
|
||||
(helpers/make-curve-params
|
||||
(get-in content [index :params])
|
||||
(get-in content [(dec index) :params]))))
|
||||
|
||||
(:x params) (update-in [index :params :x] + (:x params))
|
||||
(:y params) (update-in [index :params :y] + (:y params))
|
||||
|
||||
(:c1x params) (update-in [index :params :c1x] + (:c1x params))
|
||||
(:c1y params) (update-in [index :params :c1y] + (:c1y params))
|
||||
|
||||
(:c2x params) (update-in [index :params :c2x] + (:c2x params))
|
||||
(:c2y params) (update-in [index :params :c2y] + (:c2y params)))
|
||||
content))]
|
||||
|
||||
(impl/path-data
|
||||
(reduce apply-to-index (vec content) modifiers))))
|
||||
|
||||
(defn transform-content
|
||||
"Applies a transformation matrix over content and returns a new
|
||||
content as PathData instance."
|
||||
[content transform]
|
||||
(segment/transform-content content transform))
|
||||
|
||||
(defn move-content
|
||||
[content move-vec]
|
||||
(if (gpt/zero? move-vec)
|
||||
content
|
||||
(segment/move-content content move-vec)))
|
||||
|
||||
(defn update-geometry
|
||||
"Update shape with new geometry calculated from provided content"
|
||||
([shape content]
|
||||
(update-geometry (assoc shape :content content)))
|
||||
([shape]
|
||||
(let [flip-x
|
||||
(get shape :flip-x)
|
||||
|
||||
flip-y
|
||||
(get shape :flip-y)
|
||||
|
||||
;; NOTE: we ensure that content is PathData instance
|
||||
content
|
||||
(impl/path-data
|
||||
(get shape :content))
|
||||
|
||||
;; Ensure plain format once
|
||||
transform
|
||||
(cond-> (:transform shape (gmt/matrix))
|
||||
flip-x (gmt/scale (gpt/point -1 1))
|
||||
flip-y (gmt/scale (gpt/point 1 -1)))
|
||||
|
||||
transform-inverse
|
||||
(cond-> (gmt/matrix)
|
||||
flip-x (gmt/scale (gpt/point -1 1))
|
||||
flip-y (gmt/scale (gpt/point 1 -1))
|
||||
:always (gmt/multiply (:transform-inverse shape (gmt/matrix))))
|
||||
|
||||
center
|
||||
(or (some-> (dm/get-prop shape :selrect) grc/rect->center)
|
||||
(segment/content-center content))
|
||||
|
||||
base-content
|
||||
(segment/transform-content content (gmt/transform-in center transform-inverse))
|
||||
|
||||
;; Calculates the new selrect with points given the old center
|
||||
points
|
||||
(-> (segment/content->selrect base-content)
|
||||
(grc/rect->points)
|
||||
(gco/transform-points center transform))
|
||||
|
||||
points-center
|
||||
(gco/points->center points)
|
||||
|
||||
;; Points is now the selrect but the center is different so we can create the selrect
|
||||
;; through points
|
||||
selrect
|
||||
(-> points
|
||||
(gco/transform-points points-center transform-inverse)
|
||||
(grc/points->rect))]
|
||||
|
||||
(-> shape
|
||||
(assoc :content content)
|
||||
(assoc :points points)
|
||||
(assoc :selrect selrect)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PATH SHAPE HELPERS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn get-points
|
||||
"Returns points for the given segment, faster version of
|
||||
the `content->points`."
|
||||
[content]
|
||||
(some-> content segment/get-points))
|
||||
|
||||
(defn- calc-bool-content*
|
||||
"Calculate the boolean content from shape and objects. Returns plain
|
||||
vector of segments"
|
||||
[shape objects]
|
||||
(let [extract-content-xf
|
||||
(comp (map (d/getf objects))
|
||||
(remove :hidden)
|
||||
(remove cpf/svg-raw-shape?)
|
||||
(map #(stp/convert-to-path % objects))
|
||||
(map :content))
|
||||
|
||||
contents
|
||||
(sequence extract-content-xf (:shapes shape))]
|
||||
|
||||
(bool/calculate-content (:bool-type shape) contents)))
|
||||
|
||||
(defn calc-bool-content
|
||||
"Calculate the boolean content from shape and objects. Returns a
|
||||
packed PathData instance"
|
||||
[shape objects]
|
||||
(-> (calc-bool-content* shape objects)
|
||||
(impl/path-data)))
|
||||
|
||||
(defn shape-with-open-path?
|
||||
[shape]
|
||||
(let [svg? (contains? shape :svg-attrs)
|
||||
;; No close subpaths for svgs imported
|
||||
maybe-close (if svg? identity subpath/close-subpaths)]
|
||||
(and (= :path (:type shape))
|
||||
(not (->> shape
|
||||
:content
|
||||
(maybe-close)
|
||||
(subpath/get-subpaths)
|
||||
(every? subpath/is-closed?))))))
|
||||
|
||||
(defn convert-to-path
|
||||
"Transform a shape to a path shape"
|
||||
([shape]
|
||||
(convert-to-path shape {}))
|
||||
([shape objects]
|
||||
(-> (stp/convert-to-path shape objects)
|
||||
(update :content impl/path-data))))
|
||||
|
||||
@@ -4,15 +4,42 @@
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.svg.path.bool
|
||||
(ns app.common.types.path.bool
|
||||
(:require
|
||||
[app.common.colors :as clr]
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.math :as mth]
|
||||
[app.common.svg.path.command :as upc]
|
||||
[app.common.svg.path.subpath :as ups]))
|
||||
[app.common.types.path.helpers :as helpers]
|
||||
[app.common.types.path.segment :as segment]
|
||||
[app.common.types.path.subpath :as subpath]))
|
||||
|
||||
(def default-fills
|
||||
[{:fill-color clr/black}])
|
||||
|
||||
(def style-group-properties
|
||||
[:shadow :blur])
|
||||
|
||||
(def style-properties
|
||||
(into style-group-properties
|
||||
[:fill-color
|
||||
:fill-opacity
|
||||
:fill-color-gradient
|
||||
:fill-color-ref-file
|
||||
:fill-color-ref-id
|
||||
:fill-image
|
||||
:fills
|
||||
:stroke-color
|
||||
:stroke-color-ref-file
|
||||
:stroke-color-ref-id
|
||||
:stroke-opacity
|
||||
:stroke-style
|
||||
:stroke-width
|
||||
:stroke-alignment
|
||||
:stroke-cap-start
|
||||
:stroke-cap-end
|
||||
:strokes]))
|
||||
|
||||
(defn add-previous
|
||||
([content]
|
||||
@@ -25,87 +52,92 @@
|
||||
(assoc :prev first)
|
||||
|
||||
(some? prev)
|
||||
(assoc :prev (gsp/command->point prev))))))))
|
||||
(assoc :prev (helpers/segment->point prev))))))))
|
||||
|
||||
(defn close-paths
|
||||
"Removes the :close-path commands and replace them for line-to so we can calculate
|
||||
the intersections"
|
||||
[content]
|
||||
|
||||
(loop [head (first content)
|
||||
content (rest content)
|
||||
result []
|
||||
last-move nil
|
||||
last-p nil]
|
||||
(loop [segments (seq content)
|
||||
result []
|
||||
last-move nil
|
||||
last-point nil]
|
||||
(if-let [segment (first segments)]
|
||||
(let [point
|
||||
(helpers/segment->point segment)
|
||||
|
||||
(if (nil? head)
|
||||
result
|
||||
(let [head-p (gsp/command->point head)
|
||||
head (cond
|
||||
(and (= :close-path (:command head))
|
||||
(or (nil? last-p) ;; Ignore consecutive close-paths
|
||||
(< (gpt/distance last-p last-move) 0.01)))
|
||||
nil
|
||||
segment
|
||||
(cond
|
||||
(and (= :close-path (:command segment))
|
||||
(or (nil? last-point) ;; Ignore consecutive close-paths
|
||||
(< (gpt/distance last-point last-move) 0.01)))
|
||||
nil
|
||||
|
||||
(= :close-path (:command head))
|
||||
(upc/make-line-to last-move)
|
||||
(= :close-path (:command segment))
|
||||
(helpers/make-line-to last-move)
|
||||
|
||||
:else
|
||||
head)]
|
||||
:else
|
||||
segment)]
|
||||
|
||||
(recur (first content)
|
||||
(rest content)
|
||||
(cond-> result (some? head) (conj head))
|
||||
(if (= :move-to (:command head))
|
||||
head-p
|
||||
(recur (rest segments)
|
||||
(cond-> result (some? segment) (conj segment))
|
||||
(if (= :move-to (:command segment))
|
||||
point
|
||||
last-move)
|
||||
head-p)))))
|
||||
point))
|
||||
result)))
|
||||
|
||||
(defn- split-command
|
||||
[cmd values]
|
||||
(case (:command cmd)
|
||||
:line-to (gsp/split-line-to-ranges (:prev cmd) cmd values)
|
||||
:curve-to (gsp/split-curve-to-ranges (:prev cmd) cmd values)
|
||||
:line-to (helpers/split-line-to-ranges (:prev cmd) cmd values)
|
||||
:curve-to (helpers/split-curve-to-ranges (:prev cmd) cmd values)
|
||||
[cmd]))
|
||||
|
||||
(defn split-ts [seg-1 seg-2]
|
||||
(cond
|
||||
(and (= :line-to (:command seg-1))
|
||||
(= :line-to (:command seg-2)))
|
||||
(gsp/line-line-intersect (gsp/command->line seg-1) (gsp/command->line seg-2))
|
||||
(defn- split-ts
|
||||
[seg-1 seg-2]
|
||||
(let [cmd-1 (get seg-1 :command)
|
||||
cmd-2 (get seg-2 :command)]
|
||||
(cond
|
||||
(and (= :line-to cmd-1)
|
||||
(= :line-to cmd-2))
|
||||
(helpers/line-line-intersect (helpers/command->line seg-1)
|
||||
(helpers/command->line seg-2))
|
||||
|
||||
(and (= :line-to (:command seg-1))
|
||||
(= :curve-to (:command seg-2)))
|
||||
(gsp/line-curve-intersect (gsp/command->line seg-1) (gsp/command->bezier seg-2))
|
||||
(and (= :line-to cmd-1)
|
||||
(= :curve-to cmd-2))
|
||||
(helpers/line-curve-intersect (helpers/command->line seg-1)
|
||||
(helpers/command->bezier seg-2))
|
||||
|
||||
(and (= :curve-to (:command seg-1))
|
||||
(= :line-to (:command seg-2)))
|
||||
(let [[seg-2' seg-1']
|
||||
(gsp/line-curve-intersect (gsp/command->line seg-2) (gsp/command->bezier seg-1))]
|
||||
;; Need to reverse because we send the arguments reversed
|
||||
[seg-1' seg-2'])
|
||||
(and (= :curve-to cmd-1)
|
||||
(= :line-to cmd-2))
|
||||
(let [[seg-2' seg-1']
|
||||
(helpers/line-curve-intersect (helpers/command->line seg-2)
|
||||
(helpers/command->bezier seg-1))]
|
||||
;; Need to reverse because we send the arguments reversed
|
||||
[seg-1' seg-2'])
|
||||
|
||||
(and (= :curve-to (:command seg-1))
|
||||
(= :curve-to (:command seg-2)))
|
||||
(gsp/curve-curve-intersect (gsp/command->bezier seg-1) (gsp/command->bezier seg-2))
|
||||
(and (= :curve-to cmd-1)
|
||||
(= :curve-to cmd-2))
|
||||
(helpers/curve-curve-intersect (helpers/command->bezier seg-1)
|
||||
(helpers/command->bezier seg-2))
|
||||
|
||||
:else
|
||||
[[] []]))
|
||||
:else
|
||||
[[] []])))
|
||||
|
||||
(defn content-intersect-split
|
||||
[content-a content-b sr-a sr-b]
|
||||
|
||||
(let [command->selrect (memoize gsp/command->selrect)]
|
||||
(let [command->selrect (memoize helpers/command->selrect)]
|
||||
|
||||
(letfn [(overlap-segment-selrect?
|
||||
[segment selrect]
|
||||
(letfn [(overlap-segment-selrect? [segment selrect]
|
||||
(if (= :move-to (:command segment))
|
||||
false
|
||||
(let [r1 (command->selrect segment)]
|
||||
(grc/overlaps-rects? r1 selrect))))
|
||||
|
||||
(overlap-segments?
|
||||
[seg-1 seg-2]
|
||||
(overlap-segments? [seg-1 seg-2]
|
||||
(if (or (= :move-to (:command seg-1))
|
||||
(= :move-to (:command seg-2)))
|
||||
false
|
||||
@@ -113,17 +145,14 @@
|
||||
r2 (command->selrect seg-2)]
|
||||
(grc/overlaps-rects? r1 r2))))
|
||||
|
||||
(split
|
||||
[seg-1 seg-2]
|
||||
(split [seg-1 seg-2]
|
||||
(if (not (overlap-segments? seg-1 seg-2))
|
||||
[seg-1]
|
||||
(let [[ts-seg-1 _] (split-ts seg-1 seg-2)]
|
||||
(-> (split-command seg-1 ts-seg-1)
|
||||
(add-previous (:prev seg-1))))))
|
||||
|
||||
(split-segment-on-content
|
||||
[segment content content-sr]
|
||||
|
||||
(split-segment-on-content [segment content content-sr]
|
||||
(if (overlap-segment-selrect? segment content-sr)
|
||||
(->> content
|
||||
(filter #(overlap-segments? segment %))
|
||||
@@ -133,8 +162,7 @@
|
||||
[segment]))
|
||||
[segment]))
|
||||
|
||||
(split-content
|
||||
[content-a content-b sr-b]
|
||||
(split-content [content-a content-b sr-b]
|
||||
(into []
|
||||
(mapcat #(split-segment-on-content % content-b sr-b))
|
||||
content-a))]
|
||||
@@ -151,28 +179,28 @@
|
||||
[segment content content-sr content-geom]
|
||||
|
||||
(let [point (case (:command segment)
|
||||
:line-to (-> (gsp/command->line segment)
|
||||
(gsp/line-values 0.5))
|
||||
:line-to (-> (helpers/command->line segment)
|
||||
(helpers/line-values 0.5))
|
||||
|
||||
:curve-to (-> (gsp/command->bezier segment)
|
||||
(gsp/curve-values 0.5)))]
|
||||
:curve-to (-> (helpers/command->bezier segment)
|
||||
(helpers/curve-values 0.5)))]
|
||||
|
||||
(and (grc/contains-point? content-sr point)
|
||||
(or
|
||||
(gsp/is-point-in-geom-data? point content-geom)
|
||||
(gsp/is-point-in-border? point content)))))
|
||||
(helpers/is-point-in-geom-data? point content-geom)
|
||||
(helpers/is-point-in-border? point content)))))
|
||||
|
||||
(defn inside-segment?
|
||||
[segment content-sr content-geom]
|
||||
(let [point (case (:command segment)
|
||||
:line-to (-> (gsp/command->line segment)
|
||||
(gsp/line-values 0.5))
|
||||
:line-to (-> (helpers/command->line segment)
|
||||
(helpers/line-values 0.5))
|
||||
|
||||
:curve-to (-> (gsp/command->bezier segment)
|
||||
(gsp/curve-values 0.5)))]
|
||||
:curve-to (-> (helpers/command->bezier segment)
|
||||
(helpers/curve-values 0.5)))]
|
||||
|
||||
(and (grc/contains-point? content-sr point)
|
||||
(gsp/is-point-in-geom-data? point content-geom))))
|
||||
(helpers/is-point-in-geom-data? point content-geom))))
|
||||
|
||||
(defn overlap-segment?
|
||||
"Finds if the current segment is overlapping against other
|
||||
@@ -185,8 +213,8 @@
|
||||
(contains? #{:line-to :curve-to} (:command segment)))
|
||||
|
||||
(case (:command segment)
|
||||
:line-to (let [[p1 q1] (gsp/command->line segment)
|
||||
[p2 q2] (gsp/command->line other)]
|
||||
:line-to (let [[p1 q1] (helpers/command->line segment)
|
||||
[p2 q2] (helpers/command->line other)]
|
||||
|
||||
(when (or (and (< (gpt/distance p1 p2) 0.1)
|
||||
(< (gpt/distance q1 q2) 0.1))
|
||||
@@ -194,8 +222,8 @@
|
||||
(< (gpt/distance q1 p2) 0.1)))
|
||||
[segment other]))
|
||||
|
||||
:curve-to (let [[p1 q1 h11 h21] (gsp/command->bezier segment)
|
||||
[p2 q2 h12 h22] (gsp/command->bezier other)]
|
||||
:curve-to (let [[p1 q1 h11 h21] (helpers/command->bezier segment)
|
||||
[p2 q2 h12 h22] (helpers/command->bezier other)]
|
||||
|
||||
(when (or (and (< (gpt/distance p1 p2) 0.1)
|
||||
(< (gpt/distance q1 q2) 0.1)
|
||||
@@ -227,11 +255,11 @@
|
||||
result
|
||||
|
||||
(let [result (if (not= (:prev current) prev)
|
||||
(conj result (upc/make-move-to (:prev current)))
|
||||
(conj result (helpers/make-move-to (:prev current)))
|
||||
result)]
|
||||
(recur (first content)
|
||||
(rest content)
|
||||
(gsp/command->point current)
|
||||
(helpers/segment->point current)
|
||||
(conj result (dissoc current :prev)))))))
|
||||
|
||||
(defn remove-duplicated-segments
|
||||
@@ -273,20 +301,43 @@
|
||||
segments
|
||||
result))))))
|
||||
|
||||
(defn close-content
|
||||
[content]
|
||||
(into []
|
||||
(mapcat :data)
|
||||
(->> content
|
||||
(subpath/close-subpaths)
|
||||
(subpath/get-subpaths))))
|
||||
|
||||
(defn- content->geom-data
|
||||
[content]
|
||||
|
||||
(->> content
|
||||
(close-content)
|
||||
(filter #(not= (= :line-to (:command %))
|
||||
(= :curve-to (:command %))))
|
||||
(mapv (fn [segment]
|
||||
{:command (:command segment)
|
||||
:segment segment
|
||||
:geom (if (= :line-to (:command segment))
|
||||
(helpers/command->line segment)
|
||||
(helpers/command->bezier segment))
|
||||
:selrect (helpers/command->selrect segment)}))))
|
||||
|
||||
(defn create-union [content-a content-a-split content-b content-b-split sr-a sr-b]
|
||||
;; Pick all segments in content-a that are not inside content-b
|
||||
;; Pick all segments in content-b that are not inside content-a
|
||||
(let [content-a-geom (gsp/content->geom-data content-a)
|
||||
content-b-geom (gsp/content->geom-data content-b)
|
||||
(let [content-a-geom (content->geom-data content-a)
|
||||
content-b-geom (content->geom-data content-b)
|
||||
|
||||
content
|
||||
(concat
|
||||
(->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom))))
|
||||
(->> content-b-split (filter #(not (contains-segment? % content-a sr-a content-a-geom)))))
|
||||
|
||||
content-geom (gsp/content->geom-data content)
|
||||
content-geom (content->geom-data content)
|
||||
|
||||
content-sr (gsp/content->selrect (fix-move-to content))
|
||||
content-sr (segment/content->selrect (fix-move-to content))
|
||||
|
||||
;; Overlapping segments should be added when they are part of the border
|
||||
border-content
|
||||
@@ -302,8 +353,8 @@
|
||||
;; Pick all segments in content-a that are not inside content-b
|
||||
;; Pick all segments in content b that are inside content-a
|
||||
;; removing overlapping
|
||||
(let [content-a-geom (gsp/content->geom-data content-a)
|
||||
content-b-geom (gsp/content->geom-data content-b)]
|
||||
(let [content-a-geom (content->geom-data content-a)
|
||||
content-b-geom (content->geom-data content-b)]
|
||||
(d/concat-vec
|
||||
(->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom))))
|
||||
|
||||
@@ -315,13 +366,12 @@
|
||||
(defn create-intersection [content-a content-a-split content-b content-b-split sr-a sr-b]
|
||||
;; Pick all segments in content-a that are inside content-b
|
||||
;; Pick all segments in content-b that are inside content-a
|
||||
(let [content-a-geom (gsp/content->geom-data content-a)
|
||||
content-b-geom (gsp/content->geom-data content-b)]
|
||||
(let [content-a-geom (content->geom-data content-a)
|
||||
content-b-geom (content->geom-data content-b)]
|
||||
(d/concat-vec
|
||||
(->> content-a-split (filter #(contains-segment? % content-b sr-b content-b-geom)))
|
||||
(->> content-b-split (filter #(contains-segment? % content-a sr-a content-a-geom))))))
|
||||
|
||||
|
||||
(defn create-exclusion [content-a content-b]
|
||||
;; Pick all segments
|
||||
(d/concat-vec content-a content-b))
|
||||
@@ -331,26 +381,37 @@
|
||||
|
||||
(let [;; We need to reverse the second path when making a difference/intersection/exclude
|
||||
;; and both shapes are in the same direction
|
||||
should-reverse? (and (not= :union bool-type)
|
||||
(= (ups/clockwise? content-b)
|
||||
(ups/clockwise? content-a)))
|
||||
should-reverse?
|
||||
(and (not= :union bool-type)
|
||||
(= (subpath/clockwise? content-b)
|
||||
(subpath/clockwise? content-a)))
|
||||
|
||||
content-a (-> content-a
|
||||
(close-paths)
|
||||
(add-previous))
|
||||
content-a
|
||||
(-> content-a
|
||||
(close-paths)
|
||||
(add-previous))
|
||||
|
||||
content-b (-> content-b
|
||||
(close-paths)
|
||||
(cond-> should-reverse? (ups/reverse-content))
|
||||
(add-previous))
|
||||
content-b
|
||||
(-> content-b
|
||||
(close-paths)
|
||||
(cond-> should-reverse? (subpath/reverse-content))
|
||||
(add-previous))
|
||||
|
||||
sr-a (gsp/content->selrect content-a)
|
||||
sr-b (gsp/content->selrect content-b)
|
||||
sr-a
|
||||
(segment/content->selrect content-a)
|
||||
|
||||
sr-b
|
||||
(segment/content->selrect content-b)
|
||||
|
||||
;; Split content in new segments in the intersection with the other path
|
||||
[content-a-split content-b-split] (content-intersect-split content-a content-b sr-a sr-b)
|
||||
content-a-split (->> content-a-split add-previous (filter is-segment?))
|
||||
content-b-split (->> content-b-split add-previous (filter is-segment?))
|
||||
[content-a-split content-b-split]
|
||||
(content-intersect-split content-a content-b sr-a sr-b)
|
||||
|
||||
content-a-split
|
||||
(->> content-a-split add-previous (filter is-segment?))
|
||||
|
||||
content-b-split
|
||||
(->> content-b-split add-previous (filter is-segment?))
|
||||
|
||||
content
|
||||
(case bool-type
|
||||
@@ -362,14 +423,16 @@
|
||||
(-> content
|
||||
remove-duplicated-segments
|
||||
fix-move-to
|
||||
ups/close-subpaths)))
|
||||
subpath/close-subpaths)))
|
||||
|
||||
(defn content-bool
|
||||
(defn calculate-content
|
||||
"Create a bool content from a collection of contents and specified
|
||||
type."
|
||||
[bool-type contents]
|
||||
;; We apply the boolean operation in to each pair and the result to the next
|
||||
;; element
|
||||
(if (seq contents)
|
||||
(->> contents
|
||||
(reduce (partial content-bool-pair bool-type))
|
||||
(into []))
|
||||
(vec))
|
||||
[]))
|
||||
File diff suppressed because it is too large
Load Diff
782
common/src/app/common/types/path/impl.cljc
Normal file
782
common/src/app/common/types/path/impl.cljc
Normal file
@@ -0,0 +1,782 @@
|
||||
;; 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 app.common.types.path.impl
|
||||
"Contains schemas and data type implementation for PathData binary
|
||||
and plain formats"
|
||||
#?(:cljs
|
||||
(:require-macros [app.common.types.path.impl :refer [read-float read-short write-float write-short]]))
|
||||
(:refer-clojure :exclude [-lookup -reduce])
|
||||
(:require
|
||||
#?(:clj [app.common.fressian :as fres])
|
||||
#?(:clj [clojure.data.json :as json])
|
||||
#?(:cljs [app.common.weak-map :as weak-map])
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.schema.generators :as sg]
|
||||
[app.common.svg.path :as svg.path]
|
||||
[app.common.transit :as t]
|
||||
[app.common.types.path :as-alias path])
|
||||
(:import
|
||||
#?(:cljs [goog.string StringBuffer]
|
||||
:clj [java.nio ByteBuffer ByteOrder])))
|
||||
|
||||
#?(:clj (set! *warn-on-reflection* true))
|
||||
|
||||
(def ^:const SEGMENT-BYTE-SIZE 28)
|
||||
|
||||
(defprotocol IPathData
|
||||
(-write-to [_ buffer offset] "write the content to the specified buffer")
|
||||
(-get-byte-size [_] "get byte size"))
|
||||
|
||||
(defprotocol ITransformable
|
||||
(-transform [_ m] "apply a transform")
|
||||
(-lookup [_ index f])
|
||||
(-walk [_ f initial])
|
||||
(-reduce [_ f initial]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; IMPL HELPERS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defmacro read-short
|
||||
[target offset]
|
||||
(if (:ns &env)
|
||||
`(.getInt16 ~target ~offset true)
|
||||
(let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
|
||||
`(.getShort ~target ~offset))))
|
||||
|
||||
(defmacro read-float
|
||||
[target offset]
|
||||
(if (:ns &env)
|
||||
`(.getFloat32 ~target ~offset true)
|
||||
(let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
|
||||
`(double (.getFloat ~target ~offset)))))
|
||||
|
||||
(defmacro write-float
|
||||
[target offset value]
|
||||
(if (:ns &env)
|
||||
`(.setFloat32 ~target ~offset ~value true)
|
||||
(let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
|
||||
`(.putFloat ~target ~offset ~value))))
|
||||
|
||||
(defmacro write-short
|
||||
[target offset value]
|
||||
(if (:ns &env)
|
||||
`(.setInt16 ~target ~offset ~value true)
|
||||
(let [target (with-meta target {:tag 'java.nio.ByteBuffer})]
|
||||
`(.putShort ~target ~offset ~value))))
|
||||
|
||||
(defmacro with-cache
|
||||
"A helper macro that facilitates cache handling for content
|
||||
instance, only relevant on CLJS"
|
||||
[target key & expr]
|
||||
(if (:ns &env)
|
||||
(let [cache (gensym "cache-")
|
||||
target (with-meta target {:tag 'js})]
|
||||
`(let [~cache (.-cache ~target)
|
||||
~'result (.get ~cache ~key)]
|
||||
(if ~'result
|
||||
(do
|
||||
~'result)
|
||||
(let [~'result (do ~@expr)]
|
||||
(.set ~cache ~key ~'result)
|
||||
~'result))))
|
||||
`(do ~@expr)))
|
||||
|
||||
(defn- allocate
|
||||
[n-segments]
|
||||
#?(:clj (let [buffer (ByteBuffer/allocate (* n-segments SEGMENT-BYTE-SIZE))]
|
||||
(.order buffer ByteOrder/LITTLE_ENDIAN))
|
||||
:cljs (new js/ArrayBuffer (* n-segments SEGMENT-BYTE-SIZE))))
|
||||
|
||||
(defn- clone-buffer
|
||||
[buffer]
|
||||
#?(:clj
|
||||
(let [src (.array ^ByteBuffer buffer)
|
||||
len (alength ^bytes src)
|
||||
dst (byte-array len)]
|
||||
(System/arraycopy src 0 dst 0 len)
|
||||
(let [buffer (ByteBuffer/wrap dst)]
|
||||
(.order buffer ByteOrder/LITTLE_ENDIAN)))
|
||||
:cljs
|
||||
(let [src-view (js/Uint32Array. buffer)
|
||||
dst-buff (js/ArrayBuffer. (.-byteLength buffer))
|
||||
dst-view (js/Uint32Array. dst-buff)]
|
||||
(.set dst-view src-view)
|
||||
dst-buff)))
|
||||
|
||||
(defn- impl-transform-segment
|
||||
"Apply a transformation to a segment located under specified offset"
|
||||
[buffer offset a b c d e f]
|
||||
(let [t (read-short buffer offset)]
|
||||
(case t
|
||||
(1 2)
|
||||
(let [x (read-float buffer (+ offset 20))
|
||||
y (read-float buffer (+ offset 24))
|
||||
x (+ (* x a) (* y c) e)
|
||||
y (+ (* x b) (* y d) f)]
|
||||
(write-float buffer (+ offset 20) x)
|
||||
(write-float buffer (+ offset 24) y))
|
||||
|
||||
3
|
||||
(let [c1x (read-float buffer (+ offset 4))
|
||||
c1y (read-float buffer (+ offset 8))
|
||||
c2x (read-float buffer (+ offset 12))
|
||||
c2y (read-float buffer (+ offset 16))
|
||||
x (read-float buffer (+ offset 20))
|
||||
y (read-float buffer (+ offset 24))
|
||||
|
||||
c1x (+ (* c1x a) (* c1y c) e)
|
||||
c1y (+ (* c1x b) (* c1y d) f)
|
||||
c2x (+ (* c2x a) (* c2y c) e)
|
||||
c2y (+ (* c2x b) (* c2y d) f)
|
||||
x (+ (* x a) (* y c) e)
|
||||
y (+ (* x b) (* y d) f)]
|
||||
|
||||
(write-float buffer (+ offset 4) c1x)
|
||||
(write-float buffer (+ offset 8) c1y)
|
||||
(write-float buffer (+ offset 12) c2x)
|
||||
(write-float buffer (+ offset 16) c2y)
|
||||
(write-float buffer (+ offset 20) x)
|
||||
(write-float buffer (+ offset 24) y))
|
||||
|
||||
nil)))
|
||||
|
||||
(defn- impl-transform
|
||||
[buffer m size]
|
||||
(let [a (dm/get-prop m :a)
|
||||
b (dm/get-prop m :b)
|
||||
c (dm/get-prop m :c)
|
||||
d (dm/get-prop m :d)
|
||||
e (dm/get-prop m :e)
|
||||
f (dm/get-prop m :f)]
|
||||
(loop [index 0]
|
||||
(when (< index size)
|
||||
(let [offset (* index SEGMENT-BYTE-SIZE)]
|
||||
(impl-transform-segment buffer offset a b c d e f)
|
||||
(recur (inc index)))))))
|
||||
|
||||
(defn- impl-walk
|
||||
[buffer f initial size]
|
||||
(loop [index 0
|
||||
result (transient initial)]
|
||||
(if (< index size)
|
||||
(let [offset (* index SEGMENT-BYTE-SIZE)
|
||||
type (read-short buffer offset)
|
||||
c1x (read-float buffer (+ offset 4))
|
||||
c1y (read-float buffer (+ offset 8))
|
||||
c2x (read-float buffer (+ offset 12))
|
||||
c2y (read-float buffer (+ offset 16))
|
||||
x (read-float buffer (+ offset 20))
|
||||
y (read-float buffer (+ offset 24))
|
||||
type (case type
|
||||
1 :line-to
|
||||
2 :move-to
|
||||
3 :curve-to
|
||||
4 :close-path)
|
||||
res (f type c1x c1y c2x c2y x y)]
|
||||
(recur (inc index)
|
||||
(if (some? res)
|
||||
(conj! result res)
|
||||
result)))
|
||||
(persistent! result))))
|
||||
|
||||
(defn impl-reduce
|
||||
[buffer f initial size]
|
||||
(loop [index 0
|
||||
result initial]
|
||||
(if (< index size)
|
||||
(let [offset (* index SEGMENT-BYTE-SIZE)
|
||||
type (read-short buffer offset)
|
||||
c1x (read-float buffer (+ offset 4))
|
||||
c1y (read-float buffer (+ offset 8))
|
||||
c2x (read-float buffer (+ offset 12))
|
||||
c2y (read-float buffer (+ offset 16))
|
||||
x (read-float buffer (+ offset 20))
|
||||
y (read-float buffer (+ offset 24))
|
||||
type (case type
|
||||
1 :line-to
|
||||
2 :move-to
|
||||
3 :curve-to
|
||||
4 :close-path)
|
||||
result (f result index type c1x c1y c2x c2y x y)]
|
||||
(if (reduced? result)
|
||||
result
|
||||
(recur (inc index) result)))
|
||||
result)))
|
||||
|
||||
(defn impl-lookup
|
||||
[buffer index f]
|
||||
(let [offset (* index SEGMENT-BYTE-SIZE)
|
||||
type (read-short buffer offset)
|
||||
c1x (read-float buffer (+ offset 4))
|
||||
c1y (read-float buffer (+ offset 8))
|
||||
c2x (read-float buffer (+ offset 12))
|
||||
c2y (read-float buffer (+ offset 16))
|
||||
x (read-float buffer (+ offset 20))
|
||||
y (read-float buffer (+ offset 24))
|
||||
type (case type
|
||||
1 :line-to
|
||||
2 :move-to
|
||||
3 :curve-to
|
||||
4 :close-path)]
|
||||
#?(:clj (f type c1x c1y c2x c2y x y)
|
||||
:cljs (^function f type c1x c1y c2x c2y x y))))
|
||||
|
||||
(defn- to-string-segment*
|
||||
[buffer offset type ^StringBuilder builder]
|
||||
(case (long type)
|
||||
1 (let [x (read-float buffer (+ offset 20))
|
||||
y (read-float buffer (+ offset 24))]
|
||||
(doto builder
|
||||
(.append "M")
|
||||
(.append x)
|
||||
(.append ",")
|
||||
(.append y)))
|
||||
2 (let [x (read-float buffer (+ offset 20))
|
||||
y (read-float buffer (+ offset 24))]
|
||||
(doto builder
|
||||
(.append "L")
|
||||
(.append x)
|
||||
(.append ",")
|
||||
(.append y)))
|
||||
|
||||
3 (let [c1x (read-float buffer (+ offset 4))
|
||||
c1y (read-float buffer (+ offset 8))
|
||||
c2x (read-float buffer (+ offset 12))
|
||||
c2y (read-float buffer (+ offset 16))
|
||||
x (read-float buffer (+ offset 20))
|
||||
y (read-float buffer (+ offset 24))]
|
||||
(doto builder
|
||||
(.append "C")
|
||||
(.append c1x)
|
||||
(.append ",")
|
||||
(.append c1y)
|
||||
(.append ",")
|
||||
(.append c2x)
|
||||
(.append ",")
|
||||
(.append c2y)
|
||||
(.append ",")
|
||||
(.append x)
|
||||
(.append ",")
|
||||
(.append y)))
|
||||
4 (doto builder
|
||||
(.append "Z"))))
|
||||
|
||||
(defn- to-string
|
||||
"Format the path data structure to string"
|
||||
[buffer size]
|
||||
(let [builder #?(:clj (java.lang.StringBuilder. (int (* size 4)))
|
||||
:cljs (StringBuffer.))]
|
||||
(loop [index 0]
|
||||
(when (< index size)
|
||||
(let [offset (* index SEGMENT-BYTE-SIZE)
|
||||
type (read-short buffer offset)]
|
||||
(to-string-segment* buffer offset type builder)
|
||||
(recur (inc index)))))
|
||||
|
||||
(.toString builder)))
|
||||
|
||||
(defn- read-segment
|
||||
"Read segment from binary buffer at specified index"
|
||||
[buffer index]
|
||||
(let [offset (* index SEGMENT-BYTE-SIZE)
|
||||
type (read-short buffer offset)]
|
||||
(case (long type)
|
||||
1 (let [x (read-float buffer (+ offset 20))
|
||||
y (read-float buffer (+ offset 24))]
|
||||
{:command :move-to
|
||||
:params {:x (double x)
|
||||
:y (double y)}})
|
||||
|
||||
2 (let [x (read-float buffer (+ offset 20))
|
||||
y (read-float buffer (+ offset 24))]
|
||||
{:command :line-to
|
||||
:params {:x (double x)
|
||||
:y (double y)}})
|
||||
|
||||
3 (let [c1x (read-float buffer (+ offset 4))
|
||||
c1y (read-float buffer (+ offset 8))
|
||||
c2x (read-float buffer (+ offset 12))
|
||||
c2y (read-float buffer (+ offset 16))
|
||||
x (read-float buffer (+ offset 20))
|
||||
y (read-float buffer (+ offset 24))]
|
||||
{:command :curve-to
|
||||
:params {:x (double x)
|
||||
:y (double y)
|
||||
:c1x (double c1x)
|
||||
:c1y (double c1y)
|
||||
:c2x (double c2x)
|
||||
:c2y (double c2y)}})
|
||||
|
||||
4 {:command :close-path
|
||||
:params {}})))
|
||||
|
||||
(defn- in-range?
|
||||
[size i]
|
||||
(and (< i size) (>= i 0)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; TYPE: PATH-DATA
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
#?(:clj
|
||||
(deftype PathData [size
|
||||
^ByteBuffer buffer
|
||||
^:unsynchronized-mutable hash]
|
||||
Object
|
||||
(toString [_]
|
||||
(to-string buffer size))
|
||||
|
||||
(equals [_ other]
|
||||
(if (instance? PathData other)
|
||||
(.equals ^ByteBuffer buffer (.-buffer ^PathData other))
|
||||
false))
|
||||
|
||||
ITransformable
|
||||
(-transform [_ m]
|
||||
(let [buffer (clone-buffer buffer)]
|
||||
(impl-transform buffer m size)
|
||||
(PathData. size buffer nil)))
|
||||
|
||||
(-walk [_ f initial]
|
||||
(impl-walk buffer f initial size))
|
||||
|
||||
(-reduce [_ f initial]
|
||||
(impl-reduce buffer f initial size))
|
||||
|
||||
(-lookup [_ index f]
|
||||
(when (and (<= 0 index)
|
||||
(< index size))
|
||||
(impl-lookup buffer index f)))
|
||||
|
||||
json/JSONWriter
|
||||
(-write [this writter options]
|
||||
(json/-write (.toString this) writter options))
|
||||
|
||||
clojure.lang.IHashEq
|
||||
(hasheq [this]
|
||||
(when-not hash
|
||||
(set! hash (clojure.lang.Murmur3/hashOrdered (seq this))))
|
||||
hash)
|
||||
|
||||
clojure.lang.Sequential
|
||||
clojure.lang.Seqable
|
||||
(seq [_]
|
||||
(when (pos? size)
|
||||
((fn next-seq [i]
|
||||
(when (< i size)
|
||||
(cons (read-segment buffer i)
|
||||
(lazy-seq (next-seq (inc i))))))
|
||||
0)))
|
||||
|
||||
clojure.lang.IReduceInit
|
||||
(reduce [_ f start]
|
||||
(loop [index 0
|
||||
result start]
|
||||
(if (< index size)
|
||||
(let [result (f result (read-segment buffer index))]
|
||||
(if (reduced? result)
|
||||
@result
|
||||
(recur (inc index) result)))
|
||||
result)))
|
||||
|
||||
clojure.lang.Indexed
|
||||
(nth [_ i]
|
||||
(if (in-range? size i)
|
||||
(read-segment buffer i)
|
||||
nil))
|
||||
|
||||
(nth [_ i default]
|
||||
(if (in-range? size i)
|
||||
(read-segment buffer i)
|
||||
default))
|
||||
|
||||
clojure.lang.Counted
|
||||
(count [_] size)
|
||||
|
||||
IPathData
|
||||
(-get-byte-size [_]
|
||||
(* size SEGMENT-BYTE-SIZE))
|
||||
|
||||
(-write-to [_ _ _]
|
||||
(throw (RuntimeException. "not implemented"))))
|
||||
|
||||
:cljs
|
||||
#_:clj-kondo/ignore
|
||||
(deftype PathData [size buffer dview cache ^:mutable __hash]
|
||||
Object
|
||||
(toString [_]
|
||||
(to-string dview size))
|
||||
|
||||
IPathData
|
||||
(-get-byte-size [_]
|
||||
(.-byteLength buffer))
|
||||
|
||||
(-write-to [_ into-buffer offset]
|
||||
;; NOTE: we still use u8 because until the heap refactor merge
|
||||
;; we can't guarrantee the alignment of offset on 4 bytes
|
||||
(assert (instance? js/ArrayBuffer into-buffer))
|
||||
(let [size (.-byteLength buffer)
|
||||
mem (js/Uint8Array. into-buffer offset size)]
|
||||
(.set mem (js/Uint8Array. buffer))))
|
||||
|
||||
ITransformable
|
||||
(-transform [this m]
|
||||
(let [buffer (clone-buffer buffer)
|
||||
dview (js/DataView. buffer)]
|
||||
(impl-transform dview m size)
|
||||
(PathData. size buffer dview (weak-map/create) nil)))
|
||||
|
||||
(-walk [_ f initial]
|
||||
(impl-walk dview f initial size))
|
||||
|
||||
(-reduce [_ f initial]
|
||||
(impl-reduce dview f initial size))
|
||||
|
||||
(-lookup [_ index f]
|
||||
(when (and (<= 0 index)
|
||||
(< index size))
|
||||
(impl-lookup dview index f)))
|
||||
|
||||
cljs.core/ISequential
|
||||
cljs.core/IEquiv
|
||||
(-equiv [this other]
|
||||
(if (instance? PathData other)
|
||||
(let [obuffer (.-buffer other)]
|
||||
(if (= (.-byteLength obuffer)
|
||||
(.-byteLength buffer))
|
||||
(let [cb (js/Uint32Array. buffer)
|
||||
ob (js/Uint32Array. obuffer)
|
||||
sz (alength cb)]
|
||||
(loop [i 0]
|
||||
(if (< i sz)
|
||||
(if (= (aget ob i)
|
||||
(aget cb i))
|
||||
(recur (inc i))
|
||||
false)
|
||||
true)))
|
||||
false))
|
||||
false))
|
||||
|
||||
cljs.core/IReduce
|
||||
(-reduce [_ f]
|
||||
(loop [index 1
|
||||
result (if (pos? size)
|
||||
(read-segment dview 0)
|
||||
nil)]
|
||||
(if (< index size)
|
||||
(let [result (f result (read-segment dview index))]
|
||||
(if (reduced? result)
|
||||
@result
|
||||
(recur (inc index) result)))
|
||||
result)))
|
||||
|
||||
(-reduce [_ f start]
|
||||
(loop [index 0
|
||||
result start]
|
||||
(if (< index size)
|
||||
(let [result (f result (read-segment dview index))]
|
||||
(if (reduced? result)
|
||||
@result
|
||||
(recur (inc index) result)))
|
||||
result)))
|
||||
|
||||
cljs.core/IHash
|
||||
(-hash [coll]
|
||||
(caching-hash coll hash-ordered-coll __hash))
|
||||
|
||||
cljs.core/ICounted
|
||||
(-count [_] size)
|
||||
|
||||
cljs.core/IIndexed
|
||||
(-nth [_ i]
|
||||
(if (in-range? size i)
|
||||
(read-segment dview i)
|
||||
nil))
|
||||
|
||||
(-nth [_ i default]
|
||||
(if (in-range? i size)
|
||||
(read-segment dview i)
|
||||
default))
|
||||
|
||||
cljs.core/ISeqable
|
||||
(-seq [this]
|
||||
(when (pos? size)
|
||||
((fn next-seq [i]
|
||||
(when (< i size)
|
||||
(cons (read-segment dview i)
|
||||
(lazy-seq (next-seq (inc i))))))
|
||||
0)))
|
||||
|
||||
cljs.core/IPrintWithWriter
|
||||
(-pr-writer [this writer _]
|
||||
(cljs.core/-write writer (str "#penpot/path-data \"" (.toString this) "\"")))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SCHEMA
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def schema:safe-number
|
||||
[:schema {:gen/gen (sg/small-int :max 100 :min -100)}
|
||||
::sm/safe-number])
|
||||
|
||||
(def ^:private schema:line-to-segment
|
||||
[:map
|
||||
[:command [:= :line-to]]
|
||||
[:params
|
||||
[:map
|
||||
[:x schema:safe-number]
|
||||
[:y schema:safe-number]]]])
|
||||
|
||||
(def ^:private schema:close-path-segment
|
||||
[:map
|
||||
[:command [:= :close-path]]])
|
||||
|
||||
(def ^:private schema:move-to-segment
|
||||
[:map
|
||||
[:command [:= :move-to]]
|
||||
[:params
|
||||
[:map
|
||||
[:x schema:safe-number]
|
||||
[:y schema:safe-number]]]])
|
||||
|
||||
(def ^:private schema:curve-to-segment
|
||||
[:map
|
||||
[:command [:= :curve-to]]
|
||||
[:params
|
||||
[:map
|
||||
[:x schema:safe-number]
|
||||
[:y schema:safe-number]
|
||||
[:c1x schema:safe-number]
|
||||
[:c1y schema:safe-number]
|
||||
[:c2x schema:safe-number]
|
||||
[:c2y schema:safe-number]]]])
|
||||
|
||||
(def ^:private schema:segment
|
||||
[:multi {:title "PathSegment"
|
||||
:dispatch :command
|
||||
:decode/json #(update % :command keyword)}
|
||||
[:line-to schema:line-to-segment]
|
||||
[:close-path schema:close-path-segment]
|
||||
[:move-to schema:move-to-segment]
|
||||
[:curve-to schema:curve-to-segment]])
|
||||
|
||||
(def schema:segments
|
||||
[:vector {:gen/gen (->> (sg/generator schema:segment)
|
||||
(sg/vector)
|
||||
(sg/filter not-empty)
|
||||
(sg/filter (fn [[e1]]
|
||||
(= (:command e1) :move-to))))}
|
||||
schema:segment])
|
||||
|
||||
(def schema:content-like
|
||||
[:sequential schema:segment])
|
||||
|
||||
(def check-content-like
|
||||
(sm/check-fn schema:content-like))
|
||||
|
||||
(def check-segment
|
||||
(sm/check-fn schema:segment))
|
||||
|
||||
(def ^:private check-segments
|
||||
(sm/check-fn schema:segments))
|
||||
|
||||
(defn path-data?
|
||||
[o]
|
||||
(instance? PathData o))
|
||||
|
||||
(declare from-string)
|
||||
(declare from-plain)
|
||||
|
||||
;; Mainly used on backend: features/components_v2.clj
|
||||
(sm/register! ::path/segment schema:segment)
|
||||
(sm/register! ::path/segments schema:segments)
|
||||
|
||||
(sm/register!
|
||||
{:type ::path/content
|
||||
:compile
|
||||
(fn [_ _ _]
|
||||
(let [decoder (delay (sm/decoder schema:segments sm/json-transformer))
|
||||
generator (->> (sg/generator schema:segments)
|
||||
(sg/filter not-empty)
|
||||
(sg/fmap from-plain))]
|
||||
{:pred path-data?
|
||||
:type-properties
|
||||
{:gen/gen generator
|
||||
:encode/json identity
|
||||
:decode/json (fn [s]
|
||||
(cond
|
||||
(string? s)
|
||||
(from-string s)
|
||||
|
||||
(vector? s)
|
||||
(let [decode-fn (deref decoder)]
|
||||
(-> (decode-fn s)
|
||||
(from-plain)))
|
||||
|
||||
:else
|
||||
s))}}))})
|
||||
|
||||
(def check-path-content
|
||||
(sm/check-fn ::path/content))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; CONSTRUCTORS & PREDICATES
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn from-string
|
||||
[s]
|
||||
(from-plain (svg.path/parse s)))
|
||||
|
||||
(defn from-bytes
|
||||
[buffer]
|
||||
#?(:clj
|
||||
(cond
|
||||
(instance? ByteBuffer buffer)
|
||||
(let [size (.capacity ^ByteBuffer buffer)
|
||||
count (long (/ size SEGMENT-BYTE-SIZE))
|
||||
buffer (.order ^ByteBuffer buffer ByteOrder/LITTLE_ENDIAN)]
|
||||
(PathData. count buffer nil))
|
||||
|
||||
(bytes? buffer)
|
||||
(let [size (alength ^bytes buffer)
|
||||
count (long (/ size SEGMENT-BYTE-SIZE))
|
||||
buffer (ByteBuffer/wrap buffer)]
|
||||
(PathData. count
|
||||
(.order buffer ByteOrder/LITTLE_ENDIAN)
|
||||
nil))
|
||||
:else
|
||||
(throw (java.lang.IllegalArgumentException. "invalid data provided")))
|
||||
|
||||
:cljs
|
||||
(cond
|
||||
(instance? js/ArrayBuffer buffer)
|
||||
(let [size (.-byteLength buffer)
|
||||
count (long (/ size SEGMENT-BYTE-SIZE))]
|
||||
(PathData. count
|
||||
buffer
|
||||
(js/DataView. buffer)
|
||||
(weak-map/create)
|
||||
nil))
|
||||
|
||||
(instance? js/DataView buffer)
|
||||
(let [dview buffer
|
||||
buffer (.-buffer dview)
|
||||
size (.-byteLength buffer)
|
||||
count (long (/ size SEGMENT-BYTE-SIZE))]
|
||||
(PathData. count buffer dview (weak-map/create) nil))
|
||||
|
||||
(instance? js/Uint8Array buffer)
|
||||
(from-bytes (.-buffer buffer))
|
||||
|
||||
(instance? js/Int8Array buffer)
|
||||
(from-bytes (.-buffer buffer))
|
||||
|
||||
:else
|
||||
(throw (js/Error. "invalid data provided")))))
|
||||
|
||||
;; FIXME: consider implementing with reduce
|
||||
;; FIXME: consider ensure fixed precision for avoid doing it on formatting
|
||||
|
||||
(defn from-plain
|
||||
"Create a PathData instance from plain data structures"
|
||||
[segments]
|
||||
(assert (check-segments segments))
|
||||
|
||||
(let [total (count segments)
|
||||
#?@(:cljs [buffer' (allocate total)
|
||||
buffer (new js/DataView buffer')]
|
||||
:clj [buffer (allocate total)])]
|
||||
(loop [index 0]
|
||||
(when (< index total)
|
||||
(let [segment (nth segments index)
|
||||
offset (* index SEGMENT-BYTE-SIZE)]
|
||||
(case (get segment :command)
|
||||
:move-to
|
||||
(let [params (get segment :params)
|
||||
x (float (get params :x))
|
||||
y (float (get params :y))]
|
||||
(write-short buffer offset 1)
|
||||
(write-float buffer (+ offset 20) x)
|
||||
(write-float buffer (+ offset 24) y))
|
||||
|
||||
:line-to
|
||||
(let [params (get segment :params)
|
||||
x (float (get params :x))
|
||||
y (float (get params :y))]
|
||||
|
||||
(write-short buffer offset 2)
|
||||
(write-float buffer (+ offset 20) x)
|
||||
(write-float buffer (+ offset 24) y))
|
||||
|
||||
:curve-to
|
||||
(let [params (get segment :params)
|
||||
x (float (get params :x))
|
||||
y (float (get params :y))
|
||||
c1x (float (get params :c1x x))
|
||||
c1y (float (get params :c1y y))
|
||||
c2x (float (get params :c2x x))
|
||||
c2y (float (get params :c2y y))]
|
||||
|
||||
(write-short buffer offset 3)
|
||||
(write-float buffer (+ offset 4) c1x)
|
||||
(write-float buffer (+ offset 8) c1y)
|
||||
(write-float buffer (+ offset 12) c2x)
|
||||
(write-float buffer (+ offset 16) c2y)
|
||||
(write-float buffer (+ offset 20) x)
|
||||
(write-float buffer (+ offset 24) y))
|
||||
|
||||
:close-path
|
||||
(write-short buffer offset 4))
|
||||
(recur (inc index)))))
|
||||
|
||||
(from-bytes buffer)))
|
||||
|
||||
(defn path-data
|
||||
"Create an instance of PathData, returns itself if it is already
|
||||
PathData instance"
|
||||
[data]
|
||||
(cond
|
||||
(path-data? data)
|
||||
data
|
||||
|
||||
(nil? data)
|
||||
(from-plain [])
|
||||
|
||||
(sequential? data)
|
||||
(from-plain data)
|
||||
|
||||
:else
|
||||
(throw (ex-info "unexpected data" {:data data}))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SERIALIZATION
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/add-handlers!
|
||||
{:id "penpot/path-data"
|
||||
:class PathData
|
||||
:wfn (fn [^PathData pdata]
|
||||
(let [buffer (.-buffer pdata)]
|
||||
#?(:cljs (js/Uint8Array. buffer)
|
||||
:clj (.array ^ByteBuffer buffer))))
|
||||
:rfn from-bytes})
|
||||
|
||||
#?(:clj
|
||||
(fres/add-handlers!
|
||||
{:name "penpot/path-data"
|
||||
:class PathData
|
||||
:wfn (fn [n w o]
|
||||
(fres/write-tag! w n 1)
|
||||
(let [buffer (.-buffer ^PathData o)
|
||||
bytes (.array ^ByteBuffer buffer)]
|
||||
(fres/write-bytes! w bytes)))
|
||||
:rfn (fn [r]
|
||||
(let [^bytes bytes (fres/read-object! r)]
|
||||
(from-bytes bytes)))}))
|
||||
|
||||
889
common/src/app/common/types/path/segment.cljc
Normal file
889
common/src/app/common/types/path/segment.cljc
Normal file
@@ -0,0 +1,889 @@
|
||||
;; 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 app.common.types.path.segment
|
||||
"A collection of helpers for work with plain segment type"
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.math :as mth]
|
||||
[app.common.types.path.helpers :as helpers]
|
||||
[app.common.types.path.impl :as impl]
|
||||
[clojure.set :as set]))
|
||||
|
||||
#?(:clj (set! *warn-on-reflection* true))
|
||||
|
||||
(defn update-handler
|
||||
[command prefix point]
|
||||
(let [[cox coy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])]
|
||||
(-> command
|
||||
(assoc-in [:params cox] (:x point))
|
||||
(assoc-in [:params coy] (:y point)))))
|
||||
|
||||
(defn get-handler [{:keys [params] :as command} prefix]
|
||||
(let [cx (d/prefix-keyword prefix :x)
|
||||
cy (d/prefix-keyword prefix :y)]
|
||||
(when (and command
|
||||
(contains? params cx)
|
||||
(contains? params cy))
|
||||
(gpt/point (get params cx)
|
||||
(get params cy)))))
|
||||
|
||||
(defn get-handlers
|
||||
"Retrieve a map where for every point will retrieve a list of
|
||||
the handlers that are associated with that point.
|
||||
point -> [[index, prefix]]"
|
||||
[content]
|
||||
(let [prev-point* (volatile! nil)
|
||||
vec-conj (fnil conj [])]
|
||||
(impl/-reduce content
|
||||
(fn [result index type _ _ _ _ x y]
|
||||
(let [curr-point (gpt/point x y)
|
||||
prev-point (deref prev-point*)]
|
||||
(vreset! prev-point* curr-point)
|
||||
(if (and prev-point (= :curve-to type))
|
||||
(-> result
|
||||
(update prev-point vec-conj [index :c1])
|
||||
(update curr-point vec-conj [index :c2]))
|
||||
result)))
|
||||
{})))
|
||||
|
||||
(defn point-indices
|
||||
[content point]
|
||||
(->> (d/enumerate content)
|
||||
(filter (fn [[_ segment]] (= point (helpers/segment->point segment))))
|
||||
(mapv (fn [[index _]] index))))
|
||||
|
||||
(defn handler-indices
|
||||
"Return an index where the key is the positions and the values the handlers"
|
||||
[content point]
|
||||
(->> (d/with-prev content)
|
||||
(d/enumerate)
|
||||
(mapcat (fn [[index [cur-segment pre-segment]]]
|
||||
(if (and (some? pre-segment) (= :curve-to (:command cur-segment)))
|
||||
(let [cur-pos (helpers/segment->point cur-segment)
|
||||
pre-pos (helpers/segment->point pre-segment)]
|
||||
(cond-> []
|
||||
(= pre-pos point) (conj [index :c1])
|
||||
(= cur-pos point) (conj [index :c2])))
|
||||
[])))))
|
||||
|
||||
(defn opposite-index
|
||||
"Calculates the opposite index given a prefix and an index"
|
||||
[content index prefix]
|
||||
|
||||
(let [point (if (= prefix :c2)
|
||||
(helpers/segment->point (nth content index))
|
||||
(helpers/segment->point (nth content (dec index))))
|
||||
|
||||
point->handlers (get-handlers content)
|
||||
|
||||
handlers (->> point
|
||||
(point->handlers)
|
||||
(filter (fn [[ci cp]] (and (not= index ci) (not= prefix cp)))))]
|
||||
|
||||
(cond
|
||||
(= (count handlers) 1)
|
||||
(->> handlers first)
|
||||
|
||||
(and (= :c1 prefix) (= (count content) index))
|
||||
[(dec index) :c2]
|
||||
|
||||
:else nil)))
|
||||
|
||||
;; FIXME: rename to get-point
|
||||
(defn get-handler-point
|
||||
"Given a segment index and prefix, get a handler point"
|
||||
[content index prefix]
|
||||
(when (and (some? index)
|
||||
(some? content))
|
||||
(impl/-lookup content index
|
||||
(fn [command c1x c1y c2x c2y x y]
|
||||
(let [prefix (if (= :curve-to command)
|
||||
prefix
|
||||
nil)]
|
||||
(case prefix
|
||||
:c1 (gpt/point c1x c1y)
|
||||
:c2 (gpt/point c2x c2y)
|
||||
(gpt/point x y)))))))
|
||||
|
||||
;; FIXME: revisit this function
|
||||
(defn handler->node
|
||||
[content index prefix]
|
||||
(if (= prefix :c1)
|
||||
(helpers/segment->point (nth content (dec index)))
|
||||
(helpers/segment->point (nth content index))))
|
||||
|
||||
(defn calculate-opposite-handler
|
||||
"Given a point and its handler, gives the symmetric handler"
|
||||
[point handler]
|
||||
(let [handler-vector (gpt/to-vec point handler)]
|
||||
(gpt/add point (gpt/negate handler-vector))))
|
||||
|
||||
(defn opposite-handler
|
||||
"Calculates the coordinates of the opposite handler"
|
||||
[point handler]
|
||||
(let [phv (gpt/to-vec point handler)]
|
||||
(gpt/add point (gpt/negate phv))))
|
||||
|
||||
(defn get-points
|
||||
"Returns points for the given segment, faster version of
|
||||
the `content->points`."
|
||||
[content]
|
||||
(impl/with-cache content "get-points"
|
||||
(impl/-walk content
|
||||
(fn [type _ _ _ _ x y]
|
||||
(when (not= type :close-path)
|
||||
(gpt/point x y)))
|
||||
[])))
|
||||
|
||||
;; FIXME: incorrect API, don't need full shape
|
||||
(defn path->lines
|
||||
"Given a path returns a list of lines that approximate the path"
|
||||
[shape]
|
||||
(loop [command (first (:content shape))
|
||||
pending (rest (:content shape))
|
||||
result []
|
||||
last-start nil
|
||||
prev-point nil]
|
||||
|
||||
(if-let [{:keys [command params]} command]
|
||||
(let [point (if (= :close-path command)
|
||||
last-start
|
||||
(gpt/point params))
|
||||
|
||||
result (case command
|
||||
:line-to (conj result [prev-point point])
|
||||
:curve-to (let [h1 (gpt/point (:c1x params) (:c1y params))
|
||||
h2 (gpt/point (:c2x params) (:c2y params))]
|
||||
(into result (helpers/curve->lines prev-point point h1 h2)))
|
||||
:move-to (cond-> result
|
||||
last-start (conj [prev-point last-start]))
|
||||
result)
|
||||
last-start (if (= :move-to command)
|
||||
point
|
||||
last-start)]
|
||||
(recur (first pending)
|
||||
(rest pending)
|
||||
result
|
||||
last-start
|
||||
point))
|
||||
|
||||
(conj result [prev-point last-start]))))
|
||||
|
||||
(def ^:const path-closest-point-accuracy 0.01)
|
||||
|
||||
;; FIXME: move to helpers?, this function need performance review, it
|
||||
;; is executed so many times on path edition
|
||||
(defn- curve-closest-point
|
||||
[position start end h1 h2]
|
||||
(let [d (memoize (fn [t] (gpt/distance position (helpers/curve-values start end h1 h2 t))))]
|
||||
(loop [t1 0.0
|
||||
t2 1.0]
|
||||
(if (<= (mth/abs (- t1 t2)) path-closest-point-accuracy)
|
||||
(-> (helpers/curve-values start end h1 h2 t1)
|
||||
;; store the segment info
|
||||
(with-meta {:t t1 :from-p start :to-p end}))
|
||||
|
||||
(let [ht (+ t1 (/ (- t2 t1) 2))
|
||||
ht1 (+ t1 (/ (- t2 t1) 4))
|
||||
ht2 (+ t1 (/ (* 3 (- t2 t1)) 4))
|
||||
|
||||
[t1 t2] (cond
|
||||
(< (d ht1) (d ht2))
|
||||
[t1 ht]
|
||||
|
||||
(< (d ht2) (d ht1))
|
||||
[ht t2]
|
||||
|
||||
(and (< (d ht) (d t1)) (< (d ht) (d t2)))
|
||||
[ht1 ht2]
|
||||
|
||||
(< (d t1) (d t2))
|
||||
[t1 ht]
|
||||
|
||||
:else
|
||||
[ht t2])]
|
||||
(recur (double t1)
|
||||
(double t2)))))))
|
||||
|
||||
(defn- line-closest-point
|
||||
"Point on line"
|
||||
[position from-p to-p]
|
||||
|
||||
(let [e1 (gpt/to-vec from-p to-p)
|
||||
e2 (gpt/to-vec from-p position)
|
||||
|
||||
len2 (+ (mth/sq (:x e1)) (mth/sq (:y e1)))
|
||||
t (/ (gpt/dot e1 e2) len2)]
|
||||
|
||||
(if (and (>= t 0) (<= t 1) (not (mth/almost-zero? len2)))
|
||||
(-> (gpt/add from-p (gpt/scale e1 t))
|
||||
(with-meta {:t t
|
||||
:from-p from-p
|
||||
:to-p to-p}))
|
||||
|
||||
;; There is no perpendicular projection in the line so the closest
|
||||
;; point will be one of the extremes
|
||||
(if (<= (gpt/distance position from-p) (gpt/distance position to-p))
|
||||
from-p
|
||||
to-p))))
|
||||
|
||||
;; FIXME: incorrect API, complete shape is not necessary here
|
||||
(defn path-closest-point
|
||||
"Given a path and a position"
|
||||
[shape position]
|
||||
|
||||
(let [point+distance
|
||||
(fn [[cur-segment prev-segment]]
|
||||
(let [from-p (helpers/segment->point prev-segment)
|
||||
to-p (helpers/segment->point cur-segment)
|
||||
h1 (gpt/point (get-in cur-segment [:params :c1x])
|
||||
(get-in cur-segment [:params :c1y]))
|
||||
h2 (gpt/point (get-in cur-segment [:params :c2x])
|
||||
(get-in cur-segment [:params :c2y]))
|
||||
point
|
||||
(case (:command cur-segment)
|
||||
:line-to
|
||||
(line-closest-point position from-p to-p)
|
||||
|
||||
:curve-to
|
||||
(curve-closest-point position from-p to-p h1 h2)
|
||||
|
||||
nil)]
|
||||
(when point
|
||||
[point (gpt/distance point position)])))
|
||||
|
||||
find-min-point
|
||||
(fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]]
|
||||
(if (and (some? acc) (or (not cur) (<= min-dist cur-dist)))
|
||||
[min-p min-dist]
|
||||
[cur-p cur-dist]))]
|
||||
|
||||
(->> (:content shape)
|
||||
(d/with-prev)
|
||||
(map point+distance)
|
||||
(reduce find-min-point)
|
||||
(first))))
|
||||
|
||||
|
||||
(defn closest-point
|
||||
"Given a path and a position"
|
||||
[content position]
|
||||
|
||||
(let [point+distance
|
||||
(fn [[cur-segment prev-segment]]
|
||||
(let [from-p (helpers/segment->point prev-segment)
|
||||
to-p (helpers/segment->point cur-segment)
|
||||
h1 (gpt/point (get-in cur-segment [:params :c1x])
|
||||
(get-in cur-segment [:params :c1y]))
|
||||
h2 (gpt/point (get-in cur-segment [:params :c2x])
|
||||
(get-in cur-segment [:params :c2y]))
|
||||
point
|
||||
(case (:command cur-segment)
|
||||
:line-to
|
||||
(line-closest-point position from-p to-p)
|
||||
|
||||
:curve-to
|
||||
(curve-closest-point position from-p to-p h1 h2)
|
||||
|
||||
nil)]
|
||||
(when point
|
||||
[point (gpt/distance point position)])))
|
||||
|
||||
find-min-point
|
||||
(fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]]
|
||||
(if (and (some? acc) (or (not cur) (<= min-dist cur-dist)))
|
||||
[min-p min-dist]
|
||||
[cur-p cur-dist]))]
|
||||
|
||||
(->> content
|
||||
(d/with-prev)
|
||||
(map point+distance)
|
||||
(reduce find-min-point)
|
||||
(first))))
|
||||
|
||||
(defn- remove-line-curves
|
||||
"Remove all curves that have both handlers in the same position that the
|
||||
beginning and end points. This makes them really line-to commands"
|
||||
[content]
|
||||
(let [with-prev (d/enumerate (d/with-prev content))
|
||||
process-command
|
||||
(fn [content [index [command prev]]]
|
||||
|
||||
(let [cur-point (helpers/segment->point command)
|
||||
pre-point (helpers/segment->point prev)
|
||||
handler-c1 (get-handler command :c1)
|
||||
handler-c2 (get-handler command :c2)]
|
||||
(if (and (= :curve-to (:command command))
|
||||
(= cur-point handler-c2)
|
||||
(= pre-point handler-c1))
|
||||
(assoc content index {:command :line-to
|
||||
:params (into {} cur-point)})
|
||||
content)))]
|
||||
|
||||
(reduce process-command content with-prev)))
|
||||
|
||||
(defn make-corner-point
|
||||
"Changes the content to make a point a 'corner'"
|
||||
[content point]
|
||||
(let [handlers (-> (get-handlers content)
|
||||
(get point))
|
||||
change-content
|
||||
(fn [content [index prefix]]
|
||||
(let [cx (d/prefix-keyword prefix :x)
|
||||
cy (d/prefix-keyword prefix :y)]
|
||||
(-> content
|
||||
(assoc-in [index :params cx] (:x point))
|
||||
(assoc-in [index :params cy] (:y point)))))]
|
||||
(as-> content $
|
||||
(reduce change-content $ handlers)
|
||||
(remove-line-curves $))))
|
||||
|
||||
|
||||
(defn- line->curve
|
||||
[from-p segment]
|
||||
|
||||
(let [to-p (helpers/segment->point segment)
|
||||
|
||||
v (gpt/to-vec from-p to-p)
|
||||
d (gpt/distance from-p to-p)
|
||||
|
||||
dv1 (-> (gpt/normal-left v)
|
||||
(gpt/scale (/ d 3)))
|
||||
|
||||
h1 (gpt/add from-p dv1)
|
||||
|
||||
dv2 (-> (gpt/to-vec to-p h1)
|
||||
(gpt/unit)
|
||||
(gpt/scale (/ d 3)))
|
||||
|
||||
h2 (gpt/add to-p dv2)]
|
||||
(-> segment
|
||||
(assoc :command :curve-to)
|
||||
(update :params (fn [params]
|
||||
;; ensure plain map
|
||||
(-> (into {} params)
|
||||
(assoc :c1x (:x h1))
|
||||
(assoc :c1y (:y h1))
|
||||
(assoc :c2x (:x h2))
|
||||
(assoc :c2y (:y h2))))))))
|
||||
|
||||
;; FIXME: optimize
|
||||
(defn is-curve?
|
||||
[content point]
|
||||
(let [handlers (-> (get-handlers content)
|
||||
(get point))
|
||||
handler-points (map #(get-handler-point content (first %) (second %)) handlers)]
|
||||
(some #(not= point %) handler-points)))
|
||||
|
||||
(def ^:private xf:mapcat-points
|
||||
(comp
|
||||
(mapcat #(vector (:next-p %) (:prev-p %)))
|
||||
(remove nil?)))
|
||||
|
||||
(defn make-curve-point
|
||||
"Changes the content to make the point a 'curve'. The handlers will be positioned
|
||||
in the same vector that results from the previous->next points but with fixed length."
|
||||
[content point]
|
||||
|
||||
(let [indices (point-indices content point)
|
||||
vectors (map (fn [index]
|
||||
(let [segment (nth content index)
|
||||
prev-i (dec index)
|
||||
prev (when (not (= :move-to (:command segment)))
|
||||
(get content prev-i))
|
||||
next-i (inc index)
|
||||
next (get content next-i)
|
||||
|
||||
next (when (not (= :move-to (:command next)))
|
||||
next)]
|
||||
{:index index
|
||||
:prev-i (when (some? prev) prev-i)
|
||||
:prev-c prev
|
||||
:prev-p (helpers/segment->point prev)
|
||||
:next-i (when (some? next) next-i)
|
||||
:next-c next
|
||||
:next-p (helpers/segment->point next)
|
||||
:segment segment}))
|
||||
indices)
|
||||
|
||||
points (into #{} xf:mapcat-points vectors)]
|
||||
|
||||
(if (= (count points) 2)
|
||||
(let [v1 (gpt/to-vec (first points) point)
|
||||
v2 (gpt/to-vec (first points) (second points))
|
||||
vp (gpt/project v1 v2)
|
||||
vh (gpt/subtract v1 vp)
|
||||
|
||||
add-curve
|
||||
(fn [content {:keys [index prev-p next-p next-i]}]
|
||||
(let [cur-segment (get content index)
|
||||
next-segment (get content next-i)
|
||||
|
||||
;; New handlers for prev-point and next-point
|
||||
prev-h (when (some? prev-p) (gpt/add prev-p vh))
|
||||
next-h (when (some? next-p) (gpt/add next-p vh))
|
||||
|
||||
;; Correct 1/3 to the point improves the curve
|
||||
prev-correction (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3)))
|
||||
next-correction (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3)))
|
||||
|
||||
prev-h (when (some? prev-h) (gpt/add prev-h prev-correction))
|
||||
next-h (when (some? next-h) (gpt/add next-h next-correction))]
|
||||
(cond-> content
|
||||
(and (= :line-to (:command cur-segment)) (some? prev-p))
|
||||
(update index helpers/update-curve-to prev-p prev-h)
|
||||
|
||||
(and (= :line-to (:command next-segment)) (some? next-p))
|
||||
(update next-i helpers/update-curve-to next-h next-p)
|
||||
|
||||
(and (= :curve-to (:command cur-segment)) (some? prev-p))
|
||||
(update index update-handler :c2 prev-h)
|
||||
|
||||
(and (= :curve-to (:command next-segment)) (some? next-p))
|
||||
(update next-i update-handler :c1 next-h))))]
|
||||
|
||||
(reduce add-curve content vectors))
|
||||
|
||||
(let [add-curve
|
||||
(fn [content {:keys [index segment prev-p next-c next-i]}]
|
||||
(cond-> content
|
||||
(= :line-to (:command segment))
|
||||
(update index #(line->curve prev-p %))
|
||||
|
||||
(= :curve-to (:command segment))
|
||||
(update index #(line->curve prev-p %))
|
||||
|
||||
(= :line-to (:command next-c))
|
||||
(update next-i #(line->curve point %))
|
||||
|
||||
(= :curve-to (:command next-c))
|
||||
(update next-i #(line->curve point %))))]
|
||||
(reduce add-curve content vectors)))))
|
||||
|
||||
(defn get-segments-with-points
|
||||
"Given a content and a set of points return all the segments in the path
|
||||
that uses the points"
|
||||
[content points]
|
||||
(let [point-set (set points)]
|
||||
(loop [result (transient [])
|
||||
prev-point nil
|
||||
start-point nil
|
||||
index 0
|
||||
content (seq content)]
|
||||
(if-let [{:keys [command] :as segment} (first content)]
|
||||
(let [close-path? (= command :close-path)
|
||||
move-to? (= command :move-to)
|
||||
|
||||
cur-point (if close-path?
|
||||
start-point
|
||||
(helpers/segment->point segment))
|
||||
|
||||
;; If there is a move-to we don't have a segment
|
||||
prev-point (if move-to?
|
||||
nil
|
||||
prev-point)
|
||||
|
||||
;; We update the start point
|
||||
start-point (if move-to?
|
||||
cur-point
|
||||
start-point)
|
||||
|
||||
result (cond-> result
|
||||
(and (some? prev-point)
|
||||
(contains? point-set prev-point)
|
||||
(contains? point-set cur-point))
|
||||
|
||||
(conj! (-> segment
|
||||
(assoc :start prev-point)
|
||||
(assoc :end cur-point)
|
||||
(assoc :index index))))]
|
||||
(recur result
|
||||
cur-point
|
||||
start-point
|
||||
(inc index)
|
||||
(rest content)))
|
||||
|
||||
(persistent! result)))))
|
||||
|
||||
(defn split-segments
|
||||
"Given a content creates splits commands between points with new segments"
|
||||
[content points value]
|
||||
|
||||
(let [split-command
|
||||
(fn [{:keys [command start end index] :as segment}]
|
||||
(case command
|
||||
:line-to [index (helpers/split-line-to start segment value)]
|
||||
:curve-to [index (helpers/split-curve-to start segment value)]
|
||||
:close-path [index [(helpers/make-line-to (gpt/lerp start end value)) segment]]
|
||||
nil))
|
||||
|
||||
segment-changes
|
||||
(->> (get-segments-with-points content points)
|
||||
(into {} (keep split-command)))
|
||||
|
||||
process-segments
|
||||
(fn [[index command]]
|
||||
(if (contains? segment-changes index)
|
||||
(get segment-changes index)
|
||||
[command]))]
|
||||
|
||||
(into [] (mapcat process-segments) (d/enumerate content))))
|
||||
|
||||
;; FIXME: rename to next-segment
|
||||
(defn next-node
|
||||
"Calculates the next-node to be inserted."
|
||||
[content position prev-point prev-handler]
|
||||
(let [position (select-keys position [:x :y])
|
||||
last-command (-> content last :command)
|
||||
add-line? (and prev-point (not prev-handler) (not= last-command :close-path))
|
||||
add-curve? (and prev-point prev-handler (not= last-command :close-path))]
|
||||
(cond
|
||||
add-line? {:command :line-to
|
||||
:params position}
|
||||
add-curve? {:command :curve-to
|
||||
:params (helpers/make-curve-params position prev-handler)}
|
||||
:else {:command :move-to
|
||||
:params position})))
|
||||
(defn remove-nodes
|
||||
"Removes from content the points given. Will try to reconstruct the paths
|
||||
to keep everything consistent"
|
||||
[content points]
|
||||
|
||||
(if (empty? points)
|
||||
content
|
||||
|
||||
(let [content (d/with-prev content)]
|
||||
|
||||
(loop [result []
|
||||
last-handler nil
|
||||
[cur-segment prev-segment] (first content)
|
||||
content (rest content)]
|
||||
|
||||
(if (nil? cur-segment)
|
||||
;; The result with be an array of arrays were every entry is a subpath
|
||||
(->> result
|
||||
;; remove empty and only 1 node subpaths
|
||||
(filter #(> (count %) 1))
|
||||
;; flatten array-of-arrays plain array
|
||||
(flatten)
|
||||
(into []))
|
||||
|
||||
(let [move? (= :move-to (:command cur-segment))
|
||||
curve? (= :curve-to (:command cur-segment))
|
||||
|
||||
;; When the old command was a move we start a subpath
|
||||
result (if move? (conj result []) result)
|
||||
|
||||
subpath (peek result)
|
||||
|
||||
point (helpers/segment->point cur-segment)
|
||||
|
||||
old-prev-point (helpers/segment->point prev-segment)
|
||||
new-prev-point (helpers/segment->point (peek subpath))
|
||||
|
||||
remove? (contains? points point)
|
||||
|
||||
|
||||
;; We store the first handler for the first curve to be removed to
|
||||
;; use it for the first handler of the regenerated path
|
||||
cur-handler (cond
|
||||
(and (not last-handler) remove? curve?)
|
||||
(select-keys (:params cur-segment) [:c1x :c1y])
|
||||
|
||||
(not remove?)
|
||||
nil
|
||||
|
||||
:else
|
||||
last-handler)
|
||||
|
||||
cur-segment (cond-> cur-segment
|
||||
;; If we're starting a subpath and it's not a move make it a move
|
||||
(and (not move?) (empty? subpath))
|
||||
(assoc :command :move-to
|
||||
:params (select-keys (:params cur-segment) [:x :y]))
|
||||
|
||||
;; If have a curve the first handler will be relative to the previous
|
||||
;; point. We change the handler to the new previous point
|
||||
(and curve? (seq subpath) (not= old-prev-point new-prev-point))
|
||||
(update :params merge last-handler))
|
||||
|
||||
head-idx (dec (count result))
|
||||
|
||||
result (cond-> result
|
||||
(not remove?)
|
||||
(update head-idx conj cur-segment))]
|
||||
(recur result
|
||||
cur-handler
|
||||
(first content)
|
||||
(rest content))))))))
|
||||
|
||||
(defn join-nodes
|
||||
"Creates new segments between points that weren't previously"
|
||||
[content points]
|
||||
|
||||
(let [segments-set (into #{}
|
||||
(map (juxt :start :end))
|
||||
(get-segments-with-points content points))
|
||||
|
||||
create-line-command (fn [point other]
|
||||
[(helpers/make-move-to point)
|
||||
(helpers/make-line-to other)])
|
||||
|
||||
not-segment? (fn [point other] (and (not (contains? segments-set [point other]))
|
||||
(not (contains? segments-set [other point]))))
|
||||
|
||||
new-content (->> (d/map-perm create-line-command not-segment? points)
|
||||
(flatten)
|
||||
(into []))]
|
||||
|
||||
(into content new-content)))
|
||||
|
||||
|
||||
(defn separate-nodes
|
||||
"Removes the segments between the points given"
|
||||
[content points]
|
||||
|
||||
(let [content (d/with-prev content)]
|
||||
(loop [result []
|
||||
[cur-segment prev-segment] (first content)
|
||||
content (rest content)]
|
||||
|
||||
(if (nil? cur-segment)
|
||||
(->> result
|
||||
(filter #(> (count %) 1))
|
||||
(flatten)
|
||||
(into []))
|
||||
|
||||
(let [prev-point (helpers/segment->point prev-segment)
|
||||
cur-point (helpers/segment->point cur-segment)
|
||||
|
||||
cur-segment (cond-> cur-segment
|
||||
(and (contains? points prev-point)
|
||||
(contains? points cur-point))
|
||||
|
||||
(assoc :command :move-to
|
||||
:params (select-keys (:params cur-segment) [:x :y])))
|
||||
|
||||
move? (= :move-to (:command cur-segment))
|
||||
|
||||
result (if move? (conj result []) result)
|
||||
head-idx (dec (count result))
|
||||
|
||||
result (-> result
|
||||
(update head-idx conj cur-segment))]
|
||||
(recur result
|
||||
(first content)
|
||||
(rest content)))))))
|
||||
|
||||
|
||||
(defn- add-to-set
|
||||
"Given a list of sets adds the value to the target set"
|
||||
[set-list target value]
|
||||
(->> set-list
|
||||
(mapv (fn [it]
|
||||
(cond-> it
|
||||
(= it target) (conj value))))))
|
||||
|
||||
(defn- join-sets
|
||||
"Given a list of sets join two sets in the list into a new one"
|
||||
[set-list target other]
|
||||
(conj (->> set-list
|
||||
(filterv #(and (not= % target)
|
||||
(not= % other))))
|
||||
(set/union target other)))
|
||||
|
||||
;; FIXME: revisit impl of this fn
|
||||
(defn- group-segments [segments]
|
||||
(loop [result []
|
||||
{point-a :start point-b :end :as segment} (first segments)
|
||||
segments (rest segments)]
|
||||
|
||||
(if (nil? segment)
|
||||
result
|
||||
|
||||
(let [set-a (d/seek #(contains? % point-a) result)
|
||||
set-b (d/seek #(contains? % point-b) result)
|
||||
|
||||
result (cond-> result
|
||||
(and (nil? set-a) (nil? set-b))
|
||||
(conj #{point-a point-b})
|
||||
|
||||
(and (some? set-a) (nil? set-b))
|
||||
(add-to-set set-a point-b)
|
||||
|
||||
(and (nil? set-a) (some? set-b))
|
||||
(add-to-set set-b point-a)
|
||||
|
||||
(and (some? set-a) (some? set-b) (not= set-a set-b))
|
||||
(join-sets set-a set-b))]
|
||||
(recur result
|
||||
(first segments)
|
||||
(rest segments))))))
|
||||
|
||||
(defn- calculate-merge-points [group-segments points]
|
||||
(let [index-merge-point (fn [group] (vector group (gpt/center-points group)))
|
||||
index-group (fn [point] (vector point (d/seek #(contains? % point) group-segments)))
|
||||
|
||||
group->merge-point (into {} (map index-merge-point) group-segments)
|
||||
point->group (into {} (map index-group) points)]
|
||||
(d/mapm #(group->merge-point %2) point->group)))
|
||||
|
||||
;; TODO: Improve the replace for curves
|
||||
(defn- replace-points
|
||||
"Replaces the points in a path for its merge-point"
|
||||
[content point->merge-point]
|
||||
(let [replace-command
|
||||
(fn [segment]
|
||||
(let [point (helpers/segment->point segment)]
|
||||
(if (contains? point->merge-point point)
|
||||
(let [merge-point (get point->merge-point point)]
|
||||
(-> segment (update :params assoc :x (:x merge-point) :y (:y merge-point))))
|
||||
segment)))]
|
||||
(->> content
|
||||
(mapv replace-command))))
|
||||
|
||||
(defn merge-nodes
|
||||
"Reduces the contiguous segments in points to a single point"
|
||||
[content points]
|
||||
(let [segments (get-segments-with-points content points)]
|
||||
(if (seq segments)
|
||||
(let [point->merge-point (-> segments
|
||||
(group-segments)
|
||||
(calculate-merge-points points))]
|
||||
(-> content
|
||||
(separate-nodes points)
|
||||
(replace-points point->merge-point)))
|
||||
content)))
|
||||
|
||||
(defn transform-content
|
||||
"Applies a transformation matrix over content and returns a new
|
||||
content as PathData instance."
|
||||
[content transform]
|
||||
(if (some? transform)
|
||||
(impl/-transform content transform)
|
||||
content))
|
||||
|
||||
(defn move-content
|
||||
"Applies a displacement over content and returns a new content as
|
||||
PathData instance. Implemented in function of `transform-content`."
|
||||
[content move-vec]
|
||||
(let [transform (gmt/translate-matrix move-vec)]
|
||||
(transform-content content transform)))
|
||||
|
||||
(defn calculate-extremities
|
||||
"Calculate extremities for the provided content"
|
||||
[content]
|
||||
(loop [points (transient #{})
|
||||
content (not-empty (vec content))
|
||||
from-p nil
|
||||
move-p nil]
|
||||
(if content
|
||||
(let [last-p (peek content)
|
||||
content (if (= :move-to (:command last-p))
|
||||
(pop content)
|
||||
content)
|
||||
segment (get content 0)
|
||||
to-p (helpers/segment->point segment)]
|
||||
|
||||
(if segment
|
||||
(case (:command segment)
|
||||
:move-to
|
||||
(recur (conj! points to-p)
|
||||
(not-empty (subvec content 1))
|
||||
to-p
|
||||
to-p)
|
||||
|
||||
:close-path
|
||||
(recur (conj! points move-p)
|
||||
(not-empty (subvec content 1))
|
||||
move-p
|
||||
move-p)
|
||||
|
||||
:line-to
|
||||
(recur (cond-> points
|
||||
(and from-p to-p)
|
||||
(-> (conj! move-p)
|
||||
(conj! to-p)))
|
||||
(not-empty (subvec content 1))
|
||||
to-p
|
||||
move-p)
|
||||
|
||||
:curve-to
|
||||
(let [c1 (helpers/segment->point segment :c1)
|
||||
c2 (helpers/segment->point segment :c2)]
|
||||
(recur (if (and from-p to-p c1 c2)
|
||||
(reduce conj!
|
||||
(-> points (conj! from-p) (conj! to-p))
|
||||
(helpers/calculate-curve-extremities from-p to-p c1 c2))
|
||||
points)
|
||||
|
||||
(not-empty (subvec content 1))
|
||||
to-p
|
||||
move-p)))
|
||||
(persistent! points)))
|
||||
(persistent! points))))
|
||||
|
||||
(defn content->selrect
|
||||
[content]
|
||||
(let [extremities (calculate-extremities content)
|
||||
;; We haven't found any extremes so we turn the commands to points
|
||||
extremities
|
||||
(if (empty? extremities)
|
||||
(->> content (keep helpers/segment->point))
|
||||
extremities)]
|
||||
|
||||
;; If no points are returned we return an empty rect.
|
||||
(if (d/not-empty? extremities)
|
||||
(grc/points->rect extremities)
|
||||
(grc/make-rect))))
|
||||
|
||||
(defn content-center
|
||||
[content]
|
||||
(-> content
|
||||
content->selrect
|
||||
grc/rect->center))
|
||||
|
||||
(defn append-segment
|
||||
[content segment]
|
||||
(let [content (cond
|
||||
(impl/path-data? content)
|
||||
(vec content)
|
||||
|
||||
(nil? content)
|
||||
[]
|
||||
|
||||
:else
|
||||
content)]
|
||||
(conj content (impl/check-segment segment))))
|
||||
|
||||
(defn points->content
|
||||
"Given a vector of points generate a path content.
|
||||
|
||||
Mainly used for generate a path content from user drawing points
|
||||
using curve drawing tool."
|
||||
[points & {:keys [close]}]
|
||||
(let [initial (first points)
|
||||
point->params
|
||||
(fn [point]
|
||||
{:x (dm/get-prop point :x)
|
||||
:y (dm/get-prop point :y)})]
|
||||
(loop [points (rest points)
|
||||
result [{:command :move-to
|
||||
:params (point->params initial)}]]
|
||||
(if-let [point (first points)]
|
||||
(recur (rest points)
|
||||
(conj result {:command :line-to
|
||||
:params (point->params point)}))
|
||||
|
||||
(let [result (if close
|
||||
(conj result {:command :close-path})
|
||||
result)]
|
||||
(impl/from-plain result))))))
|
||||
@@ -4,58 +4,34 @@
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.svg.path.shapes-to-path
|
||||
(ns app.common.types.path.shape-to-path
|
||||
(:require
|
||||
[app.common.colors :as clr]
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.common :as gco]
|
||||
[app.common.geom.shapes.corners :as gso]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.svg.path.bool :as pb]
|
||||
[app.common.svg.path.command :as pc]
|
||||
[app.common.types.path.bool :as bool]
|
||||
[app.common.types.path.helpers :as helpers]
|
||||
[app.common.types.path.impl :as path.impl]
|
||||
[app.common.types.path.segment :as segm]
|
||||
[app.common.types.shape.radius :as ctsr]))
|
||||
|
||||
(def ^:const bezier-circle-c 0.551915024494)
|
||||
(def ^:const ^:private bezier-circle-c
|
||||
0.551915024494)
|
||||
|
||||
(def dissoc-attrs
|
||||
(def ^:private dissoc-attrs
|
||||
[:x :y :width :height
|
||||
:rx :ry :r1 :r2 :r3 :r4
|
||||
:metadata])
|
||||
|
||||
(def allowed-transform-types
|
||||
#{:rect
|
||||
:circle
|
||||
:image})
|
||||
(defn without-position-attrs
|
||||
[shape]
|
||||
(d/without-keys shape dissoc-attrs))
|
||||
|
||||
(def style-group-properties
|
||||
[:shadow
|
||||
:blur])
|
||||
|
||||
(def style-properties
|
||||
(into style-group-properties
|
||||
[:fill-color
|
||||
:fill-opacity
|
||||
:fill-color-gradient
|
||||
:fill-color-ref-file
|
||||
:fill-color-ref-id
|
||||
:fill-image
|
||||
:fills
|
||||
:stroke-color
|
||||
:stroke-color-ref-file
|
||||
:stroke-color-ref-id
|
||||
:stroke-opacity
|
||||
:stroke-style
|
||||
:stroke-width
|
||||
:stroke-alignment
|
||||
:stroke-cap-start
|
||||
:stroke-cap-end
|
||||
:strokes]))
|
||||
|
||||
(def default-bool-fills [{:fill-color clr/black}])
|
||||
|
||||
(defn make-corner-arc
|
||||
(defn- make-corner-arc
|
||||
"Creates a curvle corner for border radius"
|
||||
[from to corner radius]
|
||||
(let [x (case corner
|
||||
@@ -91,9 +67,9 @@
|
||||
:bottom-right (assoc to :x c2x)
|
||||
:bottom-left (assoc to :y c2y))]
|
||||
|
||||
(pc/make-curve-to to h1 h2)))
|
||||
(helpers/make-curve-to to h1 h2)))
|
||||
|
||||
(defn circle->path
|
||||
(defn- circle->path
|
||||
"Creates the bezier curves to approximate a circle shape"
|
||||
[{:keys [x y width height]}]
|
||||
(let [mx (+ x (/ width 2))
|
||||
@@ -112,13 +88,13 @@
|
||||
c1y (+ y (* (/ height 2) (- 1 c)))
|
||||
c2y (+ y (* (/ height 2) (+ 1 c)))]
|
||||
|
||||
[(pc/make-move-to p1)
|
||||
(pc/make-curve-to p2 (assoc p1 :x c2x) (assoc p2 :y c1y))
|
||||
(pc/make-curve-to p3 (assoc p2 :y c2y) (assoc p3 :x c2x))
|
||||
(pc/make-curve-to p4 (assoc p3 :x c1x) (assoc p4 :y c2y))
|
||||
(pc/make-curve-to p1 (assoc p4 :y c1y) (assoc p1 :x c1x))]))
|
||||
[(helpers/make-move-to p1)
|
||||
(helpers/make-curve-to p2 (assoc p1 :x c2x) (assoc p2 :y c1y))
|
||||
(helpers/make-curve-to p3 (assoc p2 :y c2y) (assoc p3 :x c2x))
|
||||
(helpers/make-curve-to p4 (assoc p3 :x c1x) (assoc p4 :y c2y))
|
||||
(helpers/make-curve-to p1 (assoc p4 :y c1y) (assoc p1 :x c1x))]))
|
||||
|
||||
(defn draw-rounded-rect-path
|
||||
(defn- draw-rounded-rect-path
|
||||
([x y width height r]
|
||||
(draw-rounded-rect-path x y width height r r r r))
|
||||
|
||||
@@ -135,21 +111,21 @@
|
||||
p7 (gpt/point (+ x r4) (+ height y))
|
||||
p8 (gpt/point x (+ height y (- r4)))]
|
||||
(-> []
|
||||
(conj (pc/make-move-to p1))
|
||||
(conj (helpers/make-move-to p1))
|
||||
(cond-> (not= p1 p2)
|
||||
(conj (make-corner-arc p1 p2 :top-left r1)))
|
||||
(conj (pc/make-line-to p3))
|
||||
(conj (helpers/make-line-to p3))
|
||||
(cond-> (not= p3 p4)
|
||||
(conj (make-corner-arc p3 p4 :top-right r2)))
|
||||
(conj (pc/make-line-to p5))
|
||||
(conj (helpers/make-line-to p5))
|
||||
(cond-> (not= p5 p6)
|
||||
(conj (make-corner-arc p5 p6 :bottom-right r3)))
|
||||
(conj (pc/make-line-to p7))
|
||||
(conj (helpers/make-line-to p7))
|
||||
(cond-> (not= p7 p8)
|
||||
(conj (make-corner-arc p7 p8 :bottom-left r4)))
|
||||
(conj (pc/make-line-to p1))))))
|
||||
(conj (helpers/make-line-to p1))))))
|
||||
|
||||
(defn rect->path
|
||||
(defn- rect->path
|
||||
"Creates a bezier curve that approximates a rounded corner rectangle"
|
||||
[{:keys [x y width height] :as shape}]
|
||||
(case (ctsr/radius-mode shape)
|
||||
@@ -165,7 +141,10 @@
|
||||
|
||||
(declare convert-to-path)
|
||||
|
||||
(defn fix-first-relative
|
||||
;; FIXME: this looks unnecesary because penpot already normalizes all
|
||||
;; path content to be absolute. There are no relative segments on
|
||||
;; penpot.
|
||||
(defn- fix-first-relative
|
||||
"Fix an issue with the simplify commands not changing the first relative"
|
||||
[content]
|
||||
(let [head (first content)]
|
||||
@@ -173,17 +152,19 @@
|
||||
(and head (:relative head))
|
||||
(update 0 assoc :relative false))))
|
||||
|
||||
(defn group-to-path
|
||||
(defn- group-to-path
|
||||
[group objects]
|
||||
(let [xform (comp (map #(get objects %))
|
||||
(map #(-> (convert-to-path % objects))))
|
||||
(let [xform (comp (map (d/getf objects))
|
||||
(map #(convert-to-path % objects)))
|
||||
|
||||
child-as-paths (into [] xform (:shapes group))
|
||||
head (last child-as-paths)
|
||||
head-data (select-keys head style-properties)
|
||||
head (peek child-as-paths)
|
||||
head-data (select-keys head bool/style-properties)
|
||||
content (into []
|
||||
(comp (filter #(= :path (:type %)))
|
||||
(mapcat #(fix-first-relative (:content %))))
|
||||
(comp (filter cfh/path-shape?)
|
||||
(map :content)
|
||||
(map vec)
|
||||
(mapcat fix-first-relative))
|
||||
child-as-paths)]
|
||||
(-> group
|
||||
(assoc :type :path)
|
||||
@@ -191,54 +172,68 @@
|
||||
(merge head-data)
|
||||
(d/without-keys dissoc-attrs))))
|
||||
|
||||
(defn bool-to-path
|
||||
(defn- bool-to-path
|
||||
[shape objects]
|
||||
|
||||
(let [children (->> (:shapes shape)
|
||||
(map #(get objects %))
|
||||
(map #(convert-to-path % objects)))
|
||||
bool-type (:bool-type shape)
|
||||
content (pb/content-bool bool-type (mapv :content children))]
|
||||
(let [children
|
||||
(->> (:shapes shape)
|
||||
(map (d/getf objects))
|
||||
(map #(convert-to-path % objects)))
|
||||
|
||||
bool-type
|
||||
(:bool-type shape)
|
||||
|
||||
content
|
||||
(bool/calculate-content bool-type (map :content children))]
|
||||
|
||||
(-> shape
|
||||
(assoc :type :path)
|
||||
(assoc :content content)
|
||||
(dissoc :bool-type)
|
||||
(d/without-keys dissoc-attrs))))
|
||||
|
||||
(defn convert-to-path
|
||||
"Transforms the given shape to a path"
|
||||
([shape]
|
||||
(convert-to-path shape {}))
|
||||
([{:keys [type metadata] :as shape} objects]
|
||||
(assert (map? objects))
|
||||
(case type
|
||||
(:group :frame)
|
||||
(group-to-path shape objects)
|
||||
"Transforms the given shape to a path shape"
|
||||
[shape objects]
|
||||
(assert (map? objects))
|
||||
;; FIXME: add check-objects-like
|
||||
;; FIXME: add check-shape ?
|
||||
|
||||
:bool
|
||||
(bool-to-path shape objects)
|
||||
(let [type (dm/get-prop shape :type)]
|
||||
|
||||
(:rect :circle :image :text)
|
||||
(let [new-content
|
||||
(case type
|
||||
:circle (circle->path shape)
|
||||
#_:else (rect->path shape))
|
||||
(case type
|
||||
(:group :frame)
|
||||
(group-to-path shape objects)
|
||||
|
||||
;; Apply the transforms that had the shape
|
||||
transform
|
||||
(cond-> (:transform shape (gmt/matrix))
|
||||
(:flip-x shape) (gmt/scale (gpt/point -1 1))
|
||||
(:flip-y shape) (gmt/scale (gpt/point 1 -1)))
|
||||
:bool
|
||||
(bool-to-path shape objects)
|
||||
|
||||
new-content (cond-> new-content
|
||||
(some? transform)
|
||||
(gsp/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
|
||||
(:rect :circle :image :text)
|
||||
(let [content
|
||||
(if (= type :circle)
|
||||
(circle->path shape)
|
||||
(rect->path shape))
|
||||
|
||||
(-> shape
|
||||
(assoc :type :path)
|
||||
(assoc :content new-content)
|
||||
(cond-> (= :image type)
|
||||
(assoc :fill-image metadata))
|
||||
(d/without-keys dissoc-attrs)))
|
||||
content
|
||||
(path.impl/from-plain content)
|
||||
|
||||
;; For the rest return the plain shape
|
||||
shape)))
|
||||
;; Apply the transforms that had the shape
|
||||
transform
|
||||
(cond-> (:transform shape (gmt/matrix))
|
||||
(:flip-x shape) (gmt/scale (gpt/point -1 1))
|
||||
(:flip-y shape) (gmt/scale (gpt/point 1 -1)))
|
||||
|
||||
content
|
||||
(cond-> content
|
||||
(some? transform)
|
||||
(segm/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
|
||||
|
||||
(-> shape
|
||||
(assoc :type :path)
|
||||
(assoc :content content)
|
||||
(cond-> (= :image type)
|
||||
(assoc :fill-image (get shape :metadata)))
|
||||
(d/without-keys dissoc-attrs)))
|
||||
|
||||
;; For the rest return the plain shape
|
||||
shape)))
|
||||
@@ -4,11 +4,11 @@
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.svg.path.subpath
|
||||
(ns app.common.types.path.subpath
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.svg.path.command :as upc]))
|
||||
[app.common.types.path.helpers :as helpers]))
|
||||
|
||||
(defn pt=
|
||||
"Check if two points are close"
|
||||
@@ -18,7 +18,7 @@
|
||||
(defn make-subpath
|
||||
"Creates a subpath either from a single command or with all the data"
|
||||
([command]
|
||||
(let [p (upc/command->point command)]
|
||||
(let [p (helpers/segment->point command)]
|
||||
(make-subpath p p [command])))
|
||||
([from to data]
|
||||
{:from from
|
||||
@@ -29,9 +29,9 @@
|
||||
"Adds a command to the subpath"
|
||||
[subpath command]
|
||||
(let [command (if (= :close-path (:command command))
|
||||
(upc/make-line-to (:from subpath))
|
||||
(helpers/make-line-to (:from subpath))
|
||||
command)
|
||||
p (upc/command->point command)]
|
||||
p (helpers/segment->point command)]
|
||||
(-> subpath
|
||||
(assoc :to p)
|
||||
(update :data conj command))))
|
||||
@@ -62,7 +62,7 @@
|
||||
result))
|
||||
|
||||
new-data (->> subpath :data d/with-prev reverse
|
||||
(reduce reverse-commands [(upc/make-move-to (:to subpath))]))]
|
||||
(reduce reverse-commands [(helpers/make-move-to (:to subpath))]))]
|
||||
|
||||
(make-subpath (:to subpath) (:from subpath) new-data)))
|
||||
|
||||
@@ -125,6 +125,9 @@
|
||||
(defn is-closed? [subpath]
|
||||
(pt= (:from subpath) (:to subpath)))
|
||||
|
||||
(def ^:private xf-mapcat-data
|
||||
(mapcat :data))
|
||||
|
||||
(defn close-subpaths
|
||||
"Searches a path for possible subpaths that can create closed loops and merge them"
|
||||
[content]
|
||||
@@ -153,20 +156,17 @@
|
||||
new-subpaths)))
|
||||
result))]
|
||||
|
||||
(->> closed-subpaths
|
||||
(mapcat :data)
|
||||
(into []))))
|
||||
|
||||
(into [] xf-mapcat-data closed-subpaths)))
|
||||
|
||||
;; FIXME: revisit this fn impl for perfromance
|
||||
(defn reverse-content
|
||||
"Given a content reverse the order of the commands"
|
||||
[content]
|
||||
|
||||
(->> content
|
||||
(get-subpaths)
|
||||
(->> (get-subpaths content)
|
||||
(mapv reverse-subpath)
|
||||
(reverse)
|
||||
(mapcat :data)
|
||||
(into [])))
|
||||
(into [] xf-mapcat-data)))
|
||||
|
||||
;; https://mathworld.wolfram.com/PolygonArea.html
|
||||
(defn clockwise?
|
||||
@@ -181,10 +181,10 @@
|
||||
(if (nil? current)
|
||||
(> signed-area 0)
|
||||
|
||||
(let [{x1 :x y1 :y :as p} (upc/command->point current)
|
||||
(let [{x1 :x y1 :y :as p} (helpers/segment->point current)
|
||||
last? (nil? (first subpath))
|
||||
first-point (if (nil? first-point) p first-point)
|
||||
{x2 :x y2 :y} (if last? first-point (upc/command->point (first subpath)))
|
||||
{x2 :x y2 :y} (if last? first-point (helpers/segment->point (first subpath)))
|
||||
signed-area (+ signed-area (- (* x1 y2) (* x2 y1)))]
|
||||
|
||||
(recur (first subpath)
|
||||
@@ -22,14 +22,13 @@
|
||||
:keyword])
|
||||
|
||||
(def schema:plugin-data
|
||||
[:map-of {:gen/max 5}
|
||||
schema:keyword
|
||||
(sm/register!
|
||||
^{::sm/type ::plugin-data}
|
||||
[:map-of {:gen/max 5}
|
||||
schema:string
|
||||
schema:string]])
|
||||
|
||||
(sm/register! ::plugin-data schema:plugin-data)
|
||||
|
||||
schema:keyword
|
||||
[:map-of {:gen/max 5}
|
||||
schema:string
|
||||
schema:string]]))
|
||||
|
||||
(def ^:private schema:registry-entry
|
||||
[:map
|
||||
|
||||
@@ -22,13 +22,14 @@
|
||||
[app.common.transit :as t]
|
||||
[app.common.types.color :as ctc]
|
||||
[app.common.types.grid :as ctg]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.path.segment :as path.segment]
|
||||
[app.common.types.plugins :as ctpg]
|
||||
[app.common.types.shape.attrs :refer [default-color]]
|
||||
[app.common.types.shape.blur :as ctsb]
|
||||
[app.common.types.shape.export :as ctse]
|
||||
[app.common.types.shape.interactions :as ctsi]
|
||||
[app.common.types.shape.layout :as ctsl]
|
||||
[app.common.types.shape.path :as ctsp]
|
||||
[app.common.types.shape.shadow :as ctss]
|
||||
[app.common.types.shape.text :as ctsx]
|
||||
[app.common.types.token :as cto]
|
||||
@@ -119,35 +120,35 @@
|
||||
[:vector {:gen/max 4 :gen/min 4} ::gpt/point])
|
||||
|
||||
(def schema:fill
|
||||
[:map {:title "Fill"}
|
||||
[:fill-color {:optional true} ::ctc/rgb-color]
|
||||
[:fill-opacity {:optional true} ::sm/safe-number]
|
||||
[:fill-color-gradient {:optional true} [:maybe ::ctc/gradient]]
|
||||
[:fill-color-ref-file {:optional true} [:maybe ::sm/uuid]]
|
||||
[:fill-color-ref-id {:optional true} [:maybe ::sm/uuid]]
|
||||
[:fill-image {:optional true} ::ctc/image-color]])
|
||||
(sm/register!
|
||||
^{::sm/type ::fill}
|
||||
[:map {:title "Fill"}
|
||||
[:fill-color {:optional true} ::ctc/rgb-color]
|
||||
[:fill-opacity {:optional true} ::sm/safe-number]
|
||||
[:fill-color-gradient {:optional true} [:maybe ::ctc/gradient]]
|
||||
[:fill-color-ref-file {:optional true} [:maybe ::sm/uuid]]
|
||||
[:fill-color-ref-id {:optional true} [:maybe ::sm/uuid]]
|
||||
[:fill-image {:optional true} ::ctc/image-color]]))
|
||||
|
||||
(sm/register! ::fill schema:fill)
|
||||
|
||||
(def ^:private schema:stroke
|
||||
[:map {:title "Stroke"}
|
||||
[:stroke-color {:optional true} :string]
|
||||
[:stroke-color-ref-file {:optional true} ::sm/uuid]
|
||||
[:stroke-color-ref-id {:optional true} ::sm/uuid]
|
||||
[:stroke-opacity {:optional true} ::sm/safe-number]
|
||||
[:stroke-style {:optional true}
|
||||
[::sm/one-of #{:solid :dotted :dashed :mixed :none :svg}]]
|
||||
[:stroke-width {:optional true} ::sm/safe-number]
|
||||
[:stroke-alignment {:optional true}
|
||||
[::sm/one-of #{:center :inner :outer}]]
|
||||
[:stroke-cap-start {:optional true}
|
||||
[::sm/one-of stroke-caps]]
|
||||
[:stroke-cap-end {:optional true}
|
||||
[::sm/one-of stroke-caps]]
|
||||
[:stroke-color-gradient {:optional true} ::ctc/gradient]
|
||||
[:stroke-image {:optional true} ::ctc/image-color]])
|
||||
|
||||
(sm/register! ::stroke schema:stroke)
|
||||
(def schema:stroke
|
||||
(sm/register!
|
||||
^{::sm/type ::stroke}
|
||||
[:map {:title "Stroke"}
|
||||
[:stroke-color {:optional true} :string]
|
||||
[:stroke-color-ref-file {:optional true} ::sm/uuid]
|
||||
[:stroke-color-ref-id {:optional true} ::sm/uuid]
|
||||
[:stroke-opacity {:optional true} ::sm/safe-number]
|
||||
[:stroke-style {:optional true}
|
||||
[::sm/one-of #{:solid :dotted :dashed :mixed :none :svg}]]
|
||||
[:stroke-width {:optional true} ::sm/safe-number]
|
||||
[:stroke-alignment {:optional true}
|
||||
[::sm/one-of #{:center :inner :outer}]]
|
||||
[:stroke-cap-start {:optional true}
|
||||
[::sm/one-of stroke-caps]]
|
||||
[:stroke-cap-end {:optional true}
|
||||
[::sm/one-of stroke-caps]]
|
||||
[:stroke-color-gradient {:optional true} ::ctc/gradient]
|
||||
[:stroke-image {:optional true} ::ctc/image-color]]))
|
||||
|
||||
(def check-stroke
|
||||
(sm/check-fn schema:stroke))
|
||||
@@ -171,8 +172,7 @@
|
||||
[:width ::sm/safe-number]
|
||||
[:height ::sm/safe-number]])
|
||||
|
||||
;; FIXME: rename to shape-generic-attrs
|
||||
(def schema:shape-attrs
|
||||
(def schema:shape-generic-attrs
|
||||
[:map {:title "ShapeAttrs"}
|
||||
[:page-id {:optional true} ::sm/uuid]
|
||||
[:component-id {:optional true} ::sm/uuid]
|
||||
@@ -212,7 +212,7 @@
|
||||
[:interactions {:optional true}
|
||||
[:vector {:gen/max 2} ::ctsi/interaction]]
|
||||
[:shadow {:optional true}
|
||||
[:vector {:gen/max 1} ::ctss/shadow]]
|
||||
[:vector {:gen/max 1} ctss/schema:shadow]]
|
||||
[:blur {:optional true} ::ctsb/blur]
|
||||
[:grow-type {:optional true}
|
||||
[::sm/one-of grow-types]]
|
||||
@@ -234,7 +234,7 @@
|
||||
[:map {:title "BoolAttrs"}
|
||||
[:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
|
||||
[:bool-type [::sm/one-of bool-types]]
|
||||
[:content ::ctsp/content]])
|
||||
[:content ::path/content]])
|
||||
|
||||
(def ^:private schema:rect-attrs
|
||||
[:map {:title "RectAttrs"}])
|
||||
@@ -259,7 +259,7 @@
|
||||
|
||||
(def ^:private schema:path-attrs
|
||||
[:map {:title "PathAttrs"}
|
||||
[:content ::ctsp/content]])
|
||||
[:content ::path/content]])
|
||||
|
||||
(def ^:private schema:text-attrs
|
||||
[:map {:title "TextAttrs"}
|
||||
@@ -276,7 +276,7 @@
|
||||
[]
|
||||
(->> (sg/generator schema:shape-base-attrs)
|
||||
(sg/mcat (fn [{:keys [type] :as shape}]
|
||||
(sg/let [attrs1 (sg/generator schema:shape-attrs)
|
||||
(sg/let [attrs1 (sg/generator schema:shape-generic-attrs)
|
||||
attrs2 (sg/generator schema:shape-geom-attrs)
|
||||
attrs3 (case type
|
||||
:text (sg/generator schema:text-attrs)
|
||||
@@ -294,94 +294,100 @@
|
||||
(merge attrs1 shape attrs2 attrs3)))))
|
||||
(sg/fmap create-shape)))
|
||||
|
||||
(def schema:shape-attrs
|
||||
[:multi {:dispatch :type
|
||||
:decode/json (fn [shape]
|
||||
(update shape :type keyword))
|
||||
:title "Shape"}
|
||||
[:group
|
||||
[:merge {:title "GroupShape"}
|
||||
ctsl/schema:layout-attrs
|
||||
schema:group-attrs
|
||||
schema:shape-generic-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs]]
|
||||
|
||||
[:frame
|
||||
[:merge {:title "FrameShape"}
|
||||
ctsl/schema:layout-attrs
|
||||
::ctsl/layout-attrs
|
||||
schema:frame-attrs
|
||||
schema:shape-generic-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs
|
||||
::ctv/variant-shape
|
||||
::ctv/variant-container]]
|
||||
|
||||
[:bool
|
||||
[:merge {:title "BoolShape"}
|
||||
ctsl/schema:layout-attrs
|
||||
schema:bool-attrs
|
||||
schema:shape-generic-attrs
|
||||
schema:shape-base-attrs]]
|
||||
|
||||
[:rect
|
||||
[:merge {:title "RectShape"}
|
||||
ctsl/schema:layout-attrs
|
||||
schema:rect-attrs
|
||||
schema:shape-generic-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs]]
|
||||
|
||||
[:circle
|
||||
[:merge {:title "CircleShape"}
|
||||
ctsl/schema:layout-attrs
|
||||
schema:circle-attrs
|
||||
schema:shape-generic-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs]]
|
||||
|
||||
[:image
|
||||
[:merge {:title "ImageShape"}
|
||||
ctsl/schema:layout-attrs
|
||||
schema:image-attrs
|
||||
schema:shape-generic-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs]]
|
||||
|
||||
[:svg-raw
|
||||
[:merge {:title "SvgRawShape"}
|
||||
ctsl/schema:layout-attrs
|
||||
schema:svg-raw-attrs
|
||||
schema:shape-generic-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs]]
|
||||
|
||||
[:path
|
||||
[:merge {:title "PathShape"}
|
||||
ctsl/schema:layout-attrs
|
||||
schema:path-attrs
|
||||
schema:shape-generic-attrs
|
||||
schema:shape-base-attrs]]
|
||||
|
||||
[:text
|
||||
[:merge {:title "TextShape"}
|
||||
ctsl/schema:layout-attrs
|
||||
schema:text-attrs
|
||||
schema:shape-generic-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs]]])
|
||||
|
||||
(def schema:shape
|
||||
[:and {:title "Shape"
|
||||
:gen/gen (shape-generator)
|
||||
:decode/json {:leave decode-shape}}
|
||||
[:fn shape?]
|
||||
[:multi {:dispatch :type
|
||||
:decode/json (fn [shape]
|
||||
(update shape :type keyword))
|
||||
:title "Shape"}
|
||||
[:group
|
||||
[:merge {:title "GroupShape"}
|
||||
::ctsl/layout-child-attrs
|
||||
schema:group-attrs
|
||||
schema:shape-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs]]
|
||||
(sm/register!
|
||||
^{::sm/type ::shape}
|
||||
[:and {:title "Shape"
|
||||
:gen/gen (shape-generator)
|
||||
:decode/json {:leave decode-shape}}
|
||||
[:fn shape?]
|
||||
schema:shape-attrs]))
|
||||
|
||||
[:frame
|
||||
[:merge {:title "FrameShape"}
|
||||
::ctsl/layout-child-attrs
|
||||
::ctsl/layout-attrs
|
||||
schema:frame-attrs
|
||||
schema:shape-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs
|
||||
::ctv/variant-shape
|
||||
::ctv/variant-container]]
|
||||
(def check-shape-generic-attrs
|
||||
(sm/check-fn schema:shape-generic-attrs))
|
||||
|
||||
[:bool
|
||||
[:merge {:title "BoolShape"}
|
||||
::ctsl/layout-child-attrs
|
||||
schema:bool-attrs
|
||||
schema:shape-attrs
|
||||
schema:shape-base-attrs]]
|
||||
|
||||
[:rect
|
||||
[:merge {:title "RectShape"}
|
||||
::ctsl/layout-child-attrs
|
||||
schema:rect-attrs
|
||||
schema:shape-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs]]
|
||||
|
||||
[:circle
|
||||
[:merge {:title "CircleShape"}
|
||||
::ctsl/layout-child-attrs
|
||||
schema:circle-attrs
|
||||
schema:shape-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs]]
|
||||
|
||||
[:image
|
||||
[:merge {:title "ImageShape"}
|
||||
::ctsl/layout-child-attrs
|
||||
schema:image-attrs
|
||||
schema:shape-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs]]
|
||||
|
||||
[:svg-raw
|
||||
[:merge {:title "SvgRawShape"}
|
||||
::ctsl/layout-child-attrs
|
||||
schema:svg-raw-attrs
|
||||
schema:shape-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs]]
|
||||
|
||||
[:path
|
||||
[:merge {:title "PathShape"}
|
||||
::ctsl/layout-child-attrs
|
||||
schema:path-attrs
|
||||
schema:shape-attrs
|
||||
schema:shape-base-attrs]]
|
||||
|
||||
[:text
|
||||
[:merge {:title "TextShape"}
|
||||
::ctsl/layout-child-attrs
|
||||
schema:text-attrs
|
||||
schema:shape-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs]]]])
|
||||
|
||||
(sm/register! ::shape schema:shape)
|
||||
|
||||
(def check-shape-attrs!
|
||||
(def check-shape-attrs
|
||||
(sm/check-fn schema:shape-attrs))
|
||||
|
||||
(def check-shape!
|
||||
(def check-shape
|
||||
(sm/check-fn schema:shape
|
||||
:hint "expected valid shape"))
|
||||
|
||||
@@ -396,6 +402,50 @@
|
||||
(or (some :fill-image fills)
|
||||
(some :stroke-image strokes)))
|
||||
|
||||
;; Valid attributes
|
||||
|
||||
(def ^:private allowed-shape-attrs #{:page-id :component-id :component-file :component-root :main-instance
|
||||
:remote-synced :shape-ref :touched :blocked :collapsed :locked
|
||||
:hidden :masked-group :fills :proportion :proportion-lock :constraints-h
|
||||
:constraints-v :fixed-scroll :r1 :r2 :r3 :r4 :opacity :grids :exports
|
||||
:strokes :blend-mode :interactions :shadow :blur :grow-type :applied-tokens
|
||||
:plugin-data})
|
||||
(def ^:private allowed-shape-geom-attrs #{:x :y :width :height})
|
||||
(def ^:private allowed-shape-base-attrs #{:id :name :type :selrect :points :transform :transform-inverse :parent-id :frame-id})
|
||||
(def ^:private allowed-bool-attrs #{:shapes :bool-type :content})
|
||||
(def ^:private allowed-group-attrs #{:shapes})
|
||||
(def ^:private allowed-frame-attrs #{:shapes :hide-fill-on-export :show-content :hide-in-viewer})
|
||||
(def ^:private allowed-image-attrs #{:metadata})
|
||||
(def ^:private allowed-svg-attrs #{:content})
|
||||
(def ^:private allowed-path-attrs #{:content})
|
||||
(def ^:private allowed-text-attrs #{:content})
|
||||
(def ^:private allowed-generic-attrs (set/union allowed-shape-attrs allowed-shape-geom-attrs allowed-shape-base-attrs))
|
||||
|
||||
(defn is-allowed-attr?
|
||||
[attr type]
|
||||
(case type
|
||||
:group (or (contains? allowed-group-attrs attr)
|
||||
(contains? allowed-generic-attrs attr))
|
||||
:frame (or (contains? allowed-frame-attrs attr)
|
||||
(contains? allowed-generic-attrs attr))
|
||||
:bool (or (contains? allowed-bool-attrs attr)
|
||||
(contains? allowed-shape-attrs attr)
|
||||
(contains? allowed-shape-base-attrs attr))
|
||||
:rect (contains? allowed-generic-attrs attr)
|
||||
:circle (contains? allowed-generic-attrs attr)
|
||||
:image (or (contains? allowed-image-attrs attr)
|
||||
(contains? allowed-generic-attrs attr))
|
||||
:svg-raw (or (contains? allowed-svg-attrs attr)
|
||||
(contains? allowed-generic-attrs attr))
|
||||
:path (or (contains? allowed-path-attrs attr)
|
||||
(contains? allowed-shape-attrs attr)
|
||||
(contains? allowed-shape-base-attrs attr))
|
||||
:text (or (contains? allowed-text-attrs attr)
|
||||
(contains? allowed-generic-attrs attr))))
|
||||
|
||||
|
||||
|
||||
|
||||
;; --- Initialization
|
||||
|
||||
(def ^:private minimal-rect-attrs
|
||||
@@ -525,7 +575,7 @@
|
||||
(defn setup-path
|
||||
[{:keys [content selrect points] :as shape}]
|
||||
(let [selrect (or selrect
|
||||
(gsh/content->selrect content)
|
||||
(path.segment/content->selrect content)
|
||||
(grc/make-rect))
|
||||
points (or points (grc/rect->points selrect))]
|
||||
(-> shape
|
||||
|
||||
@@ -168,25 +168,24 @@
|
||||
(def item-align-self-types
|
||||
#{:start :end :center :stretch})
|
||||
|
||||
(sm/register!
|
||||
^{::sm/type ::layout-child-attrs}
|
||||
[:map {:title "LayoutChildAttrs"}
|
||||
[:layout-item-margin-type {:optional true} [::sm/one-of item-margin-types]]
|
||||
[:layout-item-margin {:optional true}
|
||||
[:map
|
||||
[:m1 {:optional true} ::sm/safe-number]
|
||||
[:m2 {:optional true} ::sm/safe-number]
|
||||
[:m3 {:optional true} ::sm/safe-number]
|
||||
[:m4 {:optional true} ::sm/safe-number]]]
|
||||
[:layout-item-max-h {:optional true} ::sm/safe-number]
|
||||
[:layout-item-min-h {:optional true} ::sm/safe-number]
|
||||
[:layout-item-max-w {:optional true} ::sm/safe-number]
|
||||
[:layout-item-min-w {:optional true} ::sm/safe-number]
|
||||
[:layout-item-h-sizing {:optional true} [::sm/one-of item-h-sizing-types]]
|
||||
[:layout-item-v-sizing {:optional true} [::sm/one-of item-v-sizing-types]]
|
||||
[:layout-item-align-self {:optional true} [::sm/one-of item-align-self-types]]
|
||||
[:layout-item-absolute {:optional true} :boolean]
|
||||
[:layout-item-z-index {:optional true} ::sm/safe-number]])
|
||||
(def schema:layout-attrs
|
||||
[:map {:title "LayoutChildAttrs"}
|
||||
[:layout-item-margin-type {:optional true} [::sm/one-of item-margin-types]]
|
||||
[:layout-item-margin {:optional true}
|
||||
[:map
|
||||
[:m1 {:optional true} ::sm/safe-number]
|
||||
[:m2 {:optional true} ::sm/safe-number]
|
||||
[:m3 {:optional true} ::sm/safe-number]
|
||||
[:m4 {:optional true} ::sm/safe-number]]]
|
||||
[:layout-item-max-h {:optional true} ::sm/safe-number]
|
||||
[:layout-item-min-h {:optional true} ::sm/safe-number]
|
||||
[:layout-item-max-w {:optional true} ::sm/safe-number]
|
||||
[:layout-item-min-w {:optional true} ::sm/safe-number]
|
||||
[:layout-item-h-sizing {:optional true} [::sm/one-of item-h-sizing-types]]
|
||||
[:layout-item-v-sizing {:optional true} [::sm/one-of item-v-sizing-types]]
|
||||
[:layout-item-align-self {:optional true} [::sm/one-of item-align-self-types]]
|
||||
[:layout-item-absolute {:optional true} :boolean]
|
||||
[:layout-item-z-index {:optional true} ::sm/safe-number]])
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SCHEMAS
|
||||
|
||||
@@ -1,431 +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 app.common.types.shape.path
|
||||
(:require
|
||||
[app.common.schema :as sm])
|
||||
(:import
|
||||
#?(:cljs [goog.string StringBuffer]
|
||||
:clj [java.nio ByteBuffer])))
|
||||
|
||||
#?(:clj (set! *warn-on-reflection* true))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SCHEMA: PLAIN FORMAT
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def schema:line-to-segment
|
||||
[:map
|
||||
[:command [:= :line-to]]
|
||||
[:params
|
||||
[:map
|
||||
[:x ::sm/safe-number]
|
||||
[:y ::sm/safe-number]]]])
|
||||
|
||||
(def schema:close-path-segment
|
||||
[:map
|
||||
[:command [:= :close-path]]])
|
||||
|
||||
(def schema:move-to-segment
|
||||
[:map
|
||||
[:command [:= :move-to]]
|
||||
[:params
|
||||
[:map
|
||||
[:x ::sm/safe-number]
|
||||
[:y ::sm/safe-number]]]])
|
||||
|
||||
(def schema:curve-to-segment
|
||||
[:map
|
||||
[:command [:= :curve-to]]
|
||||
[:params
|
||||
[:map
|
||||
[:x ::sm/safe-number]
|
||||
[:y ::sm/safe-number]
|
||||
[:c1x ::sm/safe-number]
|
||||
[:c1y ::sm/safe-number]
|
||||
[:c2x ::sm/safe-number]
|
||||
[:c2y ::sm/safe-number]]]])
|
||||
|
||||
(def schema:path-segment
|
||||
[:multi {:title "PathSegment"
|
||||
:dispatch :command
|
||||
:decode/json #(update % :command keyword)}
|
||||
[:line-to schema:line-to-segment]
|
||||
[:close-path schema:close-path-segment]
|
||||
[:move-to schema:move-to-segment]
|
||||
[:curve-to schema:curve-to-segment]])
|
||||
|
||||
(def schema:path-content
|
||||
[:vector schema:path-segment])
|
||||
|
||||
(def check-path-content
|
||||
(sm/check-fn schema:path-content))
|
||||
|
||||
(sm/register! ::segment schema:path-segment)
|
||||
(sm/register! ::content schema:path-content)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; TYPE: PATH-DATA
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def ^:const SEGMENT-BYTE-SIZE 28)
|
||||
|
||||
(defprotocol IPathData
|
||||
(-write-to [_ buffer offset] "write the content to the specified buffer"))
|
||||
|
||||
(defrecord PathSegment [command params])
|
||||
|
||||
(defn- get-path-string
|
||||
"Format the path data structure to string"
|
||||
[buffer size]
|
||||
(let [builder #?(:clj (java.lang.StringBuilder. (int (* size 4)))
|
||||
:cljs (StringBuffer.))]
|
||||
(loop [index 0]
|
||||
(when (< index size)
|
||||
(let [offset (* index SEGMENT-BYTE-SIZE)
|
||||
type #?(:clj (.getShort ^ByteBuffer buffer offset)
|
||||
:cljs (.getInt16 buffer offset))]
|
||||
(case (long type)
|
||||
1 (let [x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20))
|
||||
:cljs (.getFloat32 buffer (+ offset 20)))
|
||||
y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24))
|
||||
:cljs (.getFloat32 buffer (+ offset 24)))]
|
||||
(doto builder
|
||||
(.append "M")
|
||||
(.append x)
|
||||
(.append ",")
|
||||
(.append y)))
|
||||
2 (let [x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20))
|
||||
:cljs (.getFloat32 buffer (+ offset 20)))
|
||||
y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24))
|
||||
:cljs (.getFloat32 buffer (+ offset 24)))]
|
||||
(doto builder
|
||||
(.append "L")
|
||||
(.append x)
|
||||
(.append ",")
|
||||
(.append y)))
|
||||
|
||||
3 (let [c1x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 4))
|
||||
:cljs (.getFloat32 buffer (+ offset 4)))
|
||||
c1y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 8))
|
||||
:cljs (.getFloat32 buffer (+ offset 8)))
|
||||
c2x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 12))
|
||||
:cljs (.getFloat32 buffer (+ offset 12)))
|
||||
c2y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 16))
|
||||
:cljs (.getFloat32 buffer (+ offset 16)))
|
||||
x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20))
|
||||
:cljs (.getFloat32 buffer (+ offset 20)))
|
||||
y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24))
|
||||
:cljs (.getFloat32 buffer (+ offset 24)))]
|
||||
(doto builder
|
||||
(.append "C")
|
||||
(.append c1x)
|
||||
(.append ",")
|
||||
(.append c1y)
|
||||
(.append ",")
|
||||
(.append c2x)
|
||||
(.append ",")
|
||||
(.append c2y)
|
||||
(.append ",")
|
||||
(.append x)
|
||||
(.append ",")
|
||||
(.append y)))
|
||||
4 (doto builder
|
||||
(.append "Z")))
|
||||
(recur (inc index)))))
|
||||
|
||||
(.toString builder)))
|
||||
|
||||
(defn- read-segment
|
||||
[buffer index]
|
||||
(let [offset (* index SEGMENT-BYTE-SIZE)
|
||||
type #?(:clj (.getShort ^ByteBuffer buffer offset)
|
||||
:cljs (.getInt16 buffer offset))]
|
||||
(case (long type)
|
||||
1 (let [x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20))
|
||||
:cljs (.getFloat32 buffer (+ offset 20)))
|
||||
y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24))
|
||||
:cljs (.getFloat32 buffer (+ offset 24)))]
|
||||
(->PathSegment :move-to {:x x :y y}))
|
||||
|
||||
2 (let [x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20))
|
||||
:cljs (.getFloat32 buffer (+ offset 20)))
|
||||
y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24))
|
||||
:cljs (.getFloat32 buffer (+ offset 24)))]
|
||||
(->PathSegment :line-to {:x x :y y}))
|
||||
|
||||
3 (let [c1x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 4))
|
||||
:cljs (.getFloat32 buffer (+ offset 4)))
|
||||
c1y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 8))
|
||||
:cljs (.getFloat32 buffer (+ offset 8)))
|
||||
c2x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 12))
|
||||
:cljs (.getFloat32 buffer (+ offset 12)))
|
||||
c2y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 16))
|
||||
:cljs (.getFloat32 buffer (+ offset 16)))
|
||||
x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20))
|
||||
:cljs (.getFloat32 buffer (+ offset 20)))
|
||||
y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24))
|
||||
:cljs (.getFloat32 buffer (+ offset 24)))]
|
||||
|
||||
(->PathSegment :curve-to {:x x :y y :c1x c1x :c1y c1y :c2x c2x :c2y c2y}))
|
||||
|
||||
4 (->PathSegment :close-path {}))))
|
||||
|
||||
(defn- in-range?
|
||||
[size i]
|
||||
(and (< i size) (>= i 0)))
|
||||
|
||||
#?(:clj
|
||||
(deftype PathData [size buffer]
|
||||
Object
|
||||
(toString [_]
|
||||
(get-path-string buffer size))
|
||||
|
||||
clojure.lang.Sequential
|
||||
clojure.lang.IPersistentCollection
|
||||
|
||||
(empty [_]
|
||||
(throw (ex-info "not implemented" {})))
|
||||
(equiv [_ other]
|
||||
(if (instance? PathData other)
|
||||
(.equals ^ByteBuffer buffer (.-buffer ^PathData other))
|
||||
false))
|
||||
|
||||
(seq [this]
|
||||
(when (pos? size)
|
||||
(->> (range size)
|
||||
(map (fn [i] (nth this i))))))
|
||||
|
||||
(cons [_ _val]
|
||||
(throw (ex-info "not implemented" {})))
|
||||
|
||||
clojure.lang.IReduceInit
|
||||
(reduce [_ f start]
|
||||
(loop [index 0
|
||||
result start]
|
||||
(if (< index size)
|
||||
(let [result (f result (read-segment buffer index))]
|
||||
(if (reduced? result)
|
||||
@result
|
||||
(recur (inc index) result)))
|
||||
result)))
|
||||
|
||||
clojure.lang.Indexed
|
||||
(nth [_ i]
|
||||
(if (in-range? size i)
|
||||
(read-segment buffer i)
|
||||
nil))
|
||||
|
||||
(nth [_ i default]
|
||||
(if (in-range? size i)
|
||||
(read-segment buffer i)
|
||||
default))
|
||||
|
||||
clojure.lang.Counted
|
||||
(count [_] size))
|
||||
|
||||
:cljs
|
||||
(deftype PathData [size buffer dview]
|
||||
Object
|
||||
(toString [_]
|
||||
(get-path-string dview size))
|
||||
|
||||
IPathData
|
||||
(-write-to [_ into-buffer offset]
|
||||
(assert (instance? js/ArrayBuffer into-buffer) "expected an instance of Uint32Array")
|
||||
(let [size (.-byteLength buffer)
|
||||
mem (js/Uint32Array. into-buffer offset size)]
|
||||
(.set mem (js/Uint32Array. buffer))))
|
||||
|
||||
cljs.core/ISequential
|
||||
cljs.core/IEquiv
|
||||
(-equiv [_ other]
|
||||
(if (instance? PathData other)
|
||||
(let [obuffer (.-buffer other)
|
||||
osize (.-byteLength obuffer)
|
||||
csize (.-byteLength buffer)]
|
||||
(if (= osize csize)
|
||||
(let [cb (js/Uint32Array. buffer)
|
||||
ob (js/Uint32Array. obuffer)]
|
||||
(loop [i 0]
|
||||
(if (< i osize)
|
||||
(if (= (aget ob i)
|
||||
(aget cb i))
|
||||
(recur (inc i))
|
||||
false)
|
||||
true)))
|
||||
false))
|
||||
false))
|
||||
|
||||
cljs.core/IReduce
|
||||
(-reduce [_ f]
|
||||
(loop [index 1
|
||||
result (if (pos? size)
|
||||
(read-segment dview 0)
|
||||
nil)]
|
||||
(if (< index size)
|
||||
(let [result (f result (read-segment dview index))]
|
||||
(if (reduced? result)
|
||||
@result
|
||||
(recur (inc index) result)))
|
||||
result)))
|
||||
|
||||
(-reduce [_ f start]
|
||||
(loop [index 0
|
||||
result start]
|
||||
(if (< index size)
|
||||
(let [result (f result (read-segment dview index))]
|
||||
(if (reduced? result)
|
||||
@result
|
||||
(recur (inc index) result)))
|
||||
result)))
|
||||
|
||||
cljs.core/IHash
|
||||
(-hash [_]
|
||||
(throw (ex-info "not-implemented" {})))
|
||||
|
||||
cljs.core/ICounted
|
||||
(-count [_] size)
|
||||
|
||||
cljs.core/IIndexed
|
||||
(-nth [_ i]
|
||||
(if (in-range? size i)
|
||||
(read-segment dview i)
|
||||
nil))
|
||||
|
||||
(-nth [_ i default]
|
||||
(if (in-range? i size)
|
||||
(read-segment dview i)
|
||||
default))
|
||||
|
||||
cljs.core/ISeqable
|
||||
(-seq [this]
|
||||
(when (pos? size)
|
||||
(->> (range size)
|
||||
(map (fn [i] (cljs.core/-nth this i))))))))
|
||||
|
||||
(defn- from-bytes
|
||||
[buffer]
|
||||
#?(:clj
|
||||
(cond
|
||||
(instance? ByteBuffer buffer)
|
||||
(let [size (.capacity ^ByteBuffer buffer)
|
||||
count (long (/ size SEGMENT-BYTE-SIZE))]
|
||||
(PathData. count buffer))
|
||||
|
||||
(bytes? buffer)
|
||||
(let [size (alength ^bytes buffer)
|
||||
count (long (/ size SEGMENT-BYTE-SIZE))]
|
||||
(PathData. count
|
||||
(ByteBuffer/wrap buffer)))
|
||||
|
||||
:else
|
||||
(throw (java.lang.IllegalArgumentException. "invalid data provided")))
|
||||
|
||||
:cljs
|
||||
(cond
|
||||
(instance? js/ArrayBuffer buffer)
|
||||
(let [size (.-byteLength buffer)
|
||||
count (long (/ size SEGMENT-BYTE-SIZE))]
|
||||
(PathData. count
|
||||
buffer
|
||||
(js/DataView. buffer)))
|
||||
|
||||
(instance? js/DataView buffer)
|
||||
(let [dview buffer
|
||||
buffer (.-buffer dview)
|
||||
size (.-byteLength buffer)
|
||||
count (long (/ size SEGMENT-BYTE-SIZE))]
|
||||
(PathData. count buffer dview))
|
||||
|
||||
:else
|
||||
(throw (js/Error. "invalid data provided")))))
|
||||
|
||||
;; FIXME: consider implementing with reduce
|
||||
;; FIXME: consider ensure fixed precision for avoid doing it on formatting
|
||||
|
||||
(defn- from-plain
|
||||
"Create a PathData instance from plain data structures"
|
||||
[content]
|
||||
(assert (check-path-content content))
|
||||
|
||||
(let [content (vec content)
|
||||
total (count content)
|
||||
#?@(:cljs [buffer (new js/ArrayBuffer (* total SEGMENT-BYTE-SIZE))
|
||||
dview (new js/DataView buffer)]
|
||||
:clj [buffer (ByteBuffer/allocate (* total SEGMENT-BYTE-SIZE))])]
|
||||
(loop [index 0]
|
||||
(when (< index total)
|
||||
(let [segment (nth content index)
|
||||
offset (* index SEGMENT-BYTE-SIZE)]
|
||||
(case (get segment :command)
|
||||
:move-to
|
||||
(let [params (get segment :params)
|
||||
x (float (get params :x))
|
||||
y (float (get params :y))]
|
||||
#?(:clj (.putShort buffer (int offset) (short 1))
|
||||
:cljs (.setInt16 dview offset 1))
|
||||
#?(:clj (.putFloat buffer (+ offset 20) x)
|
||||
:cljs (.setFloat32 dview (+ offset 20) x))
|
||||
#?(:clj (.putFloat buffer (+ offset 24) y)
|
||||
:cljs (.setFloat32 dview (+ offset 24) y)))
|
||||
|
||||
:line-to
|
||||
(let [params (get segment :params)
|
||||
x (float (get params :x))
|
||||
y (float (get params :y))]
|
||||
#?(:clj (.putShort buffer (int offset) (short 2))
|
||||
:cljs (.setInt16 dview offset 2))
|
||||
#?(:clj (.putFloat buffer (+ offset 20) x)
|
||||
:cljs (.setFloat32 dview (+ offset 20) x))
|
||||
#?(:clj (.putFloat buffer (+ offset 24) y)
|
||||
:cljs (.setFloat32 dview (+ offset 24) y)))
|
||||
|
||||
:curve-to
|
||||
(let [params (get segment :params)
|
||||
x (float (get params :x))
|
||||
y (float (get params :y))
|
||||
c1x (float (get params :c1x x))
|
||||
c1y (float (get params :c1y y))
|
||||
c2x (float (get params :c2x x))
|
||||
c2y (float (get params :c2y y))]
|
||||
|
||||
#?(:clj (.putShort buffer (int offset) (short 3))
|
||||
:cljs (.setInt16 dview offset 3))
|
||||
#?(:clj (.putFloat buffer (+ offset 4) c1x)
|
||||
:cljs (.setFloat32 dview (+ offset 4) c1x))
|
||||
#?(:clj (.putFloat buffer (+ offset 8) c1y)
|
||||
:cljs (.setFloat32 dview (+ offset 8) c1y))
|
||||
#?(:clj (.putFloat buffer (+ offset 12) c2x)
|
||||
:cljs (.setFloat32 dview (+ offset 12) c2x))
|
||||
#?(:clj (.putFloat buffer (+ offset 16) c2y)
|
||||
:cljs (.setFloat32 dview (+ offset 16) c2y))
|
||||
#?(:clj (.putFloat buffer (+ offset 20) x)
|
||||
:cljs (.setFloat32 dview (+ offset 20) x))
|
||||
#?(:clj (.putFloat buffer (+ offset 24) y)
|
||||
:cljs (.setFloat32 dview (+ offset 24) y)))
|
||||
|
||||
:close-path
|
||||
#?(:clj (.putShort buffer (int offset) (short 4))
|
||||
:cljs (.setInt16 dview offset 4)))
|
||||
(recur (inc index)))))
|
||||
|
||||
#?(:cljs (from-bytes dview)
|
||||
:clj (from-bytes buffer))))
|
||||
|
||||
(defn path-data
|
||||
"Create an instance of PathData, returns itself if it is already
|
||||
PathData instance"
|
||||
[data]
|
||||
(cond
|
||||
(instance? PathData data)
|
||||
data
|
||||
|
||||
(sequential? data)
|
||||
(from-plain data)
|
||||
|
||||
:else
|
||||
(from-bytes data)))
|
||||
@@ -26,7 +26,9 @@
|
||||
[:hidden :boolean]
|
||||
[:color ::ctc/color]])
|
||||
|
||||
(sm/register! ::shadow schema:shadow)
|
||||
|
||||
(def check-shadow
|
||||
(sm/check-fn schema:shadow))
|
||||
|
||||
(def valid-shadow?
|
||||
(sm/validator schema:shadow))
|
||||
|
||||
|
||||
@@ -16,6 +16,8 @@
|
||||
[app.common.types.shape.layout :as ctl]
|
||||
[app.common.uuid :as uuid]))
|
||||
|
||||
|
||||
;; FIXME: the order of arguments seems arbitrary, container should be a first artgument
|
||||
(defn add-shape
|
||||
"Insert a shape in the tree, at the given index below the given parent or frame.
|
||||
Update the parent as needed."
|
||||
|
||||
@@ -66,16 +66,6 @@
|
||||
[n]
|
||||
(string? n))
|
||||
|
||||
;; TODO Move this to tokens-lib
|
||||
(sm/register!
|
||||
^{::sm/type ::token}
|
||||
[:map {:title "Token"}
|
||||
[:name token-name-ref]
|
||||
[:type [::sm/one-of token-types]]
|
||||
[:value :any]
|
||||
[:description {:optional true} [:maybe :string]]
|
||||
[:modified-at {:optional true} ::sm/inst]])
|
||||
|
||||
(sm/register!
|
||||
^{::sm/type ::color}
|
||||
[:map
|
||||
|
||||
@@ -1,28 +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 app.common.types.token-theme
|
||||
(:require
|
||||
[app.common.schema :as sm]))
|
||||
|
||||
(sm/register!
|
||||
^{::sm/type ::token-theme}
|
||||
[:map {:title "TokenTheme"}
|
||||
[:name :string]
|
||||
[:group :string]
|
||||
[:description [:maybe :string]]
|
||||
[:is-source :boolean]
|
||||
[:id :string]
|
||||
[:modified-at {:optional true} ::sm/inst]
|
||||
[:sets :any]])
|
||||
|
||||
(sm/register!
|
||||
^{::sm/type ::token-set}
|
||||
[:map {:title "TokenSet"}
|
||||
[:name :string]
|
||||
[:description {:optional true} [:maybe :string]]
|
||||
[:modified-at {:optional true} ::sm/inst]
|
||||
[:tokens {:optional true} :any]])
|
||||
@@ -11,6 +11,7 @@
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.schema.generators :as sg]
|
||||
[app.common.time :as dt]
|
||||
[app.common.transit :as t]
|
||||
[app.common.types.token :as cto]
|
||||
@@ -118,12 +119,15 @@
|
||||
[:name cto/token-name-ref]
|
||||
[:type [::sm/one-of cto/token-types]]
|
||||
[:value :any]
|
||||
[:description [:maybe :string]]
|
||||
[:modified-at ::sm/inst]])
|
||||
[:description {:optional true} :string]
|
||||
[:modified-at {:optional true} ::sm/inst]])
|
||||
|
||||
(declare make-token)
|
||||
|
||||
(def schema:token
|
||||
[:and
|
||||
schema:token-attrs
|
||||
[:and {:gen/gen (->> (sg/generator schema:token-attrs)
|
||||
(sg/fmap #(make-token %)))}
|
||||
(sm/required-keys schema:token-attrs)
|
||||
[:fn token?]])
|
||||
|
||||
(def check-token
|
||||
@@ -382,15 +386,32 @@
|
||||
(def schema:token-set-attrs
|
||||
[:map {:title "TokenSet"}
|
||||
[:name :string]
|
||||
[:description [:maybe :string]]
|
||||
[:modified-at ::sm/inst]
|
||||
[:tokens [:and
|
||||
[:map-of {:gen/max 5} :string schema:token]
|
||||
[:fn d/ordered-map?]]]])
|
||||
[:description {:optional true} :string]
|
||||
[:modified-at {:optional true} ::sm/inst]
|
||||
[:tokens {:optional true
|
||||
:gen/gen (->> (sg/generator [:map-of ::sm/text schema:token])
|
||||
(sg/fmap #(into (d/ordered-map) %)))}
|
||||
[:and
|
||||
[:map-of {:gen/max 5
|
||||
:decode/json (fn [v]
|
||||
(cond
|
||||
(d/ordered-map? v)
|
||||
v
|
||||
|
||||
(map? v)
|
||||
(into (d/ordered-map) v)
|
||||
|
||||
:else
|
||||
v))}
|
||||
:string schema:token]
|
||||
[:fn d/ordered-map?]]]])
|
||||
|
||||
(declare make-token-set)
|
||||
|
||||
(def schema:token-set
|
||||
[:and
|
||||
schema:token-set-attrs
|
||||
[:and {:gen/gen (->> (sg/generator schema:token-set-attrs)
|
||||
(sg/fmap #(make-token-set %)))}
|
||||
(sm/required-keys schema:token-set-attrs)
|
||||
[:fn token-set?]])
|
||||
|
||||
(sm/register! ::token-set schema:token-set)
|
||||
@@ -554,16 +575,16 @@
|
||||
(def schema:token-theme-attrs
|
||||
[:map {:title "TokenTheme"}
|
||||
[:name :string]
|
||||
[:group :string]
|
||||
[:description [:maybe :string]]
|
||||
[:is-source [:maybe :boolean]]
|
||||
[:id :string]
|
||||
[:modified-at ::sm/inst]
|
||||
[:sets [:set {:gen/max 5} :string]]])
|
||||
[:group {:optional true} :string]
|
||||
[:description {:optional true} :string]
|
||||
[:is-source {:optional true} :boolean]
|
||||
[:id {:optional true} :string]
|
||||
[:modified-at {:optional true} ::sm/inst]
|
||||
[:sets {:optional true} [:set {:gen/max 5} :string]]])
|
||||
|
||||
(def schema:token-theme
|
||||
[:and
|
||||
schema:token-theme-attrs
|
||||
(sm/required-keys schema:token-theme-attrs)
|
||||
[:fn token-theme?]])
|
||||
|
||||
(sm/register! ::token-theme schema:token-theme)
|
||||
|
||||
@@ -17,25 +17,25 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def schema:typography
|
||||
[:map {:title "Typography"}
|
||||
[:id ::sm/uuid]
|
||||
[:name :string]
|
||||
[:font-id :string]
|
||||
[:font-family :string]
|
||||
[:font-variant-id :string]
|
||||
[:font-size :string]
|
||||
[:font-weight :string]
|
||||
[:font-style :string]
|
||||
[:line-height :string]
|
||||
[:letter-spacing :string]
|
||||
[:text-transform :string]
|
||||
[:modified-at {:optional true} ::sm/inst]
|
||||
[:path {:optional true} [:maybe :string]]
|
||||
[:plugin-data {:optional true} ::ctpg/plugin-data]])
|
||||
(sm/register!
|
||||
^{::sm/type ::typography}
|
||||
[:map {:title "Typography"}
|
||||
[:id ::sm/uuid]
|
||||
[:name :string]
|
||||
[:font-id :string]
|
||||
[:font-family :string]
|
||||
[:font-variant-id :string]
|
||||
[:font-size :string]
|
||||
[:font-weight :string]
|
||||
[:font-style :string]
|
||||
[:line-height :string]
|
||||
[:letter-spacing :string]
|
||||
[:text-transform :string]
|
||||
[:modified-at {:optional true} ::sm/inst]
|
||||
[:path {:optional true} [:maybe :string]]
|
||||
[:plugin-data {:optional true} ::ctpg/plugin-data]]))
|
||||
|
||||
(sm/register! ::typography schema:typography)
|
||||
|
||||
(def check-typography!
|
||||
(def check-typography
|
||||
(sm/check-fn ::typography))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
@@ -23,9 +23,11 @@
|
||||
|
||||
(def schema:variant-component
|
||||
;; A component that is part of a variant set.
|
||||
[:map
|
||||
[:variant-id {:optional true} ::sm/uuid]
|
||||
[:variant-properties {:optional true} [:vector schema:variant-property]]])
|
||||
(sm/register!
|
||||
^{::sm/type ::variant-component}
|
||||
[:map
|
||||
[:variant-id {:optional true} ::sm/uuid]
|
||||
[:variant-properties {:optional true} [:vector schema:variant-property]]]))
|
||||
|
||||
(def schema:variant-shape
|
||||
;; The root shape of the main instance of a variant component.
|
||||
@@ -40,7 +42,6 @@
|
||||
[:is-variant-container {:optional true} :boolean]])
|
||||
|
||||
(sm/register! ::variant-property schema:variant-property)
|
||||
(sm/register! ::variant-component schema:variant-component)
|
||||
(sm/register! ::variant-shape schema:variant-shape)
|
||||
(sm/register! ::variant-container schema:variant-container)
|
||||
|
||||
@@ -273,3 +274,9 @@
|
||||
xform
|
||||
+
|
||||
(map vector props1 props2))))
|
||||
|
||||
(defn variant-name-to-name
|
||||
"Transforms a variant-name (its properties values) into a standard name:
|
||||
the real name of the shape joined by the properties values separated by '/'"
|
||||
[variant]
|
||||
(cfh/merge-path-item (:name variant) (str/replace (:variant-name variant) #", " " / ")))
|
||||
|
||||
29
common/src/app/common/weak_map.cljs
Normal file
29
common/src/app/common/weak_map.cljs
Normal file
@@ -0,0 +1,29 @@
|
||||
;; 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 app.common.weak-map
|
||||
"A value based weak-map implementation (CLJS/JS)")
|
||||
|
||||
(deftype ValueWeakMap [^js/Map data ^js/FinalizationRegistry registry]
|
||||
Object
|
||||
(clear [_]
|
||||
(.clear data))
|
||||
(delete [_ key]
|
||||
(.delete data key))
|
||||
(get [_ key]
|
||||
(if-let [ref (.get data key)]
|
||||
(.deref ^WeakRef ref)
|
||||
nil))
|
||||
(set [_ key val]
|
||||
(.set data key (js/WeakRef. val))
|
||||
(.register registry val key)
|
||||
nil))
|
||||
|
||||
(defn create
|
||||
[]
|
||||
(let [data (js/Map.)
|
||||
registry (js/FinalizationRegistry. #(.delete data %))]
|
||||
(ValueWeakMap. data registry)))
|
||||
@@ -4,36 +4,36 @@
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns frontend-tests.tokens.token-test
|
||||
(ns common-tests.files.tokens-test
|
||||
(:require
|
||||
[app.main.ui.workspace.tokens.token :as wtt]
|
||||
[cljs.test :as t :include-macros true]))
|
||||
[app.common.files.tokens :as cft]
|
||||
[clojure.test :as t]))
|
||||
|
||||
(t/deftest test-parse-token-value
|
||||
(t/testing "parses double from a token value"
|
||||
(t/is (= {:value 100.1 :unit nil} (wtt/parse-token-value "100.1")))
|
||||
(t/is (= {:value -9 :unit nil} (wtt/parse-token-value "-9"))))
|
||||
(t/is (= {:value 100.1 :unit nil} (cft/parse-token-value "100.1")))
|
||||
(t/is (= {:value -9.0 :unit nil} (cft/parse-token-value "-9"))))
|
||||
(t/testing "trims white-space"
|
||||
(t/is (= {:value -1.3 :unit nil} (wtt/parse-token-value " -1.3 "))))
|
||||
(t/is (= {:value -1.3 :unit nil} (cft/parse-token-value " -1.3 "))))
|
||||
(t/testing "parses unit: px"
|
||||
(t/is (= {:value 70.3 :unit "px"} (wtt/parse-token-value " 70.3px "))))
|
||||
(t/is (= {:value 70.3 :unit "px"} (cft/parse-token-value " 70.3px "))))
|
||||
(t/testing "parses unit: %"
|
||||
(t/is (= {:value -10 :unit "%"} (wtt/parse-token-value "-10%"))))
|
||||
(t/is (= {:value -10.0 :unit "%"} (cft/parse-token-value "-10%"))))
|
||||
(t/testing "parses unit: px")
|
||||
(t/testing "returns nil for any invalid characters"
|
||||
(t/is (nil? (wtt/parse-token-value " -1.3a "))))
|
||||
(t/is (nil? (cft/parse-token-value " -1.3a "))))
|
||||
(t/testing "doesnt accept invalid double"
|
||||
(t/is (nil? (wtt/parse-token-value ".3")))))
|
||||
(t/is (nil? (cft/parse-token-value ".3")))))
|
||||
|
||||
(t/deftest token-applied-test
|
||||
(t/testing "matches passed token with `:token-attributes`"
|
||||
(t/is (true? (wtt/token-applied? {:name "a"} {:applied-tokens {:x "a"}} #{:x}))))
|
||||
(t/is (true? (cft/token-applied? {:name "a"} {:applied-tokens {:x "a"}} #{:x}))))
|
||||
(t/testing "doesn't match empty token"
|
||||
(t/is (nil? (wtt/token-applied? {} {:applied-tokens {:x "a"}} #{:x}))))
|
||||
(t/is (nil? (cft/token-applied? {} {:applied-tokens {:x "a"}} #{:x}))))
|
||||
(t/testing "does't match passed token `:id`"
|
||||
(t/is (nil? (wtt/token-applied? {:name "b"} {:applied-tokens {:x "a"}} #{:x}))))
|
||||
(t/is (nil? (cft/token-applied? {:name "b"} {:applied-tokens {:x "a"}} #{:x}))))
|
||||
(t/testing "doesn't match passed `:token-attributes`"
|
||||
(t/is (nil? (wtt/token-applied? {:name "a"} {:applied-tokens {:x "a"}} #{:y})))))
|
||||
(t/is (nil? (cft/token-applied? {:name "a"} {:applied-tokens {:x "a"}} #{:y})))))
|
||||
|
||||
(t/deftest shapes-ids-by-applied-attributes
|
||||
(t/testing "Returns set of matched attributes that fit the applied token"
|
||||
@@ -54,7 +54,7 @@
|
||||
shape-applied-x-y
|
||||
shape-applied-all
|
||||
shape-applied-none]
|
||||
expected (wtt/shapes-ids-by-applied-attributes {:name "1"} shapes attributes)]
|
||||
expected (cft/shapes-ids-by-applied-attributes {:name "1"} shapes attributes)]
|
||||
(t/is (= (:x expected) (shape-ids shape-applied-x
|
||||
shape-applied-x-y
|
||||
shape-applied-all)))
|
||||
@@ -62,34 +62,34 @@
|
||||
shape-applied-x-y
|
||||
shape-applied-all)))
|
||||
(t/is (= (:z expected) (shape-ids shape-applied-all)))
|
||||
(t/is (true? (wtt/shapes-applied-all? expected (shape-ids shape-applied-all) attributes)))
|
||||
(t/is (false? (wtt/shapes-applied-all? expected (apply shape-ids shapes) attributes)))
|
||||
(t/is (true? (cft/shapes-applied-all? expected (shape-ids shape-applied-all) attributes)))
|
||||
(t/is (false? (cft/shapes-applied-all? expected (apply shape-ids shapes) attributes)))
|
||||
(shape-ids shape-applied-x
|
||||
shape-applied-x-y
|
||||
shape-applied-all))))
|
||||
|
||||
(t/deftest tokens-applied-test
|
||||
(t/testing "is true when single shape matches the token and attributes"
|
||||
(t/is (true? (wtt/shapes-token-applied? {:name "a"} [{:applied-tokens {:x "a"}}
|
||||
(t/is (true? (cft/shapes-token-applied? {:name "a"} [{:applied-tokens {:x "a"}}
|
||||
{:applied-tokens {:x "b"}}]
|
||||
#{:x}))))
|
||||
(t/testing "is false when no shape matches the token or attributes"
|
||||
(t/is (nil? (wtt/shapes-token-applied? {:name "a"} [{:applied-tokens {:x "b"}}
|
||||
(t/is (nil? (cft/shapes-token-applied? {:name "a"} [{:applied-tokens {:x "b"}}
|
||||
{:applied-tokens {:x "b"}}]
|
||||
#{:x})))
|
||||
(t/is (nil? (wtt/shapes-token-applied? {:name "a"} [{:applied-tokens {:x "a"}}
|
||||
(t/is (nil? (cft/shapes-token-applied? {:name "a"} [{:applied-tokens {:x "a"}}
|
||||
{:applied-tokens {:x "a"}}]
|
||||
#{:y})))))
|
||||
|
||||
(t/deftest name->path-test
|
||||
(t/is (= ["foo" "bar" "baz"] (wtt/token-name->path "foo.bar.baz")))
|
||||
(t/is (= ["foo" "bar" "baz"] (wtt/token-name->path "foo..bar.baz")))
|
||||
(t/is (= ["foo" "bar" "baz"] (wtt/token-name->path "foo..bar.baz...."))))
|
||||
(t/is (= ["foo" "bar" "baz"] (cft/token-name->path "foo.bar.baz")))
|
||||
(t/is (= ["foo" "bar" "baz"] (cft/token-name->path "foo..bar.baz")))
|
||||
(t/is (= ["foo" "bar" "baz"] (cft/token-name->path "foo..bar.baz...."))))
|
||||
|
||||
(t/deftest token-name-path-exists?-test
|
||||
(t/is (true? (wtt/token-name-path-exists? "border-radius" {"border-radius" {"sm" {:name "sm"}}})))
|
||||
(t/is (true? (wtt/token-name-path-exists? "border-radius" {"border-radius" {:name "sm"}})))
|
||||
(t/is (true? (wtt/token-name-path-exists? "border-radius.sm" {"border-radius" {:name "sm"}})))
|
||||
(t/is (true? (wtt/token-name-path-exists? "border-radius.sm.x" {"border-radius" {:name "sm"}})))
|
||||
(t/is (false? (wtt/token-name-path-exists? "other" {"border-radius" {:name "sm"}})))
|
||||
(t/is (false? (wtt/token-name-path-exists? "dark.border-radius.md" {"dark" {"border-radius" {"sm" {:name "sm"}}}}))))
|
||||
(t/is (true? (cft/token-name-path-exists? "border-radius" {"border-radius" {"sm" {:name "sm"}}})))
|
||||
(t/is (true? (cft/token-name-path-exists? "border-radius" {"border-radius" {:name "sm"}})))
|
||||
(t/is (true? (cft/token-name-path-exists? "border-radius.sm" {"border-radius" {:name "sm"}})))
|
||||
(t/is (true? (cft/token-name-path-exists? "border-radius.sm.x" {"border-radius" {:name "sm"}})))
|
||||
(t/is (false? (cft/token-name-path-exists? "other" {"border-radius" {:name "sm"}})))
|
||||
(t/is (false? (cft/token-name-path-exists? "dark.border-radius.md" {"dark" {"border-radius" {"sm" {:name "sm"}}}}))))
|
||||
@@ -14,6 +14,7 @@
|
||||
[app.common.geom.shapes.transforms :as gsht]
|
||||
[app.common.math :as mth :refer [close?]]
|
||||
[app.common.types.modifiers :as ctm]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.shape :as cts]
|
||||
[clojure.test :as t]))
|
||||
|
||||
@@ -30,7 +31,7 @@
|
||||
(if (= type :path)
|
||||
(cts/setup-shape
|
||||
(into {:type :path
|
||||
:content (:content params default-path)}
|
||||
:content (path/content (:content params default-path))}
|
||||
params))
|
||||
(cts/setup-shape
|
||||
(into {:type type
|
||||
|
||||
@@ -1,3 +1,9 @@
|
||||
;; 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 common-tests.logic.token-test
|
||||
(:require
|
||||
[app.common.files.changes-builder :as pcb]
|
||||
|
||||
@@ -39,9 +39,9 @@
|
||||
[common-tests.types.absorb-assets-test]
|
||||
[common-tests.types.components-test]
|
||||
[common-tests.types.modifiers-test]
|
||||
[common-tests.types.path-data-test]
|
||||
[common-tests.types.shape-decode-encode-test]
|
||||
[common-tests.types.shape-interactions-test]
|
||||
[common-tests.types.shape-path-data-test]
|
||||
[common-tests.types.tokens-lib-test]
|
||||
[common-tests.uuid-test]))
|
||||
|
||||
@@ -91,5 +91,5 @@
|
||||
'common-tests.types.tokens-lib-test
|
||||
'common-tests.types.components-test
|
||||
'common-tests.types.absorb-assets-test
|
||||
'common-tests.types.shape-path-data-test
|
||||
'common-tests.types.path-data-test
|
||||
'common-tests.uuid-test))
|
||||
|
||||
380
common/test/common_tests/types/path_data_test.cljc
Normal file
380
common/test/common_tests/types/path_data_test.cljc
Normal file
@@ -0,0 +1,380 @@
|
||||
;; 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 common-tests.types.path-data-test
|
||||
(:require
|
||||
#?(:clj [app.common.fressian :as fres])
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.math :as mth]
|
||||
[app.common.pprint :as pp]
|
||||
[app.common.transit :as trans]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.path.helpers :as path.helpers]
|
||||
[app.common.types.path.impl :as path.impl]
|
||||
[app.common.types.path.segment :as path.segment]
|
||||
[clojure.test :as t]))
|
||||
|
||||
(def sample-content
|
||||
[{:command :move-to :params {:x 480.0 :y 839.0}}
|
||||
{:command :line-to :params {:x 439.0 :y 802.0}}
|
||||
{:command :curve-to :params {:c1x 368.0 :c1y 737.0 :c2x 310.0 :c2y 681.0 :x 264.0 :y 634.0}}
|
||||
{:command :close-path :params {}}])
|
||||
|
||||
(def sample-content-large
|
||||
[{:command :move-to :params {:x 480.0 :y 839.0}}
|
||||
{:command :line-to :params {:x 439.0 :y 802.0}}
|
||||
{:command :curve-to :params {:c1x 368.0 :c1y 737.0 :c2x 310.0 :c2y 681.0 :x 264.0 :y 634.0}}
|
||||
{:command :curve-to :params {:c1x 218.0 :c1y 587.0 :c2x 181.0 :c2y 545.0 :x 154.0 :y 508.0}}
|
||||
{:command :curve-to :params {:c1x 126.0 :c1y 471.0 :c2x 107.0 :c2y 438.0 :x 96.0 :y 408.0}}
|
||||
{:command :curve-to :params {:c1x 85.0 :c1y 378.0 :c2x 80.0 :c2y 347.0 :x 80.0 :y 317.0}}
|
||||
{:command :curve-to :params {:c1x 80.0 :c1y 256.0 :c2x 100.0 :c2y 206.0 :x 140.0 :y 166.0}}
|
||||
{:command :curve-to :params {:c1x 180.0 :c1y 126.0 :c2x 230.0 :c2y 106.0 :x 290.0 :y 106.0}}
|
||||
{:command :curve-to :params {:c1x 328.0 :c1y 106.0 :c2x 363.0 :c2y 115.0 :x 395.0 :y 133.0}}
|
||||
{:command :curve-to :params {:c1x 427.0 :c1y 151.0 :c2x 456.0 :c2y 177.0 :x 480.0 :y 211.0}}
|
||||
{:command :curve-to :params {:c1x 508.0 :c1y 175.0 :c2x 537.0 :c2y 148.0 :x 569.0 :y 131.0}}
|
||||
{:command :curve-to :params {:c1x 600.0 :c1y 114.0 :c2x 634.0 :c2y 106.0 :x 670.0 :y 106.0}}
|
||||
{:command :curve-to :params {:c1x 729.0 :c1y 106.0 :c2x 779.0 :c2y 126.0 :x 819.0 :y 166.0}}
|
||||
{:command :curve-to :params {:c1x 859.0 :c1y 206.0 :c2x 880.0 :c2y 256.0 :x 880.0 :y 317.0}}
|
||||
{:command :curve-to :params {:c1x 880.0 :c1y 347.0 :c2x 874.0 :c2y 378.0 :x 863.0 :y 408.0}}
|
||||
{:command :curve-to :params {:c1x 852.0 :c1y 438.0 :c2x 833.0 :c2y 471.0 :x 806.0 :y 508.0}}
|
||||
{:command :curve-to :params {:c1x 778.0 :c1y 545.0 :c2x 741.0 :c2y 587.0 :x 695.0 :y 634.0}}
|
||||
{:command :curve-to :params {:c1x 649.0 :c1y 681.0 :c2x 591.0 :c2y 737.0 :x 521.0 :y 802.0}}
|
||||
{:command :line-to :params {:x 480.0 :y 839.0}}
|
||||
{:command :close-path :params {}}
|
||||
{:command :move-to :params {:x 480.0 :y 760.0}}
|
||||
{:command :curve-to :params {:c1x 547.0 :c1y 698.0 :c2x 603.0 :c2y 644.0 :x 646.0 :y 600.0}}
|
||||
{:command :curve-to :params {:c1x 690.0 :c1y 556.0 :c2x 724.0 :c2y 517.0 :x 750.0 :y 484.0}}
|
||||
{:command :curve-to :params {:c1x 776.0 :c1y 450.0 :c2x 794.0 :c2y 420.0 :x 804.0 :y 394.0}}
|
||||
{:command :curve-to :params {:c1x 814.0 :c1y 368.0 :c2x 820.0 :c2y 342.0 :x 820.0 :y 317.0}}
|
||||
{:command :curve-to :params {:c1x 820.0 :c1y 273.0 :c2x 806.0 :c2y 236.0 :x 778.0 :y 2085.0}}
|
||||
{:command :curve-to :params {:c1x 750.0 :c1y 180.0 :c2x 714.0 :c2y 166.0 :x 670.0 :y 1660.0}}
|
||||
{:command :curve-to :params {:c1x 635.0 :c1y 166.0 :c2x 604.0 :c2y 176.0 :x 574.0 :y 1975.0}}
|
||||
{:command :curve-to :params {:c1x 545.0 :c1y 218.0 :c2x 522.0 :c2y 248.0 :x 504.0 :y 2860.0}}
|
||||
{:command :line-to :params {:x 455.0 :y 286.0}}
|
||||
{:command :curve-to :params {:c1x 437.0 :c1y 248.0 :c2x 414.0 :c2y 219.0 :x 385.0 :y 198.0}}
|
||||
{:command :curve-to :params {:c1x 355.0 :c1y 176.0 :c2x 324.0 :c2y 166.0 :x 289.0 :y 166.0}}
|
||||
{:command :curve-to :params {:c1x 245.0 :c1y 166.0 :c2x 210.0 :c2y 180.0 :x 182.0 :y 208.0}}
|
||||
{:command :curve-to :params {:c1x 154.0 :c1y 236.0 :c2x 140.0 :c2y 273.0 :x 140.0 :y 317.0}}
|
||||
{:command :curve-to :params {:c1x 140.0 :c1y 343.0 :c2x 145.0 :c2y 369.0 :x 155.0 :y 395.0}}
|
||||
{:command :curve-to :params {:c1x 165.0 :c1y 421.0 :c2x 183.0 :c2y 451.0 :x 209.0 :y 485.0}}
|
||||
{:command :curve-to :params {:c1x 235.0 :c1y 519.0 :c2x 270.0 :c2y 558.0 :x 314.0 :y 602.0}}
|
||||
{:command :curve-to :params {:c1x 358.0 :c1y 646.0 :c2x 413.0 :c2y 698.0 :x 480.0 :y 760.0}}
|
||||
{:command :close-path :params {}}
|
||||
{:command :move-to :params {:x 480.0 :y 463.0}}
|
||||
{:command :close-path :params {}}])
|
||||
|
||||
(def sample-bytes
|
||||
[1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -16 67 0 -64 81 68
|
||||
2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -128 -37 67 0 -128 72 68
|
||||
3 0 0 0 0 0 -72 67 0 64 56 68 0 0 -101 67 0 64 42 68 0 0 -124 67 0 -128 30 68
|
||||
4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0])
|
||||
|
||||
;; This means it implements IReduceInit/IReduce protocols
|
||||
(t/deftest path-data-to-vector
|
||||
(let [pdata (path/content sample-content)
|
||||
result (vec pdata)]
|
||||
(t/is (= 4 (count result)))
|
||||
(t/is (= (get-in sample-content [0 :command])
|
||||
(get-in result [0 :command])))
|
||||
(t/is (= (get-in sample-content [1 :command])
|
||||
(get-in result [1 :command])))
|
||||
(t/is (= (get-in sample-content [2 :command])
|
||||
(get-in result [2 :command])))
|
||||
(t/is (= (get-in sample-content [3 :command])
|
||||
(get-in result [3 :command])))
|
||||
|
||||
(t/is (= (get-in sample-content [0 :params])
|
||||
(get-in result [0 :params])))
|
||||
(t/is (= (get-in sample-content [1 :params])
|
||||
(get-in result [1 :params])))
|
||||
(t/is (= (get-in sample-content [2 :params])
|
||||
(get-in result [2 :params])))
|
||||
(t/is (= (get-in sample-content [3 :params])
|
||||
(get-in result [3 :params])))))
|
||||
|
||||
(t/deftest path-data-plain-to-binary
|
||||
(let [pdata (path/content sample-content)]
|
||||
(t/is (= sample-bytes
|
||||
(vec
|
||||
#?(:cljs (js/Int8Array. (.-buffer pdata))
|
||||
:clj (.array (.-buffer pdata))))))
|
||||
(t/is (= sample-content
|
||||
(vec pdata)))))
|
||||
|
||||
(t/deftest path-data-from-binary
|
||||
(let [barray #?(:clj (byte-array sample-bytes)
|
||||
:cljs (js/Int8Array.from sample-bytes))
|
||||
content (path/from-bytes barray)]
|
||||
|
||||
(t/is (= (vec content) sample-content))))
|
||||
|
||||
(t/deftest path-data-transit-roundtrip
|
||||
(let [pdata (path/content sample-content)
|
||||
result1 (trans/encode-str pdata)
|
||||
expected (str "[\"~#penpot/path-data\",\"~bAQAAAAAAAAAAAAA"
|
||||
"AAAAAAAAAAAAAAPBDAMBRRAIAAAAAAAAAAAAAAAAAAA"
|
||||
"AAAAAAAIDbQwCASEQDAAAAAAC4QwBAOEQAAJtDAEAqR"
|
||||
"AAAhEMAgB5EBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
|
||||
"AAAAAA==\"]")
|
||||
result2 (trans/decode-str result1)]
|
||||
(t/is (= expected result1))
|
||||
(t/is (= pdata result2))))
|
||||
|
||||
#?(:clj
|
||||
(t/deftest path-data-fresian
|
||||
(let [pdata (path/content sample-content)
|
||||
result1 (fres/encode pdata)
|
||||
result2 (fres/decode result1)]
|
||||
(t/is (= pdata result2)))))
|
||||
|
||||
(defn- transform-plain-content
|
||||
"Apply a transformation to a path content;
|
||||
|
||||
This is a copy of previous impl, that uses plain format to calculate
|
||||
the new transformed path content"
|
||||
[content transform]
|
||||
(let [set-tr
|
||||
(fn [params px py]
|
||||
(let [tr-point (-> (gpt/point (get params px) (get params py))
|
||||
(gpt/transform transform))]
|
||||
(assoc params
|
||||
px (:x tr-point)
|
||||
py (:y tr-point))))
|
||||
|
||||
transform-params
|
||||
(fn [{:keys [x c1x c2x] :as params}]
|
||||
(cond-> params
|
||||
(some? x) (set-tr :x :y)
|
||||
(some? c1x) (set-tr :c1x :c1y)
|
||||
(some? c2x) (set-tr :c2x :c2y)))]
|
||||
|
||||
(into []
|
||||
(map #(update % :params transform-params))
|
||||
content)))
|
||||
|
||||
(t/deftest path-transform-1
|
||||
(let [matrix (gmt/translate-matrix 10 10)
|
||||
content (path/content sample-content)
|
||||
|
||||
result1 (path/transform-content content matrix)
|
||||
result2 (transform-plain-content sample-content matrix)
|
||||
result3 (transform-plain-content content matrix)]
|
||||
|
||||
(t/is (= (vec result1) result2))
|
||||
(t/is (= result2 result3))))
|
||||
|
||||
(t/deftest path-transform-2
|
||||
(let [matrix (gmt/translate-matrix 10 10)
|
||||
content (path/content sample-content-large)
|
||||
|
||||
result1 (path/transform-content content matrix)
|
||||
result2 (transform-plain-content sample-content-large matrix)
|
||||
result3 (transform-plain-content content matrix)]
|
||||
|
||||
(t/is (= (vec result1) result2))
|
||||
(t/is (= result2 result3))))
|
||||
|
||||
(defn- content->points
|
||||
"Given a content return all points.
|
||||
|
||||
Legacy impl preserved for tests purposes"
|
||||
[content]
|
||||
(letfn [(segment->point [seg]
|
||||
(let [params (get seg :params)
|
||||
x (get params :x)
|
||||
y (get params :y)]
|
||||
(when (d/num? x y)
|
||||
(gpt/point x y))))]
|
||||
(some->> (seq content)
|
||||
(into [] (keep segment->point)))))
|
||||
|
||||
(t/deftest path-get-points
|
||||
(let [content (path/content sample-content-large)
|
||||
|
||||
result1 (content->points content)
|
||||
result2 (content->points sample-content-large)
|
||||
result3 (path.segment/get-points content)]
|
||||
|
||||
(t/is (= result1 result2))
|
||||
(t/is (= result2 result3))))
|
||||
|
||||
(defn calculate-extremities
|
||||
"Calculate extremities for the provided content.
|
||||
A legacy implementation used mainly as reference for testing"
|
||||
[content]
|
||||
(loop [points #{}
|
||||
from-p nil
|
||||
move-p nil
|
||||
content (seq content)]
|
||||
(if content
|
||||
(let [last-p (last content)
|
||||
content (if (= :move-to (:command last-p))
|
||||
(butlast content)
|
||||
content)
|
||||
command (first content)
|
||||
to-p (path.helpers/segment->point command)
|
||||
|
||||
[from-p move-p command-pts]
|
||||
(case (:command command)
|
||||
:move-to [to-p to-p (when to-p [to-p])]
|
||||
:close-path [move-p move-p (when move-p [move-p])]
|
||||
:line-to [to-p move-p (when (and from-p to-p) [from-p to-p])]
|
||||
:curve-to [to-p move-p
|
||||
(let [c1 (path.helpers/segment->point command :c1)
|
||||
c2 (path.helpers/segment->point command :c2)
|
||||
curve [from-p to-p c1 c2]]
|
||||
(when (and from-p to-p c1 c2)
|
||||
(into [from-p to-p]
|
||||
(->> (path.helpers/curve-extremities curve)
|
||||
(map #(path.helpers/curve-values curve %))))))]
|
||||
[to-p move-p []])]
|
||||
|
||||
(recur (apply conj points command-pts) from-p move-p (next content)))
|
||||
points)))
|
||||
|
||||
(t/deftest extremities-1
|
||||
(let [pdata (path/content sample-content)
|
||||
result1 (calculate-extremities sample-content)
|
||||
result2 (calculate-extremities pdata)
|
||||
result3 (path.segment/calculate-extremities sample-content)
|
||||
result4 (path.segment/calculate-extremities pdata)
|
||||
expect #{(gpt/point 480.0 839.0)
|
||||
(gpt/point 439.0 802.0)
|
||||
(gpt/point 264.0 634.0)}
|
||||
n-iter 100000]
|
||||
|
||||
(t/is (= result1 result3))
|
||||
(t/is (= result1 expect))
|
||||
(t/is (= result2 expect))
|
||||
(t/is (= result3 expect))
|
||||
(t/is (= result4 expect))))
|
||||
|
||||
(def sample-content-2
|
||||
[{:command :move-to, :params {:x 480.0, :y 839.0}}
|
||||
{:command :line-to, :params {:x 439.0, :y 802.0}}
|
||||
{:command :curve-to, :params {:c1x 368.0, :c1y 737.0, :c2x 310.0, :c2y 681.0, :x 4.0, :y 4.0}}
|
||||
{:command :curve-to, :params {:c1x 3.0, :c1y 7.0, :c2x 30.0, :c2y -68.0, :x 20.0, :y 20.0}}
|
||||
{:command :close-path :params {}}])
|
||||
|
||||
(t/deftest extremities-2
|
||||
(let [result1 (path.segment/calculate-extremities sample-content-2)
|
||||
result2 (calculate-extremities sample-content-2)]
|
||||
(t/is (= result1 result2))))
|
||||
|
||||
(t/deftest extremities-3
|
||||
(let [segments [{:command :move-to, :params {:x -310.5355224609375, :y 452.62115478515625}}]
|
||||
content (path/content segments)
|
||||
result1 (calculate-extremities segments)
|
||||
result2 (path.segment/calculate-extremities segments)
|
||||
result3 (path.segment/calculate-extremities content)
|
||||
expect #{}]
|
||||
(t/is (= result1 expect))
|
||||
(t/is (= result1 expect))
|
||||
(t/is (= result2 expect))
|
||||
(t/is (= result3 expect))))
|
||||
|
||||
(def sample-content-square
|
||||
[{:command :move-to, :params {:x 0, :y 0}}
|
||||
{:command :line-to, :params {:x 10, :y 0}}
|
||||
{:command :line-to, :params {:x 10, :y 10}}
|
||||
{:command :line-to, :params {:x 10, :y 0}}
|
||||
{:command :line-to, :params {:x 0, :y 10}}
|
||||
{:command :line-to, :params {:x 0, :y 0}}
|
||||
{:command :close-path :params {}}])
|
||||
|
||||
(t/deftest points-to-content
|
||||
(let [initial [(gpt/point 0.0 0.0)
|
||||
(gpt/point 10.0 10.0)
|
||||
(gpt/point 10.0 5.0)]
|
||||
content (path.segment/points->content initial)
|
||||
segments (vec content)]
|
||||
(t/is (= 3 (count segments)))
|
||||
(t/is (= {:command :move-to, :params {:x 0.0, :y 0.0}} (nth segments 0)))
|
||||
(t/is (= {:command :line-to, :params {:x 10.0, :y 10.0}} (nth segments 1)))
|
||||
(t/is (= {:command :line-to, :params {:x 10.0, :y 5.0}} (nth segments 2)))))
|
||||
|
||||
(t/deftest get-segments
|
||||
(let [content (path/content sample-content-square)
|
||||
points #{(gpt/point 10.0 0.0)
|
||||
(gpt/point 0.0 0.0)}
|
||||
result (path.segment/get-segments-with-points content points)
|
||||
expect [{:command :line-to,
|
||||
:params {:x 10.0, :y 0.0},
|
||||
:start (gpt/point 0.0 0.0)
|
||||
:end (gpt/point 10.0 0.0)
|
||||
:index 1}
|
||||
{:command :close-path,
|
||||
:params {},
|
||||
:start (gpt/point 0.0 0.0)
|
||||
:end (gpt/point 0.0 0.0)
|
||||
:index 6}]]
|
||||
|
||||
(t/is (= result expect))))
|
||||
|
||||
(defn handler->point
|
||||
"A legacy impl of handler point, used as reference for test"
|
||||
[content index prefix]
|
||||
(when (and (some? index)
|
||||
(some? prefix))
|
||||
(when (and (<= 0 index)
|
||||
(< index (count content)))
|
||||
(let [segment (nth content index)
|
||||
params (get segment :params)]
|
||||
(if (= :curve-to (:command segment))
|
||||
(let [[cx cy] (path.helpers/prefix->coords prefix)]
|
||||
(gpt/point (get params cx)
|
||||
(get params cy)))
|
||||
(gpt/point (get params :x)
|
||||
(get params :y)))))))
|
||||
|
||||
(t/deftest handler-to-point
|
||||
(let [content (path/content sample-content-2)
|
||||
result1 (handler->point content 3 :c1)
|
||||
result2 (handler->point content 1 :c1)
|
||||
result3 (handler->point content 0 :c1)
|
||||
|
||||
expect1 (gpt/point 3.0 7.0)
|
||||
expect2 (gpt/point 439.0 802.0)
|
||||
expect3 (gpt/point 480.0 839.0)
|
||||
|
||||
result4 (path.segment/get-handler-point content 3 :c1)
|
||||
result5 (path.segment/get-handler-point content 1 :c1)
|
||||
result6 (path.segment/get-handler-point content 0 :c1)]
|
||||
|
||||
(t/is (= result1 expect1))
|
||||
(t/is (= result2 expect2))
|
||||
(t/is (= result3 expect3))
|
||||
(t/is (= result4 expect1))
|
||||
(t/is (= result5 expect2))
|
||||
(t/is (= result6 expect3))))
|
||||
|
||||
(defn get-handlers
|
||||
"Retrieve a map where for every point will retrieve a list of
|
||||
the handlers that are associated with that point.
|
||||
point -> [[index, prefix]].
|
||||
|
||||
Legacy impl"
|
||||
[content]
|
||||
(->> (d/with-prev content)
|
||||
(d/enumerate)
|
||||
(mapcat (fn [[index [cur-segment pre-segment]]]
|
||||
(if (and pre-segment (= :curve-to (:command cur-segment)))
|
||||
(let [cur-pos (path.helpers/segment->point cur-segment)
|
||||
pre-pos (path.helpers/segment->point pre-segment)]
|
||||
(-> [[pre-pos [index :c1]]
|
||||
[cur-pos [index :c2]]]))
|
||||
[])))
|
||||
|
||||
(group-by first)
|
||||
(d/mapm #(mapv second %2))))
|
||||
|
||||
(t/deftest content-to-handlers
|
||||
(let [content (path/content sample-content-large)
|
||||
result1 (get-handlers sample-content-large)
|
||||
result2 (path.segment/get-handlers content)]
|
||||
(t/is (= result1 result2))))
|
||||
@@ -12,10 +12,10 @@
|
||||
[app.common.schema.generators :as sg]
|
||||
[app.common.schema.test :as smt]
|
||||
[app.common.types.color :refer [schema:color schema:gradient]]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.plugins :refer [schema:plugin-data]]
|
||||
[app.common.types.shape :as tsh]
|
||||
[app.common.types.shape.interactions :refer [schema:animation schema:interaction]]
|
||||
[app.common.types.shape.path :refer [schema:path-content]]
|
||||
[app.common.types.shape.shadow :refer [schema:shadow]]
|
||||
[app.common.uuid :as uuid]
|
||||
[clojure.test :as t]))
|
||||
@@ -112,17 +112,14 @@
|
||||
(= interaction interaction-3)))
|
||||
{:num 500})))
|
||||
|
||||
|
||||
(t/deftest shape-path-content-json-roundtrip
|
||||
(let [encode (sm/encoder schema:path-content (sm/json-transformer))
|
||||
decode (sm/decoder schema:path-content (sm/json-transformer))]
|
||||
(let [encode (sm/encoder ::path/content (sm/json-transformer))
|
||||
decode (sm/decoder ::path/content (sm/json-transformer))]
|
||||
(smt/check!
|
||||
(smt/for [path-content (sg/generator schema:path-content)]
|
||||
(smt/for [path-content (sg/generator ::path/content)]
|
||||
(let [path-content-1 (encode path-content)
|
||||
path-content-2 (json-roundtrip path-content-1)
|
||||
path-content-3 (decode path-content-2)]
|
||||
;; (app.common.pprint/pprint path-content)
|
||||
;; (app.common.pprint/pprint path-content-3)
|
||||
(= path-content path-content-3)))
|
||||
{:num 500})))
|
||||
|
||||
|
||||
@@ -1,59 +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 common-tests.types.shape-path-data-test
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.math :as mth]
|
||||
[app.common.pprint :as pp]
|
||||
[app.common.types.shape.path :as path]
|
||||
[clojure.test :as t]))
|
||||
|
||||
(def sample-content
|
||||
[{:command :move-to, :params {:x 480.0, :y 839.0}}
|
||||
{:command :line-to, :params {:x 439.0, :y 802.0}}
|
||||
{:command :curve-to, :params {:c1x 368.0, :c1y 737.0, :c2x 310.0, :c2y 681.0, :x 264.0, :y 634.0}}
|
||||
{:command :close-path :params {}}])
|
||||
|
||||
(def sample-bytes
|
||||
[0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67 -16 0 0 68 81 -64 0
|
||||
0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67 -37 -128 0 68 72 -128 0
|
||||
0 3 0 0 67 -72 0 0 68 56 64 0 67 -101 0 0 68 42 64 0 67 -124 0 0 68 30 -128 0
|
||||
0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0])
|
||||
|
||||
;; This means it implements IReduceInit/IReduce protocols
|
||||
(t/deftest path-data-to-vector
|
||||
(let [pdata (path/path-data sample-content)
|
||||
result (vec pdata)]
|
||||
(t/is (= 4 (count result)))
|
||||
(t/is (= (get-in sample-content [0 :command])
|
||||
(get-in result [0 :command])))
|
||||
(t/is (= (get-in sample-content [1 :command])
|
||||
(get-in result [1 :command])))
|
||||
(t/is (= (get-in sample-content [2 :command])
|
||||
(get-in result [2 :command])))
|
||||
(t/is (= (get-in sample-content [3 :command])
|
||||
(get-in result [3 :command])))
|
||||
|
||||
(t/is (= (get-in sample-content [0 :params])
|
||||
(get-in result [0 :params])))
|
||||
(t/is (= (get-in sample-content [1 :params])
|
||||
(get-in result [1 :params])))
|
||||
(t/is (= (get-in sample-content [2 :params])
|
||||
(get-in result [2 :params])))
|
||||
(t/is (= (get-in sample-content [3 :params])
|
||||
(get-in result [3 :params])))))
|
||||
|
||||
(t/deftest path-data-plain-to-binary
|
||||
(let [pdata (path/path-data sample-content)]
|
||||
(t/is (= sample-bytes
|
||||
(vec
|
||||
#?(:cljs (js/Int8Array. (.-buffer pdata))
|
||||
:clj (.array (.-buffer pdata))))))
|
||||
(t/is (= (->> sample-content
|
||||
(mapv path/map->PathSegment))
|
||||
(vec pdata)))))
|
||||
|
||||
BIN
docs/img/abstraction-levels/abstraction-levels.png
Normal file
BIN
docs/img/abstraction-levels/abstraction-levels.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 88 KiB |
@@ -34,9 +34,11 @@ Create your own app with the framework of your choice. See examples for each fra
|
||||
|
||||
| Framework | Command | Version\* |
|
||||
| --------- | ----------------------------------------------------------- | --------- |
|
||||
| Angular | ng new plugin-name | 18.0.0 |
|
||||
| React | npm create vite@latest plugin-name -- --template react-ts | 18.2.0 |
|
||||
| Vue | npm create vue@latest | 3.4.21 |
|
||||
| Angular | ng new plugin-name | 19.2.2 |
|
||||
| React | npm create vite@latest plugin-name -- --template react-ts | 19.0.0 |
|
||||
| Vue | npm create vue@latest | 3.5.13 |
|
||||
| Svelte | npm create svelte@latest | 5.23.0 |
|
||||
|
||||
|
||||
_\*: version we used in the examples._
|
||||
|
||||
|
||||
359
docs/technical-guide/developer/abstraction-levels.md
Normal file
359
docs/technical-guide/developer/abstraction-levels.md
Normal file
@@ -0,0 +1,359 @@
|
||||
---
|
||||
title: 3.07. Abstraction levels
|
||||
---
|
||||
|
||||
# Code organization in abstraction levels
|
||||
|
||||
Initially, Penpot data model implementation was organized in a different way.
|
||||
We are currently in a process of reorganization. The objective is to have data
|
||||
manipulation code structured in abstraction layers, with well-defined
|
||||
boundaries, and a hierarchical structure (each level may only use same or
|
||||
lower levels, but not higher).
|
||||
|
||||

|
||||
|
||||
At this moment the namespace structure is already organized as described here,
|
||||
but there is much code that does not comply with these rules, and needs to be
|
||||
moved or refactored. We expect to be refactoring existing modules incrementally,
|
||||
each time we do an important functionality change.
|
||||
|
||||
## Basic data
|
||||
|
||||
```text
|
||||
▾ common/
|
||||
▾ src/app/common/
|
||||
data.cljc
|
||||
▾ src/app/data/
|
||||
macros.cljc
|
||||
```
|
||||
|
||||
A level for generic data structures or operations, that are not specifically part
|
||||
of the domain model (e.g. trees, strings, maps, iterators, etc.). Also may belong
|
||||
here some functions in <code>app.common.geom/</code> and <code>app.common.files.helpers.cljc</code>.
|
||||
|
||||
We need to create a new directory for this and move there all functions in this
|
||||
leve.
|
||||
|
||||
|
||||
## Abstract data types
|
||||
|
||||
```text
|
||||
▾ common/
|
||||
▾ src/app/common/
|
||||
▾ types/
|
||||
file.cljc
|
||||
page.cljc
|
||||
shape.cljc
|
||||
color.cljc
|
||||
component.cljc
|
||||
tokens_lib.cljc
|
||||
...
|
||||
```
|
||||
|
||||
Namespaces here represent a single data entity of the domain model, or a
|
||||
fragment of one, as an [Abstract Data Type](https://www.geeksforgeeks.org/abstract-data-types/).
|
||||
An ADT is a data component that is defined through a series of properties and
|
||||
operations, and that abstracts out the details of how it's implemented and what
|
||||
is the internal structure. This allows to simplify the logic of the client
|
||||
code, and also to make future changes in the ADT without affecting callers (if
|
||||
the abstract interface does not change).
|
||||
|
||||
Each structure in this module has:
|
||||
|
||||
* A **schema spec** that defines the structure of the type and its values:
|
||||
|
||||
```clojure
|
||||
(def schema:fill
|
||||
[:map {:title "Fill"}
|
||||
[:fill-color {:optional true} ::ctc/rgb-color]
|
||||
[:fill-opacity {:optional true} ::sm/safe-number]
|
||||
...)
|
||||
|
||||
(def schema:shape-base-attrs
|
||||
[:map {:title "ShapeMinimalRecord"}
|
||||
[:id ::sm/uuid]
|
||||
[:name :string]
|
||||
[:type [::sm/one-of shape-types]]
|
||||
[:selrect ::grc/rect]
|
||||
[:points schema:points]
|
||||
...)
|
||||
|
||||
(def schema:token-set-attrs
|
||||
[:map {:title "TokenSet"}
|
||||
[:name :string]
|
||||
[:description {:optional true} :string]
|
||||
[:modified-at {:optional true} ::sm/inst]
|
||||
[:tokens {:optional true} [:and
|
||||
[:map-of {:gen/max 5}
|
||||
:string
|
||||
schema:token]
|
||||
[:fn d/ordered-map?]]]])
|
||||
```
|
||||
|
||||
* A **protocol** that define the external interface to be used for this entity.
|
||||
|
||||
(NOTE: this is currently only implemented in some subsystems like Design Tokens
|
||||
and new path handling).
|
||||
|
||||
```clojure
|
||||
(defprotocol ITokenSet
|
||||
(update-name [_ set-name] "change a token set name while keeping the path")
|
||||
(add-token [_ token] "add a token at the end of the list")
|
||||
(update-token [_ token-name f] "update a token in the list")
|
||||
(delete-token [_ token-name] "delete a token from the list")
|
||||
(get-token [_ token-name] "return token by token-name")
|
||||
(get-tokens [_] "return an ordered sequence of all tokens in the set"))
|
||||
```
|
||||
|
||||
* A **custom data type** that implements this protocol. __Functions here are the only
|
||||
ones allowed to modify the internal structure of the type__.
|
||||
|
||||
Clojure allows us two kinds of custom data types:
|
||||
* [**`deftype`**](https://funcool.github.io/clojurescript-unraveled/#deftype). We'll
|
||||
use it when we want the internal structure to be completely opaque and
|
||||
data accessed through protocol functions. Clojure allows access to the
|
||||
attributes with the <code class="language-clojure">(.-attr)</code>
|
||||
syntax, but we prefer not to use it.
|
||||
* [**`defrecord`**](https://funcool.github.io/clojurescript-unraveled/#defrecord).
|
||||
We'll use it when we want the structure to be exposed as a plain clojure
|
||||
map, and thus allowing to read attributes with <code
|
||||
class="language-clojure">(:attr t)</code>, to use <code
|
||||
class="language-clojure">get</code>, <code
|
||||
class="language-clojure">keys</code>, <code
|
||||
class="language-clojure">vals</code>, etc. Note that this also allows
|
||||
modifying the object with <code class="language-clojure">assoc</code>,
|
||||
<code class="language-clojure">update</code>, etc. But in general we
|
||||
prefer to do all modification via protocol methods, because this way
|
||||
it's easier to track down where the failure is if an invalid structure
|
||||
is detected in a validation check, and add business logic like "update
|
||||
<code class="language-clojure">modified-at</code> whenever any other
|
||||
attribute is changed".
|
||||
|
||||
```clojure
|
||||
(defrecord TokenSet [name description modified-at tokens]
|
||||
ITokenSet
|
||||
(add-token [_ token]
|
||||
(let [token (check-token token)]
|
||||
(TokenSet. name
|
||||
description
|
||||
(dt/now)
|
||||
(assoc tokens (:name token) token))))
|
||||
```
|
||||
|
||||
|
||||
* **Additional helper functions** the protocol should be made as small and compact
|
||||
as possible. If we need functions for business logic or complex queries that
|
||||
do not need to directly access the internal structure, but can be implemented by
|
||||
only calling the abstract procotol, they should be created as standalone functions.
|
||||
At this level, they must be functions that operate only on instances of the given
|
||||
domain model entity. They must always ensure the internal integrity of the data.
|
||||
|
||||
```clojure
|
||||
(defn sets-tree-seq
|
||||
"Get tokens sets tree as a flat list"
|
||||
[token-sets]
|
||||
...)
|
||||
|
||||
> IMPORTANT SUMMARY
|
||||
> * Code in this level only knows about one domain model entity.
|
||||
> * All functions ensure the internal integrity of the data.
|
||||
> * For this, the schema is used, and the functions must check parameters
|
||||
> and output values as needed.
|
||||
> * No outside code should get any knowledge of the internal structure, so it
|
||||
> can be changed in the future without breaking cliente code.
|
||||
> * All modifications of the data should be done via protocol methods (even in
|
||||
> <code class="language-clojure">defrecords</code>). This allows a) more
|
||||
> control of the internal data dependencies, b) easier bug tracking of
|
||||
> corrupted data, and c) easier refactoring when the structure is modified.
|
||||
|
||||
Currently most of Penpot code does not follow those requirements, but it
|
||||
should do in new code or in any refactor.
|
||||
|
||||
## File operations
|
||||
|
||||
```text
|
||||
▾ common/
|
||||
▾ src/app/common/
|
||||
▾ files/
|
||||
helpers.cljc
|
||||
shapes_helpers.cljc
|
||||
...
|
||||
```
|
||||
|
||||
Functions that modify a file object (or a part of it) in place, returning the
|
||||
file object changed. They ensure the referential integrity within the file, or
|
||||
between a file and its libraries.
|
||||
|
||||
**These functions are used when we need to manipulate objects of different
|
||||
domain entities inside a file.**
|
||||
|
||||
```clojure
|
||||
(defn resolve-component
|
||||
"Retrieve the referenced component, from the local file or from a library"
|
||||
[shape file libraries & {:keys [include-deleted?] :or {include-deleted? False}}]
|
||||
(if (= (:component-file shape) (:id file))
|
||||
(ctkl/get-component (:data file) (:component-id shape) include-deleted?)
|
||||
(get-component libraries
|
||||
(:component-file shape)
|
||||
(:component-id shape)
|
||||
:include-deleted? include-deleted?)))
|
||||
|
||||
(defn delete-component
|
||||
"Mark a component as deleted and store the main instance shapes iside it, to
|
||||
be able to be recovered later."
|
||||
[file-data component-id skip-undelete? delta]
|
||||
(let [delta (or delta (gpt/point 0 0))]
|
||||
(if skip-undelete?
|
||||
(ctkl/delete-component file-data component-id)
|
||||
(-> file-data
|
||||
(ctkl/update-component component-id #(load-component-objects file-data % delta))
|
||||
(ctkl/mark-component-deleted component-id)))))
|
||||
```
|
||||
|
||||
> This module is still needing an important refactor. Mainly to take functions
|
||||
> from common.types and move them here.
|
||||
|
||||
### File validation and repair
|
||||
|
||||
There is a function in <code class="language-clojure">app.common.files.validate</code> that checks a file for
|
||||
referential and semantic integrity. It's called automatically when file changes
|
||||
are sent to backend, but may be invoked manually whenever it's needed.
|
||||
|
||||
## File changes objects
|
||||
|
||||
```text
|
||||
▾ common/
|
||||
▾ src/app/common/
|
||||
▾ files/
|
||||
changes_builder.cljc
|
||||
changes.cljc
|
||||
...
|
||||
```
|
||||
|
||||
This layer is how we adopt the [Event sourcing pattern](https://www.geeksforgeeks.org/event-sourcing-pattern/).
|
||||
Instead of directly modifying files, we create <code class="language-clojure">changes</code>
|
||||
objects, that represent one modification, and that can be serialized, stored,
|
||||
send to backend, logged, etc. Then it can be *materialized* by a **processing
|
||||
function**, that takes a file and a change, and returns the updated file.
|
||||
|
||||
This also allows an important feature: undoing changes.
|
||||
|
||||
Processing functions should not contain business logic or algorithms. Just
|
||||
adapt the change interface to the operations in **File** or **Abstract Data
|
||||
Types** levels.
|
||||
|
||||
There exists a <code class="language-clojure">changes-builder</code> module
|
||||
with helper functions to conveniently build changes objects, and to
|
||||
automatically calculate the reverse undo change.
|
||||
|
||||
> IMPORTANT RULES
|
||||
>
|
||||
> All changes must satisfy two properties:
|
||||
> * **[Idempotence](https://en.wikipedia.org/wiki/Idempotence)**. The event
|
||||
> sourcing architecture and multiuser capability may cause that the same
|
||||
> change may be applied more than once to a file. So changes must not, for
|
||||
> example, be like *increment counter* but rather *set counter to value x*.
|
||||
> * **Minimal scope**. To reduce conflicts, changes should only modify the
|
||||
> relevant part of the domain entity. This way, if a concurrent change on
|
||||
> the same entity arrives, from another user, and it modifies a different
|
||||
> part of the data, they may ve processed without overriding.
|
||||
|
||||
## Business logic
|
||||
|
||||
```text
|
||||
▾ common/
|
||||
▾ src/app/common/
|
||||
▾ logic/
|
||||
shapes.cljc
|
||||
libraries.cljc
|
||||
```
|
||||
|
||||
At this level there are functions that implement high level user actions, in an
|
||||
abstract way (independent of UI). Here may be complex business logic (eg. to
|
||||
create a component copy we must clone all shapes, assign new ids, relink
|
||||
parents, change the head structure to be a copy and link each shape in the copy
|
||||
with the corresponding one in the main).
|
||||
|
||||
They don't directly modify files, but generate changes objects, that may be
|
||||
executed in frontend or sent to backend.
|
||||
|
||||
Those functions may also be composed in even higher level actions. For example
|
||||
a "update shape attr" action may use "unapply token" actions when the attribute
|
||||
has an applied token.
|
||||
|
||||
```clojure
|
||||
(defn generate-instantiate-component
|
||||
"Generate changes to create a new instance from a component."
|
||||
([changes objects file-id component-id position page libraries]
|
||||
(generate-instantiate-component changes objects file-id component-id position page libraries nil nil nil {}))
|
||||
([changes objects file-id component-id position page libraries old-id parent-id frame-id
|
||||
{:keys [force-frame?]
|
||||
:or {force-frame? false}}]
|
||||
(let [component (ctf/get-component libraries file-id component-id)
|
||||
library (get libraries file-id)
|
||||
parent (when parent-id (get objects parent-id))
|
||||
|
||||
[...]
|
||||
|
||||
[new-shape new-shapes]
|
||||
(ctn/make-component-instance page
|
||||
component
|
||||
(:data library)
|
||||
position
|
||||
(cond-> {}
|
||||
force-frame?
|
||||
(assoc :force-frame-id frame-id)))
|
||||
|
||||
[...]
|
||||
|
||||
changes
|
||||
(reduce #(pcb/add-object %1 %2 {:ignore-touched true})
|
||||
changes
|
||||
(rest new-shapes))]
|
||||
|
||||
[new-shape changes])))
|
||||
```
|
||||
|
||||
## Data events
|
||||
|
||||
```text
|
||||
▾ frontend/
|
||||
▾ src/app/main/data/
|
||||
▾ dashboard/
|
||||
▾ viewer/
|
||||
▾ workspace/
|
||||
```
|
||||
|
||||
This is the intersection of the logic and the presentation in Penpot. Data
|
||||
events belong to the presentation interface and they manage the global state of
|
||||
the application. But they may also work on loaded files by using **File** or
|
||||
**Abstract Data Types** operations to query the data, and by creating and
|
||||
commiting **changes** via the **Business logic** generate functions.
|
||||
|
||||
**IMPORTANT: data events must not contain business logic theirselves**, or
|
||||
directly manipulate data structures. They only may modify or query the global
|
||||
state, and delegate all logic to lower level functions.
|
||||
|
||||
In current Penpot code, there is some quantity of business logic in data events,
|
||||
that should be progressively moved elsewhere as we keep refactoring.
|
||||
|
||||
```clojure
|
||||
(defn detach-component
|
||||
"Remove all references to components in the shape with the given id,
|
||||
and all its children, at the current page."
|
||||
[id]
|
||||
(dm/assert! (uuid? id))
|
||||
(ptk/reify ::detach-component
|
||||
ptk/WatchEvent
|
||||
(watch [it state _]
|
||||
(let [page-id (:current-page-id state)
|
||||
file-id (:current-file-id state)
|
||||
|
||||
fdata (dsh/lookup-file-data state file-id)
|
||||
libraries (dsh/lookup-libraries state)
|
||||
|
||||
changes (-> (pcb/empty-changes it)
|
||||
(cll/generate-detach-component id fdata page-id libraries))]
|
||||
|
||||
(rx/of (dch/commit-changes changes))))))
|
||||
```
|
||||
@@ -1,5 +1,5 @@
|
||||
---
|
||||
title: 3.1. Architecture
|
||||
title: 3.01. Architecture
|
||||
---
|
||||
|
||||
# Architecture
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
---
|
||||
title: 3.6. Backend Guide
|
||||
title: 3.06. Backend Guide
|
||||
---
|
||||
|
||||
# Backend guide #
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
---
|
||||
title: 3.4. Common Guide
|
||||
title: 3.04. Common Guide
|
||||
---
|
||||
|
||||
# Common guide
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
---
|
||||
title: 3.7. Data Guide
|
||||
title: 3.08. Data Guide
|
||||
---
|
||||
|
||||
# Data Guide
|
||||
@@ -29,217 +29,6 @@ all of this is important in general.
|
||||
Clojure (for example ending it with ? for boolean values), because this may
|
||||
cause problems when exporting.
|
||||
|
||||
## Code organization in abstraction levels
|
||||
|
||||
Initially, Penpot data model implementation was organized in a different way.
|
||||
We are currently in a process of reorganization. The objective is to have data
|
||||
manipulation code structured in abstraction layers, with well-defined
|
||||
boundaries.
|
||||
|
||||
At this moment the namespace structure is already organized as described here,
|
||||
but there is much code that does not comply with these rules, and needs to be
|
||||
moved or refactored. We expect to be refactoring existing modules incrementally,
|
||||
each time we do an important functionality change.
|
||||
|
||||
### Abstract data types
|
||||
|
||||
```text
|
||||
▾ common/
|
||||
▾ src/app/common/
|
||||
▾ types/
|
||||
file.cljc
|
||||
page.cljc
|
||||
shape.cljc
|
||||
color.cljc
|
||||
component.cljc
|
||||
...
|
||||
```
|
||||
|
||||
Namespaces here represent a single data structure, or a fragment of one, as an
|
||||
abstract data type. Each structure has:
|
||||
|
||||
* A **schema spec** that defines the structure of the type and its values:
|
||||
|
||||
```clojure
|
||||
(sm/define! ::fill
|
||||
[:map {:title "Fill"}
|
||||
[:fill-color {:optional true} ::ctc/rgb-color]
|
||||
[:fill-opacity {:optional true} ::sm/safe-number]
|
||||
...)
|
||||
|
||||
(sm/define! ::shape-attrs
|
||||
[:map {:title "ShapeAttrs"}
|
||||
[:name {:optional true} :string]
|
||||
[:selrect {:optional true} ::grc/rect]
|
||||
[:points {:optional true} ::points]
|
||||
[:blocked {:optional true} :boolean]
|
||||
[:fills {:optional true}
|
||||
[:vector {:gen/max 2} ::fill]]
|
||||
...)
|
||||
```
|
||||
|
||||
* **Helper functions** to create, query and manipulate the structure. Helpers
|
||||
at this level only are allowed to see the internal attributes of a type.
|
||||
Updaters receive an object of the type, and return a new object modified,
|
||||
also ensuring the internal integrity of the data after the change.
|
||||
|
||||
```clojure
|
||||
(defn setup-shape
|
||||
"A function that initializes the geometric data of the shape. The props must
|
||||
contain at least :x :y :width :height."
|
||||
[{:keys [type] :as props}]
|
||||
...)
|
||||
|
||||
(defn has-direction?
|
||||
[interaction]
|
||||
(#{:slide :push} (-> interaction :animation :animation-type)))
|
||||
|
||||
(defn set-direction
|
||||
[interaction direction]
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(check-interaction! interaction))
|
||||
(dm/assert!
|
||||
"expected valid direction"
|
||||
(contains? direction-types direction))
|
||||
(dm/assert!
|
||||
"expected compatible interaction map"
|
||||
(has-direction? interaction))
|
||||
(update interaction :animation assoc :direction direction))
|
||||
```
|
||||
|
||||
> IMPORTANT: we should always use helper functions to access and modify these data
|
||||
> structures. Avoid direct attribute read or using functions like <code class="language-clojure">assoc</code> or
|
||||
> <code class="language-clojure">update</code>, even if the information is contained in a single attribute. This way
|
||||
> it will be much simpler to add validation checks or to modify the internal
|
||||
> representation of a type, and will be easier to search for places in the code
|
||||
> where this data item is used.
|
||||
>
|
||||
> Currently much of Penpot code does not follow this requirement, but it
|
||||
should do in new code or in any refactor.
|
||||
|
||||
### File operations
|
||||
|
||||
```text
|
||||
▾ common/
|
||||
▾ src/app/common/
|
||||
▾ files/
|
||||
helpers.cljc
|
||||
shapes_helpers.cljc
|
||||
...
|
||||
```
|
||||
|
||||
Functions that modify a file object (or a part of it) in place, returning the
|
||||
file object changed. They ensure the referential integrity within the file, or
|
||||
between a file and its libraries.
|
||||
|
||||
```clojure
|
||||
(defn resolve-component
|
||||
"Retrieve the referenced component, from the local file or from a library"
|
||||
[shape file libraries & {:keys [include-deleted?] :or {include-deleted? False}}]
|
||||
(if (= (:component-file shape) (:id file))
|
||||
(ctkl/get-component (:data file) (:component-id shape) include-deleted?)
|
||||
(get-component libraries
|
||||
(:component-file shape)
|
||||
(:component-id shape)
|
||||
:include-deleted? include-deleted?)))
|
||||
|
||||
(defn delete-component
|
||||
"Mark a component as deleted and store the main instance shapes inside it, to
|
||||
be able to be recovered later."
|
||||
[file-data component-id skip-undelete? Main-instance]
|
||||
(let [components-v2 (dm/get-in file-data [:options :components-v2])]
|
||||
(if (or (not components-v2) skip-undelete?)
|
||||
(ctkl/delete-component file-data component-id)
|
||||
(let [set-main-instance ;; If there is a saved main-instance, restore it.
|
||||
#(if main-instance
|
||||
(assoc-in % [:objects (:main-instance-id %)] main-instance)
|
||||
%)]
|
||||
(-> file-data
|
||||
(ctkl/update-component component-id load-component-objects)
|
||||
(ctkl/update-component component-id set-main-instance)
|
||||
(ctkl/mark-component-deleted component-id))))))
|
||||
```
|
||||
|
||||
> This module is still needing an important refactor. Mainly to take functions
|
||||
> from common.types and move them here.
|
||||
|
||||
#### File validation and repair
|
||||
|
||||
There is a function in <code class="language-clojure">app.common.files.validate</code> that checks a file for
|
||||
referential and semantic integrity. It's called automatically when file changes
|
||||
are sent to backend, but may be invoked manually whenever it's needed.
|
||||
|
||||
### File changes objects
|
||||
|
||||
```text
|
||||
▾ common/
|
||||
▾ src/app/common/
|
||||
▾ files/
|
||||
changes_builder.cljc
|
||||
changes.cljc
|
||||
...
|
||||
```
|
||||
|
||||
Wrap the update functions in file operations module into <code class="language-clojure">changes</code> objects, that
|
||||
may be serialized, stored, sent to backend and executed to actually modify a file
|
||||
object. They should not contain business logic or algorithms. Only adapt the
|
||||
interface to the file operations or types.
|
||||
|
||||
```clojure
|
||||
(sm/define! ::changes
|
||||
[:map {:title "changes"}
|
||||
[: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?]])
|
||||
|
||||
(defmethod process-change :add-component
|
||||
[file-data params]
|
||||
(ctkl/add-component file-data params))
|
||||
```
|
||||
|
||||
### Business logic
|
||||
|
||||
```text
|
||||
▾ common/
|
||||
▾ src/app/common/
|
||||
▾ logic/
|
||||
shapes.cljc
|
||||
libraries.cljc
|
||||
```
|
||||
|
||||
Functions that implement semantic user actions, in an abstract way (independent
|
||||
of UI). They don't directly modify files, but generate changes objects, that
|
||||
may be executed in frontend or sent to backend.
|
||||
|
||||
```clojure
|
||||
(defn generate-instantiate-component
|
||||
"Generate changes to create a new instance from a component."
|
||||
[changes objects file-id component-id position page libraries old-id parent-id
|
||||
frame-id {:keys [force-frame?] :or {force-frame? False}}]
|
||||
(let [component (ctf/get-component libraries file-id component-id)
|
||||
parent (when parent-id (get objects parent-id))
|
||||
library (get libraries file-id)
|
||||
components-v2 (dm/get-in library [:data :options :components-v2])
|
||||
[new-shape new-shapes]º
|
||||
(ctn/make-component-instance page
|
||||
Component
|
||||
(:data library)
|
||||
Position
|
||||
Components-v2
|
||||
(cond-> {}
|
||||
force-frame? (assoc :force-frame-id frame-id)))
|
||||
changes (cond-> (pcb/add-object changes first-shape {:ignore-touched true})
|
||||
(some? old-id) (pcb/amend-last-change #(assoc % :old-id old-id)))
|
||||
changes (reduce #(pcb/add-object %1 %2 {:ignore-touched true})
|
||||
changes
|
||||
(rest new-shapes))]
|
||||
[new-shape changes]))
|
||||
```
|
||||
|
||||
## Data migrations
|
||||
|
||||
```text
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
---
|
||||
title: 3.2. Data model
|
||||
title: 3.02. Data model
|
||||
---
|
||||
|
||||
# Penpot Data Model
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
---
|
||||
title: 3.3. Dev environment
|
||||
title: 3.03. Dev environment
|
||||
---
|
||||
|
||||
# Development environment
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
---
|
||||
title: 3.5. Frontend Guide
|
||||
title: 3.05. Frontend Guide
|
||||
---
|
||||
|
||||
# Frontend Guide
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
---
|
||||
title: 3.8. Penpot subsystems
|
||||
title: 3.09. Penpot subsystems
|
||||
---
|
||||
|
||||
# Penpot subsystems
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
---
|
||||
title: 3.9. UI Guide
|
||||
title: 3.10. UI Guide
|
||||
---
|
||||
|
||||
# UI Guide
|
||||
|
||||
@@ -1,13 +1,11 @@
|
||||
---
|
||||
title: 1.1 Recommended Settings
|
||||
title: 1.1 Recommended storage
|
||||
---
|
||||
|
||||
# Recommended settings
|
||||
# Recommended storage
|
||||
|
||||
To self-host Penpot, you’ll need a server with the following specifications:
|
||||
Disk requirements depend on your usage, with the primary factors being database storage and user-uploaded files.
|
||||
|
||||
* **CPU:** 1-2 CPUs
|
||||
* **RAM:** 4 GiB of RAM
|
||||
* **Disk Space:** Disk requirements depend on your usage. Disk usage primarily involves the database and any files uploaded by users.
|
||||
As a rule of thumb, start with a **minimum** database size of **50GB** to **100GB** with elastic sizing capability — this configuration should adequately support up to 10 editors. For environments with **more than 10 users**, we recommend adding approximately **5GB** of capacity per additional editor.
|
||||
|
||||
This setup should be sufficient for a smooth experience with typical usage (your mileage may vary).
|
||||
Keep in mind that database size doesn't grow strictly proportionally with user count, as it depends heavily on how Penpot is used and the complexity of files created. Most organizations begin with this baseline and elastic sizing approach, then monitor usage patterns monthly until resource requirements stabilize.
|
||||
|
||||
@@ -18,6 +18,7 @@ const preview = {
|
||||
decorators: decorators,
|
||||
parameters: {
|
||||
controls: {
|
||||
disableSaveFromUI: true,
|
||||
matchers: {
|
||||
color: /(background|color)$/i,
|
||||
date: /Date$/i,
|
||||
|
||||
@@ -42,7 +42,7 @@
|
||||
:dev
|
||||
{:extra-paths ["dev"]
|
||||
:extra-deps
|
||||
{thheller/shadow-cljs {:mvn/version "2.28.18"}
|
||||
{thheller/shadow-cljs {:mvn/version "3.0.3"}
|
||||
com.bhauman/rebel-readline {:mvn/version "RELEASE"}
|
||||
org.clojure/tools.namespace {:mvn/version "RELEASE"}
|
||||
criterium/criterium {:mvn/version "RELEASE"}
|
||||
|
||||
@@ -25,6 +25,7 @@
|
||||
"build:app:libs": "node ./scripts/build-libs.js",
|
||||
"build:app:main": "clojure -M:dev:shadow-cljs release main worker",
|
||||
"build:app": "yarn run clear:shadow-cache && yarn run build:app:main && yarn run build:app:libs",
|
||||
"build:library": "yarn run clear:shadow-cache && clojure -M:dev:shadow-cljs release library",
|
||||
"e2e:server": "node ./scripts/e2e-server.js",
|
||||
"fmt:clj": "cljfmt fix --parallel=true src/ test/",
|
||||
"fmt:clj:check": "cljfmt check --parallel=false src/ test/",
|
||||
@@ -44,6 +45,7 @@
|
||||
"watch:app:main": "clojure -M:dev:shadow-cljs watch main worker storybook",
|
||||
"clear:shadow-cache": "rm -rf .shadow-cljs",
|
||||
"watch:app": "yarn run clear:shadow-cache && concurrently \"yarn run watch:app:main\" \"yarn run watch:app:libs\"",
|
||||
"watch:library": "yarn run clear:shadow-cache && clojure -M:dev:shadow-cljs watch library",
|
||||
"watch": "yarn run watch:app:assets",
|
||||
"watch:storybook": "concurrently \"storybook dev -p 6006 --no-open\" \"yarn run watch:storybook:assets\"",
|
||||
"watch:storybook:assets": "node ./scripts/watch-storybook.js"
|
||||
@@ -89,7 +91,7 @@
|
||||
"rimraf": "^6.0.1",
|
||||
"sass": "^1.83.4",
|
||||
"sass-embedded": "^1.83.4",
|
||||
"shadow-cljs": "2.28.20",
|
||||
"shadow-cljs": "3.0.3",
|
||||
"storybook": "^8.5.2",
|
||||
"svg-sprite": "^2.0.4",
|
||||
"typescript": "^5.7.3",
|
||||
|
||||
26
frontend/playwright/data/get-teams-render-wasm.json
Normal file
26
frontend/playwright/data/get-teams-render-wasm.json
Normal file
@@ -0,0 +1,26 @@
|
||||
[
|
||||
{
|
||||
"~:features": {
|
||||
"~#set": [
|
||||
"render-wasm",
|
||||
"layout/grid",
|
||||
"styles/v2",
|
||||
"fdata/pointer-map",
|
||||
"fdata/objects-map",
|
||||
"components/v2",
|
||||
"fdata/shape-data-type"
|
||||
]
|
||||
},
|
||||
"~:permissions": {
|
||||
"~:type": "~:membership",
|
||||
"~:is-owner": true,
|
||||
"~:is-admin": true,
|
||||
"~:can-edit": true
|
||||
},
|
||||
"~:name": "Default",
|
||||
"~:modified-at": "~m1713533116375",
|
||||
"~:id": "~uc7ce0794-0992-8105-8004-38e630f7920a",
|
||||
"~:created-at": "~m1713533116375",
|
||||
"~:is-default": true
|
||||
}
|
||||
]
|
||||
@@ -448,55 +448,7 @@
|
||||
},
|
||||
"~:rotation": 0,
|
||||
"~:grow-type": "~:fixed",
|
||||
"~:content": [
|
||||
{
|
||||
"~:command": "~:move-to",
|
||||
"~:params": {
|
||||
"~:x": 1121,
|
||||
"~:y": 554
|
||||
}
|
||||
},
|
||||
{
|
||||
"~:command": "~:line-to",
|
||||
"~:params": {
|
||||
"~:x": 1229,
|
||||
"~:y": 458
|
||||
}
|
||||
},
|
||||
{
|
||||
"~:command": "~:curve-to",
|
||||
"~:params": {
|
||||
"~:x": 1303,
|
||||
"~:y": 518,
|
||||
"~:c1x": 1229,
|
||||
"~:c1y": 458,
|
||||
"~:c2x": 1320,
|
||||
"~:c2y": 492
|
||||
}
|
||||
},
|
||||
{
|
||||
"~:command": "~:curve-to",
|
||||
"~:params": {
|
||||
"~:x": 1219,
|
||||
"~:y": 584,
|
||||
"~:c1x": 1286,
|
||||
"~:c1y": 544,
|
||||
"~:c2x": 1258,
|
||||
"~:c2y": 572
|
||||
}
|
||||
},
|
||||
{
|
||||
"~:command": "~:curve-to",
|
||||
"~:params": {
|
||||
"~:x": 1121,
|
||||
"~:y": 554,
|
||||
"~:c1x": 1180,
|
||||
"~:c1y": 596,
|
||||
"~:c2x": 1121,
|
||||
"~:c2y": 554
|
||||
}
|
||||
}
|
||||
],
|
||||
"~:content": ["~#penpot/path-data","~bAQAAAAAAAAAAAAAAAAAAAAAAAAAAIIxEAIAKRAIAAAAAAAAAAAAAAAAAAAAAAAAAAKCZRAAA5UMDAAAAAKCZRAAA5UMAAKVEAAD2QwDgokQAgAFEAwAAAADAoEQAAAhEAECdRAAAD0QAYJhEAAASRAMAAAAAgJNEAAAVRAAgjEQAgApEACCMRACACkQ="],
|
||||
"~:name": "Path",
|
||||
"~:width": null,
|
||||
"~:type": "~:path",
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -9,7 +9,7 @@ export class OnboardingPage extends BaseWebSocketPage {
|
||||
async fillOnboardingInputsStep1() {
|
||||
await this.page.getByText("Personal").click();
|
||||
await this.page.getByText("Select option").click();
|
||||
await this.page.getByText("Testing before self-hosting").click();
|
||||
await this.page.getByText("Product Managment").click();
|
||||
|
||||
await this.submitButton.click();
|
||||
}
|
||||
@@ -21,24 +21,8 @@ export class OnboardingPage extends BaseWebSocketPage {
|
||||
}
|
||||
|
||||
async fillOnboardingInputsStep3() {
|
||||
await this.page.getByText("Select option").first().click();
|
||||
await this.page.getByText("Product Managment").click();
|
||||
await this.page.getByText("Select option").first().click();
|
||||
await this.page.getByText("Director").click();
|
||||
await this.page.getByText("Select option").click();
|
||||
await this.page.getByText("11-30").click();
|
||||
|
||||
await this.submitButton.click();
|
||||
}
|
||||
|
||||
async fillOnboardingInputsStep4() {
|
||||
await this.page.getByText("Other").click();
|
||||
await this.page.getByPlaceholder("Other (specify)").fill("Another");
|
||||
await this.submitButton.click();
|
||||
}
|
||||
|
||||
async fillOnboardingInputsStep5() {
|
||||
await this.page.getByText("Event").click();
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -26,20 +26,11 @@ test("User can complete the onboarding", async ({ page }) => {
|
||||
).toBeVisible();
|
||||
|
||||
await onboardingPage.fillOnboardingInputsStep2();
|
||||
await expect(
|
||||
page.getByRole("heading", { name: "Tell us about your job" }),
|
||||
).toBeVisible();
|
||||
|
||||
await onboardingPage.fillOnboardingInputsStep3();
|
||||
await expect(
|
||||
page.getByRole("heading", { name: "Where would you like to get" }),
|
||||
).toBeVisible();
|
||||
|
||||
await onboardingPage.fillOnboardingInputsStep4();
|
||||
await expect(
|
||||
page.getByRole("heading", { name: "How did you hear about Penpot?" }),
|
||||
).toBeVisible();
|
||||
await onboardingPage.fillOnboardingInputsStep3();
|
||||
|
||||
await onboardingPage.fillOnboardingInputsStep5();
|
||||
await expect(page.getByRole("button", { name: "Start" })).toBeEnabled();
|
||||
});
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user