mirror of
https://github.com/penpot/penpot.git
synced 2026-01-22 21:30:09 -05:00
Compare commits
1 Commits
rsanchez-d
...
2.6.2
| Author | SHA1 | Date | |
|---|---|---|---|
|
c2b13a6d5d |
62
CHANGES.md
62
CHANGES.md
@@ -1,66 +1,6 @@
|
||||
# CHANGELOG
|
||||
|
||||
## 2.8.0 (Next / Unreleased)
|
||||
|
||||
### :rocket: Epics and highlights
|
||||
|
||||
### :boom: Breaking changes & Deprecations
|
||||
|
||||
### :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
|
||||
|
||||
### :boom: Breaking changes & Deprecations
|
||||
|
||||
### :heart: Community contributions (Thank you!)
|
||||
|
||||
### :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)
|
||||
- Fix problem in viewer with the back button [Taiga #10907](https://tree.taiga.io/project/penpot/issue/10907)
|
||||
|
||||
### :bug: Bugs fixed
|
||||
- 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)
|
||||
- Fix design tab has a horizontal scroll [Taiga #10660](https://tree.taiga.io/project/penpot/issue/10660)
|
||||
- Fix long file names being clipped when longer than allowed length [Taiga #10662](https://tree.taiga.io/project/penpot/issue/10662)
|
||||
- Fix problem with error detail in toast [Taiga #10519](https://tree.taiga.io/project/penpot/issue/10519)
|
||||
- Fix view mode error when an external user tries to export something from a prototype using a shared link [Taiga #10251](https://tree.taiga.io/project/penpot/issue/10251)
|
||||
- Fix merge path nodes with only one node selected [Taiga #9626](https://tree.taiga.io/project/penpot/issue/9626)
|
||||
- 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)
|
||||
|
||||
## 2.6.2 (Unreleased)
|
||||
## 2.6.2
|
||||
|
||||
### :bug: Bugs fixed
|
||||
|
||||
|
||||
39
README.md
39
README.md
@@ -16,18 +16,18 @@
|
||||
</p>
|
||||
|
||||
<p align="center">
|
||||
<a href="https://penpot.app/"><b>Website</b></a> •
|
||||
<a href="https://help.penpot.app/user-guide/"><b>User Guide</b></a> •
|
||||
<a href="https://penpot.app/learning-center"><b>Learning Center</b></a> •
|
||||
<a href="https://penpot.app/"><b>Website</b></a> •
|
||||
<a href="https://help.penpot.app/technical-guide/getting-started/"><b>Getting Started</b></a> •
|
||||
<a href="https://help.penpot.app/user-guide/"><b>User Guide</b></a> •
|
||||
<a href="https://help.penpot.app/user-guide/introduction/info/"><b>Tutorials & Info</b></a> •
|
||||
<a href="https://community.penpot.app/"><b>Community</b></a>
|
||||
</p>
|
||||
<p align="center">
|
||||
<a href="https://www.youtube.com/@Penpot"><b>Youtube</b></a> •
|
||||
<a href="https://peertube.kaleidos.net/a/penpot_app/video-channels"><b>Peertube</b></a> •
|
||||
<a href="https://www.linkedin.com/company/penpot/"><b>Linkedin</b></a> •
|
||||
<a href="https://instagram.com/penpot.app"><b>Instagram</b></a> •
|
||||
<a href="https://fosstodon.org/@penpot/"><b>Mastodon</b></a> •
|
||||
<a href="https://bsky.app/profile/penpot.app"><b>Bluesky</b></a> •
|
||||
<a href="https://www.youtube.com/@Penpot"><b>Youtube</b></a> •
|
||||
<a href="https://peertube.kaleidos.net/a/penpot_app/video-channels"><b>Peertube</b></a> •
|
||||
<a href="https://www.linkedin.com/company/penpot/"><b>Linkedin</b></a> •
|
||||
<a href="https://instagram.com/penpot.app"><b>Instagram</b></a> •
|
||||
<a href="https://fosstodon.org/@penpot/"><b>Mastodon</b></a> •
|
||||
<a href="https://twitter.com/penpotapp"><b>X</b></a>
|
||||
|
||||
</p>
|
||||
@@ -40,13 +40,12 @@
|
||||
|
||||
Penpot is the first **open-source** design tool for design and code collaboration. Designers can create stunning designs, interactive prototypes, design systems at scale, while developers enjoy ready-to-use code and make their workflow easy and fast. And all of this with no handoff drama.
|
||||
|
||||
Available on browser or self-hosted, Penpot works with open standards like SVG, CSS, HTML and JSON, and it’s free!
|
||||
Penpot is available on browser and [self host](https://penpot.app/self-host). It’s web-based and works with open standards (SVG, CSS and HTML). And last but not least, it’s free!
|
||||
|
||||
The latest updates take Penpot even further. It’s the first design tool to integrate native [design tokens](https://penpot.dev/collaboration/design-tokens)—a single source of truth to improve efficiency and collaboration between product design and development.
|
||||
With the [huge 2.0 release](https://penpot.app/dev-diaries), Penpot took the platform to a whole new level. This update introduces the ground-breaking [CSS Grid Layout feature](https://penpot.app/penpot-2.0), a complete UI redesign, a new Components system, and much more.
|
||||
For organizations that need extra service for its teams, [get in touch](https://cal.com/team/penpot/talk-to-us)
|
||||
Penpot’s latest [huge release 2.0](https://penpot.app/dev-diaries), takes the platform to a whole new level. This update introduces the ground-breaking [CSS Grid Layout feature](https://penpot.app/penpot-2.0), a complete UI redesign, a new Components system, and much more. Plus, it's faster and more accessible.
|
||||
|
||||
🎇 Design, code, and Open Source meet at [Penpot Fest](https://penpot.app/penpotfest)! Be part of the 2025 edition in Madrid, Spain, on October 9-10.
|
||||
|
||||
🎇 **Penpot Fest** is our design, code & Open Source event. Check out the highlights from [Penpot Fest 2023 edition](https://www.youtube.com/watch?v=sOpLZaK5mDc)!
|
||||
|
||||
## Table of contents ##
|
||||
|
||||
@@ -62,7 +61,7 @@ For organizations that need extra service for its teams, [get in touch](https://
|
||||
Penpot expresses designs as code. Designers can do their best work and see it will be beautifully implemented by developers in a two-way collaboration.
|
||||
|
||||
### Plugin system ###
|
||||
[Penpot plugins](https://penpot.app/penpothub/plugins) let you expand the platform's capabilities, give you the flexibility to integrate it with other apps, and design custom solutions.
|
||||
[Penpot plugins](https://penpot.app/penpothub/plugins) let you expand the platform's capabilities, give you the flexibility to integrate it with other apps, and design custom solutions.
|
||||
|
||||
### Designed for developers ###
|
||||
Penpot was built to serve both designers and developers and create a fluid design-code process. You have the choice to enjoy real-time collaboration or play "solo".
|
||||
@@ -79,10 +78,6 @@ Penpot offers integration into the development toolchain, thanks to its support
|
||||
### What’s great for design ###
|
||||
With Penpot you can design libraries to share and reuse; turn design elements into components and tokens to allow reusability and scalability; and build realistic user flows and interactions.
|
||||
|
||||
### Design Tokens ###
|
||||
With Penpot’s standardized [design tokens](https://penpot.dev/collaboration/design-tokens) format, you can easily reuse and sync tokens across different platforms, workflows, and disciplines.
|
||||
|
||||
|
||||
<br />
|
||||
|
||||
<p align="center">
|
||||
@@ -130,13 +125,13 @@ You will find the following categories:
|
||||
|
||||
## Contributing ##
|
||||
|
||||
Any contribution will make a difference to improve Penpot. How can you get involved?
|
||||
Any contribution will make a difference to improve Penpot. How can you get involved?
|
||||
|
||||
Choose your way:
|
||||
Choose your way:
|
||||
|
||||
- Create and [share Libraries & Templates](https://penpot.app/libraries-templates.html) that will be helpful for the community
|
||||
- Invite your [team to join](https://design.penpot.app/#/auth/register)
|
||||
- Give this repo a star and follow us on Social Media: [Mastodon](https://fosstodon.org/@penpot/), [Youtube](https://www.youtube.com/c/Penpot), [Instagram](https://instagram.com/penpot.app), [Linkedin](https://www.linkedin.com/company/penpotdesign), [Peertube](https://peertube.kaleidos.net/a/penpot_app), [X](https://twitter.com/penpotapp) and [BlueSky](https://bsky.app/profile/penpot.app)
|
||||
- Star this repo and follow us on Social Media: [Mastodon](https://fosstodon.org/@penpot/), [Youtube](https://www.youtube.com/c/Penpot), [Instagram](https://instagram.com/penpot.app), [Linkedin](https://www.linkedin.com/company/penpotdesign), [Peertube](https://peertube.kaleidos.net/a/penpot_app) and [X](https://twitter.com/penpotapp).
|
||||
- Participate in the [Community](https://community.penpot.app/) space by asking and answering questions; reacting to others’ articles; opening your own conversations and following along on decisions affecting the project.
|
||||
- Report bugs with our easy [guide for bugs hunting](https://help.penpot.app/contributing-guide/reporting-bugs/) or [GitHub issues](https://github.com/penpot/penpot/issues)
|
||||
- Become a [translator](https://help.penpot.app/contributing-guide/translations)
|
||||
|
||||
@@ -35,35 +35,40 @@ def get_prepl_conninfo():
|
||||
|
||||
return host, port
|
||||
|
||||
def send(data):
|
||||
def send_eval(expr):
|
||||
host, port = get_prepl_conninfo()
|
||||
with socket.create_connection((host, port)) as s:
|
||||
f = s.makefile(mode="rw")
|
||||
|
||||
json.dump(data, f)
|
||||
f.write("\n")
|
||||
f.flush()
|
||||
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")
|
||||
|
||||
while True:
|
||||
line = f.readline()
|
||||
result = json.loads(line)
|
||||
tag = result.get("tag", None)
|
||||
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")
|
||||
|
||||
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 encode(val):
|
||||
return json.dumps(json.dumps(val))
|
||||
|
||||
def print_error(error):
|
||||
print("ERR:", error["hint"])
|
||||
def print_error(res):
|
||||
for error in res["via"]:
|
||||
print("ERR:", error["message"])
|
||||
break
|
||||
|
||||
def run_cmd(params):
|
||||
try:
|
||||
res, err = send(params)
|
||||
if err:
|
||||
print_error(err)
|
||||
expr = "(app.srepl.cli/exec {})".format(encode(params))
|
||||
res, failed = send_eval(expr)
|
||||
if failed:
|
||||
print_error(res)
|
||||
sys.exit(-1)
|
||||
|
||||
return res
|
||||
@@ -91,7 +96,7 @@ def update_profile(email, fullname, password, is_active):
|
||||
"email": email,
|
||||
"fullname": fullname,
|
||||
"password": password,
|
||||
"isActive": is_active
|
||||
"is_active": is_active
|
||||
}
|
||||
}
|
||||
|
||||
@@ -133,7 +138,7 @@ def derive_password(password):
|
||||
params = {
|
||||
"cmd": "derive-password",
|
||||
"params": {
|
||||
"password": password
|
||||
"password": password,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -31,8 +31,7 @@ export PENPOT_FLAGS="\
|
||||
enable-tiered-file-data-storage \
|
||||
enable-file-validation \
|
||||
enable-file-schema-validation \
|
||||
enable-subscriptons \
|
||||
enable-subscriptons-old";
|
||||
enable-subscriptions-old";
|
||||
|
||||
# Default deletion delay for devenv
|
||||
export PENPOT_DELETION_DELAY="24h"
|
||||
@@ -72,18 +71,15 @@ export PENPOT_OBJECTS_STORAGE_S3_ENDPOINT=http://minio:9000
|
||||
export PENPOT_OBJECTS_STORAGE_S3_BUCKET=penpot
|
||||
export PENPOT_OBJECTS_STORAGE_FS_DIRECTORY="assets"
|
||||
|
||||
export JAVA_OPTS="\
|
||||
export JAVA_OPTS="--enable-preview \
|
||||
-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:-OmitStackTraceInFastThrow \
|
||||
-XX:+UnlockDiagnosticVMOptions \
|
||||
-XX:+DebugNonSafepoints \
|
||||
--sun-misc-unsafe-memory-access=allow \
|
||||
--enable-preview \
|
||||
--enable-native-access=ALL-UNNAMED";
|
||||
-XX:+DebugNonSafepoints";
|
||||
|
||||
export OPTIONS="-A:jmx-remote -A:dev"
|
||||
|
||||
|
||||
@@ -18,7 +18,7 @@ if [ -f ./environ ]; then
|
||||
source ./environ
|
||||
fi
|
||||
|
||||
export JVM_OPTS="-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -Dlog4j2.configurationFile=log4j2.xml -XX:-OmitStackTraceInFastThrow --enable-native-access=ALL-UNNAMED --enable-preview $JVM_OPTS"
|
||||
export JVM_OPTS="-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -Dlog4j2.configurationFile=log4j2.xml -XX:-OmitStackTraceInFastThrow --enable-preview $JVM_OPTS"
|
||||
|
||||
ENTRYPOINT=${1:-app.main};
|
||||
|
||||
|
||||
@@ -24,8 +24,18 @@ export PENPOT_FLAGS="\
|
||||
enable-tiered-file-data-storage \
|
||||
enable-file-validation \
|
||||
enable-file-schema-validation \
|
||||
enable-subscriptons \
|
||||
enable-subscriptons-old ";
|
||||
enable-subscriptions-old";
|
||||
|
||||
export OPTIONS="
|
||||
-A:jmx-remote -A:dev \
|
||||
-J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
|
||||
-J-Djdk.attach.allowAttachSelf \
|
||||
-J-Dpolyglot.engine.WarnInterpreterOnly=false \
|
||||
-J-Dlog4j2.configurationFile=log4j2-devenv.xml \
|
||||
-J-XX:+EnableDynamicAgentLoading \
|
||||
-J-XX:-OmitStackTraceInFastThrow \
|
||||
-J-XX:+UnlockDiagnosticVMOptions \
|
||||
-J-XX:+DebugNonSafepoints"
|
||||
|
||||
# Default deletion delay for devenv
|
||||
export PENPOT_DELETION_DELAY="24h"
|
||||
@@ -56,20 +66,6 @@ export PENPOT_OBJECTS_STORAGE_S3_BUCKET=penpot
|
||||
|
||||
entrypoint=${1:-app.main};
|
||||
|
||||
export JAVA_OPTS="\
|
||||
-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
|
||||
-Djdk.attach.allowAttachSelf \
|
||||
-Dlog4j2.configurationFile=log4j2-devenv.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:jmx-remote -A:dev"
|
||||
|
||||
set -ex
|
||||
clojure $OPTIONS -M -m $entrypoint;
|
||||
|
||||
clojure $OPTIONS -A:dev -M -m $entrypoint;
|
||||
|
||||
@@ -11,25 +11,6 @@
|
||||
[app.common.data :as d]
|
||||
[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;
|
||||
|
||||
@@ -434,12 +434,12 @@
|
||||
(d/without-nils))))))
|
||||
|
||||
(defn encode-file
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id features] :as file}]
|
||||
(let [file (if (contains? features "fdata/objects-map")
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
|
||||
(let [file (if (contains? (:features file) "fdata/objects-map")
|
||||
(feat.fdata/enable-objects-map file)
|
||||
file)
|
||||
|
||||
file (if (contains? features "fdata/pointer-map")
|
||||
file (if (contains? (:features file) "fdata/pointer-map")
|
||||
(binding [pmap/*tracked* (pmap/create-tracked)]
|
||||
(let [file (feat.fdata/enable-pointer-map file)]
|
||||
(feat.fdata/persist-pointers! cfg id)
|
||||
|
||||
@@ -603,20 +603,10 @@
|
||||
(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))]
|
||||
@@ -651,10 +641,10 @@
|
||||
(->> (keep (match-shape-entry-fn file-id page-id) entries)
|
||||
(reduce (fn [result {:keys [id entry]}]
|
||||
(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)))
|
||||
@@ -765,6 +755,7 @@
|
||||
;; only the applied
|
||||
(vary-meta dissoc ::fmg/migrated))]
|
||||
|
||||
|
||||
(bfm/register-pending-migrations! cfg file)
|
||||
(bfc/save-file! cfg file ::db/return-keys false)
|
||||
|
||||
|
||||
@@ -42,8 +42,6 @@
|
||||
org.postgresql.util.PGInterval
|
||||
org.postgresql.util.PGobject))
|
||||
|
||||
(def ^:dynamic *conn* nil)
|
||||
|
||||
(declare open)
|
||||
(declare create-pool)
|
||||
|
||||
|
||||
@@ -20,6 +20,7 @@
|
||||
[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]
|
||||
@@ -35,9 +36,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]
|
||||
@@ -126,10 +127,10 @@
|
||||
(sm/lazy-validator ::ctsx/content))
|
||||
|
||||
(def valid-path-content?
|
||||
(sm/lazy-validator ::path/segments))
|
||||
(sm/lazy-validator ::ctsp/content))
|
||||
|
||||
(def valid-path-segment?
|
||||
(sm/lazy-validator ::path/segment))
|
||||
(sm/lazy-validator ::ctsp/segment))
|
||||
|
||||
(def valid-rgb-color-string?
|
||||
(sm/lazy-validator ::ctc/rgb-color))
|
||||
@@ -579,10 +580,12 @@
|
||||
(let [shape (update shape :content fix-path-content)]
|
||||
(if (not (valid-path-content? (:content shape)))
|
||||
shape
|
||||
(-> shape
|
||||
(dissoc :bool-content)
|
||||
(dissoc :bool-type)
|
||||
(path/update-geometry))))
|
||||
(let [[points selrect] (gshp/content->points+selrect shape (:content shape))]
|
||||
(-> shape
|
||||
(dissoc :bool-content)
|
||||
(dissoc :bool-type)
|
||||
(assoc :points points)
|
||||
(assoc :selrect selrect)))))
|
||||
|
||||
;; When we fount a bool shape with no content,
|
||||
;; we convert it to a simple rect
|
||||
@@ -1459,6 +1462,8 @@
|
||||
(:objects page)
|
||||
(:id page)
|
||||
file-id
|
||||
true
|
||||
nil
|
||||
cfsh/prepare-create-artboard-from-selection)]
|
||||
|
||||
(shape-cb shape)
|
||||
|
||||
@@ -9,10 +9,7 @@
|
||||
(: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]
|
||||
@@ -33,7 +30,7 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn enable-objects-map
|
||||
[file & _opts]
|
||||
[file]
|
||||
(let [update-page
|
||||
(fn [page]
|
||||
(if (and (pmap/pointer-map? page)
|
||||
@@ -139,56 +136,10 @@
|
||||
|
||||
(defn enable-pointer-map
|
||||
"Enable the fdata/pointer-map feature on the file."
|
||||
[file & _opts]
|
||||
[file]
|
||||
(-> 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,7 +108,6 @@
|
||||
[::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}
|
||||
@@ -119,12 +118,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)
|
||||
@@ -136,14 +135,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,7 +15,6 @@
|
||||
[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]
|
||||
@@ -68,27 +67,18 @@
|
||||
(defmethod ig/init-key ::process-event-handler
|
||||
[_ cfg]
|
||||
(fn [{:keys [props] :as task}]
|
||||
(l/dbg :hint "process webhook event" :name (:name props))
|
||||
|
||||
(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}))))))))))
|
||||
(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})))))))))
|
||||
;; --- RUN
|
||||
|
||||
(declare interpret-exception)
|
||||
|
||||
@@ -231,7 +231,7 @@
|
||||
:hint "email has complaint reports")))
|
||||
|
||||
(defn prepare-register
|
||||
[{:keys [::db/pool] :as cfg} {:keys [email accept-newsletter-updates] :as params}]
|
||||
[{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
|
||||
|
||||
(validate-register-attempt! cfg params)
|
||||
|
||||
@@ -243,8 +243,7 @@
|
||||
:backend "penpot"
|
||||
:iss :prepared-register
|
||||
:profile-id (:id profile)
|
||||
:exp (dt/in-future {:days 7})
|
||||
:props {:newsletter-updates (or accept-newsletter-updates false)}}
|
||||
:exp (dt/in-future {:days 7})}
|
||||
|
||||
params (d/without-nils params)
|
||||
token (tokens/generate (::setup/props cfg) params)]
|
||||
|
||||
@@ -474,7 +474,7 @@
|
||||
(update page :objects update-vals #(dissoc % :thumbnail)))
|
||||
|
||||
(defn get-page
|
||||
[{:keys [::db/conn] :as cfg} {:keys [profile-id file-id page-id object-id share-id] :as params}]
|
||||
[{:keys [::db/conn] :as cfg} {:keys [profile-id file-id page-id object-id] :as params}]
|
||||
|
||||
(when (and (uuid? object-id)
|
||||
(not (uuid? page-id)))
|
||||
@@ -482,30 +482,22 @@
|
||||
:code :params-validation
|
||||
:hint "page-id is required when object-id is provided"))
|
||||
|
||||
(let [perms (get-permissions conn profile-id file-id share-id)
|
||||
(let [team (teams/get-team conn
|
||||
:profile-id profile-id
|
||||
:file-id file-id)
|
||||
|
||||
file (get-file cfg file-id)
|
||||
file (get-file cfg file-id)
|
||||
|
||||
proj (db/get conn :project {:id (:project-id file)})
|
||||
_ (-> (cfeat/get-team-enabled-features cf/flags team)
|
||||
(cfeat/check-client-features! (:features params))
|
||||
(cfeat/check-file-features! (:features file)))
|
||||
|
||||
team (-> (db/get conn :team {:id (:team-id proj)})
|
||||
(teams/decode-row))
|
||||
|
||||
_ (-> (cfeat/get-team-enabled-features cf/flags team)
|
||||
(cfeat/check-client-features! (:features params))
|
||||
(cfeat/check-file-features! (:features file)))
|
||||
|
||||
page (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
|
||||
(let [page-id (or page-id (-> file :data :pages first))
|
||||
page (dm/get-in file [:data :pages-index page-id])]
|
||||
(if (pmap/pointer-map? page)
|
||||
(deref page)
|
||||
page)))]
|
||||
|
||||
(when-not perms
|
||||
(ex/raise :type :not-found
|
||||
:code :object-not-found
|
||||
:hint "object not found"))
|
||||
page (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
|
||||
(let [page-id (or page-id (-> file :data :pages first))
|
||||
page (dm/get-in file [:data :pages-index page-id])]
|
||||
(if (pmap/pointer-map? page)
|
||||
(deref page)
|
||||
page)))]
|
||||
|
||||
(cond-> (prune-thumbnails page)
|
||||
(some? object-id)
|
||||
|
||||
@@ -111,21 +111,18 @@
|
||||
::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-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"))]
|
||||
;; 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)]
|
||||
(db/update! conn :team
|
||||
{:features features}
|
||||
{:id (:id team)}
|
||||
{::db/return-keys false})))
|
||||
{:id team-id})))
|
||||
|
||||
(-> (create-file cfg params)
|
||||
(vary-meta assoc ::audit/props {:team-id team-id}))))
|
||||
|
||||
@@ -177,19 +177,12 @@
|
||||
:stored-revn (:revn file)}))
|
||||
|
||||
;; When newly computed features does not match exactly with
|
||||
;; 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"))]
|
||||
;; the features defined on team row, we update it.
|
||||
(when (not= features (:features team))
|
||||
(let [features (db/create-array conn "text" features)]
|
||||
(db/update! conn :team
|
||||
{:features features}
|
||||
{:id (:id team)}
|
||||
{::db/return-keys false})))
|
||||
|
||||
{:id (:id team)})))
|
||||
|
||||
(mtx/run! metrics {:id :update-file-changes :inc (count changes)})
|
||||
|
||||
|
||||
@@ -76,10 +76,9 @@
|
||||
(perms/make-check-fn has-read-permissions?))
|
||||
|
||||
(defn decode-row
|
||||
[{:keys [features subscription] :as row}]
|
||||
[{:keys [features] :as row}]
|
||||
(cond-> row
|
||||
(some? features) (assoc :features (db/decode-pgarray features #{}))
|
||||
(some? subscription) (assoc :subscription (db/decode-transit-pgobject subscription))))
|
||||
(some? features) (assoc :features (db/decode-pgarray features #{}))))
|
||||
|
||||
;; FIXME: move
|
||||
|
||||
@@ -127,40 +126,16 @@
|
||||
(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")
|
||||
|
||||
(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;")
|
||||
(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")
|
||||
|
||||
(defn process-permissions
|
||||
[team]
|
||||
@@ -175,21 +150,13 @@
|
||||
(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)
|
||||
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))))
|
||||
(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))))
|
||||
|
||||
;; --- Query: Team (by ID)
|
||||
|
||||
|
||||
@@ -6,17 +6,13 @@
|
||||
|
||||
(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 :as cli]
|
||||
[app.srepl.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]))
|
||||
@@ -32,80 +28,17 @@
|
||||
: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 [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))))))
|
||||
(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))))))))
|
||||
|
||||
;; --- State initialization
|
||||
|
||||
|
||||
@@ -9,23 +9,14 @@
|
||||
(: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.setup :as-alias setup]
|
||||
[app.tokens :as tokens]
|
||||
[app.util.json :as json]
|
||||
[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))
|
||||
@@ -33,21 +24,16 @@
|
||||
|
||||
(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]
|
||||
(-> {::cmd (get data :cmd)}
|
||||
(merge (:params data))
|
||||
(exec-command)))
|
||||
(let [data (json/decode data)]
|
||||
(-> {::cmd (keyword (:cmd data "default"))}
|
||||
(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)
|
||||
@@ -63,7 +49,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!
|
||||
@@ -84,12 +70,7 @@
|
||||
:deleted-at nil})]
|
||||
(pos? (db/get-update-count res)))))))))
|
||||
|
||||
(defmethod exec-command "echo"
|
||||
[params]
|
||||
params)
|
||||
|
||||
|
||||
(defmethod exec-command "delete-profile"
|
||||
(defmethod exec-command :delete-profile
|
||||
[{:keys [email soft]}]
|
||||
(when-not email
|
||||
(ex/raise :type :assertion
|
||||
@@ -107,7 +88,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
|
||||
@@ -121,130 +102,12 @@
|
||||
" 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 "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)))
|
||||
(defmethod exec-command :default
|
||||
[{:keys [::cmd]}]
|
||||
(ex/raise :type :internal
|
||||
:code :not-implemented
|
||||
:hint (str/ffmt "command '%' not implemented" (name cmd))))
|
||||
|
||||
@@ -179,7 +179,7 @@
|
||||
component-child (first component-children)]
|
||||
(if (or (nil? child) (nil? component-child))
|
||||
container
|
||||
(let [container (if (and (not (ctk/is-main-of? component-child child))
|
||||
(let [container (if (and (not (ctk/is-main-of? component-child child true))
|
||||
(nil? (ctk/get-swap-slot child))
|
||||
(ctk/instance-head? child))
|
||||
(let [slot (guess-swap-slot component-child component-container)]
|
||||
|
||||
@@ -156,10 +156,6 @@
|
||||
[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)
|
||||
@@ -420,12 +416,10 @@
|
||||
"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}]
|
||||
(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))))))
|
||||
(db/tx-run! (assoc main/system ::db/rollback rollback?)
|
||||
(fn [system]
|
||||
(binding [h/*system* system]
|
||||
(h/process-file! system file-id update-fn opts)))))
|
||||
|
||||
(defn process-team-files!
|
||||
"Apply a function to each file of the specified team."
|
||||
@@ -437,8 +431,7 @@
|
||||
(when (string? label)
|
||||
(h/take-team-snapshot! system team-id label))
|
||||
|
||||
(binding [h/*system* system
|
||||
db/*conn* (db/get-connection system)]
|
||||
(binding [h/*system* 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)
|
||||
|
||||
@@ -6,7 +6,7 @@
|
||||
|
||||
(ns app.common.data.macros
|
||||
"Data retrieval & manipulation specific macros."
|
||||
(:refer-clojure :exclude [get-in select-keys str with-open max])
|
||||
(:refer-clojure :exclude [get-in select-keys str with-open min max])
|
||||
#?(:cljs (:require-macros [app.common.data.macros]))
|
||||
(:require
|
||||
#?(:clj [clojure.core :as c]
|
||||
@@ -144,8 +144,3 @@
|
||||
(str "expr assert: " (pr-str expr)))]
|
||||
(when *assert*
|
||||
`(runtime-assert ~hint (fn [] ~expr))))))
|
||||
|
||||
(defn truncate
|
||||
"Truncates a string to a certain length"
|
||||
[s max-length]
|
||||
(subs s 0 (min max-length (count s))))
|
||||
|
||||
@@ -46,7 +46,6 @@
|
||||
#{"fdata/objects-map"
|
||||
"fdata/pointer-map"
|
||||
"fdata/shape-data-type"
|
||||
"fdata/path-data"
|
||||
"components/v2"
|
||||
"styles/v2"
|
||||
"layout/grid"
|
||||
@@ -59,18 +58,12 @@
|
||||
;; 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
|
||||
@@ -93,9 +86,8 @@
|
||||
;; without migration applied)
|
||||
(def no-migration-features
|
||||
(-> #{"layout/grid"
|
||||
"design-tokens/v1"
|
||||
"fdata/shape-data-type"
|
||||
"fdata/path-data"}
|
||||
"design-tokens/v1"}
|
||||
(into frontend-only-features)
|
||||
(into backend-only-features)))
|
||||
|
||||
@@ -111,7 +103,9 @@
|
||||
"Translate a flag to a feature name"
|
||||
[flag]
|
||||
(case flag
|
||||
:feature-components-v2 "components/v2"
|
||||
:feature-styles-v2 "styles/v2"
|
||||
:feature-grid-layout "layout/grid"
|
||||
:feature-fdata-objects-map "fdata/objects-map"
|
||||
:feature-fdata-pointer-map "fdata/pointer-map"
|
||||
:feature-plugins "plugins/runtime"
|
||||
@@ -222,12 +216,6 @@
|
||||
|
||||
(check-supported-features! file-features)
|
||||
|
||||
;; Components v1 is deprecated
|
||||
(when-not (contains? file-features "components/v2")
|
||||
(ex/raise :type :restriction
|
||||
:code :file-in-components-v1
|
||||
:hint "components v1 is deprecated"))
|
||||
|
||||
(let [not-supported (-> file-features
|
||||
(set/difference enabled-features)
|
||||
(set/difference backend-only-features)
|
||||
|
||||
@@ -11,6 +11,7 @@
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.files.changes :as ch]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.pprint :as pp]
|
||||
[app.common.schema :as sm]
|
||||
@@ -37,12 +38,20 @@
|
||||
fail-on-spec?]
|
||||
:or {add-container? false
|
||||
fail-on-spec? false}}]
|
||||
(let [change (cond-> change
|
||||
add-container?
|
||||
(let [components-v2 (dm/get-in file [:data :options :components-v2])
|
||||
component-id (:current-component-id file)
|
||||
change (cond-> change
|
||||
(and add-container? (some? component-id) (not components-v2))
|
||||
(-> (assoc :component-id component-id)
|
||||
(cond-> (some? (:current-frame-id file))
|
||||
(assoc :frame-id (:current-frame-id file))))
|
||||
|
||||
(and add-container? (or (nil? component-id) components-v2))
|
||||
(assoc :page-id (:current-page-id file)
|
||||
:frame-id (:current-frame-id file)))
|
||||
|
||||
valid? (or (and (nil? (:component-id change))
|
||||
valid? (or (and components-v2
|
||||
(nil? (:component-id change))
|
||||
(nil? (:page-id change)))
|
||||
(ch/valid-change? change))]
|
||||
|
||||
@@ -57,11 +66,11 @@
|
||||
|
||||
(cond-> file
|
||||
(and valid? (or (not add-container?) (some? (:component-id change)) (some? (:page-id change))))
|
||||
(-> (update :changes conjv change)
|
||||
(update :data ch/process-changes [change] false))
|
||||
(-> (update :changes conjv change) ;; In components-v2 we do not add shapes
|
||||
(update :data ch/process-changes [change] false)) ;; inside a component
|
||||
|
||||
(not valid?)
|
||||
(update :errors conjv change)))))
|
||||
(update :errors conjv change)))));)
|
||||
|
||||
(defn- lookup-objects
|
||||
([file]
|
||||
@@ -176,10 +185,12 @@
|
||||
(update :parent-stack conjv (:id obj)))))
|
||||
|
||||
(defn close-artboard [file]
|
||||
(let [parent-id (-> file :parent-stack peek)
|
||||
(let [components-v2 (dm/get-in file [:data :options :components-v2])
|
||||
parent-id (-> file :parent-stack peek)
|
||||
parent (lookup-shape file parent-id)
|
||||
current-frame-id (or (:frame-id parent)
|
||||
root-id)]
|
||||
(when (or (nil? (:current-component-id file)) components-v2)
|
||||
root-id))]
|
||||
(-> file
|
||||
(assoc :current-frame-id current-frame-id)
|
||||
(update :parent-stack pop))))
|
||||
@@ -272,13 +283,14 @@
|
||||
|
||||
:else
|
||||
(let [objects (lookup-objects file)
|
||||
bool' (gsh/update-bool bool children objects)]
|
||||
bool-content (gsh/calc-bool-content bool objects)
|
||||
bool' (gsh/update-bool-selrect bool children objects)]
|
||||
(commit-change
|
||||
file
|
||||
{:type :mod-obj
|
||||
:id bool-id
|
||||
:operations
|
||||
[{:type :set :attr :content :val (:content bool') :ignore-touched true}
|
||||
[{:type :set :attr :bool-content :val bool-content :ignore-touched true}
|
||||
{:type :set :attr :selrect :val (:selrect bool') :ignore-touched true}
|
||||
{:type :set :attr :points :val (:points bool') :ignore-touched true}
|
||||
{:type :set :attr :x :val (-> bool' :selrect :x) :ignore-touched true}
|
||||
@@ -502,29 +514,58 @@
|
||||
|
||||
(defn start-component
|
||||
([file data]
|
||||
(start-component file data :frame))
|
||||
(let [components-v2 (dm/get-in file [:data :options :components-v2])
|
||||
root-type (if components-v2 :frame :group)]
|
||||
(start-component file data root-type)))
|
||||
|
||||
([file data root-type]
|
||||
(let [name (:name data)
|
||||
;; FIXME: data probably can be a shape instance, then we can use gsh/shape->rect
|
||||
(let [components-v2 (dm/get-in file [:data :options :components-v2])
|
||||
selrect (or (grc/make-rect (:x data) (:y data) (:width data) (:height data))
|
||||
grc/empty-rect)
|
||||
name (:name data)
|
||||
path (:path data)
|
||||
main-instance-id (:main-instance-id data)
|
||||
main-instance-page (:main-instance-page data)
|
||||
|
||||
obj-id (or (:id data) (uuid/next))]
|
||||
;; In components v1 we must create the root shape and set it inside
|
||||
;; the :objects attribute of the component. When in components-v2,
|
||||
;; this will be ignored as the root shape has already been created
|
||||
;; in its page, by the normal page import.
|
||||
attrs (-> data
|
||||
(assoc :type root-type)
|
||||
(assoc :x (:x selrect))
|
||||
(assoc :y (:y selrect))
|
||||
(assoc :width (:width selrect))
|
||||
(assoc :height (:height selrect))
|
||||
(assoc :selrect selrect)
|
||||
(dissoc :path)
|
||||
(dissoc :main-instance-id)
|
||||
(dissoc :main-instance-page)
|
||||
(dissoc :main-instance-x)
|
||||
(dissoc :main-instance-y))
|
||||
|
||||
obj (-> (cts/setup-shape attrs)
|
||||
(check-name file root-type)
|
||||
;; Components need to have nil values for frame and parent
|
||||
(assoc :frame-id nil)
|
||||
(assoc :parent-id nil))]
|
||||
|
||||
(-> file
|
||||
(commit-change
|
||||
{:type :add-component
|
||||
:id obj-id
|
||||
:name name
|
||||
:path path
|
||||
:main-instance-id main-instance-id
|
||||
:main-instance-page main-instance-page})
|
||||
(cond-> {:type :add-component
|
||||
:id (:id obj)
|
||||
:name name
|
||||
:path path
|
||||
:main-instance-id main-instance-id
|
||||
:main-instance-page main-instance-page}
|
||||
(not components-v2)
|
||||
(assoc :shapes [obj])))
|
||||
|
||||
(assoc :last-id obj-id)
|
||||
(assoc :parent-stack [obj-id])
|
||||
(assoc :current-component-id obj-id)
|
||||
(assoc :current-frame-id (if (= root-type :frame) obj-id uuid/zero))))))
|
||||
(assoc :last-id (:id obj))
|
||||
(assoc :parent-stack [(:id obj)])
|
||||
(assoc :current-component-id (:id obj))
|
||||
(assoc :current-frame-id (if (= (:type obj) :frame) (:id obj) uuid/zero))))))
|
||||
|
||||
(defn start-deleted-component
|
||||
[file data]
|
||||
@@ -559,7 +600,8 @@
|
||||
|
||||
file
|
||||
(cond
|
||||
component-data
|
||||
;; In components-v2 components haven't any shape inside them.
|
||||
(and component-data (:main-instance-id component-data))
|
||||
(update file :data
|
||||
(fn [data]
|
||||
(ctkl/update-component data component-id dissoc :objects)))
|
||||
@@ -635,12 +677,17 @@
|
||||
page (ctpl/get-page (:data file) page-id)
|
||||
component (ctkl/get-component (:data file) component-id)
|
||||
|
||||
components-v2 (dm/get-in file [:options :components-v2])
|
||||
|
||||
[shape shapes]
|
||||
(ctn/make-component-instance page
|
||||
component
|
||||
(:id file)
|
||||
(gpt/point x
|
||||
y))]
|
||||
y)
|
||||
components-v2
|
||||
#_{:main-instance true
|
||||
:force-id main-instance-id})]
|
||||
|
||||
(as-> file $
|
||||
(reduce #(commit-change %1
|
||||
|
||||
@@ -26,10 +26,11 @@
|
||||
[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]
|
||||
[app.common.types.variant :as ctv]
|
||||
[app.common.uuid :as uuid]
|
||||
[clojure.set :as set]))
|
||||
|
||||
@@ -335,17 +336,13 @@
|
||||
[:type [:= :mod-component]]
|
||||
[:id ::sm/uuid]
|
||||
[:shapes {:optional true} [:vector {:gen/max 3} :any]]
|
||||
[:name {:optional true} :string]
|
||||
[:variant-id {:optional true} ::sm/uuid]
|
||||
[:variant-properties {:optional true} [:vector ::ctv/variant-property]]]]
|
||||
[:name {:optional true} :string]]]
|
||||
|
||||
[:del-component
|
||||
[:map {:title "DelComponentChange"}
|
||||
[:type [:= :del-component]]
|
||||
[:id ::sm/uuid]
|
||||
;; when it is an undo of a cut-paste, we need to undo the movement
|
||||
;; of the shapes so we need to move them delta
|
||||
[:delta {:optional true} ::gpt/point]
|
||||
[:main-instance {:optional true} :any]
|
||||
[:skip-undelete? {:optional true} :boolean]]]
|
||||
|
||||
[:restore-component
|
||||
@@ -406,7 +403,7 @@
|
||||
[:type [:= :set-token-theme]]
|
||||
[:theme-name :string]
|
||||
[:group :string]
|
||||
[:theme [:maybe ctob/schema:token-theme-attrs]]]]
|
||||
[:theme [:maybe ::ctot/token-theme]]]]
|
||||
|
||||
[:set-tokens-lib
|
||||
[:map {:title "SetTokensLib"}
|
||||
@@ -418,14 +415,14 @@
|
||||
[:type [:= :set-token-set]]
|
||||
[:set-name :string]
|
||||
[:group? :boolean]
|
||||
[:token-set [:maybe ctob/schema:token-set-attrs]]]]
|
||||
[:token-set [:maybe ::ctot/token-set]]]]
|
||||
|
||||
[:set-token
|
||||
[:map {:title "SetTokenChange"}
|
||||
[:type [:= :set-token]]
|
||||
[:set-name :string]
|
||||
[:token-name :string]
|
||||
[:token [:maybe ctob/schema:token-attrs]]]]]])
|
||||
[:token [:maybe ::cto/token]]]]]])
|
||||
|
||||
(def schema:changes
|
||||
[:sequential {:gen/max 5 :gen/min 1} schema:change])
|
||||
@@ -739,7 +736,7 @@
|
||||
group
|
||||
|
||||
(= :bool (:type group))
|
||||
(gsh/update-bool group children objects)
|
||||
(gsh/update-bool-selrect group children objects)
|
||||
|
||||
(:masked-group group)
|
||||
(set-mask-selrect group children)
|
||||
@@ -959,8 +956,8 @@
|
||||
(ctkl/mod-component data params))
|
||||
|
||||
(defmethod process-change :del-component
|
||||
[data {:keys [id skip-undelete? delta]}]
|
||||
(ctf/delete-component data id skip-undelete? delta))
|
||||
[data {:keys [id skip-undelete? main-instance]}]
|
||||
(ctf/delete-component data id skip-undelete? main-instance))
|
||||
|
||||
(defmethod process-change :restore-component
|
||||
[data {:keys [id page-id]}]
|
||||
|
||||
@@ -8,6 +8,7 @@
|
||||
(: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]
|
||||
@@ -83,7 +84,8 @@
|
||||
|
||||
(defn with-objects
|
||||
[changes objects]
|
||||
(let [fdata (ctf/make-file-data (uuid/next) uuid/zero)
|
||||
(let [fdata (binding [cfeat/*current* #{"components/v2"}]
|
||||
(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
|
||||
@@ -478,12 +480,9 @@
|
||||
(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)))))
|
||||
@@ -660,7 +659,7 @@
|
||||
nil ;; so it does not need resize
|
||||
|
||||
(= (:type parent) :bool)
|
||||
(gsh/update-bool parent children objects)
|
||||
(gsh/update-bool-selrect parent children objects)
|
||||
|
||||
(= (:type parent) :group)
|
||||
(if (:masked-group parent)
|
||||
@@ -922,11 +921,11 @@
|
||||
(apply-changes-local))))
|
||||
|
||||
(defn add-component
|
||||
([changes id path name updated-shapes main-instance-id main-instance-page]
|
||||
(add-component changes id path name updated-shapes main-instance-id main-instance-page nil nil nil))
|
||||
([changes id path name updated-shapes main-instance-id main-instance-page annotation]
|
||||
(add-component changes id path name updated-shapes main-instance-id main-instance-page annotation nil nil))
|
||||
([changes id path name updated-shapes main-instance-id main-instance-page annotation variant-id variant-properties & {:keys [apply-changes-local-library?]}]
|
||||
([changes id path name new-shapes updated-shapes main-instance-id main-instance-page]
|
||||
(add-component changes id path name new-shapes updated-shapes main-instance-id main-instance-page nil nil nil))
|
||||
([changes id path name new-shapes updated-shapes main-instance-id main-instance-page annotation]
|
||||
(add-component changes id path name new-shapes updated-shapes main-instance-id main-instance-page annotation nil nil))
|
||||
([changes id path name new-shapes updated-shapes main-instance-id main-instance-page annotation variant-id variant-properties & {:keys [apply-changes-local-library?]}]
|
||||
(assert-page-id! changes)
|
||||
(assert-objects! changes)
|
||||
(let [page-id (::page-id (meta changes))
|
||||
@@ -965,11 +964,11 @@
|
||||
:name name
|
||||
:main-instance-id main-instance-id
|
||||
:main-instance-page main-instance-page
|
||||
:annotation annotation}
|
||||
(some? variant-id)
|
||||
(assoc :variant-id variant-id)
|
||||
(seq variant-properties)
|
||||
(assoc :variant-properties variant-properties)))
|
||||
:annotation annotation
|
||||
:variant-id variant-id
|
||||
:variant-properties variant-properties}
|
||||
(some? new-shapes) ;; this will be null in components-v2
|
||||
(assoc :shapes (vec new-shapes))))
|
||||
(into (map mk-change) updated-shapes))))
|
||||
(update :undo-changes
|
||||
(fn [undo-changes]
|
||||
@@ -992,39 +991,27 @@
|
||||
new-component (update-fn prev-component)]
|
||||
(if prev-component
|
||||
(-> changes
|
||||
(update :redo-changes conj (cond-> {:type :mod-component
|
||||
:id id
|
||||
:name (:name new-component)
|
||||
:path (:path new-component)
|
||||
:main-instance-id (:main-instance-id new-component)
|
||||
:main-instance-page (:main-instance-page new-component)
|
||||
:annotation (:annotation new-component)
|
||||
:objects (:objects new-component) ;; for deleted components
|
||||
:modified-at (:modified-at new-component)}
|
||||
(some? (:variant-id new-component))
|
||||
(assoc :variant-id (:variant-id new-component))
|
||||
(nil? (:variant-id new-component))
|
||||
(dissoc :variant-id)
|
||||
(seq (:variant-properties new-component))
|
||||
(assoc :variant-properties (:variant-properties new-component))
|
||||
(not (seq (:variant-properties new-component)))
|
||||
(dissoc :variant-properties)))
|
||||
(update :undo-changes conj (cond-> {:type :mod-component
|
||||
:id id
|
||||
:name (:name prev-component)
|
||||
:path (:path prev-component)
|
||||
:main-instance-id (:main-instance-id prev-component)
|
||||
:main-instance-page (:main-instance-page prev-component)
|
||||
:annotation (:annotation prev-component)
|
||||
:objects (:objects prev-component)}
|
||||
(some? (:variant-id prev-component))
|
||||
(assoc :variant-id (:variant-id prev-component))
|
||||
(nil? (:variant-id prev-component))
|
||||
(dissoc :variant-id)
|
||||
(seq (:variant-properties prev-component))
|
||||
(assoc :variant-properties (:variant-properties prev-component))
|
||||
(not (seq (:variant-properties prev-component)))
|
||||
(dissoc :variant-properties)))
|
||||
(update :redo-changes conj {:type :mod-component
|
||||
:id id
|
||||
:name (:name new-component)
|
||||
:path (:path new-component)
|
||||
:main-instance-id (:main-instance-id new-component)
|
||||
:main-instance-page (:main-instance-page new-component)
|
||||
:annotation (:annotation new-component)
|
||||
:variant-id (:variant-id new-component)
|
||||
:variant-properties (:variant-properties new-component)
|
||||
:objects (:objects new-component) ;; this won't exist in components-v2 (except for deleted components)
|
||||
:modified-at (:modified-at new-component)})
|
||||
(update :undo-changes conj {:type :mod-component
|
||||
:id id
|
||||
:name (:name prev-component)
|
||||
:path (:path prev-component)
|
||||
:main-instance-id (:main-instance-id prev-component)
|
||||
:main-instance-page (:main-instance-page prev-component)
|
||||
:annotation (:annotation prev-component)
|
||||
:variant-id (:variant-id prev-component)
|
||||
:variant-properties (:variant-properties prev-component)
|
||||
:objects (:objects prev-component)})
|
||||
(cond-> apply-changes-local-library?
|
||||
(apply-changes-local {:apply-to-library? true})))
|
||||
changes)))
|
||||
@@ -1040,7 +1027,7 @@
|
||||
:page-id page-id})))
|
||||
|
||||
(defn restore-component
|
||||
[changes id page-id delta]
|
||||
[changes id page-id main-instance]
|
||||
(assert-library! changes)
|
||||
(-> changes
|
||||
(update :redo-changes conj {:type :restore-component
|
||||
@@ -1048,34 +1035,7 @@
|
||||
:page-id page-id})
|
||||
(update :undo-changes conj {:type :del-component
|
||||
: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))))
|
||||
:main-instance main-instance})))
|
||||
|
||||
(defn reorder-grid-children
|
||||
[changes ids]
|
||||
@@ -1123,11 +1083,3 @@
|
||||
(defn get-objects
|
||||
[changes]
|
||||
(dm/get-in (::file-data (meta changes)) [:pages-index uuid/zero :objects]))
|
||||
|
||||
(defn get-page
|
||||
[changes]
|
||||
(::page (meta changes)))
|
||||
|
||||
(defn get-page-id
|
||||
[changes]
|
||||
(::page-id (meta changes)))
|
||||
|
||||
@@ -427,6 +427,11 @@
|
||||
(map #(str/concat base-name (suffix-fn %))
|
||||
(iterate inc 1))))
|
||||
|
||||
(defn ^:private get-suffix
|
||||
"Default suffix impelemtation"
|
||||
[copy-count]
|
||||
(str/concat " " copy-count))
|
||||
|
||||
(defn generate-unique-name
|
||||
"Generates a unique name by selecting the first available name from a generated sequence.
|
||||
The sequence consists of `base-name` and its variants, avoiding conflicts with `existing-names`.
|
||||
@@ -440,7 +445,8 @@
|
||||
|
||||
Returns:
|
||||
- A unique name not present in `existing-names`."
|
||||
[base-name existing-names & {:keys [suffix-fn immediate-suffix? suffix]}]
|
||||
[base-name existing-names & {:keys [suffix-fn immediate-suffix?]
|
||||
:or {suffix-fn get-suffix}}]
|
||||
(dm/assert!
|
||||
"expected a set of strings"
|
||||
(coll? existing-names))
|
||||
@@ -448,21 +454,9 @@
|
||||
(dm/assert!
|
||||
"expected a string for `basename`."
|
||||
(string? base-name))
|
||||
(let [suffix-fn (if suffix-fn
|
||||
suffix-fn
|
||||
(if suffix
|
||||
(fn [copy-count]
|
||||
(str/concat "-"
|
||||
suffix
|
||||
(when (> copy-count 1)
|
||||
(str "-" copy-count))))
|
||||
(fn [copy-count]
|
||||
(str/concat " " copy-count))))
|
||||
|
||||
existing-name-set (cond-> (set existing-names)
|
||||
(let [existing-name-set (cond-> (set existing-names)
|
||||
immediate-suffix? (conj base-name))
|
||||
names (name-seq base-name suffix-fn)]
|
||||
|
||||
(->> names
|
||||
(remove #(contains? existing-name-set %))
|
||||
first)))
|
||||
|
||||
@@ -16,6 +16,7 @@
|
||||
[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]
|
||||
@@ -26,8 +27,6 @@
|
||||
[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]
|
||||
@@ -99,13 +98,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)
|
||||
(update :features (fnil into #{}) (deref cfeat/*new*))))))
|
||||
(migrate)))))
|
||||
|
||||
(defn migrated?
|
||||
[file]
|
||||
@@ -130,8 +129,8 @@
|
||||
[data _]
|
||||
(letfn [(migrate-path [shape]
|
||||
(if-not (contains? shape :content)
|
||||
(let [content (path.segment/points->content (:segments shape) :close (:close? shape))
|
||||
selrect (path.segment/content->selrect content)
|
||||
(let [content (gsp/segments->content (:segments shape) (:close? shape))
|
||||
selrect (gsh/content->selrect content)
|
||||
points (grc/rect->points selrect)]
|
||||
(-> shape
|
||||
(dissoc :segments)
|
||||
@@ -202,7 +201,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 (path.segment/content->selrect (:content shape))
|
||||
(let [selrect (gsh/content->selrect (:content shape))
|
||||
points (grc/rect->points selrect)
|
||||
transform (gmt/matrix)
|
||||
transform-inv (gmt/matrix)]
|
||||
@@ -1265,26 +1264,6 @@
|
||||
(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 _]
|
||||
(letfn [(update-object [object]
|
||||
;; NOTE: we still preserve the previous value for possible
|
||||
;; rollback, we still need to perform an other migration
|
||||
;; for properly delete the bool-content prop from shapes
|
||||
;; once the know the migration was OK
|
||||
(if (cfh/bool-shape? object)
|
||||
(if-let [content (:bool-content object)]
|
||||
(assoc object :content content)
|
||||
object)
|
||||
(dissoc object :bool-content :bool-type)))
|
||||
|
||||
(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))))
|
||||
|
||||
(defmethod migrate-data "0003-fix-root-shape"
|
||||
[data _]
|
||||
(letfn [(update-object [shape]
|
||||
@@ -1307,23 +1286,6 @@
|
||||
(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)
|
||||
["legacy-2"
|
||||
@@ -1379,7 +1341,5 @@
|
||||
"legacy-66"
|
||||
"legacy-67"
|
||||
"0001-remove-tokens-from-groups"
|
||||
"0002-normalize-bool-content"
|
||||
"0002-clean-shape-interactions"
|
||||
"0003-fix-root-shape"
|
||||
"0003-convert-path-content"]))
|
||||
"0003-fix-root-shape"]))
|
||||
|
||||
@@ -572,51 +572,6 @@
|
||||
(pcb/with-file-data file-data)
|
||||
(pcb/update-shapes [(:id shape)] repair-shape))))
|
||||
|
||||
(defmethod repair-error :not-a-variant
|
||||
[_ error file _]
|
||||
(log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
|
||||
file)
|
||||
|
||||
(defmethod repair-error :invalid-variant-id
|
||||
[_ error file _]
|
||||
(log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
|
||||
file)
|
||||
|
||||
(defmethod repair-error :invalid-variant-properties
|
||||
[_ error file _]
|
||||
(log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
|
||||
file)
|
||||
|
||||
(defmethod repair-error :variant-not-main
|
||||
[_ error file _]
|
||||
(log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
|
||||
file)
|
||||
|
||||
(defmethod repair-error :parent-not-variant
|
||||
[_ error file _]
|
||||
(log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
|
||||
file)
|
||||
|
||||
(defmethod repair-error :variant-bad-name
|
||||
[_ error file _]
|
||||
(log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
|
||||
file)
|
||||
|
||||
(defmethod repair-error :variant-no-properties
|
||||
[_ error file _]
|
||||
(log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
|
||||
file)
|
||||
|
||||
(defmethod repair-error :variant-bad-variant-name
|
||||
[_ error file _]
|
||||
(log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
|
||||
file)
|
||||
|
||||
(defmethod repair-error :variant-component-bad-name
|
||||
[_ error file _]
|
||||
(log/error :hint "Variant error code, we don't want to auto repair it for now" :code (:code error))
|
||||
file)
|
||||
|
||||
(defmethod repair-error :default
|
||||
[_ error file _]
|
||||
(log/error :hint "Unknown error code, don't know how to repair" :code (:code error))
|
||||
|
||||
@@ -15,8 +15,6 @@
|
||||
[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))
|
||||
@@ -37,7 +35,6 @@
|
||||
(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
|
||||
@@ -47,7 +44,6 @@
|
||||
to-move (->> shapes
|
||||
(map (d/getf objects))
|
||||
(not-empty))]
|
||||
|
||||
(if to-move
|
||||
(-> changes
|
||||
(cond-> (and remove-layout-data?
|
||||
@@ -66,10 +62,6 @@
|
||||
changes id parent-id objects selected index frame-name without-fill? nil))
|
||||
|
||||
([changes id parent-id objects selected index frame-name without-fill? target-cell-id]
|
||||
(prepare-create-artboard-from-selection
|
||||
changes id parent-id objects selected index frame-name without-fill? target-cell-id nil))
|
||||
|
||||
([changes id parent-id objects selected index frame-name without-fill? target-cell-id delta]
|
||||
(when-let [selected-objs (->> selected
|
||||
(map (d/getf objects))
|
||||
(not-empty))]
|
||||
@@ -107,11 +99,10 @@
|
||||
:id))
|
||||
target-cell-id)
|
||||
|
||||
|
||||
attrs
|
||||
{:type :frame
|
||||
:x (cond-> (:x srect) delta (+ (:x delta)))
|
||||
:y (cond-> (:y srect) delta (+ (:y delta)))
|
||||
:x (:x srect)
|
||||
:y (:y srect)
|
||||
:width (:width srect)
|
||||
:height (:height srect)}
|
||||
|
||||
|
||||
@@ -10,15 +10,12 @@
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.files.variant :as cfv]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.types.component :as ctk]
|
||||
[app.common.types.components-list :as ctkl]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.types.pages-list :as ctpl]
|
||||
[app.common.types.shape-tree :as ctst]
|
||||
[app.common.types.variant :as ctv]
|
||||
[app.common.uuid :as uuid]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
@@ -59,17 +56,7 @@
|
||||
:instance-head-not-frame
|
||||
:misplaced-slot
|
||||
:missing-slot
|
||||
:shape-ref-cycle
|
||||
:not-a-variant
|
||||
:invalid-variant-id
|
||||
:invalid-variant-properties
|
||||
:variant-not-main
|
||||
:parent-not-variant
|
||||
:variant-bad-name
|
||||
:variant-bad-variant-name
|
||||
:variant-component-bad-name
|
||||
:variant-no-properties
|
||||
:variant-component-bad-id})
|
||||
:shape-ref-cycle})
|
||||
|
||||
(def ^:private schema:error
|
||||
[:map {:title "ValidationError"}
|
||||
@@ -414,68 +401,6 @@
|
||||
(check-empty-swap-slot shape file page)
|
||||
(run! #(check-shape % file page libraries :context :not-component) (:shapes shape)))
|
||||
|
||||
(defn- check-variant-container
|
||||
"Shape is a variant container, so:
|
||||
-all its children should be variants with variant-id equals to the shape-id
|
||||
-all the components should have the same properties
|
||||
"
|
||||
[shape file page]
|
||||
(let [shape-id (:id shape)
|
||||
shapes (:shapes shape)
|
||||
children (map #(ctst/get-shape page %) shapes)
|
||||
prop-names (cfv/extract-properties-names (first children) (:data file))]
|
||||
(doseq [child children]
|
||||
(if (not (ctk/is-variant? child))
|
||||
(report-error :not-a-variant
|
||||
(str/ffmt "Shape % should be a variant" (:id child))
|
||||
child file page)
|
||||
(do
|
||||
(when (not= (:variant-id child) shape-id)
|
||||
(report-error :invalid-variant-id
|
||||
(str/ffmt "Variant % has invalid variant-id %" (:id child) (:variant-id child))
|
||||
child file page))
|
||||
(when (not= prop-names (cfv/extract-properties-names child (:data file)))
|
||||
(report-error :invalid-variant-properties
|
||||
(str/ffmt "Variant % has invalid properties %" (:id child) (vec prop-names))
|
||||
child file page)))))))
|
||||
|
||||
(defn- check-variant
|
||||
"Shape is a variant, so
|
||||
-it should be a main component
|
||||
-its parent should be a variant-container
|
||||
-its variant-name is derived from the properties
|
||||
-its name should be tha same as its parent's
|
||||
"
|
||||
[shape file page]
|
||||
(let [parent (ctst/get-shape page (:parent-id shape))
|
||||
component (ctkl/get-component (:data file) (:component-id shape) true)
|
||||
name (ctv/properties-to-name (:variant-properties component))]
|
||||
(when-not (ctk/main-instance? shape)
|
||||
(report-error :variant-not-main
|
||||
(str/ffmt "Variant % is not a main instance" (:id shape))
|
||||
shape file page))
|
||||
(when-not (ctk/is-variant-container? parent)
|
||||
(report-error :parent-not-variant
|
||||
(str/ffmt "Variant % has an invalid parent" (:id shape))
|
||||
shape file page))
|
||||
|
||||
(when-not (= name (:variant-name shape))
|
||||
(report-error :variant-bad-variant-name
|
||||
(str/ffmt "Variant % has an invalid variant-name" (:id shape))
|
||||
shape file page))
|
||||
(when-not (= (:name parent) (:name shape))
|
||||
(report-error :variant-bad-name
|
||||
(str/ffmt "Variant % has an invalid name" (:id shape))
|
||||
shape file page))
|
||||
(when-not (= (:name parent) (cfh/merge-path-item (:path component) (:name component)))
|
||||
(report-error :variant-component-bad-name
|
||||
(str/ffmt "Component % has an invalid name" (:id shape))
|
||||
shape file page))
|
||||
(when-not (= (:variant-id component) (:variant-id shape))
|
||||
(report-error :variant-component-bad-id
|
||||
(str/ffmt "Variant % has adifferent variant-id than its component" (:id shape))
|
||||
shape file page))))
|
||||
|
||||
(defn- check-shape
|
||||
"Validate referential integrity and semantic coherence of
|
||||
a shape and all its children. Report all errors found.
|
||||
@@ -496,12 +421,6 @@
|
||||
(check-parent-children shape file page)
|
||||
(check-frame shape file page)
|
||||
|
||||
(when (ctk/is-variant-container? shape)
|
||||
(check-variant-container shape file page))
|
||||
|
||||
(when (ctk/is-variant? shape)
|
||||
(check-variant shape file page))
|
||||
|
||||
(if (ctk/instance-head? shape)
|
||||
(if (not= :frame (:type shape))
|
||||
(report-error :instance-head-not-frame
|
||||
@@ -577,24 +496,6 @@
|
||||
"This deleted component has shapes with shape-ref pointing to self"
|
||||
component file nil :cycles-ids cycles-ids))))
|
||||
|
||||
(defn- check-variant-component
|
||||
"Component is a variant, so:
|
||||
-Its main should be a variant
|
||||
-It should have at least one variant property"
|
||||
[component file]
|
||||
(let [component-page (ctf/get-component-page (:data file) component)
|
||||
main-component (if (:deleted component)
|
||||
(dm/get-in component [:objects (:main-instance-id component)])
|
||||
(ctst/get-shape component-page (:main-instance-id component)))]
|
||||
(when-not (ctk/is-variant? main-component)
|
||||
(report-error :not-a-variant
|
||||
(str/ffmt "Shape % should be a variant" (:id main-component))
|
||||
main-component file component-page))
|
||||
(when (< (count (:variant-properties component)) 1)
|
||||
(report-error :variant-no-properties
|
||||
(str/ffmt "Component variant % should have properties" (:id main-component))
|
||||
main-component file nil))))
|
||||
|
||||
(defn- check-component
|
||||
"Validate semantic coherence of a component. Report all errors found."
|
||||
[component file]
|
||||
@@ -604,10 +505,7 @@
|
||||
component file nil))
|
||||
(when (:deleted component)
|
||||
(check-component-duplicate-swap-slot component file)
|
||||
(check-ref-cycles component file))
|
||||
|
||||
(when (ctk/is-variant? component)
|
||||
(check-variant-component component file)))
|
||||
(check-ref-cycles component file)))
|
||||
|
||||
(defn- get-orphan-shapes
|
||||
[{:keys [objects] :as page}]
|
||||
|
||||
@@ -1,84 +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.files.variant
|
||||
(:require
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.types.component :as ctc]
|
||||
[app.common.types.components-list :as ctcl]
|
||||
[app.common.types.variant :as ctv]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
|
||||
(defn find-variant-components
|
||||
"Find a list of the components thet belongs to this variant-id"
|
||||
[data objects variant-id]
|
||||
;; We can't simply filter components, because we need to maintain the order
|
||||
(->> (dm/get-in objects [variant-id :shapes])
|
||||
(map #(dm/get-in objects [% :component-id]))
|
||||
(map #(ctcl/get-component data % true))
|
||||
reverse))
|
||||
|
||||
(defn- dashes-to-end
|
||||
[property-values]
|
||||
(let [dashes (if (some #(= % "--") property-values) ["--"] [])]
|
||||
(concat (remove #(= % "--") property-values) dashes)))
|
||||
|
||||
|
||||
(defn extract-properties-names
|
||||
[shape data]
|
||||
(->> shape
|
||||
(#(ctcl/get-component data (:component-id %) true))
|
||||
:variant-properties
|
||||
(map :name)))
|
||||
|
||||
|
||||
(defn extract-properties-values
|
||||
[data objects variant-id]
|
||||
(->> (find-variant-components data objects variant-id)
|
||||
(mapcat :variant-properties)
|
||||
(group-by :name)
|
||||
(map (fn [[k v]]
|
||||
{:name k
|
||||
:value (->> v
|
||||
(map #(if (str/empty? (:value %)) "--" (:value %)))
|
||||
distinct
|
||||
dashes-to-end)}))))
|
||||
|
||||
(defn get-variant-mains
|
||||
[component data]
|
||||
(assert (ctv/valid-variant-component? component) "expected valid component variant")
|
||||
(when-let [variant-id (:variant-id component)]
|
||||
(let [page-id (:main-instance-page component)
|
||||
objects (-> (dm/get-in data [:pages-index page-id])
|
||||
(get :objects))]
|
||||
(dm/get-in objects [variant-id :shapes]))))
|
||||
|
||||
|
||||
(defn is-secondary-variant?
|
||||
[component data]
|
||||
(let [shapes (get-variant-mains component data)]
|
||||
(and (seq shapes)
|
||||
(not= (:main-instance-id component) (last shapes)))))
|
||||
|
||||
(defn get-primary-variant
|
||||
[data component]
|
||||
(let [page-id (:main-instance-page component)
|
||||
objects (-> (dm/get-in data [:pages-index page-id])
|
||||
(get :objects))
|
||||
variant-id (:variant-id component)]
|
||||
(->> (dm/get-in objects [variant-id :shapes])
|
||||
peek
|
||||
(get objects))))
|
||||
|
||||
(defn get-primary-component
|
||||
[data component-id]
|
||||
(when-let [component (ctcl/get-component data component-id)]
|
||||
(if (ctc/is-variant? component)
|
||||
(->> component
|
||||
(get-primary-variant data)
|
||||
:component-id
|
||||
(ctcl/get-component data))
|
||||
component)))
|
||||
@@ -79,7 +79,7 @@
|
||||
:file-schema-validation
|
||||
;; Reports the schema validation errors internally.
|
||||
:soft-file-schema-validation
|
||||
;; Activates the referential integrity validation during update file.
|
||||
;; Activates the referential integrity validation during update file; related to components-v2.
|
||||
:file-validation
|
||||
;; Reports the referential integrity validation errors internally.
|
||||
:soft-file-validation
|
||||
@@ -125,7 +125,6 @@
|
||||
:export-file-v3
|
||||
:render-wasm-dpr
|
||||
:hide-release-modal
|
||||
:subscriptions
|
||||
:subscriptions-old})
|
||||
|
||||
(def all-flags
|
||||
|
||||
@@ -5,7 +5,7 @@
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.geom.point
|
||||
(:refer-clojure :exclude [divide min max abs zero?])
|
||||
(:refer-clojure :exclude [divide min max abs])
|
||||
(:require
|
||||
#?(:clj [app.common.fressian :as fres])
|
||||
#?(:cljs [cljs.core :as c]
|
||||
@@ -470,13 +470,6 @@
|
||||
(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,11 +10,13 @@
|
||||
[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]))
|
||||
|
||||
@@ -164,7 +166,7 @@
|
||||
(dm/export gtr/calculate-geometry)
|
||||
(dm/export gtr/update-group-selrect)
|
||||
(dm/export gtr/update-mask-selrect)
|
||||
(dm/export gtr/update-bool)
|
||||
(dm/export gtr/update-bool-selrect)
|
||||
(dm/export gtr/apply-transform)
|
||||
(dm/export gtr/transform-shape)
|
||||
(dm/export gtr/transform-selrect)
|
||||
@@ -178,6 +180,12 @@
|
||||
;; 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?)
|
||||
@@ -185,6 +193,9 @@
|
||||
(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)
|
||||
|
||||
29
common/src/app/common/geom/shapes/bool.cljc
Normal file
29
common/src/app/common/geom/shapes/bool.cljc
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.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.math :as mth]
|
||||
[app.common.types.path :as path]))
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.math :as mth]))
|
||||
|
||||
(defn shape-stroke-margin
|
||||
[shape stroke-width]
|
||||
@@ -104,7 +104,7 @@
|
||||
(let [strokes (:strokes shape)
|
||||
|
||||
open-path? (and ^boolean (cfh/path-shape? shape)
|
||||
^boolean (path/shape-with-open-path? shape))
|
||||
^boolean (gsp/open-path? shape))
|
||||
|
||||
stroke-width
|
||||
(->> strokes
|
||||
|
||||
@@ -39,7 +39,7 @@
|
||||
;;
|
||||
;; 5. If any track still has an infinite growth limit set its growth limit to its base size.
|
||||
|
||||
;; - Distribute extra space accross spaned tracks
|
||||
;; - Distribute extra space accross spaned tracks
|
||||
;; - Maximize tracks
|
||||
;;
|
||||
;; - Expand flexible tracks
|
||||
@@ -198,7 +198,7 @@
|
||||
|
||||
track-list))
|
||||
|
||||
(defn stretch-tracks
|
||||
(defn add-auto-size
|
||||
[track-list add-size]
|
||||
(->> track-list
|
||||
(mapv (fn [{:keys [type size max-size] :as track}]
|
||||
@@ -357,8 +357,7 @@
|
||||
to-idx (+ (dec (get cell prop)) (get cell prop-span))
|
||||
indexed-tracks (subvec (d/enumerate track-list) from-idx to-idx)
|
||||
|
||||
to-allocate
|
||||
(size-to-allocate type parent (get children-map shape-id) cell bounds objects)
|
||||
to-allocate (size-to-allocate type parent (get children-map shape-id) cell bounds objects)
|
||||
|
||||
;; Remove the size and the tracks that are not allocated
|
||||
[to-allocate total-frs indexed-tracks]
|
||||
@@ -494,11 +493,11 @@
|
||||
|
||||
column-tracks (cond-> column-tracks
|
||||
(= :stretch (:layout-justify-content parent))
|
||||
(stretch-tracks column-add-auto))
|
||||
(add-auto-size column-add-auto))
|
||||
|
||||
row-tracks (cond-> row-tracks
|
||||
(= :stretch (:layout-align-content parent))
|
||||
(stretch-tracks row-add-auto))
|
||||
(add-auto-size row-add-auto))
|
||||
|
||||
column-total-size (tracks-total-size column-tracks)
|
||||
row-total-size (tracks-total-size row-tracks)
|
||||
|
||||
@@ -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.types.path.segment :as path.segm]))
|
||||
[app.common.math :as mth]))
|
||||
|
||||
(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))
|
||||
(path.segm/path->lines shape))
|
||||
(gpp/path->lines shape))
|
||||
start-point (-> shape :content (first) :params (gpt/point))]
|
||||
|
||||
(or (intersects-lines? rect-lines path-lines)
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -12,10 +12,11 @@
|
||||
[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.path :as path]))
|
||||
[app.common.types.modifiers :as ctm]))
|
||||
|
||||
#?(:clj (set! *warn-on-reflection* true))
|
||||
|
||||
@@ -76,11 +77,7 @@
|
||||
position-data)
|
||||
position-data))))
|
||||
|
||||
;; 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
|
||||
|
||||
;; FIXME: revist usage of mutability
|
||||
(defn move
|
||||
"Move the shape relatively to its current
|
||||
position applying the provided delta."
|
||||
@@ -98,8 +95,8 @@
|
||||
(d/update-when :x d/safe+ dx)
|
||||
(d/update-when :y d/safe+ dy)
|
||||
(d/update-when :position-data move-position-data mvec)
|
||||
(cond-> (or (= :bool type) (= :path type))
|
||||
(update :content path/move-content mvec)))))
|
||||
(cond-> (= :bool type) (update :bool-content gpa/move-content mvec))
|
||||
(cond-> (= :path type) (update :content gpa/move-content mvec)))))
|
||||
|
||||
;; --- Absolute Movement
|
||||
|
||||
@@ -320,11 +317,14 @@
|
||||
points (gco/transform-points (dm/get-prop shape :points) transform-mtx)
|
||||
selrect (gco/transform-selrect (dm/get-prop shape :selrect) transform-mtx)
|
||||
|
||||
shape (if (= type :bool)
|
||||
(update shape :bool-content gpa/transform-content transform-mtx)
|
||||
shape)
|
||||
shape (if (= type :text)
|
||||
(update shape :position-data transform-position-data transform-mtx)
|
||||
shape)
|
||||
shape (if (or (= type :path) (= type :bool))
|
||||
(update shape :content path/transform-content transform-mtx)
|
||||
shape (if (= type :path)
|
||||
(update shape :content gpa/transform-content transform-mtx)
|
||||
(assoc shape
|
||||
:x (dm/get-prop selrect :x)
|
||||
:y (dm/get-prop selrect :y)
|
||||
@@ -355,9 +355,12 @@
|
||||
rotation (mod (+ (d/nilv (:rotation shape) 0)
|
||||
(d/nilv (dm/get-in shape [:modifiers :rotation]) 0))
|
||||
360)
|
||||
shape (if (= type :bool)
|
||||
(update shape :bool-content gpa/transform-content transform-mtx)
|
||||
shape)
|
||||
|
||||
shape (if (or (= type :path) (= type :bool))
|
||||
(update shape :content path/transform-content transform-mtx)
|
||||
shape (if (= type :path)
|
||||
(update shape :content gpa/transform-content transform-mtx)
|
||||
(assoc shape
|
||||
:x (dm/get-prop selrect :x)
|
||||
:y (dm/get-prop selrect :y)
|
||||
@@ -374,14 +377,8 @@
|
||||
"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]
|
||||
(cond
|
||||
(nil? transform-mtx)
|
||||
shape
|
||||
|
||||
^boolean (gmt/move? transform-mtx)
|
||||
(if ^boolean (gmt/move? transform-mtx)
|
||||
(apply-transform-move shape transform-mtx)
|
||||
|
||||
:else
|
||||
(apply-transform-generic shape transform-mtx)))
|
||||
|
||||
(defn- update-group-viewbox
|
||||
@@ -453,13 +450,19 @@
|
||||
(assoc :flip-x (-> mask :flip-x))
|
||||
(assoc :flip-y (-> mask :flip-y)))))
|
||||
|
||||
(defn update-bool
|
||||
(defn update-bool-selrect
|
||||
"Calculates the selrect+points for the boolean shape"
|
||||
[shape _children objects]
|
||||
[shape children objects]
|
||||
|
||||
(let [content (path/calc-bool-content shape objects)
|
||||
shape (assoc shape :content content)]
|
||||
(path/update-geometry shape)))
|
||||
(let [bool-content (gshb/calc-bool-content shape objects)
|
||||
shape (assoc shape :bool-content bool-content)
|
||||
[points selrect] (gpa/content->points+selrect shape bool-content)]
|
||||
|
||||
(if (and (some? selrect) (d/not-empty? points))
|
||||
(-> shape
|
||||
(assoc :selrect selrect)
|
||||
(assoc :points points))
|
||||
(update-group-selrect shape children))))
|
||||
|
||||
(defn update-shapes-geometry
|
||||
[objects ids]
|
||||
@@ -474,7 +477,7 @@
|
||||
(update-mask-selrect shape children)
|
||||
|
||||
(cfh/bool-shape? shape)
|
||||
(update-bool shape children objects)
|
||||
(update-bool-selrect shape children objects)
|
||||
|
||||
(cfh/group-shape? shape)
|
||||
(update-group-selrect shape children)
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -10,14 +10,14 @@
|
||||
[app.common.files.changes-builder :as pcb]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.logic.variant-properties :as clvp]
|
||||
[app.common.logic.variants :as clv]
|
||||
[app.common.types.component :as ctk]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.pages-list :as ctpl]
|
||||
[app.common.types.shape.interactions :as ctsi]
|
||||
[app.common.types.shape.layout :as ctl]
|
||||
[app.common.types.token :as cto]
|
||||
[app.common.uuid :as uuid]))
|
||||
[app.common.uuid :as uuid]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(defn- generate-unapply-tokens
|
||||
"When updating attributes that have a token applied, we must unapply it, because the value
|
||||
@@ -81,167 +81,163 @@
|
||||
(pcb/update-shapes ids update-fn {:attrs #{:blocked :hidden}}))))
|
||||
|
||||
(defn generate-delete-shapes
|
||||
([changes file page objects ids options]
|
||||
(generate-delete-shapes (-> changes
|
||||
(pcb/with-page page)
|
||||
(pcb/with-objects objects)
|
||||
(pcb/with-library-data file))
|
||||
ids
|
||||
options))
|
||||
([changes ids {:keys [ignore-touched component-swap]}]
|
||||
(let [objects (pcb/get-objects changes)
|
||||
data (pcb/get-library-data changes)
|
||||
page-id (pcb/get-page-id changes)
|
||||
page (or (pcb/get-page changes)
|
||||
(ctpl/get-page data page-id))
|
||||
[changes file page objects ids {:keys [components-v2 ignore-touched component-swap]}]
|
||||
(let [ids (cfh/clean-loops objects ids)
|
||||
|
||||
ids (cfh/clean-loops objects ids)
|
||||
in-component-copy?
|
||||
(fn [shape-id]
|
||||
in-component-copy?
|
||||
(fn [shape-id]
|
||||
;; Look for shapes that are inside a component copy, but are
|
||||
;; not the root. In this case, they must not be deleted,
|
||||
;; but hidden (to be able to recover them more easily).
|
||||
;; Unless we are doing a component swap, in which case we want
|
||||
;; to delete the old shape
|
||||
(let [shape (get objects shape-id)]
|
||||
(and (ctn/has-any-copy-parent? objects shape)
|
||||
(not component-swap))))
|
||||
(let [shape (get objects shape-id)]
|
||||
(and (ctn/has-any-copy-parent? objects shape)
|
||||
(not component-swap))))
|
||||
|
||||
[ids-to-delete ids-to-hide]
|
||||
(loop [ids-seq (seq ids)
|
||||
ids-to-delete []
|
||||
ids-to-hide []]
|
||||
(let [id (first ids-seq)]
|
||||
(if (nil? id)
|
||||
[ids-to-delete ids-to-hide]
|
||||
(if (in-component-copy? id)
|
||||
(recur (rest ids-seq)
|
||||
ids-to-delete
|
||||
(conj ids-to-hide id))
|
||||
(recur (rest ids-seq)
|
||||
(conj ids-to-delete id)
|
||||
ids-to-hide)))))
|
||||
[ids-to-delete ids-to-hide]
|
||||
(if components-v2
|
||||
(loop [ids-seq (seq ids)
|
||||
ids-to-delete []
|
||||
ids-to-hide []]
|
||||
(let [id (first ids-seq)]
|
||||
(if (nil? id)
|
||||
[ids-to-delete ids-to-hide]
|
||||
(if (in-component-copy? id)
|
||||
(recur (rest ids-seq)
|
||||
ids-to-delete
|
||||
(conj ids-to-hide id))
|
||||
(recur (rest ids-seq)
|
||||
(conj ids-to-delete id)
|
||||
ids-to-hide)))))
|
||||
[ids []])
|
||||
|
||||
lookup (d/getf objects)
|
||||
changes (-> changes
|
||||
(pcb/with-page page)
|
||||
(pcb/with-objects objects)
|
||||
(pcb/with-library-data file))
|
||||
|
||||
groups-to-unmask
|
||||
(reduce (fn [group-ids id]
|
||||
lookup (d/getf objects)
|
||||
|
||||
groups-to-unmask
|
||||
(reduce (fn [group-ids id]
|
||||
;; When the shape to delete is the mask of a masked group,
|
||||
;; the mask condition must be removed, and it must be
|
||||
;; converted to a normal group.
|
||||
(let [obj (lookup id)
|
||||
parent (lookup (:parent-id obj))]
|
||||
(if (and (:masked-group parent)
|
||||
(= id (first (:shapes parent))))
|
||||
(conj group-ids (:id parent))
|
||||
group-ids)))
|
||||
#{}
|
||||
ids-to-delete)
|
||||
(let [obj (lookup id)
|
||||
parent (lookup (:parent-id obj))]
|
||||
(if (and (:masked-group parent)
|
||||
(= id (first (:shapes parent))))
|
||||
(conj group-ids (:id parent))
|
||||
group-ids)))
|
||||
#{}
|
||||
ids-to-delete)
|
||||
|
||||
interacting-shapes
|
||||
(filter (fn [shape]
|
||||
interacting-shapes
|
||||
(filter (fn [shape]
|
||||
;; If any of the deleted shapes is the destination of
|
||||
;; some interaction, this must be deleted, too.
|
||||
(let [interactions (:interactions shape)]
|
||||
(some #(and (ctsi/has-destination %)
|
||||
(contains? ids-to-delete (:destination %)))
|
||||
interactions)))
|
||||
(vals objects))
|
||||
(let [interactions (:interactions shape)]
|
||||
(some #(and (ctsi/has-destination %)
|
||||
(contains? ids-to-delete (:destination %)))
|
||||
interactions)))
|
||||
(vals objects))
|
||||
|
||||
changes
|
||||
(reduce (fn [changes {:keys [id] :as flow}]
|
||||
(if (contains? ids-to-delete (:starting-frame flow))
|
||||
(pcb/set-flow changes id nil)
|
||||
changes))
|
||||
changes
|
||||
(:flows page))
|
||||
changes
|
||||
(reduce (fn [changes {:keys [id] :as flow}]
|
||||
(if (contains? ids-to-delete (:starting-frame flow))
|
||||
(pcb/set-flow changes id nil)
|
||||
changes))
|
||||
changes
|
||||
(:flows page))
|
||||
|
||||
|
||||
all-parents
|
||||
(reduce (fn [res id]
|
||||
all-parents
|
||||
(reduce (fn [res id]
|
||||
;; All parents of any deleted shape must be resized.
|
||||
(into res (cfh/get-parent-ids objects id)))
|
||||
(d/ordered-set)
|
||||
(concat ids-to-delete ids-to-hide))
|
||||
(into res (cfh/get-parent-ids objects id)))
|
||||
(d/ordered-set)
|
||||
(concat ids-to-delete ids-to-hide))
|
||||
|
||||
all-children
|
||||
(->> ids-to-delete ;; Children of deleted shapes must be also deleted.
|
||||
(reduce (fn [res id]
|
||||
(into res (cfh/get-children-ids objects id)))
|
||||
[])
|
||||
(reverse)
|
||||
(into (d/ordered-set)))
|
||||
all-children
|
||||
(->> ids-to-delete ;; Children of deleted shapes must be also deleted.
|
||||
(reduce (fn [res id]
|
||||
(into res (cfh/get-children-ids objects id)))
|
||||
[])
|
||||
(reverse)
|
||||
(into (d/ordered-set)))
|
||||
|
||||
find-all-empty-parents
|
||||
(fn recursive-find-empty-parents [empty-parents]
|
||||
(let [all-ids (into empty-parents ids-to-delete)
|
||||
contains? (partial contains? all-ids)
|
||||
xform (comp (map lookup)
|
||||
(filter #(or (cfh/group-shape? %) (cfh/bool-shape? %) (ctk/is-variant-container? %)))
|
||||
(remove #(->> (:shapes %) (remove contains?) seq))
|
||||
(map :id))
|
||||
parents (into #{} xform all-parents)]
|
||||
(if (= empty-parents parents)
|
||||
empty-parents
|
||||
(recursive-find-empty-parents parents))))
|
||||
find-all-empty-parents
|
||||
(fn recursive-find-empty-parents [empty-parents]
|
||||
(let [all-ids (into empty-parents ids-to-delete)
|
||||
contains? (partial contains? all-ids)
|
||||
xform (comp (map lookup)
|
||||
(filter #(or (cfh/group-shape? %) (cfh/bool-shape? %)))
|
||||
(remove #(->> (:shapes %) (remove contains?) seq))
|
||||
(map :id))
|
||||
parents (into #{} xform all-parents)]
|
||||
(if (= empty-parents parents)
|
||||
empty-parents
|
||||
(recursive-find-empty-parents parents))))
|
||||
|
||||
empty-parents
|
||||
empty-parents
|
||||
;; Any parent whose children are all deleted, must be deleted too.
|
||||
;; Unless we are during a component swap: in this case we are replacing a shape by
|
||||
;; other one, so must not delete empty parents.
|
||||
(if-not component-swap
|
||||
(into (d/ordered-set) (find-all-empty-parents #{}))
|
||||
#{})
|
||||
(if-not component-swap
|
||||
(into (d/ordered-set) (find-all-empty-parents #{}))
|
||||
#{})
|
||||
|
||||
components-to-delete
|
||||
(reduce (fn [components id]
|
||||
(let [shape (get objects id)]
|
||||
(if (and (= (:component-file shape) (:id data)) ;; Main instances should exist only in local file
|
||||
(:main-instance shape)) ;; but check anyway
|
||||
(conj components (:component-id shape))
|
||||
components)))
|
||||
[]
|
||||
(into ids-to-delete all-children))
|
||||
components-to-delete
|
||||
(if components-v2
|
||||
(reduce (fn [components id]
|
||||
(let [shape (get objects id)]
|
||||
(if (and (= (:component-file shape) (:id file)) ;; Main instances should exist only in local file
|
||||
(:main-instance shape)) ;; but check anyway
|
||||
(conj components (:component-id shape))
|
||||
components)))
|
||||
[]
|
||||
(into ids-to-delete all-children))
|
||||
[])
|
||||
|
||||
ids-set (set ids-to-delete)
|
||||
|
||||
ids-set (set ids-to-delete)
|
||||
guides-to-delete
|
||||
(->> (:guides page)
|
||||
(vals)
|
||||
(filter #(contains? ids-set (:frame-id %)))
|
||||
(map :id))
|
||||
|
||||
guides-to-delete
|
||||
(->> (:guides page)
|
||||
(vals)
|
||||
(filter #(contains? ids-set (:frame-id %)))
|
||||
(map :id))
|
||||
changes (reduce (fn [changes guide-id]
|
||||
(pcb/set-flow changes guide-id nil))
|
||||
changes
|
||||
guides-to-delete)
|
||||
|
||||
changes (reduce (fn [changes guide-id]
|
||||
(pcb/set-flow changes guide-id nil))
|
||||
changes
|
||||
guides-to-delete)
|
||||
|
||||
changes (reduce (fn [changes component-id]
|
||||
changes (reduce (fn [changes component-id]
|
||||
;; It's important to delete the component before the main instance, because we
|
||||
;; need to store the instance position if we want to restore it later.
|
||||
(pcb/delete-component changes component-id (:id page)))
|
||||
changes
|
||||
components-to-delete)
|
||||
(pcb/delete-component changes component-id (:id page)))
|
||||
changes
|
||||
components-to-delete)
|
||||
|
||||
changes (-> changes
|
||||
(generate-update-shape-flags ids-to-hide objects {:hidden true})
|
||||
(pcb/remove-objects all-children {:ignore-touched true})
|
||||
(pcb/remove-objects ids-to-delete {:ignore-touched ignore-touched})
|
||||
(pcb/remove-objects empty-parents)
|
||||
(pcb/resize-parents all-parents)
|
||||
(pcb/update-shapes groups-to-unmask
|
||||
(fn [shape]
|
||||
(assoc shape :masked-group false)))
|
||||
(pcb/update-shapes (map :id interacting-shapes)
|
||||
(fn [shape]
|
||||
(d/update-when shape :interactions
|
||||
(fn [interactions]
|
||||
(into []
|
||||
(remove #(and (ctsi/has-destination %)
|
||||
(contains? ids-to-delete (:destination %))))
|
||||
interactions))))))]
|
||||
[all-parents changes])))
|
||||
changes (-> changes
|
||||
(generate-update-shape-flags ids-to-hide objects {:hidden true})
|
||||
(pcb/remove-objects all-children {:ignore-touched true})
|
||||
(pcb/remove-objects ids-to-delete {:ignore-touched ignore-touched})
|
||||
(pcb/remove-objects empty-parents)
|
||||
(pcb/resize-parents all-parents)
|
||||
(pcb/update-shapes groups-to-unmask
|
||||
(fn [shape]
|
||||
(assoc shape :masked-group false)))
|
||||
(pcb/update-shapes (map :id interacting-shapes)
|
||||
(fn [shape]
|
||||
(d/update-when shape :interactions
|
||||
(fn [interactions]
|
||||
(into []
|
||||
(remove #(and (ctsi/has-destination %)
|
||||
(contains? ids-to-delete (:destination %))))
|
||||
interactions))))))]
|
||||
[all-parents changes]))
|
||||
|
||||
|
||||
(defn generate-relocate
|
||||
@@ -259,7 +255,7 @@
|
||||
|
||||
child-heads-ids (map :id child-heads)
|
||||
|
||||
variant-shapes (filter ctk/is-variant? shapes)
|
||||
variant-heads (filter ctk/is-variant? child-heads)
|
||||
|
||||
component-main-parent
|
||||
(ctn/find-component-main objects parent false)
|
||||
@@ -343,19 +339,7 @@
|
||||
(map :id)))
|
||||
|
||||
index-cell-data (when to-index (ctl/get-cell-by-index parent to-index))
|
||||
cell (or cell (and index-cell-data [(:row index-cell-data) (:column index-cell-data)]))
|
||||
|
||||
|
||||
;; Parents that are a variant-container that becomes empty
|
||||
empty-variant-cont (reduce
|
||||
(fn [to-delete parent-id]
|
||||
(let [parent (get objects parent-id)]
|
||||
(if (and (ctk/is-variant-container? parent)
|
||||
(empty? (remove (set ids) (:shapes parent))))
|
||||
(conj to-delete (:id parent))
|
||||
to-delete)))
|
||||
#{}
|
||||
(remove #(= % parent-id) all-parents))]
|
||||
cell (or cell (and index-cell-data [(:row index-cell-data) (:column index-cell-data)]))]
|
||||
|
||||
(-> changes
|
||||
;; Remove layout-item properties when moving a shape outside a layout
|
||||
@@ -384,11 +368,82 @@
|
||||
|
||||
;; Remove variant info and rename when moving outside a variant-container
|
||||
(cond-> (not (ctk/is-variant-container? parent))
|
||||
(clvp/generate-make-shapes-no-variant variant-shapes))
|
||||
((fn [changes]
|
||||
(reduce
|
||||
(fn [changes shape]
|
||||
(let [new-name (str/replace (:variant-name shape) #", " " / ")
|
||||
[cpath cname] (cfh/parse-path-name new-name)]
|
||||
(-> changes
|
||||
(pcb/update-component (:component-id shape)
|
||||
#(-> (dissoc % :variant-id :variant-properties)
|
||||
(assoc :name cname
|
||||
:path cpath))
|
||||
{:apply-changes-local-library? true})
|
||||
(pcb/update-shapes [(:id shape)]
|
||||
#(-> (dissoc % :variant-id :variant-name)
|
||||
(assoc :name new-name))))))
|
||||
changes
|
||||
variant-heads))))
|
||||
|
||||
;; Add variant info and rename when moving into a different variant-container
|
||||
(cond-> (ctk/is-variant-container? parent)
|
||||
(clvp/generate-make-shapes-variant child-heads parent))
|
||||
((fn [changes]
|
||||
(let [get-base-name #(if (some? (:variant-name %))
|
||||
(str/replace (:variant-name %) #", " " / ")
|
||||
(:name %))
|
||||
|
||||
calc-num-props #(-> %
|
||||
get-base-name
|
||||
cfh/split-path
|
||||
count)
|
||||
|
||||
max-path-items (apply max (map calc-num-props child-heads))
|
||||
|
||||
first-comp-id (->> parent
|
||||
:shapes
|
||||
first
|
||||
(get objects)
|
||||
:component-id)
|
||||
|
||||
data (pcb/get-library-data changes)
|
||||
variant-properties (get-in data [:components first-comp-id :variant-properties])
|
||||
num-props (count variant-properties)
|
||||
num-new-props (if (< max-path-items num-props)
|
||||
0
|
||||
(- max-path-items num-props))
|
||||
|
||||
changes (nth
|
||||
(iterate #(clv/generate-add-new-property % (:id parent)) changes)
|
||||
num-new-props)]
|
||||
(reduce
|
||||
(fn [changes shape]
|
||||
(if (= (:id parent) (:variant-id shape))
|
||||
changes ;; do nothing if we aren't changing the parent
|
||||
(let [base-name (get-base-name shape)
|
||||
|
||||
;; we need to get the updated library data to have access to the current properties
|
||||
data (pcb/get-library-data changes)
|
||||
|
||||
props (clv/path-to-properties
|
||||
base-name
|
||||
(get-in data [:components first-comp-id :variant-properties]))
|
||||
|
||||
variant-name (clv/properties-to-name props)
|
||||
[cpath cname] (cfh/parse-path-name (:name parent))]
|
||||
|
||||
(-> (pcb/update-component changes
|
||||
(:component-id shape)
|
||||
#(assoc % :variant-id (:id parent)
|
||||
:variant-properties props
|
||||
:name cname
|
||||
:path cpath)
|
||||
{:apply-changes-local-library? true})
|
||||
(pcb/update-shapes [(:id shape)]
|
||||
#(assoc % :variant-id (:id parent)
|
||||
:variant-name variant-name
|
||||
:name (:name parent)))))))
|
||||
changes
|
||||
child-heads)))))
|
||||
|
||||
;; Move the shapes
|
||||
(pcb/change-parent parent-id
|
||||
@@ -463,11 +518,7 @@
|
||||
(pcb/update-shapes ids #(assoc % :blocked true)))
|
||||
|
||||
;; Resize parent containers that need to
|
||||
(pcb/resize-parents parents)
|
||||
|
||||
;; Remove parents when are a variant-container that becomes empty
|
||||
(cond-> (seq empty-variant-cont)
|
||||
(#(second (generate-delete-shapes % empty-variant-cont {})))))))
|
||||
(pcb/resize-parents parents))))
|
||||
|
||||
(defn change-show-in-viewer
|
||||
[shape hide?]
|
||||
|
||||
@@ -1,201 +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.logic.variant-properties
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.files.changes-builder :as pcb]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.files.variant :as cfv]
|
||||
[app.common.types.component :as ctk]
|
||||
[app.common.types.components-list :as ctcl]
|
||||
[app.common.types.variant :as ctv]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(defn generate-update-property-name
|
||||
[changes variant-id pos new-name]
|
||||
(let [data (pcb/get-library-data changes)
|
||||
objects (pcb/get-objects changes)
|
||||
related-components (cfv/find-variant-components data objects variant-id)]
|
||||
(reduce (fn [changes component]
|
||||
(pcb/update-component
|
||||
changes (:id component)
|
||||
#(assoc-in % [:variant-properties pos :name] new-name)
|
||||
{:apply-changes-local-library? true}))
|
||||
changes
|
||||
related-components)))
|
||||
|
||||
|
||||
(defn generate-remove-property
|
||||
[changes variant-id pos]
|
||||
(let [data (pcb/get-library-data changes)
|
||||
objects (pcb/get-objects changes)
|
||||
related-components (cfv/find-variant-components data objects variant-id)]
|
||||
(reduce (fn [changes component]
|
||||
(let [props (:variant-properties component)
|
||||
props (d/remove-at-index props pos)
|
||||
main-id (:main-instance-id component)
|
||||
name (ctv/properties-to-name props)]
|
||||
(-> changes
|
||||
(pcb/update-component (:id component) #(assoc % :variant-properties props)
|
||||
{:apply-changes-local-library? true})
|
||||
(pcb/update-shapes [main-id] #(assoc % :variant-name name)))))
|
||||
changes
|
||||
related-components)))
|
||||
|
||||
|
||||
(defn generate-update-property-value
|
||||
[changes component-id pos value]
|
||||
(let [data (pcb/get-library-data changes)
|
||||
component (ctcl/get-component data component-id true)
|
||||
main-id (:main-instance-id component)
|
||||
name (-> (:variant-properties component)
|
||||
(update pos assoc :value value)
|
||||
ctv/properties-to-name)]
|
||||
(-> changes
|
||||
(pcb/update-component component-id #(assoc-in % [:variant-properties pos :value] value)
|
||||
{:apply-changes-local-library? true})
|
||||
(pcb/update-shapes [main-id] #(assoc % :variant-name name)))))
|
||||
|
||||
|
||||
(defn generate-add-new-property
|
||||
[changes variant-id & {:keys [fill-values? property-name]}]
|
||||
(let [data (pcb/get-library-data changes)
|
||||
objects (pcb/get-objects changes)
|
||||
related-components (cfv/find-variant-components data objects variant-id)
|
||||
|
||||
props (-> related-components last :variant-properties)
|
||||
next-prop-num (ctv/next-property-number props)
|
||||
property-name (or property-name (str ctv/property-prefix next-prop-num))
|
||||
|
||||
[_ changes]
|
||||
(reduce (fn [[num changes] component]
|
||||
(let [main-id (:main-instance-id component)
|
||||
|
||||
update-props #(-> (d/nilv % [])
|
||||
(conj {:name property-name
|
||||
:value (if fill-values? (str ctv/value-prefix num) "")}))
|
||||
|
||||
update-name #(if fill-values?
|
||||
(if (str/empty? %)
|
||||
(str ctv/value-prefix num)
|
||||
(str % ", " ctv/value-prefix num))
|
||||
%)]
|
||||
[(inc num)
|
||||
(-> changes
|
||||
(pcb/update-component (:id component)
|
||||
#(update % :variant-properties update-props)
|
||||
{:apply-changes-local-library? true})
|
||||
(pcb/update-shapes [main-id] #(update % :variant-name update-name)))]))
|
||||
[1 changes]
|
||||
related-components)]
|
||||
changes))
|
||||
|
||||
(defn- generate-make-shape-no-variant
|
||||
[changes 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)
|
||||
#(-> (dissoc % :variant-id :variant-properties)
|
||||
(assoc :name cname
|
||||
:path cpath))
|
||||
{:apply-changes-local-library? true})
|
||||
(pcb/update-shapes [(:id shape)]
|
||||
#(-> (dissoc % :variant-id :variant-name)
|
||||
(assoc :name new-name))))))
|
||||
|
||||
(defn generate-make-shapes-no-variant
|
||||
[changes shapes]
|
||||
(reduce generate-make-shape-no-variant changes shapes))
|
||||
|
||||
|
||||
(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))
|
||||
new-props (- min-props
|
||||
(+ (count props)
|
||||
(if add-name? 1 0)))
|
||||
props (ctv/add-new-props props (repeat new-props ""))]
|
||||
|
||||
(if add-name?
|
||||
(ctv/add-new-prop props (:name component))
|
||||
props)))
|
||||
|
||||
(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)]
|
||||
(ctv/path-to-properties shape-name base-properties min-props)))
|
||||
|
||||
|
||||
(defn generate-make-shapes-variant
|
||||
[changes shapes variant-container]
|
||||
(let [data (pcb/get-library-data changes)
|
||||
objects (pcb/get-objects changes)
|
||||
variant-id (:id variant-container)
|
||||
|
||||
;; If we are cut-pasting a variant-container, this will be null
|
||||
;; because it hasn't any shapes yet
|
||||
first-comp-id (->> variant-container
|
||||
:shapes
|
||||
first
|
||||
(get objects)
|
||||
:component-id)
|
||||
|
||||
base-props (->> (get-in data [:components first-comp-id :variant-properties])
|
||||
(map #(assoc % :value "")))
|
||||
num-base-props (count base-props)
|
||||
|
||||
[cpath cname] (cfh/parse-path-name (:name variant-container))
|
||||
container-name (:name variant-container)
|
||||
|
||||
create-new-properties
|
||||
(fn [shape min-props]
|
||||
(if (ctk/is-variant? shape)
|
||||
(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 (create-new-properties shape num-base-props))))
|
||||
0
|
||||
shapes)
|
||||
|
||||
num-new-props (if (or (zero? num-base-props)
|
||||
(< total-props num-base-props))
|
||||
0
|
||||
(- total-props num-base-props))
|
||||
|
||||
changes (nth
|
||||
(iterate #(generate-add-new-property % variant-id) changes)
|
||||
num-new-props)
|
||||
|
||||
changes (pcb/update-shapes changes (map :id shapes)
|
||||
#(assoc % :variant-id variant-id
|
||||
:name (:name variant-container)))]
|
||||
(reduce
|
||||
(fn [changes shape]
|
||||
(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)))
|
||||
@@ -1,75 +1,160 @@
|
||||
;; 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.logic.variants
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[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.components-list :as ctcl]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.types.variant :as ctv]))
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
|
||||
(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)
|
||||
objects (pcb/get-objects changes)
|
||||
component-id (:component-id shape)
|
||||
value (str ctv/value-prefix
|
||||
(-> (cfv/extract-properties-values data objects variant-id)
|
||||
last
|
||||
:value
|
||||
count
|
||||
inc))
|
||||
(def property-prefix "Property")
|
||||
(def property-regex (re-pattern (str property-prefix "(\\d+)")))
|
||||
(def value-prefix "Value")
|
||||
|
||||
[new-shape changes] (-> changes
|
||||
(cll/generate-duplicate-component
|
||||
{:data data}
|
||||
component-id
|
||||
new-component-id
|
||||
{:new-shape-id new-shape-id :apply-changes-local-library? true}))]
|
||||
(defn find-related-components
|
||||
"Find a list of the components thet belongs to this variant-id"
|
||||
[data objects variant-id]
|
||||
(->> (dm/get-in objects [variant-id :shapes])
|
||||
(map #(dm/get-in objects [% :component-id]))
|
||||
(map #(ctcl/get-component data % true))
|
||||
reverse))
|
||||
|
||||
|
||||
(defn properties-to-name
|
||||
"Transform the properties into a name, with the values separated by comma"
|
||||
[properties]
|
||||
(->> properties
|
||||
(map :value)
|
||||
(remove str/empty?)
|
||||
(str/join ", ")))
|
||||
|
||||
|
||||
(defn next-property-number
|
||||
"Returns the next property number, to avoid duplicates on the property names"
|
||||
[properties]
|
||||
(let [numbers (keep
|
||||
#(some->> (:name %) (re-find property-regex) second d/parse-integer)
|
||||
properties)
|
||||
max-num (if (seq numbers)
|
||||
(apply max numbers)
|
||||
0)]
|
||||
(inc (max max-num (count properties)))))
|
||||
|
||||
|
||||
(defn path-to-properties
|
||||
"From a list of properties and a name with path, assign each token of the
|
||||
path as value of a different property"
|
||||
[path properties]
|
||||
(let [next-prop-num (next-property-number properties)
|
||||
cpath (cfh/split-path path)
|
||||
assigned (mapv #(assoc % :value (nth cpath %2 "")) properties (range))
|
||||
remaining (drop (count properties) cpath)
|
||||
new-properties (map-indexed (fn [i v] {:name (str property-prefix (+ next-prop-num i))
|
||||
:value v}) remaining)]
|
||||
(into assigned new-properties)))
|
||||
|
||||
(defn- dashes-to-end
|
||||
[property-values]
|
||||
(let [dashes (if (some #(= % "--") property-values) ["--"] [])]
|
||||
(concat (remove #(= % "--") property-values) dashes)))
|
||||
|
||||
|
||||
(defn extract-properties-values
|
||||
[data objects variant-id]
|
||||
(->> (find-related-components data objects variant-id)
|
||||
(mapcat :variant-properties)
|
||||
(group-by :name)
|
||||
(map (fn [[k v]]
|
||||
{:name k
|
||||
:value (->> v
|
||||
(map #(if (str/empty? (:value %)) "--" (:value %)))
|
||||
distinct
|
||||
dashes-to-end)}))))
|
||||
|
||||
|
||||
(defn generate-update-property-name
|
||||
[changes variant-id pos new-name]
|
||||
(let [data (pcb/get-library-data changes)
|
||||
objects (pcb/get-objects changes)
|
||||
related-components (find-related-components data objects variant-id)]
|
||||
(reduce (fn [changes component]
|
||||
(pcb/update-component
|
||||
changes (:id component)
|
||||
#(assoc-in % [:variant-properties pos :name] new-name)
|
||||
{:apply-changes-local-library? true}))
|
||||
changes
|
||||
related-components)))
|
||||
|
||||
|
||||
(defn generate-remove-property
|
||||
[changes variant-id pos]
|
||||
(let [data (pcb/get-library-data changes)
|
||||
objects (pcb/get-objects changes)
|
||||
related-components (find-related-components data objects variant-id)]
|
||||
(reduce (fn [changes component]
|
||||
(let [props (:variant-properties component)
|
||||
props (d/remove-at-index props pos)
|
||||
main-id (:main-instance-id component)
|
||||
name (properties-to-name props)]
|
||||
(-> changes
|
||||
(pcb/update-component (:id component) #(assoc % :variant-properties props)
|
||||
{:apply-changes-local-library? true})
|
||||
(pcb/update-shapes [main-id] #(assoc % :variant-name name)))))
|
||||
changes
|
||||
related-components)))
|
||||
|
||||
|
||||
(defn generate-update-property-value
|
||||
[changes component-id pos value]
|
||||
(let [data (pcb/get-library-data changes)
|
||||
component (ctcl/get-component data component-id true)
|
||||
main-id (:main-instance-id component)
|
||||
name (-> (:variant-properties component)
|
||||
(update pos assoc :value value)
|
||||
properties-to-name)]
|
||||
(-> changes
|
||||
(clvp/generate-update-property-value new-component-id prop-num value)
|
||||
(pcb/change-parent (:parent-id shape) [new-shape] 0))))
|
||||
(pcb/update-component component-id #(assoc-in % [:variant-properties pos :value] value)
|
||||
{:apply-changes-local-library? true})
|
||||
(pcb/update-shapes [main-id] #(assoc % :variant-name name)))))
|
||||
|
||||
(defn generate-keep-touched
|
||||
[changes new-shape original-shape original-shapes page]
|
||||
(let [data (pcb/get-library-data changes)
|
||||
objects (pcb/get-objects changes)
|
||||
|
||||
orig-comp (ctcl/get-component data (:component-id original-shape) true)
|
||||
(defn generate-add-new-property
|
||||
[changes variant-id & {:keys [fill-values?]}]
|
||||
(let [data (pcb/get-library-data changes)
|
||||
objects (pcb/get-objects changes)
|
||||
related-components (find-related-components data objects variant-id)
|
||||
|
||||
new-path-map (into {}
|
||||
(map (fn [shape] {(generate-path "" objects (:id new-shape) shape) shape}))
|
||||
(cfh/get-children-with-self objects (:id new-shape)))
|
||||
props (-> related-components first :variant-properties)
|
||||
next-prop-num (next-property-number props)
|
||||
property-name (str property-prefix next-prop-num)
|
||||
|
||||
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/get-ref-shape data orig-comp 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)))
|
||||
[_ changes]
|
||||
(reduce (fn [[num changes] component]
|
||||
(let [main-id (:main-instance-id component)
|
||||
|
||||
update-props #(-> (d/nilv % [])
|
||||
(conj {:name property-name
|
||||
:value (if fill-values? (str value-prefix num) "")}))
|
||||
|
||||
update-name #(if fill-values?
|
||||
(if (str/empty? %)
|
||||
(str value-prefix num)
|
||||
(str % ", " value-prefix num))
|
||||
%)]
|
||||
[(inc num)
|
||||
(-> changes
|
||||
(pcb/update-component (:id component)
|
||||
#(update % :variant-properties update-props)
|
||||
{:apply-changes-local-library? true})
|
||||
(pcb/update-shapes [main-id] #(update % :variant-name update-name)))]))
|
||||
[1 changes]
|
||||
related-components)]
|
||||
changes))
|
||||
|
||||
|
||||
@@ -9,7 +9,6 @@
|
||||
#?(: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]
|
||||
@@ -114,10 +113,6 @@
|
||||
[schema]
|
||||
(mu/optional-keys schema default-options))
|
||||
|
||||
(defn required-keys
|
||||
[schema]
|
||||
(mu/required-keys schema default-options))
|
||||
|
||||
(defn transformer
|
||||
[& transformers]
|
||||
(apply mt/transformer transformers))
|
||||
@@ -150,30 +145,11 @@
|
||||
;; :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
|
||||
[]
|
||||
(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))))
|
||||
(mt/transformer
|
||||
(mt/json-transformer)
|
||||
(mt/collection-transformer)))
|
||||
|
||||
(defn string-transformer
|
||||
[]
|
||||
@@ -833,8 +809,7 @@
|
||||
|
||||
gen (sg/one-of
|
||||
(sg/small-int :max max :min min)
|
||||
(->> (sg/small-double :max max :min min)
|
||||
(sg/fmap #(mth/precision % 2))))]
|
||||
(sg/small-double :max max :min min))]
|
||||
|
||||
{:pred pred
|
||||
:type-properties
|
||||
@@ -899,7 +874,7 @@
|
||||
{:title "inst"
|
||||
:description "Satisfies Inst protocol"
|
||||
:error/message "should be an instant"
|
||||
:gen/gen (->> (sg/small-int :min 0 :max 100000)
|
||||
:gen/gen (->> (sg/small-int)
|
||||
(sg/fmap (fn [v] (tm/parse-instant v))))
|
||||
|
||||
:decode/string tm/parse-instant
|
||||
@@ -909,22 +884,6 @@
|
||||
::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 vector])
|
||||
(:refer-clojure :exclude [set subseq uuid filter map let boolean])
|
||||
#?(:cljs (:require-macros [app.common.schema.generators]))
|
||||
(:require
|
||||
[app.common.schema.registry :as sr]
|
||||
@@ -126,7 +126,3 @@
|
||||
(defn tuple
|
||||
[& opts]
|
||||
(apply tg/tuple opts))
|
||||
|
||||
(defn vector
|
||||
[& opts]
|
||||
(apply tg/vector opts))
|
||||
|
||||
@@ -56,8 +56,13 @@
|
||||
(str "(pass=TRUE, tests=" (:num-tests params) ", seed=" (:seed params) ", elapsed=" time "ms)"))))
|
||||
|
||||
(defmethod ct/report #?(:clj ::thrunk :cljs [:cljs.test/default ::thrunk])
|
||||
[_]
|
||||
nil)
|
||||
[{: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)))
|
||||
|
||||
(defmethod ct/report #?(:clj ::trial :cljs [:cljs.test/default ::trial])
|
||||
[_]
|
||||
@@ -71,12 +76,9 @@
|
||||
(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)
|
||||
|
||||
@@ -40,3 +40,76 @@
|
||||
(map (fn [segment]
|
||||
(.toPersistentMap ^js segment)))
|
||||
(parser/parse path-str)))))
|
||||
|
||||
#?(:cljs
|
||||
(defn content->buffer
|
||||
"Converts the path content into binary format."
|
||||
[content]
|
||||
(let [total (count content)
|
||||
ssize 28
|
||||
buffer (new js/ArrayBuffer (* total ssize))
|
||||
dview (new js/DataView buffer)]
|
||||
(loop [index 0]
|
||||
(when (< index total)
|
||||
(let [segment (nth content index)
|
||||
offset (* index ssize)]
|
||||
(case (:command segment)
|
||||
:move-to
|
||||
(let [{:keys [x y]} (:params segment)]
|
||||
(.setInt16 dview (+ offset 0) 1)
|
||||
(.setFloat32 dview (+ offset 20) x)
|
||||
(.setFloat32 dview (+ offset 24) y))
|
||||
:line-to
|
||||
(let [{:keys [x y]} (:params segment)]
|
||||
(.setInt16 dview (+ offset 0) 2)
|
||||
(.setFloat32 dview (+ offset 20) x)
|
||||
(.setFloat32 dview (+ offset 24) y))
|
||||
:curve-to
|
||||
(let [{:keys [c1x c1y c2x c2y x y]} (:params segment)]
|
||||
(.setInt16 dview (+ offset 0) 3)
|
||||
(.setFloat32 dview (+ offset 4) c1x)
|
||||
(.setFloat32 dview (+ offset 8) c1y)
|
||||
(.setFloat32 dview (+ offset 12) c2x)
|
||||
(.setFloat32 dview (+ offset 16) c2y)
|
||||
(.setFloat32 dview (+ offset 20) x)
|
||||
(.setFloat32 dview (+ offset 24) y))
|
||||
|
||||
:close-path
|
||||
(.setInt16 dview (+ offset 0) 4))
|
||||
(recur (inc index)))))
|
||||
buffer)))
|
||||
|
||||
#?(:cljs
|
||||
(defn buffer->content
|
||||
"Converts the a buffer to a path content vector"
|
||||
[buffer]
|
||||
(assert (instance? js/ArrayBuffer buffer) "expected ArrayBuffer instance")
|
||||
(let [ssize 28
|
||||
total (/ (.-byteLength buffer) ssize)
|
||||
dview (new js/DataView buffer)]
|
||||
(loop [index 0
|
||||
result []]
|
||||
(if (< index total)
|
||||
(let [offset (* index ssize)
|
||||
type (.getInt16 dview (+ offset 0))
|
||||
command (case type
|
||||
1 :move-to
|
||||
2 :line-to
|
||||
3 :curve-to
|
||||
4 :close-path)
|
||||
params (case type
|
||||
1 {:x (.getFloat32 dview (+ offset 20))
|
||||
:y (.getFloat32 dview (+ offset 24))}
|
||||
2 {:x (.getFloat32 dview (+ offset 20))
|
||||
:y (.getFloat32 dview (+ offset 24))}
|
||||
3 {:c1x (.getFloat32 dview (+ offset 4))
|
||||
:c1y (.getFloat32 dview (+ offset 8))
|
||||
:c2x (.getFloat32 dview (+ offset 12))
|
||||
:c2y (.getFloat32 dview (+ offset 16))
|
||||
:x (.getFloat32 dview (+ offset 20))
|
||||
:y (.getFloat32 dview (+ offset 24))}
|
||||
4 {})]
|
||||
(recur (inc index)
|
||||
(conj result {:command command
|
||||
:params params})))
|
||||
result)))))
|
||||
|
||||
334
common/src/app/common/svg/path/bool.cljc
Normal file
334
common/src/app/common/svg/path/bool.cljc
Normal file
@@ -0,0 +1,334 @@
|
||||
;; 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.bool
|
||||
(:require
|
||||
[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.svg.path.command :as upc]
|
||||
[app.common.svg.path.subpath :as ups]))
|
||||
|
||||
(defn add-previous
|
||||
([content]
|
||||
(add-previous content nil))
|
||||
([content first]
|
||||
(->> (d/with-prev content)
|
||||
(mapv (fn [[cmd prev]]
|
||||
(cond-> cmd
|
||||
(and (nil? prev) (some? first))
|
||||
(assoc :prev first)
|
||||
|
||||
(some? prev)
|
||||
(assoc :prev (gsp/command->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]
|
||||
|
||||
(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
|
||||
|
||||
(= :close-path (:command head))
|
||||
(upc/make-line-to last-move)
|
||||
|
||||
:else
|
||||
head)]
|
||||
|
||||
(recur (first content)
|
||||
(rest content)
|
||||
(cond-> result (some? head) (conj head))
|
||||
(if (= :move-to (:command head))
|
||||
head-p
|
||||
last-move)
|
||||
head-p)))))
|
||||
|
||||
(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)
|
||||
[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))
|
||||
|
||||
(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 (= :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 (:command seg-1))
|
||||
(= :curve-to (:command seg-2)))
|
||||
(gsp/curve-curve-intersect (gsp/command->bezier seg-1) (gsp/command->bezier seg-2))
|
||||
|
||||
:else
|
||||
[[] []]))
|
||||
|
||||
(defn content-intersect-split
|
||||
[content-a content-b sr-a sr-b]
|
||||
|
||||
(let [command->selrect (memoize gsp/command->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]
|
||||
(if (or (= :move-to (:command seg-1))
|
||||
(= :move-to (:command seg-2)))
|
||||
false
|
||||
(let [r1 (command->selrect seg-1)
|
||||
r2 (command->selrect seg-2)]
|
||||
(grc/overlaps-rects? r1 r2))))
|
||||
|
||||
(split
|
||||
[seg-1 seg-2]
|
||||
(if (not (overlap-segments? seg-1 seg-2))
|
||||
[seg-1]
|
||||
(let [[ts-seg-1 _] (split-ts seg-1 seg-2)]
|
||||
(-> (split-command seg-1 ts-seg-1)
|
||||
(add-previous (:prev seg-1))))))
|
||||
|
||||
(split-segment-on-content
|
||||
[segment content content-sr]
|
||||
|
||||
(if (overlap-segment-selrect? segment content-sr)
|
||||
(->> content
|
||||
(filter #(overlap-segments? segment %))
|
||||
(reduce
|
||||
(fn [result current]
|
||||
(into [] (mapcat #(split % current)) result))
|
||||
[segment]))
|
||||
[segment]))
|
||||
|
||||
(split-content
|
||||
[content-a content-b sr-b]
|
||||
(into []
|
||||
(mapcat #(split-segment-on-content % content-b sr-b))
|
||||
content-a))]
|
||||
|
||||
[(split-content content-a content-b sr-b)
|
||||
(split-content content-b content-a sr-a)])))
|
||||
|
||||
(defn is-segment?
|
||||
[cmd]
|
||||
(and (contains? cmd :prev)
|
||||
(contains? #{:line-to :curve-to} (:command cmd))))
|
||||
|
||||
(defn contains-segment?
|
||||
[segment content content-sr content-geom]
|
||||
|
||||
(let [point (case (:command segment)
|
||||
:line-to (-> (gsp/command->line segment)
|
||||
(gsp/line-values 0.5))
|
||||
|
||||
:curve-to (-> (gsp/command->bezier segment)
|
||||
(gsp/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)))))
|
||||
|
||||
(defn inside-segment?
|
||||
[segment content-sr content-geom]
|
||||
(let [point (case (:command segment)
|
||||
:line-to (-> (gsp/command->line segment)
|
||||
(gsp/line-values 0.5))
|
||||
|
||||
:curve-to (-> (gsp/command->bezier segment)
|
||||
(gsp/curve-values 0.5)))]
|
||||
|
||||
(and (grc/contains-point? content-sr point)
|
||||
(gsp/is-point-in-geom-data? point content-geom))))
|
||||
|
||||
(defn overlap-segment?
|
||||
"Finds if the current segment is overlapping against other
|
||||
segment meaning they have the same coordinates"
|
||||
[segment content]
|
||||
|
||||
(let [overlap-single?
|
||||
(fn [other]
|
||||
(when (and (= (:command segment) (:command other))
|
||||
(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)]
|
||||
|
||||
(when (or (and (< (gpt/distance p1 p2) 0.1)
|
||||
(< (gpt/distance q1 q2) 0.1))
|
||||
(and (< (gpt/distance p1 q2) 0.1)
|
||||
(< (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)]
|
||||
|
||||
(when (or (and (< (gpt/distance p1 p2) 0.1)
|
||||
(< (gpt/distance q1 q2) 0.1)
|
||||
(< (gpt/distance h11 h12) 0.1)
|
||||
(< (gpt/distance h21 h22) 0.1))
|
||||
|
||||
(and (< (gpt/distance p1 q2) 0.1)
|
||||
(< (gpt/distance q1 p2) 0.1)
|
||||
(< (gpt/distance h11 h22) 0.1)
|
||||
(< (gpt/distance h21 h12) 0.1)))
|
||||
|
||||
[segment other])))))]
|
||||
|
||||
(->> content
|
||||
(d/seek overlap-single?)
|
||||
(some?))))
|
||||
|
||||
(defn fix-move-to
|
||||
[content]
|
||||
;; Remove the field `:prev` and makes the necessaries `move-to`
|
||||
;; then clean the subpaths
|
||||
|
||||
(loop [current (first content)
|
||||
content (rest content)
|
||||
prev nil
|
||||
result []]
|
||||
|
||||
(if (nil? current)
|
||||
result
|
||||
|
||||
(let [result (if (not= (:prev current) prev)
|
||||
(conj result (upc/make-move-to (:prev current)))
|
||||
result)]
|
||||
(recur (first content)
|
||||
(rest content)
|
||||
(gsp/command->point current)
|
||||
(conj result (dissoc current :prev)))))))
|
||||
|
||||
(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)
|
||||
|
||||
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-sr (gsp/content->selrect (fix-move-to content))
|
||||
|
||||
;; Overlapping segments should be added when they are part of the border
|
||||
border-content
|
||||
(->> content-b-split
|
||||
(filter #(and (contains-segment? % content-a sr-a content-a-geom)
|
||||
(overlap-segment? % content-a-split)
|
||||
(not (inside-segment? % content-sr content-geom)))))]
|
||||
|
||||
;; Ensure that the output is always a vector
|
||||
(d/concat-vec content border-content)))
|
||||
|
||||
(defn create-difference [content-a content-a-split content-b content-b-split sr-a sr-b]
|
||||
;; Pick all segments in content-a that are not inside content-b
|
||||
;; Pick all segments in content b that are inside content-a
|
||||
;; removing overlapping
|
||||
(let [content-a-geom (gsp/content->geom-data content-a)
|
||||
content-b-geom (gsp/content->geom-data content-b)]
|
||||
(d/concat-vec
|
||||
(->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom))))
|
||||
|
||||
;; Reverse second content so we can have holes inside other shapes
|
||||
(->> content-b-split
|
||||
(filter #(and (contains-segment? % content-a sr-a content-a-geom)
|
||||
(not (overlap-segment? % content-a-split))))))))
|
||||
|
||||
(defn create-intersection [content-a content-a-split content-b content-b-split sr-a sr-b]
|
||||
;; Pick all segments in content-a that are inside content-b
|
||||
;; Pick all segments in content-b that are inside content-a
|
||||
(let [content-a-geom (gsp/content->geom-data content-a)
|
||||
content-b-geom (gsp/content->geom-data content-b)]
|
||||
(d/concat-vec
|
||||
(->> content-a-split (filter #(contains-segment? % content-b sr-b content-b-geom)))
|
||||
(->> content-b-split (filter #(contains-segment? % content-a sr-a content-a-geom))))))
|
||||
|
||||
|
||||
(defn create-exclusion [content-a content-b]
|
||||
;; Pick all segments
|
||||
(d/concat-vec content-a content-b))
|
||||
|
||||
(defn content-bool-pair
|
||||
[bool-type content-a content-b]
|
||||
|
||||
(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)))
|
||||
|
||||
content-a (-> content-a
|
||||
(close-paths)
|
||||
(add-previous))
|
||||
|
||||
content-b (-> content-b
|
||||
(close-paths)
|
||||
(cond-> should-reverse? (ups/reverse-content))
|
||||
(add-previous))
|
||||
|
||||
sr-a (gsp/content->selrect content-a)
|
||||
sr-b (gsp/content->selrect content-b)
|
||||
|
||||
;; Split content in new segments in the intersection with the other path
|
||||
[content-a-split content-b-split] (content-intersect-split content-a content-b sr-a sr-b)
|
||||
content-a-split (->> content-a-split add-previous (filter is-segment?))
|
||||
content-b-split (->> content-b-split add-previous (filter is-segment?))
|
||||
|
||||
bool-content
|
||||
(case bool-type
|
||||
:union (create-union content-a content-a-split content-b content-b-split sr-a sr-b)
|
||||
:difference (create-difference content-a content-a-split content-b content-b-split sr-a sr-b)
|
||||
:intersection (create-intersection content-a content-a-split content-b content-b-split sr-a sr-b)
|
||||
:exclude (create-exclusion content-a-split content-b-split))]
|
||||
|
||||
(->> (fix-move-to bool-content)
|
||||
(ups/close-subpaths))))
|
||||
|
||||
(defn content-bool
|
||||
[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 []))
|
||||
[]))
|
||||
|
||||
204
common/src/app/common/svg/path/command.cljc
Normal file
204
common/src/app/common/svg/path/command.cljc
Normal file
@@ -0,0 +1,204 @@
|
||||
;; 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))))
|
||||
|
||||
324
common/src/app/common/svg/path/legacy_parser1.cljs
Normal file
324
common/src/app/common/svg/path/legacy_parser1.cljs
Normal file
@@ -0,0 +1,324 @@
|
||||
;; 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,23 +12,15 @@
|
||||
(: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.types.path.helpers :as path.helpers]
|
||||
[app.common.types.path.segment :as path.segment]
|
||||
[app.common.svg.path.command :as upc]
|
||||
[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 []
|
||||
@@ -193,7 +185,7 @@
|
||||
|
||||
(defn smooth->curve
|
||||
[{:keys [params]} pos handler]
|
||||
(let [{c1x :x c1y :y} (path.segment/calculate-opposite-handler pos handler)]
|
||||
(let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)]
|
||||
{:c1x c1x
|
||||
:c1y c1y
|
||||
:c2x (:cx params)
|
||||
@@ -421,7 +413,7 @@
|
||||
|
||||
(= :smooth-quadratic-bezier-curve-to (:command command))
|
||||
(-> (assoc :command :curve-to)
|
||||
(update :params merge (quadratic->curve prev-pos (gpt/point params) (path.segment/calculate-opposite-handler prev-pos prev-qc)))))
|
||||
(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))
|
||||
@@ -444,13 +436,13 @@
|
||||
(gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
|
||||
|
||||
:smooth-quadratic-bezier-curve-to
|
||||
(path.segment/calculate-opposite-handler prev-pos prev-qc)
|
||||
(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
|
||||
(get-point prev-pos command))
|
||||
(upc/command->point prev-pos command))
|
||||
|
||||
next-start (if (= :move-to (:command command)) next-pos prev-start)]
|
||||
|
||||
|
||||
@@ -4,34 +4,58 @@
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.types.path.shape-to-path
|
||||
(ns app.common.svg.path.shapes-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.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.geom.shapes.path :as gsp]
|
||||
[app.common.svg.path.bool :as pb]
|
||||
[app.common.svg.path.command :as pc]
|
||||
[app.common.types.shape.radius :as ctsr]))
|
||||
|
||||
(def ^:const ^:private bezier-circle-c
|
||||
0.551915024494)
|
||||
(def ^:const bezier-circle-c 0.551915024494)
|
||||
|
||||
(def ^:private dissoc-attrs
|
||||
(def dissoc-attrs
|
||||
[:x :y :width :height
|
||||
:rx :ry :r1 :r2 :r3 :r4
|
||||
:metadata])
|
||||
|
||||
(defn without-position-attrs
|
||||
[shape]
|
||||
(d/without-keys shape dissoc-attrs))
|
||||
(def allowed-transform-types
|
||||
#{:rect
|
||||
:circle
|
||||
:image})
|
||||
|
||||
(defn- make-corner-arc
|
||||
(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
|
||||
"Creates a curvle corner for border radius"
|
||||
[from to corner radius]
|
||||
(let [x (case corner
|
||||
@@ -67,9 +91,9 @@
|
||||
:bottom-right (assoc to :x c2x)
|
||||
:bottom-left (assoc to :y c2y))]
|
||||
|
||||
(helpers/make-curve-to to h1 h2)))
|
||||
(pc/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))
|
||||
@@ -88,13 +112,13 @@
|
||||
c1y (+ y (* (/ height 2) (- 1 c)))
|
||||
c2y (+ y (* (/ height 2) (+ 1 c)))]
|
||||
|
||||
[(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))]))
|
||||
[(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))]))
|
||||
|
||||
(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))
|
||||
|
||||
@@ -111,21 +135,21 @@
|
||||
p7 (gpt/point (+ x r4) (+ height y))
|
||||
p8 (gpt/point x (+ height y (- r4)))]
|
||||
(-> []
|
||||
(conj (helpers/make-move-to p1))
|
||||
(conj (pc/make-move-to p1))
|
||||
(cond-> (not= p1 p2)
|
||||
(conj (make-corner-arc p1 p2 :top-left r1)))
|
||||
(conj (helpers/make-line-to p3))
|
||||
(conj (pc/make-line-to p3))
|
||||
(cond-> (not= p3 p4)
|
||||
(conj (make-corner-arc p3 p4 :top-right r2)))
|
||||
(conj (helpers/make-line-to p5))
|
||||
(conj (pc/make-line-to p5))
|
||||
(cond-> (not= p5 p6)
|
||||
(conj (make-corner-arc p5 p6 :bottom-right r3)))
|
||||
(conj (helpers/make-line-to p7))
|
||||
(conj (pc/make-line-to p7))
|
||||
(cond-> (not= p7 p8)
|
||||
(conj (make-corner-arc p7 p8 :bottom-left r4)))
|
||||
(conj (helpers/make-line-to p1))))))
|
||||
(conj (pc/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)
|
||||
@@ -141,10 +165,7 @@
|
||||
|
||||
(declare convert-to-path)
|
||||
|
||||
;; 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
|
||||
(defn fix-first-relative
|
||||
"Fix an issue with the simplify commands not changing the first relative"
|
||||
[content]
|
||||
(let [head (first content)]
|
||||
@@ -152,19 +173,17 @@
|
||||
(and head (:relative head))
|
||||
(update 0 assoc :relative false))))
|
||||
|
||||
(defn- group-to-path
|
||||
(defn group-to-path
|
||||
[group objects]
|
||||
(let [xform (comp (map (d/getf objects))
|
||||
(map #(convert-to-path % objects)))
|
||||
(let [xform (comp (map #(get objects %))
|
||||
(map #(-> (convert-to-path % objects))))
|
||||
|
||||
child-as-paths (into [] xform (:shapes group))
|
||||
head (peek child-as-paths)
|
||||
head-data (select-keys head bool/style-properties)
|
||||
head (last child-as-paths)
|
||||
head-data (select-keys head style-properties)
|
||||
content (into []
|
||||
(comp (filter cfh/path-shape?)
|
||||
(map :content)
|
||||
(map vec)
|
||||
(mapcat fix-first-relative))
|
||||
(comp (filter #(= :path (:type %)))
|
||||
(mapcat #(fix-first-relative (:content %))))
|
||||
child-as-paths)]
|
||||
(-> group
|
||||
(assoc :type :path)
|
||||
@@ -172,68 +191,54 @@
|
||||
(merge head-data)
|
||||
(d/without-keys dissoc-attrs))))
|
||||
|
||||
(defn- bool-to-path
|
||||
(defn bool-to-path
|
||||
[shape objects]
|
||||
|
||||
(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))]
|
||||
|
||||
(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))]
|
||||
(-> 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"
|
||||
[shape objects]
|
||||
(assert (map? objects))
|
||||
;; FIXME: add check-objects-like
|
||||
;; FIXME: add check-shape ?
|
||||
"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)
|
||||
|
||||
(let [type (dm/get-prop shape :type)]
|
||||
:bool
|
||||
(bool-to-path shape objects)
|
||||
|
||||
(case type
|
||||
(:group :frame)
|
||||
(group-to-path shape objects)
|
||||
(:rect :circle :image :text)
|
||||
(let [new-content
|
||||
(case type
|
||||
:circle (circle->path shape)
|
||||
#_:else (rect->path shape))
|
||||
|
||||
:bool
|
||||
(bool-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)))
|
||||
|
||||
(:rect :circle :image :text)
|
||||
(let [content
|
||||
(if (= type :circle)
|
||||
(circle->path shape)
|
||||
(rect->path shape))
|
||||
new-content (cond-> new-content
|
||||
(some? transform)
|
||||
(gsp/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
|
||||
|
||||
content
|
||||
(path.impl/from-plain content)
|
||||
(-> shape
|
||||
(assoc :type :path)
|
||||
(assoc :content new-content)
|
||||
(cond-> (= :image type)
|
||||
(assoc :fill-image metadata))
|
||||
(d/without-keys dissoc-attrs)))
|
||||
|
||||
;; 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)))
|
||||
;; For the rest return the plain shape
|
||||
shape)))
|
||||
@@ -4,11 +4,11 @@
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.types.path.subpath
|
||||
(ns app.common.svg.path.subpath
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.types.path.helpers :as helpers]))
|
||||
[app.common.svg.path.command :as upc]))
|
||||
|
||||
(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 (helpers/segment->point command)]
|
||||
(let [p (upc/command->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))
|
||||
(helpers/make-line-to (:from subpath))
|
||||
(upc/make-line-to (:from subpath))
|
||||
command)
|
||||
p (helpers/segment->point command)]
|
||||
p (upc/command->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 [(helpers/make-move-to (:to subpath))]))]
|
||||
(reduce reverse-commands [(upc/make-move-to (:to subpath))]))]
|
||||
|
||||
(make-subpath (:to subpath) (:from subpath) new-data)))
|
||||
|
||||
@@ -125,11 +125,8 @@
|
||||
(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"
|
||||
"Searches a path for possible supaths that can create closed loops and merge them"
|
||||
[content]
|
||||
(let [subpaths (get-subpaths content)
|
||||
closed-subpaths
|
||||
@@ -156,17 +153,20 @@
|
||||
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]
|
||||
(->> (get-subpaths content)
|
||||
|
||||
(->> content
|
||||
(get-subpaths)
|
||||
(mapv reverse-subpath)
|
||||
(reverse)
|
||||
(into [] xf-mapcat-data)))
|
||||
(mapcat :data)
|
||||
(into [])))
|
||||
|
||||
;; 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} (helpers/segment->point current)
|
||||
(let [{x1 :x y1 :y :as p} (upc/command->point current)
|
||||
last? (nil? (first subpath))
|
||||
first-point (if (nil? first-point) p first-point)
|
||||
{x2 :x y2 :y} (if last? first-point (helpers/segment->point (first subpath)))
|
||||
{x2 :x y2 :y} (if last? first-point (upc/command->point (first subpath)))
|
||||
signed-area (+ signed-area (- (* x1 y2) (* x2 y1)))]
|
||||
|
||||
(recur (first subpath)
|
||||
@@ -22,7 +22,6 @@
|
||||
[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]))
|
||||
@@ -221,9 +220,9 @@
|
||||
(let [transform (csvg/parse-transform (:transform attrs))
|
||||
content (cond-> (path/parse (:d attrs))
|
||||
(some? transform)
|
||||
(path.segm/transform-content transform))
|
||||
(gsh/transform-content transform))
|
||||
|
||||
selrect (path.segm/content->selrect content)
|
||||
selrect (gsh/content->selrect content)
|
||||
points (grc/rect->points selrect)
|
||||
origin (gpt/negate (gpt/point svg-data))
|
||||
attrs (-> (dissoc attrs :d :transform)
|
||||
@@ -436,12 +435,16 @@
|
||||
|
||||
attrs
|
||||
(-> attrs
|
||||
(cond-> linecap
|
||||
(dissoc :strokeLinecap))
|
||||
(cond-> (some? color)
|
||||
(dissoc :stroke :strokeWidth :strokeOpacity))
|
||||
(update
|
||||
:style
|
||||
(fn [style]
|
||||
(-> style
|
||||
(cond-> linecap
|
||||
(dissoc :strokeLinecap))
|
||||
(cond-> (some? color)
|
||||
(dissoc :stroke :strokeWidth :strokeOpacity)))))
|
||||
(d/without-nils))]
|
||||
@@ -458,14 +461,12 @@
|
||||
|
||||
(and (some? linecap) (cfh/path-shape? shape)
|
||||
(or (= linecap :round) (= linecap :square)))
|
||||
|
||||
(assoc :stroke-cap-start linecap
|
||||
:stroke-cap-end linecap
|
||||
:stroke-linecap linecap)
|
||||
:stroke-cap-end linecap)
|
||||
|
||||
(d/any-key? (dm/get-in shape [:strokes 0])
|
||||
:strokeColor :strokeOpacity :strokeWidth
|
||||
:strokeLinecap :strokeCapStart :strokeCapEnd)
|
||||
:strokeCapStart :strokeCapEnd)
|
||||
(assoc-in [:strokes 0 :stroke-style] :svg))))
|
||||
|
||||
(defn setup-opacity [shape]
|
||||
|
||||
@@ -31,7 +31,7 @@
|
||||
"Need that root is already a frame"
|
||||
(cfh/frame-shape? root))
|
||||
|
||||
(let [[_new-root updated-shapes]
|
||||
(let [[_new-root _new-shapes updated-shapes]
|
||||
(ctn/convert-shape-in-component root (:objects page) (:id file))
|
||||
|
||||
updated-root (first updated-shapes) ; Can't use new-root because it has a new id
|
||||
@@ -54,7 +54,8 @@
|
||||
:name name
|
||||
:path path
|
||||
:main-instance-id (:id updated-root)
|
||||
:main-instance-page (:id page)))))))))
|
||||
:main-instance-page (:id page)
|
||||
:shapes updated-shapes))))))))
|
||||
|
||||
(defn update-component
|
||||
[file component-label & {:keys [] :as params}]
|
||||
@@ -97,6 +98,7 @@
|
||||
component
|
||||
(:data library)
|
||||
(gpt/point 100 100)
|
||||
true
|
||||
{:force-id (thi/new-id! copy-root-label)
|
||||
:force-frame-id frame-id})
|
||||
|
||||
|
||||
@@ -85,7 +85,7 @@
|
||||
& {:keys [component-params root-params child-params]}]
|
||||
;; Generated shape tree:
|
||||
;; {:root-label} [:name Frame1] # [Component :component-label]
|
||||
;; :child-label [:name Rect1]
|
||||
;; :child-label [:name Rect1]
|
||||
(-> file
|
||||
(add-frame-with-child root-label child-label :frame-params root-params :child-params child-params)
|
||||
(thc/make-component component-label root-label component-params)))
|
||||
@@ -95,7 +95,7 @@
|
||||
& {:keys [component-params main-root-params main-child-params copy-root-params]}]
|
||||
;; Generated shape tree:
|
||||
;; {:main-root-label} [:name Frame1] # [Component :component-label]
|
||||
;; :main-child-label [:name Rect1]
|
||||
;; :main-child-label [:name Rect1]
|
||||
;;
|
||||
;; :copy-root-label [:name Frame1] #--> [Component :component-label] :main-root-label
|
||||
;; <no-label> [:name Rect1] ---> :main-child-label
|
||||
@@ -113,9 +113,9 @@
|
||||
& {:keys [component-params root-params child-params-list]}]
|
||||
;; Generated shape tree:
|
||||
;; {:root-label} [:name Frame1] # [Component :component-label]
|
||||
;; :child1-label [:name Rect1]
|
||||
;; :child2-label [:name Rect2]
|
||||
;; :child3-label [:name Rect3]
|
||||
;; :child1-label [:name Rect1]
|
||||
;; :child2-label [:name Rect2]
|
||||
;; :child3-label [:name Rect3]
|
||||
(as-> file $
|
||||
(add-frame $ root-label root-params)
|
||||
(reduce (fn [file [index [label params]]]
|
||||
@@ -134,9 +134,9 @@
|
||||
& {:keys [component-params main-root-params main-child-params-list copy-root-params]}]
|
||||
;; Generated shape tree:
|
||||
;; {:root-label} [:name Frame1] # [Component :component-label]
|
||||
;; :child1-label [:name Rect1]
|
||||
;; :child2-label [:name Rect2]
|
||||
;; :child3-label [:name Rect3]
|
||||
;; :child1-label [:name Rect1]
|
||||
;; :child2-label [:name Rect2]
|
||||
;; :child3-label [:name Rect3]
|
||||
;;
|
||||
;; :copy-root-label [:name Frame1] #--> [Component :component-label] :root-label
|
||||
;; <no-label> [:name Rect1] ---> :child1-label
|
||||
@@ -156,7 +156,7 @@
|
||||
& {:keys [component1-params root1-params main1-child-params component2-params main2-root-params nested-head-params]}]
|
||||
;; Generated shape tree:
|
||||
;; {:main1-root-label} [:name Frame1] # [Component :component1-label]
|
||||
;; :main1-child-label [:name Rect1]
|
||||
;; :main1-child-label [:name Rect1]
|
||||
;;
|
||||
;; {:main2-root-label} [:name Frame2] # [Component :component2-label]
|
||||
;; :nested-head-label [:name Frame1] @--> [Component :component1-label] :main1-root-label
|
||||
@@ -183,7 +183,7 @@
|
||||
& {:keys [component1-params root1-params main1-child-params component2-params main2-root-params nested-head-params copy2-root-params]}]
|
||||
;; Generated shape tree:
|
||||
;; {:main1-root-label} [:name Frame1] # [Component :component1-label]
|
||||
;; :main1-child-label [:name Rect1]
|
||||
;; :main1-child-label [:name Rect1]
|
||||
;;
|
||||
;; {:main2-root-label} [:name Frame2] # [Component :component2-label]
|
||||
;; :nested-head-label [:name Frame1] @--> [Component :component1-label] :main1-root-label
|
||||
@@ -336,7 +336,8 @@
|
||||
file
|
||||
{file-id file}
|
||||
(ctn/make-container container :page)
|
||||
(:id shape)))
|
||||
(:id shape)
|
||||
true))
|
||||
file' (thf/apply-changes file changes)]
|
||||
(if propagate-fn
|
||||
(propagate-fn file')
|
||||
@@ -360,7 +361,7 @@
|
||||
(:objects page)
|
||||
#{(-> (ths/get-shape file shape-tag :page-label page-label)
|
||||
:id)}
|
||||
{})
|
||||
{:components-v2 true})
|
||||
file' (thf/apply-changes file changes)]
|
||||
(if propagate-fn
|
||||
(propagate-fn file')
|
||||
@@ -379,7 +380,7 @@
|
||||
(gpt/point 0 0) ;; delta
|
||||
{(:id file) file} ;; libraries
|
||||
(:data file) ;; library-data
|
||||
(:id file)) ;; file-id
|
||||
(:id file)) ;; file-id
|
||||
(cll/generate-duplicate-changes-update-indices (:objects page) ;; objects
|
||||
#{(:id shape)}))
|
||||
file' (thf/apply-changes file changes)]
|
||||
|
||||
@@ -22,18 +22,4 @@
|
||||
(thc/make-component component1-label root1-label)
|
||||
(thc/update-component component1-label {:variant-id variant-id :variant-properties [{:name "Property1" :value "Value1"}]})
|
||||
(thc/make-component component2-label root2-label)
|
||||
(thc/update-component component2-label {:variant-id variant-id :variant-properties [{:name "Property1" :value "Value2"}]}))))
|
||||
|
||||
(defn add-variant-two-properties
|
||||
[file variant-label component1-label root1-label component2-label root2-label
|
||||
& {:keys []}]
|
||||
(let [file (ths/add-sample-shape file variant-label :type :frame :is-variant-container true)
|
||||
variant-id (thi/id variant-label)]
|
||||
|
||||
(-> file
|
||||
(ths/add-sample-shape root2-label :type :frame :parent-label variant-label :variant-id variant-id :variant-name "p1v2, p2v2")
|
||||
(ths/add-sample-shape root1-label :type :frame :parent-label variant-label :variant-id variant-id :variant-name "p1v1, p2v1")
|
||||
(thc/make-component component1-label root1-label)
|
||||
(thc/update-component component1-label {:variant-id variant-id :variant-properties [{:name "Property1" :value "p1v1"} {:name "Property2" :value "p2v1"}]})
|
||||
(thc/make-component component2-label root2-label)
|
||||
(thc/update-component component2-label {:variant-id variant-id :variant-properties [{:name "Property1" :value "p1v2"} {:name "Property2" :value "p2v2"}]}))))
|
||||
(thc/update-component component2-label {:variant-id variant-id :variant-properties [{:name "Property1" :value "Value1"}]}))))
|
||||
|
||||
@@ -10,7 +10,6 @@
|
||||
[app.common.schema :as sm]
|
||||
[app.common.types.page :as ctp]
|
||||
[app.common.types.plugins :as ctpg]
|
||||
[app.common.types.variant :as ctv]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -18,17 +17,15 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(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])
|
||||
[: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]])
|
||||
|
||||
(sm/register! ::component schema:component)
|
||||
|
||||
@@ -93,8 +90,8 @@
|
||||
:constraints-h :constraints-group
|
||||
:constraints-v :constraints-group
|
||||
:fixed-scroll :constraints-group
|
||||
:bool-type :content-group
|
||||
:bool-content :content-group
|
||||
:bool-type :bool-group
|
||||
:bool-content :bool-group
|
||||
:exports :exports-group
|
||||
:grids :grids-group
|
||||
|
||||
@@ -182,8 +179,10 @@
|
||||
(= (:component-file shape) file-id)))
|
||||
|
||||
(defn is-main-of?
|
||||
[shape-main shape-inst]
|
||||
(= (:shape-ref shape-inst) (:id shape-main)))
|
||||
[shape-main shape-inst components-v2]
|
||||
(or (= (:shape-ref shape-inst) (:id shape-main))
|
||||
(and (= (:shape-ref shape-inst) (:shape-ref shape-main))
|
||||
(not components-v2))))
|
||||
|
||||
(defn main-instance?
|
||||
"Check if this shape is the root of the main instance of some
|
||||
@@ -287,7 +286,7 @@
|
||||
|
||||
(defn get-component-root
|
||||
[component]
|
||||
(if (some? (:main-instance-id component))
|
||||
(if (true? (:main-instance-id component))
|
||||
(get-in component [:objects (:main-instance-id component)])
|
||||
(get-in component [:objects (:id component)])))
|
||||
|
||||
@@ -334,6 +333,8 @@
|
||||
(let [parent (get objects (:parent-id shape))]
|
||||
;; We don't want to change the structure of component copies
|
||||
(and (not (in-component-copy-not-head? shape))
|
||||
;; We don't want to duplicate variants
|
||||
(not (is-variant? shape))
|
||||
;; Non instance, non copy. We allow
|
||||
(or (not (instance-head? shape))
|
||||
(not (in-component-copy? parent))))))
|
||||
|
||||
@@ -34,12 +34,20 @@
|
||||
(assoc component :modified-at (dt/now)))
|
||||
|
||||
(defn add-component
|
||||
[fdata {:keys [id name path main-instance-id main-instance-page annotation variant-id variant-properties]}]
|
||||
(let [fdata (update fdata :components assoc id (touch {:id id :name name :path path}))]
|
||||
(cond-> (update-in fdata [:components id] assoc :main-instance-id main-instance-id :main-instance-page main-instance-page)
|
||||
annotation (update-in [:components id] assoc :annotation annotation)
|
||||
variant-id (update-in [:components id] assoc :variant-id variant-id)
|
||||
variant-properties (update-in [:components id] assoc :variant-properties variant-properties))))
|
||||
[fdata {:keys [id name path main-instance-id main-instance-page shapes annotation variant-id variant-properties]}]
|
||||
(let [components-v2 (dm/get-in fdata [:options :components-v2])
|
||||
fdata (update fdata :components assoc id (touch {:id id :name name :path path}))]
|
||||
(if components-v2
|
||||
(cond-> (update-in fdata [:components id] assoc :main-instance-id main-instance-id :main-instance-page main-instance-page)
|
||||
annotation (update-in [:components id] assoc :annotation annotation)
|
||||
variant-id (update-in [:components id] assoc :variant-id variant-id)
|
||||
variant-properties (update-in [:components id] assoc :variant-properties variant-properties))
|
||||
|
||||
(let [wrap-object-fn cfeat/*wrap-with-objects-map-fn*]
|
||||
(assoc-in fdata [:components id :objects]
|
||||
(->> shapes
|
||||
(d/index-by :id)
|
||||
(wrap-object-fn)))))))
|
||||
|
||||
(defn mod-component
|
||||
[file-data {:keys [id name path main-instance-id main-instance-page objects annotation variant-id variant-properties modified-at]}]
|
||||
@@ -111,6 +119,7 @@
|
||||
[file-data component-id f & args]
|
||||
(d/update-in-when file-data [:components component-id] #(-> (apply f % args)
|
||||
(touch))))
|
||||
|
||||
(defn set-component-modified
|
||||
[file-data component-id]
|
||||
(update-component file-data component-id identity))
|
||||
|
||||
@@ -267,8 +267,67 @@
|
||||
new-children (->> (cfh/get-children objects (:id root))
|
||||
(map #(dissoc % :component-root)))]
|
||||
[(assoc new-root :id new-id)
|
||||
nil
|
||||
(into [new-root] new-children)]))
|
||||
|
||||
(defn make-component-shape ;; Only used for components v1
|
||||
"Clone the shape and all children. Generate new ids and detach
|
||||
from parent and frame. Update the original shapes to have links
|
||||
to the new ones."
|
||||
[shape objects file-id components-v2]
|
||||
(assert (nil? (:component-id shape)))
|
||||
(assert (nil? (:component-file shape)))
|
||||
(assert (nil? (:shape-ref shape)))
|
||||
(let [frame-ids-map (volatile! {})
|
||||
|
||||
;; Ensure that the component root is not an instance
|
||||
update-new-shape (fn [new-shape original-shape]
|
||||
(when (= (:type original-shape) :frame)
|
||||
(vswap! frame-ids-map assoc (:id original-shape) (:id new-shape)))
|
||||
|
||||
(cond-> new-shape
|
||||
true
|
||||
(dissoc :component-root)
|
||||
|
||||
(nil? (:parent-id new-shape))
|
||||
(dissoc :component-id
|
||||
:component-file
|
||||
:shape-ref)))
|
||||
|
||||
;; Make the original shape an instance of the new component.
|
||||
;; If one of the original shape children already was a component
|
||||
;; instance, maintain this instanceness untouched.
|
||||
update-original-shape (fn [original-shape new-shape]
|
||||
(cond-> original-shape
|
||||
(nil? (:shape-ref original-shape))
|
||||
(-> (assoc :shape-ref (:id new-shape))
|
||||
(dissoc :touched))
|
||||
|
||||
(nil? (:parent-id new-shape))
|
||||
(assoc :component-id (:id new-shape)
|
||||
:component-file file-id
|
||||
:component-root true)
|
||||
|
||||
(and (nil? (:parent-id new-shape)) components-v2)
|
||||
(assoc :main-instance true)
|
||||
|
||||
(some? (:parent-id new-shape))
|
||||
(dissoc :component-root)))
|
||||
|
||||
[new-root-shape new-shapes updated-shapes]
|
||||
(ctst/clone-shape shape
|
||||
nil
|
||||
objects
|
||||
:update-new-shape update-new-shape
|
||||
:update-original-shape update-original-shape)
|
||||
|
||||
;; If frame-id points to a shape inside the component, remap it to the
|
||||
;; corresponding new frame shape. If not, set it to nil.
|
||||
remap-frame-id (fn [shape]
|
||||
(update shape :frame-id #(get @frame-ids-map % nil)))]
|
||||
|
||||
[new-root-shape (map remap-frame-id new-shapes) updated-shapes]))
|
||||
|
||||
(defn remove-swap-keep-attrs
|
||||
"Remove flex children properties except the fit-content for flex layouts. These are properties
|
||||
that we don't have to propagate to copies but will be respected when swapping components"
|
||||
@@ -293,18 +352,20 @@
|
||||
WARNING: This process does not remap media references (on fills, strokes, ...); that is
|
||||
delegated to an async process on the backend side that checks unreferenced shapes and
|
||||
automatically creates correct references."
|
||||
([page component library-data position]
|
||||
(make-component-instance page component library-data position {}))
|
||||
([page component library-data position
|
||||
([page component library-data position components-v2]
|
||||
(make-component-instance page component library-data position components-v2 {}))
|
||||
([page component library-data position components-v2
|
||||
{:keys [main-instance? force-id force-frame-id keep-ids?]
|
||||
:or {main-instance? false force-id nil force-frame-id nil keep-ids? false}}]
|
||||
(let [component-page (ctpl/get-page library-data (:main-instance-page component))
|
||||
|
||||
component-shape (-> (get-shape component-page (:main-instance-id component))
|
||||
(assoc :parent-id nil) ;; On v2 we force parent-id to nil in order to behave like v1
|
||||
(assoc :frame-id uuid/zero)
|
||||
(remove-swap-keep-attrs))
|
||||
(let [component-page (when components-v2
|
||||
(ctpl/get-page library-data (:main-instance-page component)))
|
||||
|
||||
component-shape (if components-v2
|
||||
(-> (get-shape component-page (:main-instance-id component))
|
||||
(assoc :parent-id nil) ;; On v2 we force parent-id to nil in order to behave like v1
|
||||
(assoc :frame-id uuid/zero)
|
||||
(remove-swap-keep-attrs))
|
||||
(get-shape component (:id component)))
|
||||
|
||||
orig-pos (gpt/point (:x component-shape) (:y component-shape))
|
||||
delta (gpt/subtract position orig-pos)
|
||||
@@ -334,7 +395,8 @@
|
||||
update-new-shape
|
||||
(fn [new-shape original-shape]
|
||||
(let [new-name (:name new-shape)
|
||||
root? (ctk/instance-root? original-shape)]
|
||||
root? (or (ctk/instance-root? original-shape) ; If shape is inside a component (not components-v2)
|
||||
(nil? (:parent-id original-shape)))] ; we detect it by having no parent)
|
||||
|
||||
(when root?
|
||||
(vswap! unames conj new-name))
|
||||
@@ -355,8 +417,10 @@
|
||||
main-instance?
|
||||
(dissoc :shape-ref)
|
||||
|
||||
(not main-instance?)
|
||||
(assoc :shape-ref (:id original-shape)) ; shape-ref points to the near instance
|
||||
(and (not main-instance?)
|
||||
(or components-v2 ; In v1, shape-ref points to the remote instance
|
||||
(nil? (:shape-ref original-shape)))) ; in v2, shape-ref points to the near instance
|
||||
(assoc :shape-ref (:id original-shape))
|
||||
|
||||
(nil? (:parent-id original-shape))
|
||||
(assoc :component-id (:id component)
|
||||
@@ -364,14 +428,14 @@
|
||||
:component-root true
|
||||
:name new-name)
|
||||
|
||||
(or (some? (:parent-id original-shape)) ; On v2 we have removed the parent-id for component roots
|
||||
(or (some? (:parent-id original-shape)) ; On v2 we have removed the parent-id for component roots (see above)
|
||||
(some? component-frame))
|
||||
(dissoc :component-root))))
|
||||
|
||||
[new-shape new-shapes _]
|
||||
(ctst/clone-shape component-shape
|
||||
frame-id
|
||||
(:objects component-page)
|
||||
(if components-v2 (:objects component-page) (:objects component))
|
||||
:update-new-shape update-new-shape
|
||||
:force-id force-id
|
||||
:keep-ids? keep-ids?
|
||||
@@ -481,39 +545,21 @@
|
||||
no-changes?
|
||||
(and (every? #(= parent-id (:parent-id %)) children)
|
||||
(not pasting?))
|
||||
|
||||
;; When pasting frames, children have the frames and their children
|
||||
;; We need to check only the top shapes
|
||||
children-ids (set (map :id children))
|
||||
top-children (remove #(contains? children-ids (:parent-id %)) children)
|
||||
|
||||
;; Are all the top-children a main-instance of a component?
|
||||
all-main?
|
||||
(every? ctk/main-instance? top-children)
|
||||
(every? ctk/main-instance? children)
|
||||
|
||||
any-main-descendant
|
||||
(some
|
||||
(fn [shape]
|
||||
(some ctk/main-instance? (cfh/get-children-with-self objects (:id shape))))
|
||||
children)
|
||||
children)]
|
||||
|
||||
;; Are all the top-children a main-instance of a cutted component?
|
||||
all-comp-cut?
|
||||
(when all-main?
|
||||
(->> top-children
|
||||
(map #(ctkl/get-component (dm/get-in libraries [(:component-file %) :data])
|
||||
(:component-id %)
|
||||
true))
|
||||
(every? :deleted)))]
|
||||
(if (or no-changes?
|
||||
(and (not (invalid-structure-for-component? objects parent children pasting? libraries))
|
||||
;; If we are moving into a main component, no descendant can be main
|
||||
(or (nil? any-main-descendant) (not (ctk/main-instance? parent)))
|
||||
;; If we are moving into a variant-container, all the items should be main
|
||||
;; so if we are pasting, only allow main instances that are cut-and-pasted
|
||||
(or (not (ctk/is-variant-container? parent))
|
||||
(and (not pasting?) all-main?)
|
||||
all-comp-cut?)))
|
||||
(or all-main? (not (ctk/is-variant-container? parent)))
|
||||
;; If we are moving into a main component, no descendant can be main
|
||||
(or (nil? any-main-descendant) (not (ctk/main-instance? parent)))))
|
||||
[parent-id (get-frame parent-id)]
|
||||
(recur (:parent-id parent) objects children pasting? libraries))))))
|
||||
|
||||
@@ -556,7 +602,8 @@
|
||||
|
||||
;; TODO: the check of :width and :height probably may be
|
||||
;; removed after the check added in
|
||||
;; data/workspace/modifiers/check-delta function.
|
||||
;; data/workspace/modifiers/check-delta function. Better check
|
||||
;; it and test toroughly when activating components-v2 mode.
|
||||
in-copy?
|
||||
(ctk/in-component-copy? shape)
|
||||
|
||||
|
||||
@@ -127,11 +127,11 @@
|
||||
(ctp/make-empty-page {:id page-id :name "Page 1"}))]
|
||||
|
||||
(cond-> (assoc empty-file-data :id file-id)
|
||||
(some? page)
|
||||
(some? page-id)
|
||||
(ctpl/add-page page)
|
||||
|
||||
:always
|
||||
(update :options assoc :components-v2 true)))))
|
||||
(contains? cfeat/*current* "components/v2")
|
||||
(assoc-in [:options :components-v2] true)))))
|
||||
|
||||
(defn make-file
|
||||
[{:keys [id project-id name revn is-shared features
|
||||
@@ -221,45 +221,48 @@
|
||||
(ctpl/get-page file-data (:main-instance-page component)))
|
||||
|
||||
(defn get-component-container
|
||||
"Retrieve the container that holds the component shapes (the page
|
||||
or the component itself on deleted component)."
|
||||
"Retrieve the container that holds the component shapes (the page in components-v2
|
||||
or the component itself in v1 or deleted component)."
|
||||
[file-data component]
|
||||
(if (not (:deleted component))
|
||||
(let [component-page (get-component-page file-data component)]
|
||||
(cfh/make-container component-page :page))
|
||||
(cfh/make-container component :component)))
|
||||
(let [components-v2 (dm/get-in file-data [:options :components-v2])]
|
||||
(if (and components-v2 (not (:deleted component)))
|
||||
(let [component-page (get-component-page file-data component)]
|
||||
(cfh/make-container component-page :page))
|
||||
(cfh/make-container component :component))))
|
||||
|
||||
(defn get-component-root
|
||||
"Retrieve the root shape of the component."
|
||||
[file-data component]
|
||||
(if (not (:deleted component))
|
||||
(-> file-data
|
||||
(get-component-page component)
|
||||
(ctn/get-shape (:main-instance-id component)))
|
||||
(ctk/get-component-root component)))
|
||||
(let [components-v2 (dm/get-in file-data [:options :components-v2])]
|
||||
(if (and components-v2 (not (:deleted component)))
|
||||
(-> file-data
|
||||
(get-component-page component)
|
||||
(ctn/get-shape (:main-instance-id component)))
|
||||
(ctk/get-component-root component))))
|
||||
|
||||
(defn get-component-shape
|
||||
"Retrieve one shape in the component by id. If with-context? is true, add the
|
||||
file and container where the shape resides in its metadata."
|
||||
[file-data component shape-id & {:keys [with-context?] :or {with-context? false}}]
|
||||
(if (not (:deleted component))
|
||||
(let [component-page (get-component-page file-data component)]
|
||||
(when component-page
|
||||
(let [child (cfh/get-child (:objects component-page)
|
||||
(:main-instance-id component)
|
||||
shape-id)]
|
||||
(cond-> child
|
||||
(and child with-context?)
|
||||
(with-meta {:file {:id (:id file-data)
|
||||
:data file-data}
|
||||
:container (ctn/make-container component-page :page)})))))
|
||||
(let [components-v2 (dm/get-in file-data [:options :components-v2])]
|
||||
(if (and components-v2 (not (:deleted component)))
|
||||
(let [component-page (get-component-page file-data component)]
|
||||
(when component-page
|
||||
(let [child (cfh/get-child (:objects component-page)
|
||||
(:main-instance-id component)
|
||||
shape-id)]
|
||||
(cond-> child
|
||||
(and child with-context?)
|
||||
(with-meta {:file {:id (:id file-data)
|
||||
:data file-data}
|
||||
:container (ctn/make-container component-page :page)})))))
|
||||
|
||||
(let [shape (dm/get-in component [:objects shape-id])]
|
||||
(cond-> shape
|
||||
(and shape with-context?)
|
||||
(with-meta {:file {:id (:id file-data)
|
||||
:data file-data}
|
||||
:container (ctn/make-container component :component)})))))
|
||||
(let [shape (dm/get-in component [:objects shape-id])]
|
||||
(cond-> shape
|
||||
(and shape with-context?)
|
||||
(with-meta {:file {:id (:id file-data)
|
||||
:data file-data}
|
||||
:container (ctn/make-container component :component)}))))))
|
||||
|
||||
(defn get-ref-shape
|
||||
"Retrieve the shape in the component that is referenced by the instance shape."
|
||||
@@ -381,11 +384,12 @@
|
||||
(defn get-component-shapes
|
||||
"Retrieve all shapes of the component"
|
||||
[file-data component]
|
||||
|
||||
(if (not (:deleted component)) ;; the deleted components have its children in the :objects property
|
||||
(let [instance-page (get-component-page file-data component)]
|
||||
(cfh/get-children-with-self (:objects instance-page) (:main-instance-id component)))
|
||||
(vals (:objects component))))
|
||||
(let [components-v2 (dm/get-in file-data [:options :components-v2])]
|
||||
(if (and components-v2
|
||||
(not (:deleted component))) ;; the deleted components have its children in the :objects property
|
||||
(let [instance-page (get-component-page file-data component)]
|
||||
(cfh/get-children-with-self (:objects instance-page) (:main-instance-id component)))
|
||||
(vals (:objects component)))))
|
||||
|
||||
;; Return true if the object is a component that exists on the file or its libraries (even a deleted one)
|
||||
(defn is-main-of-known-component?
|
||||
@@ -399,52 +403,44 @@
|
||||
|
||||
(defn load-component-objects
|
||||
"Add an :objects property to the component, with only the shapes that belong to it"
|
||||
([file-data component]
|
||||
(load-component-objects file-data component (gpt/point 0 0)))
|
||||
([file-data component delta]
|
||||
(if (and component (empty? (:objects component))) ;; This operation may be called twice, e.g. in an idempotent change
|
||||
(let [component-page (get-component-page file-data component)
|
||||
page-objects (:objects component-page)
|
||||
objects (->> (cons (:main-instance-id component)
|
||||
(cfh/get-children-ids page-objects (:main-instance-id component)))
|
||||
(map #(get page-objects %))
|
||||
;; when it is an undo of a cut-paste, we need to undo the movement
|
||||
;; of the shapes so we need to move them delta
|
||||
(map #(gsh/move % delta))
|
||||
(d/index-by :id))]
|
||||
(assoc component :objects objects))
|
||||
component)))
|
||||
[file-data component]
|
||||
(let [components-v2 (dm/get-in file-data [:options :components-v2])]
|
||||
(if (and components-v2 component (empty? (:objects component))) ;; This operation may be called twice, e.g. in an idempotent change
|
||||
(let [component-page (get-component-page file-data component)
|
||||
page-objects (:objects component-page)
|
||||
objects (->> (cons (:main-instance-id component)
|
||||
(cfh/get-children-ids page-objects (:main-instance-id component)))
|
||||
(map #(get page-objects %))
|
||||
(d/index-by :id))]
|
||||
(assoc component :objects objects))
|
||||
component)))
|
||||
|
||||
(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?
|
||||
[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)
|
||||
(-> file-data
|
||||
(ctkl/update-component component-id #(load-component-objects file-data % delta))
|
||||
(ctkl/mark-component-deleted component-id)))))
|
||||
(let [set-main-instance ;; If there is a saved main-instance, restore it. This happens on the restore-component action
|
||||
#(if main-instance
|
||||
(assoc-in % [:objects (:main-instance-id %)] main-instance)
|
||||
%)]
|
||||
(-> file-data
|
||||
(ctkl/update-component component-id (partial load-component-objects file-data))
|
||||
(ctkl/update-component component-id set-main-instance)
|
||||
(ctkl/mark-component-deleted component-id))))))
|
||||
|
||||
(defn restore-component
|
||||
"Recover a deleted component and all its shapes and put all this again in place."
|
||||
[file-data component-id page-id]
|
||||
(let [update-page? (not (nil? page-id))
|
||||
component (ctkl/get-component file-data component-id true)
|
||||
main-instance-page (or page-id (:main-instance-page component))
|
||||
main-instance (dm/get-in file-data [:pages-index main-instance-page
|
||||
:objects (:main-instance-id component)])]
|
||||
(cond-> file-data
|
||||
:always
|
||||
(->
|
||||
(ctkl/update-component component-id #(dissoc % :objects))
|
||||
(ctkl/mark-component-undeleted component-id))
|
||||
|
||||
update-page?
|
||||
(ctkl/update-component component-id #(assoc % :main-instance-page page-id))
|
||||
|
||||
(ctk/is-variant? component)
|
||||
(ctkl/update-component component-id #(assoc % :variant-id (:variant-id main-instance))))))
|
||||
(let [components-v2 (dm/get-in file-data [:options :components-v2])
|
||||
update-page? (and components-v2 (not (nil? page-id)))]
|
||||
(-> file-data
|
||||
(ctkl/update-component component-id #(dissoc % :objects))
|
||||
(ctkl/mark-component-undeleted component-id)
|
||||
(cond-> update-page?
|
||||
(ctkl/update-component component-id #(assoc % :main-instance-page page-id))))))
|
||||
|
||||
(defn purge-component
|
||||
"Remove permanently a component."
|
||||
@@ -561,6 +557,7 @@
|
||||
component
|
||||
library-data
|
||||
position
|
||||
(dm/get-in file-data [:options :components-v2])
|
||||
{:main-instance? true
|
||||
:keep-ids? true})
|
||||
|
||||
@@ -592,7 +589,8 @@
|
||||
:name (:name component)
|
||||
:path (:path component)
|
||||
:main-instance-id (:id main-instance-shape)
|
||||
:main-instance-page page-id}))
|
||||
:main-instance-page page-id
|
||||
:shapes (get-component-shapes library-data component)}))
|
||||
|
||||
; Change all existing instances to point to the local file
|
||||
remap-instances
|
||||
|
||||
@@ -1,215 +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.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))))
|
||||
|
||||
@@ -1,438 +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.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.math :as mth]
|
||||
[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]
|
||||
(add-previous content nil))
|
||||
([content first]
|
||||
(->> (d/with-prev content)
|
||||
(mapv (fn [[cmd prev]]
|
||||
(cond-> cmd
|
||||
(and (nil? prev) (some? first))
|
||||
(assoc :prev first)
|
||||
|
||||
(some? 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 [segments (seq content)
|
||||
result []
|
||||
last-move nil
|
||||
last-point nil]
|
||||
(if-let [segment (first segments)]
|
||||
(let [point
|
||||
(helpers/segment->point segment)
|
||||
|
||||
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 segment))
|
||||
(helpers/make-line-to last-move)
|
||||
|
||||
:else
|
||||
segment)]
|
||||
|
||||
(recur (rest segments)
|
||||
(cond-> result (some? segment) (conj segment))
|
||||
(if (= :move-to (:command segment))
|
||||
point
|
||||
last-move)
|
||||
point))
|
||||
result)))
|
||||
|
||||
(defn- split-command
|
||||
[cmd values]
|
||||
(case (:command cmd)
|
||||
: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]
|
||||
(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 cmd-1)
|
||||
(= :curve-to cmd-2))
|
||||
(helpers/line-curve-intersect (helpers/command->line seg-1)
|
||||
(helpers/command->bezier 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 cmd-1)
|
||||
(= :curve-to cmd-2))
|
||||
(helpers/curve-curve-intersect (helpers/command->bezier seg-1)
|
||||
(helpers/command->bezier seg-2))
|
||||
|
||||
:else
|
||||
[[] []])))
|
||||
|
||||
(defn content-intersect-split
|
||||
[content-a content-b sr-a sr-b]
|
||||
|
||||
(let [command->selrect (memoize helpers/command->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]
|
||||
(if (or (= :move-to (:command seg-1))
|
||||
(= :move-to (:command seg-2)))
|
||||
false
|
||||
(let [r1 (command->selrect seg-1)
|
||||
r2 (command->selrect seg-2)]
|
||||
(grc/overlaps-rects? r1 r2))))
|
||||
|
||||
(split [seg-1 seg-2]
|
||||
(if (not (overlap-segments? seg-1 seg-2))
|
||||
[seg-1]
|
||||
(let [[ts-seg-1 _] (split-ts seg-1 seg-2)]
|
||||
(-> (split-command seg-1 ts-seg-1)
|
||||
(add-previous (:prev seg-1))))))
|
||||
|
||||
(split-segment-on-content [segment content content-sr]
|
||||
(if (overlap-segment-selrect? segment content-sr)
|
||||
(->> content
|
||||
(filter #(overlap-segments? segment %))
|
||||
(reduce
|
||||
(fn [result current]
|
||||
(into [] (mapcat #(split % current)) result))
|
||||
[segment]))
|
||||
[segment]))
|
||||
|
||||
(split-content [content-a content-b sr-b]
|
||||
(into []
|
||||
(mapcat #(split-segment-on-content % content-b sr-b))
|
||||
content-a))]
|
||||
|
||||
[(split-content content-a content-b sr-b)
|
||||
(split-content content-b content-a sr-a)])))
|
||||
|
||||
(defn is-segment?
|
||||
[cmd]
|
||||
(and (contains? cmd :prev)
|
||||
(contains? #{:line-to :curve-to} (:command cmd))))
|
||||
|
||||
(defn contains-segment?
|
||||
[segment content content-sr content-geom]
|
||||
|
||||
(let [point (case (:command segment)
|
||||
:line-to (-> (helpers/command->line segment)
|
||||
(helpers/line-values 0.5))
|
||||
|
||||
:curve-to (-> (helpers/command->bezier segment)
|
||||
(helpers/curve-values 0.5)))]
|
||||
|
||||
(and (grc/contains-point? content-sr point)
|
||||
(or
|
||||
(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 (-> (helpers/command->line segment)
|
||||
(helpers/line-values 0.5))
|
||||
|
||||
:curve-to (-> (helpers/command->bezier segment)
|
||||
(helpers/curve-values 0.5)))]
|
||||
|
||||
(and (grc/contains-point? content-sr point)
|
||||
(helpers/is-point-in-geom-data? point content-geom))))
|
||||
|
||||
(defn overlap-segment?
|
||||
"Finds if the current segment is overlapping against other
|
||||
segment meaning they have the same coordinates"
|
||||
[segment content]
|
||||
|
||||
(let [overlap-single?
|
||||
(fn [other]
|
||||
(when (and (= (:command segment) (:command other))
|
||||
(contains? #{:line-to :curve-to} (:command segment)))
|
||||
|
||||
(case (:command segment)
|
||||
: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))
|
||||
(and (< (gpt/distance p1 q2) 0.1)
|
||||
(< (gpt/distance q1 p2) 0.1)))
|
||||
[segment 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)
|
||||
(< (gpt/distance h11 h12) 0.1)
|
||||
(< (gpt/distance h21 h22) 0.1))
|
||||
|
||||
(and (< (gpt/distance p1 q2) 0.1)
|
||||
(< (gpt/distance q1 p2) 0.1)
|
||||
(< (gpt/distance h11 h22) 0.1)
|
||||
(< (gpt/distance h21 h12) 0.1)))
|
||||
|
||||
[segment other])))))]
|
||||
|
||||
(->> content
|
||||
(d/seek overlap-single?)
|
||||
(some?))))
|
||||
|
||||
(defn fix-move-to
|
||||
[content]
|
||||
;; Remove the field `:prev` and makes the necessaries `move-to`
|
||||
;; then clean the subpaths
|
||||
|
||||
(loop [current (first content)
|
||||
content (rest content)
|
||||
prev nil
|
||||
result []]
|
||||
|
||||
(if (nil? current)
|
||||
result
|
||||
|
||||
(let [result (if (not= (:prev current) prev)
|
||||
(conj result (helpers/make-move-to (:prev current)))
|
||||
result)]
|
||||
(recur (first content)
|
||||
(rest content)
|
||||
(helpers/segment->point current)
|
||||
(conj result (dissoc current :prev)))))))
|
||||
|
||||
(defn remove-duplicated-segments
|
||||
"Remove from the content segments"
|
||||
[content]
|
||||
(letfn [;; This is a comparator for float points with a precission
|
||||
;; used to remove already existing segments
|
||||
(comparator [[fx1 fy1 tx1 ty1 :as v1] [fx2 fy2 tx2 ty2 :as v2]]
|
||||
(if (and (mth/close? tx1 tx2)
|
||||
(mth/close? ty1 ty2)
|
||||
(mth/close? fx1 fx2)
|
||||
(mth/close? fy1 fy2))
|
||||
0 ;; equal
|
||||
(compare v1 v2)))]
|
||||
|
||||
(loop [current (first content)
|
||||
content (rest content)
|
||||
segments (sorted-set-by comparator)
|
||||
result []]
|
||||
|
||||
(if (nil? current)
|
||||
result
|
||||
|
||||
(let [fx (-> current :prev :x)
|
||||
fy (-> current :prev :y)
|
||||
tx (-> current :params :x)
|
||||
ty (-> current :params :y)
|
||||
|
||||
result
|
||||
(cond-> result
|
||||
(and (not (contains? segments [fx fy tx ty]))
|
||||
(not (contains? segments [tx ty fx fy])))
|
||||
(conj current))
|
||||
|
||||
segments (conj segments [fx fy tx ty])]
|
||||
|
||||
(recur (first content)
|
||||
(rest content)
|
||||
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 (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 (content->geom-data content)
|
||||
|
||||
content-sr (segment/content->selrect (fix-move-to content))
|
||||
|
||||
;; Overlapping segments should be added when they are part of the border
|
||||
border-content
|
||||
(->> content-b-split
|
||||
(filter #(and (contains-segment? % content-a sr-a content-a-geom)
|
||||
(overlap-segment? % content-a-split)
|
||||
(not (inside-segment? % content-sr content-geom)))))]
|
||||
|
||||
;; Ensure that the output is always a vector
|
||||
(d/concat-vec content border-content)))
|
||||
|
||||
(defn create-difference [content-a content-a-split content-b content-b-split sr-a sr-b]
|
||||
;; Pick all segments in content-a that are not inside content-b
|
||||
;; Pick all segments in content b that are inside content-a
|
||||
;; removing overlapping
|
||||
(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))))
|
||||
|
||||
;; Reverse second content so we can have holes inside other shapes
|
||||
(->> content-b-split
|
||||
(filter #(and (contains-segment? % content-a sr-a content-a-geom)
|
||||
(not (overlap-segment? % content-a-split))))))))
|
||||
|
||||
(defn create-intersection [content-a content-a-split content-b content-b-split 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 (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))
|
||||
|
||||
(defn content-bool-pair
|
||||
[bool-type content-a content-b]
|
||||
|
||||
(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)
|
||||
(= (subpath/clockwise? content-b)
|
||||
(subpath/clockwise? content-a)))
|
||||
|
||||
content-a
|
||||
(-> content-a
|
||||
(close-paths)
|
||||
(add-previous))
|
||||
|
||||
content-b
|
||||
(-> content-b
|
||||
(close-paths)
|
||||
(cond-> should-reverse? (subpath/reverse-content))
|
||||
(add-previous))
|
||||
|
||||
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
|
||||
(case bool-type
|
||||
:union (create-union content-a content-a-split content-b content-b-split sr-a sr-b)
|
||||
:difference (create-difference content-a content-a-split content-b content-b-split sr-a sr-b)
|
||||
:intersection (create-intersection content-a content-a-split content-b content-b-split sr-a sr-b)
|
||||
:exclude (create-exclusion content-a-split content-b-split))]
|
||||
|
||||
(-> content
|
||||
remove-duplicated-segments
|
||||
fix-move-to
|
||||
subpath/close-subpaths)))
|
||||
|
||||
(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))
|
||||
(vec))
|
||||
[]))
|
||||
@@ -1,782 +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.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)))}))
|
||||
|
||||
@@ -1,889 +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.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))))))
|
||||
@@ -22,18 +22,16 @@
|
||||
[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]
|
||||
[app.common.types.variant :as ctv]
|
||||
[app.common.uuid :as uuid]
|
||||
[clojure.set :as set]))
|
||||
|
||||
@@ -235,7 +233,7 @@
|
||||
[:map {:title "BoolAttrs"}
|
||||
[:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
|
||||
[:bool-type [::sm/one-of bool-types]]
|
||||
[:content ::path/content]])
|
||||
[:bool-content ::ctsp/content]])
|
||||
|
||||
(def ^:private schema:rect-attrs
|
||||
[:map {:title "RectAttrs"}])
|
||||
@@ -260,7 +258,7 @@
|
||||
|
||||
(def ^:private schema:path-attrs
|
||||
[:map {:title "PathAttrs"}
|
||||
[:content ::path/content]])
|
||||
[:content ::ctsp/content]])
|
||||
|
||||
(def ^:private schema:text-attrs
|
||||
[:map {:title "TextAttrs"}
|
||||
@@ -319,9 +317,7 @@
|
||||
schema:frame-attrs
|
||||
schema:shape-attrs
|
||||
schema:shape-geom-attrs
|
||||
schema:shape-base-attrs
|
||||
::ctv/variant-shape
|
||||
::ctv/variant-container]]
|
||||
schema:shape-base-attrs]]
|
||||
|
||||
[:bool
|
||||
[:merge {:title "BoolShape"}
|
||||
@@ -397,50 +393,6 @@
|
||||
(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
|
||||
@@ -570,7 +522,7 @@
|
||||
(defn setup-path
|
||||
[{:keys [content selrect points] :as shape}]
|
||||
(let [selrect (or selrect
|
||||
(path.segment/content->selrect content)
|
||||
(gsh/content->selrect content)
|
||||
(grc/make-rect))
|
||||
points (or points (grc/rect->points selrect))]
|
||||
(-> shape
|
||||
|
||||
56
common/src/app/common/types/shape/path.cljc
Normal file
56
common/src/app/common/types/shape/path.cljc
Normal file
@@ -0,0 +1,56 @@
|
||||
;; 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]))
|
||||
|
||||
(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])
|
||||
|
||||
(sm/register! ::segment schema:path-segment)
|
||||
(sm/register! ::content schema:path-content)
|
||||
@@ -66,6 +66,16 @@
|
||||
[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
|
||||
|
||||
28
common/src/app/common/types/token_theme.cljc
Normal file
28
common/src/app/common/types/token_theme.cljc
Normal file
@@ -0,0 +1,28 @@
|
||||
;; 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]])
|
||||
@@ -9,9 +9,7 @@
|
||||
#?(:clj [app.common.fressian :as fres])
|
||||
[app.common.data :as d]
|
||||
[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]
|
||||
@@ -119,15 +117,12 @@
|
||||
[:name cto/token-name-ref]
|
||||
[:type [::sm/one-of cto/token-types]]
|
||||
[:value :any]
|
||||
[:description {:optional true} :string]
|
||||
[:modified-at {:optional true} ::sm/inst]])
|
||||
|
||||
(declare make-token)
|
||||
[:description [:maybe :string]]
|
||||
[:modified-at ::sm/inst]])
|
||||
|
||||
(def schema:token
|
||||
[:and {:gen/gen (->> (sg/generator schema:token-attrs)
|
||||
(sg/fmap #(make-token %)))}
|
||||
(sm/required-keys schema:token-attrs)
|
||||
[:and
|
||||
schema:token-attrs
|
||||
[:fn token?]])
|
||||
|
||||
(def check-token
|
||||
@@ -326,7 +321,6 @@
|
||||
(assoc-in [:ids temp-id] token))))
|
||||
{:tokens-tree {} :ids {}} tokens))
|
||||
|
||||
|
||||
(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")
|
||||
@@ -386,32 +380,15 @@
|
||||
(def schema:token-set-attrs
|
||||
[:map {:title "TokenSet"}
|
||||
[:name :string]
|
||||
[: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)
|
||||
[:description [:maybe :string]]
|
||||
[:modified-at ::sm/inst]
|
||||
[:tokens [:and
|
||||
[:map-of {:gen/max 5} :string schema:token]
|
||||
[:fn d/ordered-map?]]]])
|
||||
|
||||
(def schema:token-set
|
||||
[:and {:gen/gen (->> (sg/generator schema:token-set-attrs)
|
||||
(sg/fmap #(make-token-set %)))}
|
||||
(sm/required-keys schema:token-set-attrs)
|
||||
[:and
|
||||
schema:token-set-attrs
|
||||
[:fn token-set?]])
|
||||
|
||||
(sm/register! ::token-set schema:token-set)
|
||||
@@ -575,16 +552,16 @@
|
||||
(def schema:token-theme-attrs
|
||||
[:map {:title "TokenTheme"}
|
||||
[:name :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]]])
|
||||
[:group :string]
|
||||
[:description [:maybe :string]]
|
||||
[:is-source [:maybe :boolean]]
|
||||
[:id :string]
|
||||
[:modified-at ::sm/inst]
|
||||
[:sets [:set {:gen/max 5} :string]]])
|
||||
|
||||
(def schema:token-theme
|
||||
[:and
|
||||
(sm/required-keys schema:token-theme-attrs)
|
||||
schema:token-theme-attrs
|
||||
[:fn token-theme?]])
|
||||
|
||||
(sm/register! ::token-theme schema:token-theme)
|
||||
@@ -826,7 +803,7 @@
|
||||
(map-indexed (fn [index item]
|
||||
(assoc item :index index))))))
|
||||
|
||||
(defn flatten-nested-tokens-json
|
||||
(defn- flatten-nested-tokens-json
|
||||
"Recursively flatten the dtcg token structure, joining keys with '.'."
|
||||
[tokens token-path]
|
||||
(reduce-kv
|
||||
@@ -853,7 +830,7 @@
|
||||
|
||||
(declare make-tokens-lib)
|
||||
|
||||
(defn legacy-nodes->dtcg-nodes [sets-data]
|
||||
(defn- legacy-nodes->dtcg-nodes [sets-data]
|
||||
(walk/postwalk
|
||||
(fn [node]
|
||||
(cond-> node
|
||||
@@ -889,6 +866,8 @@ Will return a value that matches this schema:
|
||||
(get-active-themes-set-tokens [_] "set of set names that are active in the the active themes")
|
||||
(encode-dtcg [_] "Encodes library to a dtcg compatible json string")
|
||||
(decode-dtcg-json [_ parsed-json] "Decodes parsed json containing tokens and converts to library")
|
||||
(decode-single-set-json [_ set-name tokens] "Decodes parsed json containing single token set and converts to library")
|
||||
(decode-single-set-legacy-json [_ set-name tokens] "Decodes parsed legacy json containing single token set and converts to library")
|
||||
(decode-legacy-json [_ parsed-json] "Decodes parsed legacy json containing tokens and converts to library")
|
||||
(get-all-tokens [_] "all tokens in the lib")
|
||||
(validate [_]))
|
||||
@@ -943,7 +922,6 @@ Will return a value that matches this schema:
|
||||
this)))
|
||||
|
||||
|
||||
|
||||
(delete-set [_ set-name]
|
||||
(let [prefixed-path (set-name->prefixed-full-path set-name)]
|
||||
(TokensLib. (d/dissoc-in sets prefixed-path)
|
||||
@@ -1333,6 +1311,17 @@ Will return a value that matches this schema:
|
||||
(assoc-in ["$metadata" "activeThemes"] active-themes-clear)
|
||||
(assoc-in ["$metadata" "activeSets"] active-sets))))
|
||||
|
||||
(decode-single-set-json [this set-name tokens]
|
||||
(assert (map? tokens) "expected a map data structure for `data`")
|
||||
|
||||
(add-set this (make-token-set :name (normalize-set-name set-name)
|
||||
:tokens (flatten-nested-tokens-json tokens ""))))
|
||||
|
||||
|
||||
(decode-single-set-legacy-json [this set-name tokens]
|
||||
(assert (map? tokens) "expected a map data structure for `data`")
|
||||
(decode-single-set-json this set-name (legacy-nodes->dtcg-nodes tokens)))
|
||||
|
||||
(decode-dtcg-json [_ data]
|
||||
(assert (map? data) "expected a map data structure for `data`")
|
||||
|
||||
@@ -1492,14 +1481,6 @@ Will return a value that matches this schema:
|
||||
{:encode/json encode-dtcg
|
||||
:decode/json decode-dtcg}})
|
||||
|
||||
(defn duplicate-set [set-name lib & {:keys [suffix]}]
|
||||
(let [sets (get-sets lib)
|
||||
unames (map :name sets)
|
||||
copy-name (cfh/generate-unique-name set-name unames :suffix suffix)]
|
||||
(some-> (get-set lib set-name)
|
||||
(assoc :name copy-name)
|
||||
(assoc :modified-at (dt/now)))))
|
||||
|
||||
(sm/register! type:tokens-lib)
|
||||
|
||||
;; === Serialization handlers for RPC API (transit) and database (fressian)
|
||||
|
||||
@@ -1,281 +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.variant
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.math :as math]
|
||||
[app.common.schema :as sm]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SCHEMA
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def schema:variant-property
|
||||
[:map
|
||||
[:name :string]
|
||||
[:value :string]])
|
||||
|
||||
(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]]])
|
||||
|
||||
(def schema:variant-shape
|
||||
;; The root shape of the main instance of a variant component.
|
||||
[:map
|
||||
[:variant-id {:optional true} ::sm/uuid]
|
||||
[:variant-name {:optional true} :string]])
|
||||
|
||||
(def schema:variant-container
|
||||
;; is a board that contains all variant components of a variant set,
|
||||
;; for grouping them visually in the workspace.
|
||||
[:map
|
||||
[: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)
|
||||
|
||||
(def valid-variant-component?
|
||||
(sm/check-fn schema:variant-component))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def property-prefix "Property")
|
||||
(def property-regex (re-pattern (str property-prefix "(\\d+)")))
|
||||
(def value-prefix "Value ")
|
||||
|
||||
|
||||
(defn properties-to-name
|
||||
"Transform the properties into a name, with the values separated by comma"
|
||||
[properties]
|
||||
(->> properties
|
||||
(map :value)
|
||||
(remove str/empty?)
|
||||
(str/join ", ")))
|
||||
|
||||
|
||||
(defn next-property-number
|
||||
"Returns the next property number, to avoid duplicates on the property names"
|
||||
[properties]
|
||||
(let [numbers (keep
|
||||
#(some->> (:name %) (re-find property-regex) second d/parse-integer)
|
||||
properties)
|
||||
max-num (if (seq numbers)
|
||||
(apply max numbers)
|
||||
0)]
|
||||
(inc (max max-num (count properties)))))
|
||||
|
||||
(defn add-new-prop
|
||||
"Adds a new property with generated name and provided value to the existing props list."
|
||||
[props value]
|
||||
(conj props {:name (str property-prefix (next-property-number props))
|
||||
:value value}))
|
||||
|
||||
(defn add-new-props
|
||||
"Adds new properties with generated names and provided values to the existing props list."
|
||||
[props values]
|
||||
(let [next-prop-num (next-property-number props)
|
||||
xf (map-indexed (fn [i v]
|
||||
{:name (str property-prefix (+ next-prop-num i))
|
||||
:value v}))]
|
||||
(into props xf values)))
|
||||
|
||||
(defn path-to-properties
|
||||
"From a list of properties and a name with path, assign each token of the
|
||||
path as value of a different property"
|
||||
([path properties]
|
||||
(path-to-properties path properties 0))
|
||||
([path properties min-props]
|
||||
(let [cpath (cfh/split-path path)
|
||||
total-props (max (count cpath) min-props)
|
||||
assigned (mapv #(assoc % :value (nth cpath %2 "")) properties (range))
|
||||
;; Add empty strings to the end of cpath to reach the minimum number of properties
|
||||
cpath (take total-props (concat cpath (repeat "")))
|
||||
remaining (drop (count properties) cpath)]
|
||||
(add-new-props assigned remaining))))
|
||||
|
||||
|
||||
(defn properties-map-to-string
|
||||
"Transforms a map of properties to a string of properties omitting the empty ones"
|
||||
[properties]
|
||||
(->> properties
|
||||
(keep (fn [{:keys [name value]}]
|
||||
(when (not (str/blank? value))
|
||||
(str name "=" value))))
|
||||
(str/join ", ")))
|
||||
|
||||
|
||||
(defn properties-string-to-map
|
||||
"Transforms a string of properties to a map of properties"
|
||||
[s]
|
||||
(->> (str/split s ",")
|
||||
(mapv #(str/split % "="))
|
||||
(mapv (fn [[k v]]
|
||||
{:name (str/trim k)
|
||||
:value (str/trim v)}))))
|
||||
|
||||
|
||||
(defn valid-properties-string?
|
||||
"Checks if a string of properties has a processable format or not"
|
||||
[s]
|
||||
(let [pattern #"^([a-zA-Z0-9\s]+=[a-zA-Z0-9\s]+)(,\s*[a-zA-Z0-9\s]+=[a-zA-Z0-9\s]+)*$"]
|
||||
(not (nil? (re-matches pattern s)))))
|
||||
|
||||
|
||||
(defn find-properties-to-remove
|
||||
"Compares two property maps to find which properties should be removed"
|
||||
[prev-props upd-props]
|
||||
(let [upd-names (set (map :name upd-props))]
|
||||
(filterv #(not (contains? upd-names (:name %))) prev-props)))
|
||||
|
||||
|
||||
(defn find-properties-to-update
|
||||
"Compares two property maps to find which properties should be updated"
|
||||
[prev-props upd-props]
|
||||
(filterv #(some (fn [prop] (and (= (:name %) (:name prop))
|
||||
(not= (:value %) (:value prop)))) prev-props) upd-props))
|
||||
|
||||
|
||||
(defn find-properties-to-add
|
||||
"Compares two property maps to find which properties should be added"
|
||||
[prev-props upd-props]
|
||||
(let [prev-names (set (map :name prev-props))]
|
||||
(filterv #(not (contains? prev-names (:name %))) upd-props)))
|
||||
|
||||
|
||||
(defn find-index-for-property-name
|
||||
"Finds the index of a name in a property map"
|
||||
[props name]
|
||||
(some (fn [[idx prop]]
|
||||
(when (= (:name prop) name)
|
||||
idx))
|
||||
(map-indexed vector props)))
|
||||
|
||||
(defn remove-prefix
|
||||
"Removes the given prefix (with or without a trailing ' / ') from the beginning of the name"
|
||||
[name prefix]
|
||||
(let [long-name (str prefix " / ")]
|
||||
(cond
|
||||
(str/starts-with? name long-name)
|
||||
(subs name (count long-name))
|
||||
|
||||
(str/starts-with? name prefix)
|
||||
(subs name (count prefix))
|
||||
|
||||
:else
|
||||
name)))
|
||||
|
||||
(def ^:private xf:map-name
|
||||
(map :name))
|
||||
|
||||
(defn- matching-indices
|
||||
[props1 props2]
|
||||
(let [names-in-p2 (into #{} xf:map-name props2)
|
||||
xform (comp
|
||||
(map-indexed (fn [index {:keys [name]}]
|
||||
(when (contains? names-in-p2 name)
|
||||
index)))
|
||||
(filter some?))]
|
||||
(into #{} xform props1)))
|
||||
|
||||
(defn- find-index-by-name
|
||||
"Returns the index of the first item in props with the given name, or nil if not found."
|
||||
[name props]
|
||||
(some (fn [[idx item]]
|
||||
(when (= (:name item) name)
|
||||
idx))
|
||||
(map-indexed vector props)))
|
||||
|
||||
(defn- next-valid-position
|
||||
"Returns the first non-negative integer not present in the used-pos set."
|
||||
[used-pos]
|
||||
(loop [p 0]
|
||||
(if (contains? used-pos p)
|
||||
(recur (inc p))
|
||||
p)))
|
||||
|
||||
(defn- find-position
|
||||
"Returns the index of the property with the given name in `props`,
|
||||
or the next available index not in `used-pos` if not found."
|
||||
[name props used-pos]
|
||||
(or (find-index-by-name name props)
|
||||
(next-valid-position used-pos)))
|
||||
|
||||
(defn merge-properties
|
||||
"Merges props2 into props1 with the following rules:
|
||||
- For each property p2 in props2:
|
||||
- Skip it if its value is empty.
|
||||
- If props1 contains a property with the same name, update its value with that of p2.
|
||||
- Otherwise, assign p2's value to the first unused property in props1. A property is considered used if:
|
||||
- Its name exists in both props1 and props2, or
|
||||
- Its value has already been updated during the merge.
|
||||
- If no unused properties are available in props1, append a new property with a default name and p2's value."
|
||||
[props1 props2]
|
||||
(let [props2 (remove #(str/empty? (:value %)) props2)]
|
||||
(-> (reduce
|
||||
(fn [{:keys [props used-pos]} prop]
|
||||
(let [pos (find-position (:name prop) props used-pos)
|
||||
used-pos (conj used-pos pos)]
|
||||
(if (< pos (count props))
|
||||
{:props (assoc-in (vec props) [pos :value] (:value prop)) :used-pos used-pos}
|
||||
{:props (add-new-prop props (:value prop)) :used-pos used-pos})))
|
||||
{:props (vec props1) :used-pos (matching-indices props1 props2)}
|
||||
props2)
|
||||
:props)))
|
||||
|
||||
(defn compare-properties
|
||||
"Compares vectors of properties keeping the value if it is the same for all
|
||||
or setting a custom value where their values do not coincide"
|
||||
([props-list]
|
||||
(compare-properties props-list nil))
|
||||
|
||||
([props-list distinct-mark]
|
||||
(let [grouped (group-by :name (apply concat props-list))
|
||||
check-values (fn [values]
|
||||
(let [vals (map :value values)]
|
||||
(if (apply = vals)
|
||||
(first vals)
|
||||
distinct-mark)))]
|
||||
(mapv (fn [[name values]]
|
||||
{:name name :value (check-values values)})
|
||||
grouped))))
|
||||
|
||||
(defn same-variant?
|
||||
"Determines if all elements belong to the same variant"
|
||||
[components]
|
||||
(let [variant-ids (distinct (map :variant-id components))
|
||||
not-blank? (complement str/blank?)]
|
||||
(and
|
||||
(= 1 (count variant-ids))
|
||||
(not-blank? (first variant-ids)))))
|
||||
|
||||
(defn distance
|
||||
"Computes a weighted distance between two property lists `props1` and `props2`.
|
||||
Latter properties weight less that previous ones"
|
||||
[props1 props2]
|
||||
(let [total-num-props (count props1)
|
||||
xform (map-indexed
|
||||
(fn [idx [p1 p2]]
|
||||
(if (not= p1 p2)
|
||||
(math/pow 2 (- total-num-props idx))
|
||||
0)))]
|
||||
(transduce
|
||||
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) #", " " / ")))
|
||||
@@ -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.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)))
|
||||
@@ -14,7 +14,6 @@
|
||||
[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]))
|
||||
|
||||
@@ -31,7 +30,7 @@
|
||||
(if (= type :path)
|
||||
(cts/setup-shape
|
||||
(into {:type :path
|
||||
:content (path/content (:content params default-path))}
|
||||
:content (:content params default-path)}
|
||||
params))
|
||||
(cts/setup-shape
|
||||
(into {:type type
|
||||
|
||||
@@ -40,6 +40,8 @@
|
||||
(:objects page)
|
||||
(:id page)
|
||||
(:id file)
|
||||
true
|
||||
nil
|
||||
nil)
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
@@ -72,6 +74,8 @@
|
||||
(:objects page)
|
||||
(:id page)
|
||||
(:id file)
|
||||
true
|
||||
nil
|
||||
cfsh/prepare-create-artboard-from-selection)
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
@@ -107,6 +111,8 @@
|
||||
(:objects page)
|
||||
(:id page)
|
||||
(:id file)
|
||||
true
|
||||
nil
|
||||
cfsh/prepare-create-artboard-from-selection)
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
@@ -145,6 +151,8 @@
|
||||
(:objects page)
|
||||
(:id page)
|
||||
(:id file)
|
||||
true
|
||||
nil
|
||||
cfsh/prepare-create-artboard-from-selection)
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
@@ -183,6 +191,8 @@
|
||||
(:objects page)
|
||||
(:id page)
|
||||
(:id file)
|
||||
true
|
||||
nil
|
||||
nil)
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
@@ -222,6 +232,8 @@
|
||||
(:objects page)
|
||||
(:id page)
|
||||
(:id file)
|
||||
true
|
||||
nil
|
||||
cfsh/prepare-create-artboard-from-selection)
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
@@ -253,7 +265,8 @@
|
||||
changes (cll/generate-rename-component (pcb/empty-changes)
|
||||
(:id component)
|
||||
"Test component after"
|
||||
(:data file))
|
||||
(:data file)
|
||||
true)
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
|
||||
@@ -432,8 +445,8 @@
|
||||
(t/is (some? copy1-child'))
|
||||
(t/is (ctk/instance-root? copy1-root'))
|
||||
(t/is (ctk/instance-of? copy1-root' (:id file') (:id component')))
|
||||
(t/is (ctk/is-main-of? main1-root' copy1-root'))
|
||||
(t/is (ctk/is-main-of? main1-child' copy1-child'))
|
||||
(t/is (ctk/is-main-of? main1-root' copy1-root' true))
|
||||
(t/is (ctk/is-main-of? main1-child' copy1-child' true))
|
||||
(t/is (ctst/parent-of? copy1-root' copy1-child'))))
|
||||
|
||||
(t/deftest test-instantiate-component-from-lib
|
||||
@@ -476,8 +489,8 @@
|
||||
(t/is (some? copy1-child'))
|
||||
(t/is (ctk/instance-root? copy1-root'))
|
||||
(t/is (ctk/instance-of? copy1-root' (:id library) (:id component')))
|
||||
(t/is (ctk/is-main-of? main1-root' copy1-root'))
|
||||
(t/is (ctk/is-main-of? main1-child' copy1-child'))
|
||||
(t/is (ctk/is-main-of? main1-root' copy1-root' true))
|
||||
(t/is (ctk/is-main-of? main1-child' copy1-child' true))
|
||||
(t/is (ctst/parent-of? copy1-root' copy1-child'))))
|
||||
|
||||
(t/deftest test-instantiate-nested-component
|
||||
@@ -520,8 +533,8 @@
|
||||
(t/is (some? copy1-child'))
|
||||
(t/is (ctk/instance-root? copy1-root'))
|
||||
(t/is (ctk/instance-of? copy1-root' (:id file') (:id component')))
|
||||
(t/is (ctk/is-main-of? main1-root' copy1-root'))
|
||||
(t/is (ctk/is-main-of? main1-child' copy1-child'))
|
||||
(t/is (ctk/is-main-of? main1-root' copy1-root' true))
|
||||
(t/is (ctk/is-main-of? main1-child' copy1-child' true))
|
||||
(t/is (ctst/parent-of? copy1-root' copy1-child'))))
|
||||
|
||||
(t/deftest test-instantiate-nested-component-from-lib
|
||||
@@ -567,8 +580,8 @@
|
||||
(t/is (some? copy1-child'))
|
||||
(t/is (ctk/instance-root? copy1-root'))
|
||||
(t/is (ctk/instance-of? copy1-root' (:id library) (:id component')))
|
||||
(t/is (ctk/is-main-of? main1-root' copy1-root'))
|
||||
(t/is (ctk/is-main-of? main1-child' copy1-child'))
|
||||
(t/is (ctk/is-main-of? main1-root' copy1-root' true))
|
||||
(t/is (ctk/is-main-of? main1-child' copy1-child' true))
|
||||
(t/is (ctst/parent-of? copy1-root' copy1-child'))))
|
||||
|
||||
(t/deftest test-detach-copy
|
||||
|
||||
@@ -47,7 +47,8 @@
|
||||
file-mdf
|
||||
{(:id file-mdf) file-mdf}
|
||||
page-mdf
|
||||
(:id copy-root))
|
||||
(:id copy-root)
|
||||
true)
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
|
||||
@@ -98,7 +99,8 @@
|
||||
{(:id file-mdf) file-mdf
|
||||
(:id library) library}
|
||||
page-mdf
|
||||
(:id copy-root))
|
||||
(:id copy-root)
|
||||
true)
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
|
||||
@@ -149,7 +151,8 @@
|
||||
file-mdf
|
||||
{(:id file-mdf) file-mdf}
|
||||
page-mdf
|
||||
(:id copy-root))
|
||||
(:id copy-root)
|
||||
true)
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
|
||||
@@ -195,7 +198,8 @@
|
||||
file-mdf
|
||||
{(:id file-mdf) file-mdf}
|
||||
page-mdf
|
||||
(:id copy-root))
|
||||
(:id copy-root)
|
||||
true)
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
|
||||
@@ -242,7 +246,8 @@
|
||||
file-mdf
|
||||
{(:id file-mdf) file-mdf}
|
||||
page-mdf
|
||||
(:id copy-root))
|
||||
(:id copy-root)
|
||||
true)
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
|
||||
@@ -286,7 +291,8 @@
|
||||
file-mdf
|
||||
{(:id file-mdf) file-mdf}
|
||||
page-mdf
|
||||
(:id copy2-root))
|
||||
(:id copy2-root)
|
||||
true)
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
|
||||
@@ -332,7 +338,8 @@
|
||||
file-mdf
|
||||
{(:id file-mdf) file-mdf}
|
||||
page-mdf
|
||||
(:id copy2-root))
|
||||
(:id copy2-root)
|
||||
true)
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
|
||||
|
||||
@@ -227,7 +227,7 @@
|
||||
(t/is (= (:touched copy-root') nil))
|
||||
(t/is (= (:touched copy-new-child') nil))
|
||||
(t/is (ctst/parent-of? copy-root' copy-new-child'))
|
||||
(t/is (ctk/is-main-of? main-free-shape' copy-new-child'))))
|
||||
(t/is (ctk/is-main-of? main-free-shape' copy-new-child' true))))
|
||||
|
||||
(t/deftest test-sync-when-deleting-shape
|
||||
(let [;; ==== Setup
|
||||
|
||||
@@ -1,9 +1,3 @@
|
||||
;; 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]
|
||||
|
||||
@@ -7,10 +7,7 @@
|
||||
(ns common-tests.logic.variants-test
|
||||
(:require
|
||||
[app.common.files.changes-builder :as pcb]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.logic.libraries :as cll]
|
||||
[app.common.logic.shapes :as cls]
|
||||
[app.common.logic.variant-properties :as clvp]
|
||||
[app.common.logic.variants :as clv]
|
||||
[app.common.test-helpers.components :as thc]
|
||||
[app.common.test-helpers.files :as thf]
|
||||
[app.common.test-helpers.ids-map :as thi]
|
||||
@@ -23,7 +20,7 @@
|
||||
(t/deftest test-update-property-name
|
||||
(let [;; ==== Setup
|
||||
file (-> (thf/sample-file :file1)
|
||||
(thv/add-variant-two-properties :v01 :c01 :m01 :c02 :m02))
|
||||
(thv/add-variant :v01 :c01 :m01 :c02 :m02))
|
||||
v-id (-> (ths/get-shape file :v01) :id)
|
||||
page (thf/current-page file)
|
||||
|
||||
@@ -32,8 +29,8 @@
|
||||
(pcb/with-page-id (:id page))
|
||||
(pcb/with-library-data (:data file))
|
||||
(pcb/with-objects (:objects page))
|
||||
(clvp/generate-update-property-name v-id 0 "NewName1")
|
||||
(clvp/generate-update-property-name v-id 1 "NewName2"))
|
||||
(clv/generate-update-property-name v-id 0 "NewName1")
|
||||
(clv/generate-update-property-name v-id 1 "NewName2"))
|
||||
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
@@ -68,7 +65,7 @@
|
||||
(pcb/with-page-id (:id page))
|
||||
(pcb/with-library-data (:data file))
|
||||
(pcb/with-objects (:objects page))
|
||||
(clvp/generate-add-new-property v-id))
|
||||
(clv/generate-add-new-property v-id))
|
||||
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
@@ -104,7 +101,7 @@
|
||||
(pcb/with-page-id (:id page))
|
||||
(pcb/with-library-data (:data file))
|
||||
(pcb/with-objects (:objects page))
|
||||
(clvp/generate-add-new-property v-id {:fill-values? true}))
|
||||
(clv/generate-add-new-property v-id {:fill-values? true}))
|
||||
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
@@ -120,7 +117,7 @@
|
||||
(t/is (= (count (:variant-properties comp01')) 2))
|
||||
(t/is (= (count (:variant-properties comp02)) 1))
|
||||
(t/is (= (count (:variant-properties comp02')) 2))
|
||||
(t/is (= (-> comp01' :variant-properties last :value) "Value 1"))))
|
||||
(t/is (= (-> comp01' :variant-properties last :value) "Value1"))))
|
||||
|
||||
|
||||
|
||||
@@ -135,7 +132,7 @@
|
||||
(pcb/with-page-id (:id page))
|
||||
(pcb/with-library-data (:data file))
|
||||
(pcb/with-objects (:objects page))
|
||||
(clvp/generate-add-new-property v-id))
|
||||
(clv/generate-add-new-property v-id))
|
||||
|
||||
|
||||
file (thf/apply-changes file changes)
|
||||
@@ -150,7 +147,7 @@
|
||||
(pcb/with-page-id (:id page))
|
||||
(pcb/with-library-data (:data file))
|
||||
(pcb/with-objects (:objects page))
|
||||
(clvp/generate-remove-property v-id 0))
|
||||
(clv/generate-remove-property v-id 0))
|
||||
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
@@ -183,8 +180,8 @@
|
||||
(pcb/with-page-id (:id page))
|
||||
(pcb/with-library-data (:data file))
|
||||
(pcb/with-objects (:objects page))
|
||||
(clvp/generate-update-property-value (:id comp01) 0 "NewValue1")
|
||||
(clvp/generate-update-property-value (:id comp02) 0 "NewValue2"))
|
||||
(clv/generate-update-property-value (:id comp01) 0 "NewValue1")
|
||||
(clv/generate-update-property-value (:id comp02) 0 "NewValue2"))
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
|
||||
@@ -195,73 +192,3 @@
|
||||
;; ==== Check
|
||||
(t/is (= (-> comp01' :variant-properties first :value) "NewValue1"))
|
||||
(t/is (= (-> comp02' :variant-properties first :value) "NewValue2"))))
|
||||
|
||||
|
||||
(t/deftest test-duplicate-variant-container
|
||||
(let [;; ==== Setup
|
||||
file (-> (thf/sample-file :file1)
|
||||
(thv/add-variant :v01 :c01 :m01 :c02 :m02))
|
||||
data (:data file)
|
||||
page (thf/current-page file)
|
||||
objects (:objects page)
|
||||
|
||||
variant-container (ths/get-shape file :v01)
|
||||
|
||||
|
||||
|
||||
|
||||
;; ==== Action
|
||||
changes (-> (pcb/empty-changes nil)
|
||||
(pcb/with-page-id (:id page))
|
||||
(pcb/with-library-data (:data file))
|
||||
(pcb/with-objects (:objects page))
|
||||
(cll/generate-duplicate-changes objects ;; objects
|
||||
page ;; page
|
||||
#{(:id variant-container)} ;; ids
|
||||
(gpt/point 0 0) ;; delta
|
||||
{(:id file) file} ;; libraries
|
||||
(:data file) ;; library-data
|
||||
(:id file))) ;; file-id
|
||||
|
||||
;; ==== Get
|
||||
file' (thf/apply-changes file changes)
|
||||
data' (:data file')
|
||||
page' (thf/current-page file')
|
||||
objects' (:objects page')]
|
||||
|
||||
;; ==== Check
|
||||
(thf/validate-file! file')
|
||||
(t/is (= (count (:components data)) 2))
|
||||
(t/is (= (count (:components data')) 4))
|
||||
(t/is (= (count objects) 4))
|
||||
(t/is (= (count objects') 7))))
|
||||
|
||||
|
||||
(t/deftest test-delete-variant
|
||||
;; When a variant container becomes empty, it id automatically deleted
|
||||
(let [;; ==== Setup
|
||||
file (-> (thf/sample-file :file1)
|
||||
(thv/add-variant-two-properties :v01 :c01 :m01 :c02 :m02))
|
||||
container (ths/get-shape file :v01)
|
||||
m01-id (-> (ths/get-shape file :m01) :id)
|
||||
m02-id (-> (ths/get-shape file :m02) :id)
|
||||
|
||||
page (thf/current-page file)
|
||||
|
||||
;; ==== Action
|
||||
changes (-> (pcb/empty-changes nil)
|
||||
(pcb/with-page-id (:id page))
|
||||
(pcb/with-library-data (:data file))
|
||||
(pcb/with-objects (:objects page))
|
||||
(#(second (cls/generate-delete-shapes % #{m01-id m02-id} {}))))
|
||||
|
||||
file' (thf/apply-changes file changes)
|
||||
|
||||
;; ==== Get
|
||||
container' (ths/get-shape file' :v01)]
|
||||
|
||||
;; ==== Check
|
||||
;; The variant containew was not nil before the deletion
|
||||
(t/is (not (nil? container)))
|
||||
;; The variant containew is nil after the deletion
|
||||
(t/is (nil? container'))))
|
||||
|
||||
@@ -39,7 +39,6 @@
|
||||
[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.tokens-lib-test]
|
||||
@@ -91,5 +90,4 @@
|
||||
'common-tests.types.tokens-lib-test
|
||||
'common-tests.types.components-test
|
||||
'common-tests.types.absorb-assets-test
|
||||
'common-tests.types.path-data-test
|
||||
'common-tests.uuid-test))
|
||||
|
||||
@@ -547,3 +547,4 @@
|
||||
|
||||
;; FOR POSSIBLE FUTURE TEST CASES
|
||||
;; (str "M259.958 89.134c-6.88-.354-10.484-1.241-12.44-3.064-1.871-1.743-6.937-3.098-15.793-4.226-7.171-.913-17.179-2.279-22.24-3.034-5.06-.755-15.252-2.016-22.648-2.8-18.685-1.985-35.63-4.223-38.572-5.096-3.655-1.084-3.016-3.548.708-2.726 1.751.387 13.376 1.701 25.833 2.922 12.456 1.22 29.018 3.114 36.803 4.208 29.94 4.206 29.433 4.204 34.267.136 3.787-3.186 5.669-3.669 14.303-3.669 14.338 0 17.18 1.681 12.182 7.205-2.053 2.268-1.994 2.719.707 5.42 3.828 3.827 3.74 5.846-.238 5.5-1.752-.153-7.544-.502-12.872-.776zm7.563-3.194c0-.778-1.751-1.352-3.892-1.274l-3.893.141 3.539 1.133c1.946.624 3.698 1.197 3.893 1.275.194.077.354-.496.354-1.275zm-15.899-8.493c1.43-2.29 1.414-2.83-.084-2.83-2.05 0-5.25 2.76-5.25 4.529 0 2.226 3.599 1.08 5.334-1.699zm8.114 0c2.486-2.746 2.473-2.83-.438-2.83-1.65 0-3.683 1.273-4.516 2.83-1.175 2.196-1.077 2.831.438 2.831 1.075 0 3.107-1.274 4.516-2.83zm7.814.674c2.858-3.444.476-4.085-3.033-.816-2.451 2.284-2.677 2.973-.975 2.973 1.22 0 3.023-.97 4.008-2.157zm-49.571-4.509c-1.168-.43-3.294-1.802-4.725-3.051-2.112-1.843-9.304-2.595-38.219-3.994-46.474-2.25-63-4.077-60.27-6.665.324-.308 9.507.261 20.406 1.264 10.9 1.003 31.16 2.258 45.024 2.789l25.207.964 4.625-3.527c4.313-3.29 5.41-3.474 16.24-2.732 6.389.438 11.981 1.388 12.428 2.111.447.723-.517 2.73-2.141 4.46l-2.954 3.144c1.607 1.697 3.308 3.289 5.049 4.845 3.248 2.189-5.438 1.289-8.678 1.284-5.428-.061-10.825-.463-11.992-.892zm12.74-3.242c-1.123-.694-2.36-.943-2.75-.554-.389.39.21 1.275 1.334 1.97 1.122.693 2.36.942 2.749.553.389-.39-.21-1.275-1.334-1.97zm-5.663 0a1.42 1.42 0 00-1.415-1.416 1.42 1.42 0 00-1.416 1.416 1.42 1.42 0 001.416 1.415 1.42 1.42 0 001.415-1.415zm-8.464-6.404c.984-1.187 1.35-2.598.813-3.135-1.181-1.18-5.408 1.297-6.184 3.624-.806 2.42 3.265 2.048 5.37-.49zm6.863.258c.867-1.045 1.163-2.313.658-2.819-1.063-1.062-4.719 1.631-4.719 3.476 0 1.864 2.274 1.496 4.061-.657zm8.792-.36c1.637-1.972 1.448-2.197-1.486-1.77-1.848.27-3.622 1.287-3.943 2.26-.838 2.547 3.212 2.181 5.429-.49zm32.443-4.11c-6.156-2.228-67.1-6.138-119.124-7.642-39.208-1.134-72.072-.928-94.618.593-6.617.446-19.681 1.16-29.03 1.587-15.798.72-17.183.573-19.588-2.085-4.498-4.97-2.544-7.857 6.39-9.44 4.394-.778 9.164-2.436 10.6-3.685 5.44-4.729 20.332-14.06 31.14-19.509C65.717 11.88 78.955 7.79 103.837 3.08 121.686-.3 125.552-.642 129.318.82c2.44.948 12.4 1.948 22.132 2.221 15.37.432 20.004 1.18 35.294 5.698 22.36 6.606 39.732 15.1 56.55 27.653 7.307 5.452 14.086 9.913 15.066 9.913.98 0 2.148.956 2.596 2.124.55 1.432 2.798 2.123 6.914 2.123 6.213 0 12.4 3.046 12.38 6.096-.012 1.75-6.502 5.353-9.118 5.063-.818-.09-3.717-.972-6.442-1.958zm-16.986-7.436c0-1.575-33.326-18.118-43.173-21.43-23.008-7.739-54.084-12.922-77.136-12.866-16.863.041-37.877 3.628-52.465 8.956-18.062 6.596-26.563 10.384-29.181 13.002-1.205 1.205-5.306 3.769-9.112 5.698-7.754 3.929-8.841 5.482-3.029 4.325 13.494-2.685 66.794-3.773 110.913-2.264 38.005 1.3 96.812 4.435 102.122 5.443.584.111 1.061-.277 1.061-.864zm-236.39-3.18c0-.78-1.592-1.416-3.539-1.416-1.946 0-3.538.637-3.538 1.415 0 .779 1.592 1.416 3.538 1.416 1.947 0 3.54-.637 3.54-1.416zm7.078-1.416c0-.779-.956-1.416-2.124-1.416-1.167 0-2.123.637-2.123 1.416 0 .778.956 1.415 2.123 1.415 1.168 0 2.124-.637 2.124-1.415zm11.734-4.437c3.278-1.661 6.278-3.483 6.667-4.048 1.366-1.98 20.645-11.231 32.557-15.622 11.862-4.372 36.546-9.865 44.327-9.865 3.485 0 3.867-.404 3.012-3.185-.538-1.752-1.177-3.41-1.42-3.685-.907-1.026-36.72 7.16-45.065 10.302-17.226 6.484-47.566 24.27-47.566 27.886 0 1.786.845 1.585 7.488-1.783zm206.254-5.577c-12.298-10.518-53.842-27.166-70.896-28.41-5.526-.404-6.3-.097-6.695 2.655-.33 2.307.402 3.275 2.831 3.742 32.436 6.237 52.205 12.315 66.975 20.594 11.904 6.673 14.477 7.141 7.785 1.419zM150.1 11.04c-1.949-3.64-7.568-4.078-6.886-.538.256 1.329 2.054 2.817 3.997 3.309 4.498 1.137 4.816.832 2.888-2.771zm6.756.94c-.248-1.752-1.026-3.185-1.727-3.185-.7 0-1.493 1.433-1.76 3.185-.328 2.152.232 3.185 1.727 3.185 1.485 0 2.064-1.047 1.76-3.185zm-30.178-2.458c0-2.303-.908-3.694-2.627-4.025-3.6-.694-5.23 1.301-4.22 5.166 1.216 4.647 6.847 3.709 6.847-1.14zm12.544 2.104c-.448-1.168-1.224-2.132-1.725-2.142-.5-.013-2.343-.404-4.095-.873-2.569-.689-3.185-.274-3.185 2.142 0 2.476.854 2.996 4.91 2.996 3.783 0 4.723-.487 4.095-2.123z")
|
||||
|
||||
|
||||
@@ -54,7 +54,7 @@
|
||||
(t/is (= (count components') 1))
|
||||
|
||||
(t/is (ctk/instance-of? copy-root' (:id file') (:id component')))
|
||||
(t/is (ctk/is-main-of? main-root' copy-root'))
|
||||
(t/is (ctk/is-main-of? main-root' copy-root' true))
|
||||
(t/is (ctk/main-instance-of? (:id main-root') (:id (second pages')) component'))))
|
||||
|
||||
(t/deftest absorb-colors
|
||||
|
||||
@@ -0,0 +1,6 @@
|
||||
{"color":
|
||||
{"red":
|
||||
{"100":
|
||||
{"value":"red",
|
||||
"type":"color",
|
||||
"description":""}}}}
|
||||
6
common/test/common_tests/types/data/single-set.json
Normal file
6
common/test/common_tests/types/data/single-set.json
Normal file
@@ -0,0 +1,6 @@
|
||||
{"color":
|
||||
{"red":
|
||||
{"100":
|
||||
{"$value":"red",
|
||||
"$type":"color",
|
||||
"$description":""}}}}
|
||||
@@ -1,380 +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.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,14 +112,17 @@
|
||||
(= interaction interaction-3)))
|
||||
{:num 500})))
|
||||
|
||||
|
||||
(t/deftest shape-path-content-json-roundtrip
|
||||
(let [encode (sm/encoder ::path/content (sm/json-transformer))
|
||||
decode (sm/decoder ::path/content (sm/json-transformer))]
|
||||
(let [encode (sm/encoder schema:path-content (sm/json-transformer))
|
||||
decode (sm/decoder schema:path-content (sm/json-transformer))]
|
||||
(smt/check!
|
||||
(smt/for [path-content (sg/generator ::path/content)]
|
||||
(smt/for [path-content (sg/generator schema: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})))
|
||||
|
||||
|
||||
@@ -120,6 +120,7 @@
|
||||
(t/is (= ["Foo/Foo" "Foo/Baz" "Foo/Bar"] (move ["Foo"] ["Foo" "Foo"] ["Foo" "Baz"] false)))
|
||||
(t/is (= ["Foo/Baz" "Foo/Bar" "Foo/Foo"] (move ["Foo"] ["Foo" "Foo"] nil false))))))
|
||||
|
||||
|
||||
(t/deftest move-token-set-nested-2
|
||||
(let [tokens-lib (-> (ctob/make-tokens-lib)
|
||||
(ctob/add-set (ctob/make-token-set :name "a/b"))
|
||||
@@ -219,6 +220,7 @@
|
||||
(t/is (thrown-with-msg? #?(:cljs js/Error :clj Exception) #"expected valid params for token-theme"
|
||||
(ctob/make-token-theme params)))))
|
||||
|
||||
|
||||
(t/deftest make-tokens-lib
|
||||
(let [tokens-lib (ctob/make-tokens-lib)]
|
||||
(t/is (= (ctob/set-count tokens-lib) 0))))
|
||||
@@ -313,58 +315,6 @@
|
||||
(t/is (= (:sets token-theme') #{}))
|
||||
(t/is (nil? token-set'))))
|
||||
|
||||
(t/deftest duplicate-token-set
|
||||
(let [tokens-lib (-> (ctob/make-tokens-lib)
|
||||
(ctob/add-set (ctob/make-token-set :name "test-token-set"
|
||||
:tokens {"test-token"
|
||||
(ctob/make-token :name "test-token"
|
||||
:type :boolean
|
||||
:value true)})))
|
||||
token-set-copy (ctob/duplicate-set "test-token-set" tokens-lib {:suffix "copy"})
|
||||
token (get-in token-set-copy [:tokens "test-token"])]
|
||||
|
||||
(t/is (some? token-set-copy))
|
||||
(t/is (= (:name token-set-copy) "test-token-set-copy"))
|
||||
(t/is (= (count (:tokens token-set-copy)) 1))
|
||||
(t/is (= (:name token) "test-token"))))
|
||||
|
||||
(t/deftest duplicate-token-set-twice
|
||||
(let [tokens-lib (-> (ctob/make-tokens-lib)
|
||||
(ctob/add-set (ctob/make-token-set :name "test-token-set"
|
||||
:tokens {"test-token"
|
||||
(ctob/make-token :name "test-token"
|
||||
:type :boolean
|
||||
:value true)})))
|
||||
|
||||
tokens-lib (ctob/add-set tokens-lib (ctob/duplicate-set "test-token-set" tokens-lib {:suffix "copy"}))
|
||||
|
||||
token-set-copy (ctob/duplicate-set "test-token-set" tokens-lib {:suffix "copy"})
|
||||
token (get-in token-set-copy [:tokens "test-token"])]
|
||||
|
||||
(t/is (some? token-set-copy))
|
||||
(t/is (= (:name token-set-copy) "test-token-set-copy-2"))
|
||||
(t/is (= (count (:tokens token-set-copy)) 1))
|
||||
(t/is (= (:name token) "test-token"))))
|
||||
|
||||
(t/deftest duplicate-empty-token-set
|
||||
(let [tokens-lib (-> (ctob/make-tokens-lib)
|
||||
(ctob/add-set (ctob/make-token-set :name "test-token-set")))
|
||||
|
||||
token-set-copy (ctob/duplicate-set "test-token-set" tokens-lib {:suffix "copy"})
|
||||
tokens (get token-set-copy :tokens)]
|
||||
|
||||
(t/is (some? token-set-copy))
|
||||
(t/is (= (:name token-set-copy) "test-token-set-copy"))
|
||||
(t/is (= (count (:tokens token-set-copy)) 0))
|
||||
(t/is (= (count tokens) 0))))
|
||||
|
||||
(t/deftest duplicate-not-existing-token-set
|
||||
(let [tokens-lib (ctob/make-tokens-lib)
|
||||
|
||||
token-set-copy (ctob/duplicate-set "test-token-set" tokens-lib {:suffix "copy"})]
|
||||
|
||||
(t/is (nil? token-set-copy))))
|
||||
|
||||
(t/deftest active-themes-set-names
|
||||
(let [tokens-lib (-> (ctob/make-tokens-lib)
|
||||
(ctob/add-set (ctob/make-token-set :name "test-token-set")))
|
||||
@@ -968,6 +918,7 @@
|
||||
(t/is (dt/is-after? (:modified-at token-set') (:modified-at token-set)))
|
||||
(t/is (dt/is-after? (:modified-at token') (:modified-at token)))))
|
||||
|
||||
|
||||
(t/deftest update-token-in-sets-rename
|
||||
(let [tokens-lib (-> (ctob/make-tokens-lib)
|
||||
(ctob/add-set (ctob/make-token-set :name "test-token-set"))
|
||||
@@ -1420,6 +1371,30 @@
|
||||
(t/testing "invalid tokens got discarded"
|
||||
(t/is (nil? (get-set-token "typography" "H1.Bold")))))))
|
||||
|
||||
#?(:clj
|
||||
(t/deftest single-set-legacy-json-decoding
|
||||
(let [json (-> (slurp "test/common_tests/types/data/legacy-single-set.json")
|
||||
(tr/decode-str))
|
||||
lib (ctob/decode-single-set-legacy-json (ctob/ensure-tokens-lib nil) "single_set" json)
|
||||
get-set-token (fn [set-name token-name]
|
||||
(some-> (ctob/get-set lib set-name)
|
||||
(ctob/get-token token-name)))]
|
||||
(t/is (= '("single_set") (ctob/get-ordered-set-names lib)))
|
||||
(t/testing "token added"
|
||||
(t/is (some? (get-set-token "single_set" "color.red.100")))))))
|
||||
|
||||
#?(:clj
|
||||
(t/deftest single-set-dtcg-json-decoding
|
||||
(let [json (-> (slurp "test/common_tests/types/data/single-set.json")
|
||||
(tr/decode-str))
|
||||
lib (ctob/decode-single-set-json (ctob/ensure-tokens-lib nil) "single_set" json)
|
||||
get-set-token (fn [set-name token-name]
|
||||
(some-> (ctob/get-set lib set-name)
|
||||
(ctob/get-token token-name)))]
|
||||
(t/is (= '("single_set") (ctob/get-ordered-set-names lib)))
|
||||
(t/testing "token added"
|
||||
(t/is (some? (get-set-token "single_set" "color.red.100")))))))
|
||||
|
||||
#?(:clj
|
||||
(t/deftest dtcg-encoding-decoding-json
|
||||
(let [json (-> (slurp "test/common_tests/types/data/tokens-multi-set-example.json")
|
||||
|
||||
@@ -1,112 +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.variant-test
|
||||
(:require
|
||||
[app.common.types.variant :as ctv]
|
||||
[clojure.test :as t]))
|
||||
|
||||
|
||||
(t/deftest variant-distance01
|
||||
;;c1: primary, default, rounded, blue, dark
|
||||
;;c2: primary, hover, squared, blue, dark
|
||||
;;c3: primary, default, squared, blue, light
|
||||
|
||||
;; I have a copy of c1, and I change from rounded to squared
|
||||
;; c2: 1 difference in pos 2
|
||||
;; c3: 1 differences in pos 5
|
||||
;; The min distance should be c3
|
||||
|
||||
(let [target [{:name "type" :value "primary"}
|
||||
{:name "status" :value "default"}
|
||||
{:name "borders" :value "squared"}
|
||||
{:name "color" :value "blue"}
|
||||
{:name "theme" :value "dark"}]
|
||||
props2 [{:name "type" :value "primary"}
|
||||
{:name "status" :value "hover"}
|
||||
{:name "borders" :value "rounded"}
|
||||
{:name "color" :value "blue"}
|
||||
{:name "theme" :value "dark"}]
|
||||
props3 [{:name "type" :value "primary"}
|
||||
{:name "status" :value "default"}
|
||||
{:name "borders" :value "rounded"}
|
||||
{:name "color" :value "blue"}
|
||||
{:name "theme" :value "light"}]
|
||||
dist2 (ctv/distance target props2)
|
||||
dist3 (ctv/distance target props3)]
|
||||
(t/is (< dist3 dist2))))
|
||||
|
||||
|
||||
(t/deftest variant-distance02
|
||||
;;c1: primary, default, rounded, blue, dark
|
||||
;;c2: primary, hover, squared, red, dark
|
||||
;;c3: secondary, hover, rounded, blue, dark
|
||||
|
||||
;; I have a copy of c1, and I change from default to hover
|
||||
;; c2: 2 differences in pos 3 and 4
|
||||
;; c3: 1 differences in pos 1
|
||||
;; The min distance should be c2
|
||||
|
||||
(let [target [{:name "type" :value "primary"}
|
||||
{:name "status" :value "hover"}
|
||||
{:name "borders" :value "rounded"}
|
||||
{:name "color" :value "blue"}
|
||||
{:name "theme" :value "dark"}]
|
||||
props2 [{:name "type" :value "primary"}
|
||||
{:name "status" :value "hover"}
|
||||
{:name "borders" :value "squared"}
|
||||
{:name "color" :value "red"}
|
||||
{:name "theme" :value "dark"}]
|
||||
props3 [{:name "type" :value "secondary"}
|
||||
{:name "status" :value "hover"}
|
||||
{:name "borders" :value "rounded"}
|
||||
{:name "color" :value "blue"}
|
||||
{:name "theme" :value "dark"}]
|
||||
dist2 (ctv/distance target props2)
|
||||
dist3 (ctv/distance target props3)]
|
||||
(t/is (< dist2 dist3))))
|
||||
|
||||
(t/deftest variant-distance03
|
||||
;;c1: primary, default, rounded, blue, dark
|
||||
;;c2: secondary, default, rounded, blue, light
|
||||
;;c3: secondary, hover, squared, blue, dark
|
||||
;;c4: secondary, hover, rounded, blue, dark
|
||||
|
||||
;; I have a copy of c1, and I change from primary to secondary
|
||||
;; c2: 1 difference in pos 4
|
||||
;; c3: 2 differences in pos 1 and 2
|
||||
;; c4: 1 difference in pos 1
|
||||
;; The distances should be c2 < c4 < c3
|
||||
|
||||
(let [target [{:name "type" :value "secondary"}
|
||||
{:name "status" :value "default"}
|
||||
{:name "borders" :value "rounded"}
|
||||
{:name "color" :value "blue"}
|
||||
{:name "theme" :value "dark"}]
|
||||
props2 [{:name "type" :value "secondary"}
|
||||
{:name "status" :value "default"}
|
||||
{:name "borders" :value "rounded"}
|
||||
{:name "color" :value "blue"}
|
||||
{:name "theme" :value "light"}]
|
||||
props3 [{:name "type" :value "secondary"}
|
||||
{:name "status" :value "hover"}
|
||||
{:name "borders" :value "squared"}
|
||||
{:name "color" :value "blue"}
|
||||
{:name "theme" :value "dark"}]
|
||||
props4 [{:name "type" :value "secondary"}
|
||||
{:name "status" :value "hover"}
|
||||
{:name "borders" :value "rounded"}
|
||||
{:name "color" :value "blue"}
|
||||
{:name "theme" :value "dark"}]
|
||||
dist2 (ctv/distance target props2)
|
||||
dist3 (ctv/distance target props3)
|
||||
dist4 (ctv/distance target props4)]
|
||||
(t/is (< dist2 dist4))
|
||||
(t/is (< dist4 dist3))))
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -1,108 +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.variant-test
|
||||
(:require
|
||||
[app.common.types.variant :as ctv]
|
||||
[clojure.test :as t]))
|
||||
|
||||
(t/deftest convert-between-variant-properties-maps-and-strings
|
||||
(let [map-with-two-props [{:name "border" :value "yes"} {:name "color" :value "gray"}]
|
||||
map-with-two-props-one-blank [{:name "border" :value "no"} {:name "color" :value ""}]
|
||||
map-with-one-prop [{:name "border" :value "no"}]
|
||||
map-with-spaces [{:name "border 1" :value "of course"} {:name "color 2" :value "dark gray"}]
|
||||
|
||||
string-valid-with-two-props "border=yes, color=gray"
|
||||
string-valid-with-one-prop "border=no"
|
||||
string-valid-with-spaces "border 1=of course, color 2=dark gray"
|
||||
string-invalid "border=yes, color="]
|
||||
|
||||
(t/testing "convert map to string"
|
||||
(t/is (= (ctv/properties-map-to-string map-with-two-props) string-valid-with-two-props))
|
||||
(t/is (= (ctv/properties-map-to-string map-with-two-props-one-blank) string-valid-with-one-prop))
|
||||
(t/is (= (ctv/properties-map-to-string map-with-spaces) string-valid-with-spaces)))
|
||||
|
||||
(t/testing "convert string to map"
|
||||
(t/is (= (ctv/properties-string-to-map string-valid-with-two-props) map-with-two-props))
|
||||
(t/is (= (ctv/properties-string-to-map string-valid-with-one-prop) map-with-one-prop))
|
||||
(t/is (= (ctv/properties-string-to-map string-valid-with-spaces) map-with-spaces)))
|
||||
|
||||
(t/testing "check if a string is valid"
|
||||
(t/is (= (ctv/valid-properties-string? string-valid-with-two-props) true))
|
||||
(t/is (= (ctv/valid-properties-string? string-valid-with-one-prop) true))
|
||||
(t/is (= (ctv/valid-properties-string? string-valid-with-spaces) true))
|
||||
(t/is (= (ctv/valid-properties-string? string-invalid) false)))))
|
||||
|
||||
|
||||
(t/deftest find-properties
|
||||
(let [prev-props [{:name "border" :value "yes"} {:name "color" :value "gray"}]
|
||||
upd-props-1 [{:name "border" :value "yes"}]
|
||||
upd-props-2 [{:name "border" :value "yes"} {:name "color" :value "blue"}]
|
||||
upd-props-3 [{:name "border" :value "yes"} {:name "color" :value "gray"} {:name "shadow" :value "large"}]
|
||||
upd-props-4 [{:name "color" :value "yellow"} {:name "shadow" :value "large"}]]
|
||||
|
||||
(t/testing "a property to remove"
|
||||
(t/is (= (ctv/find-properties-to-remove prev-props upd-props-1)
|
||||
[{:name "color" :value "gray"}]))
|
||||
(t/is (= (ctv/find-properties-to-update prev-props upd-props-1)
|
||||
[]))
|
||||
(t/is (= (ctv/find-properties-to-add prev-props upd-props-1)
|
||||
[])))
|
||||
|
||||
(t/testing "a property to update"
|
||||
(t/is (= (ctv/find-properties-to-remove prev-props upd-props-2)
|
||||
[]))
|
||||
(t/is (= (ctv/find-properties-to-update prev-props upd-props-2)
|
||||
[{:name "color" :value "blue"}]))
|
||||
(t/is (= (ctv/find-properties-to-add prev-props upd-props-2)
|
||||
[])))
|
||||
|
||||
(t/testing "a property to add"
|
||||
(t/is (= (ctv/find-properties-to-remove prev-props upd-props-3)
|
||||
[]))
|
||||
(t/is (= (ctv/find-properties-to-update prev-props upd-props-3)
|
||||
[]))
|
||||
(t/is (= (ctv/find-properties-to-add prev-props upd-props-3)
|
||||
[{:name "shadow" :value "large"}])))
|
||||
|
||||
(t/testing "properties to remove, update & add"
|
||||
(t/is (= (ctv/find-properties-to-remove prev-props upd-props-4)
|
||||
[{:name "border" :value "yes"}]))
|
||||
(t/is (= (ctv/find-properties-to-update prev-props upd-props-4)
|
||||
[{:name "color" :value "yellow"}]))
|
||||
(t/is (= (ctv/find-properties-to-add prev-props upd-props-4)
|
||||
[{:name "shadow" :value "large"}])))
|
||||
|
||||
(t/testing "find property index"
|
||||
(t/is (= (ctv/find-index-for-property-name prev-props "border") 0))
|
||||
(t/is (= (ctv/find-index-for-property-name prev-props "color") 1)))))
|
||||
|
||||
|
||||
(t/deftest compare-properties
|
||||
(let [props-1 [{:name "border" :value "yes"} {:name "color" :value "gray"}]
|
||||
props-2 [{:name "border" :value "yes"} {:name "color" :value "red"}]
|
||||
props-3 [{:name "border" :value "no"} {:name "color" :value "gray"}]]
|
||||
|
||||
(t/testing "compare properties"
|
||||
(t/is (= (ctv/compare-properties [props-1 props-2])
|
||||
[{:name "border" :value "yes"} {:name "color" :value nil}]))
|
||||
(t/is (= (ctv/compare-properties [props-1 props-2 props-3])
|
||||
[{:name "border" :value nil} {:name "color" :value nil}]))
|
||||
(t/is (= (ctv/compare-properties [props-1 props-2 props-3] "&")
|
||||
[{:name "border" :value "&"} {:name "color" :value "&"}])))))
|
||||
|
||||
|
||||
(t/deftest check-belong-same-variant
|
||||
(let [components-1 [{:variant-id "a variant"} {:variant-id "a variant"}]
|
||||
components-2 [{:variant-id "a variant"} {:variant-id "another variant"}]
|
||||
components-3 [{:variant-id "a variant"} {}]
|
||||
components-4 [{} {}]]
|
||||
|
||||
(t/testing "check-belong-same-variant"
|
||||
(t/is (= (ctv/same-variant? components-1) true))
|
||||
(t/is (= (ctv/same-variant? components-2) false))
|
||||
(t/is (= (ctv/same-variant? components-3) false))
|
||||
(t/is (= (ctv/same-variant? components-4) false)))))
|
||||
@@ -1,16 +1,15 @@
|
||||
FROM ubuntu:24.04
|
||||
FROM debian:bookworm
|
||||
LABEL maintainer="Penpot <docker@penpot.app>"
|
||||
|
||||
ARG DEBIAN_FRONTEND=noninteractive
|
||||
|
||||
ENV NODE_VERSION=v22.14.0 \
|
||||
ENV NODE_VERSION=v22.13.1 \
|
||||
CLOJURE_VERSION=1.12.0.1501 \
|
||||
CLJKONDO_VERSION=2025.01.16 \
|
||||
BABASHKA_VERSION=1.12.196 \
|
||||
CLJFMT_VERSION=0.13.0 \
|
||||
RUSTUP_VERSION=1.27.1 \
|
||||
RUST_VERSION=1.85.0 \
|
||||
EMSCRIPTEN_VERSION=4.0.6 \
|
||||
LANG=en_US.UTF-8 \
|
||||
LC_ALL=en_US.UTF-8
|
||||
|
||||
@@ -46,7 +45,7 @@ RUN set -ex; \
|
||||
rm -rf /var/lib/apt/lists/*;
|
||||
|
||||
RUN set -ex; \
|
||||
usermod -l penpot -d /home/penpot -G users -s /bin/bash ubuntu; \
|
||||
useradd -m -g users -s /bin/bash penpot; \
|
||||
passwd penpot -d; \
|
||||
echo "penpot ALL=(ALL) NOPASSWD:ALL" >> /etc/sudoers
|
||||
|
||||
@@ -64,6 +63,8 @@ RUN set -ex; \
|
||||
woff-tools \
|
||||
woff2 \
|
||||
fontforge \
|
||||
gconf-service \
|
||||
libasound2 \
|
||||
libatk1.0-0 \
|
||||
libatk-bridge2.0-0 \
|
||||
libcairo2 \
|
||||
@@ -72,6 +73,7 @@ RUN set -ex; \
|
||||
libexpat1 \
|
||||
libfontconfig1 \
|
||||
libgcc1 \
|
||||
libgconf-2-4 \
|
||||
libgdk-pixbuf2.0-0 \
|
||||
libglib2.0-0 \
|
||||
libgtk-3-0 \
|
||||
@@ -93,6 +95,7 @@ RUN set -ex; \
|
||||
libxss1 \
|
||||
libxtst6 \
|
||||
fonts-liberation \
|
||||
libappindicator1 \
|
||||
libnss3 \
|
||||
libgbm1 \
|
||||
xvfb \
|
||||
@@ -104,12 +107,12 @@ RUN set -eux; \
|
||||
ARCH="$(dpkg --print-architecture)"; \
|
||||
case "${ARCH}" in \
|
||||
aarch64|arm64) \
|
||||
ESUM='18071047526ab4b53131f9bb323e8703485ae37fcb2f2c5ef0f1b7bab66d1b94'; \
|
||||
BINARY_URL='https://github.com/adoptium/temurin24-binaries/releases/download/jdk-24%2B36/OpenJDK24U-jdk_aarch64_linux_hotspot_24_36.tar.gz'; \
|
||||
ESUM='fb43ae1202402842559cb6223886ec1663b90ffbec48479abbcb92c92c9012eb'; \
|
||||
BINARY_URL='https://github.com/adoptium/temurin23-binaries/releases/download/jdk-23.0.2%2B7/OpenJDK23U-jdk_aarch64_linux_hotspot_23.0.2_7.tar.gz'; \
|
||||
;; \
|
||||
amd64|x86_64) \
|
||||
ESUM='c340dee97b6aa215d248bc196dcac5b56e7be9b5c5d45e691344d40d5d0b171d'; \
|
||||
BINARY_URL='https://github.com/adoptium/temurin24-binaries/releases/download/jdk-24%2B36/OpenJDK24U-jdk_x64_linux_hotspot_24_36.tar.gz'; \
|
||||
ESUM='870ac8c05c6fe563e7a3878a47d0234b83c050e83651d2c47e8b822ec74512dd'; \
|
||||
BINARY_URL='https://github.com/adoptium/temurin23-binaries/releases/download/jdk-23.0.2%2B7/OpenJDK23U-jdk_x64_linux_hotspot_23.0.2_7.tar.gz'; \
|
||||
;; \
|
||||
*) \
|
||||
echo "Unsupported arch: ${ARCH}"; \
|
||||
@@ -134,7 +137,7 @@ RUN set -ex; \
|
||||
RUN set -ex; \
|
||||
install -d /usr/share/postgresql-common/pgdg; \
|
||||
curl -o /usr/share/postgresql-common/pgdg/apt.postgresql.org.asc --fail https://www.postgresql.org/media/keys/ACCC4CF8.asc; \
|
||||
echo "deb [signed-by=/usr/share/postgresql-common/pgdg/apt.postgresql.org.asc] https://apt.postgresql.org/pub/repos/apt noble-pgdg main" >> /etc/apt/sources.list.d/postgresql.list; \
|
||||
echo "deb [signed-by=/usr/share/postgresql-common/pgdg/apt.postgresql.org.asc] https://apt.postgresql.org/pub/repos/apt bookworm-pgdg main" >> /etc/apt/sources.list.d/postgresql.list; \
|
||||
apt-get -qq update; \
|
||||
apt-get -qqy install postgresql-client-16; \
|
||||
rm -rf /var/lib/apt/lists/*;
|
||||
@@ -270,8 +273,8 @@ WORKDIR /usr/local
|
||||
RUN set -eux; \
|
||||
git clone https://github.com/emscripten-core/emsdk.git; \
|
||||
cd emsdk; \
|
||||
./emsdk install $EMSCRIPTEN_VERSION; \
|
||||
./emsdk activate $EMSCRIPTEN_VERSION; \
|
||||
./emsdk install latest; \
|
||||
./emsdk activate latest; \
|
||||
rustup target add wasm32-unknown-emscripten;
|
||||
|
||||
WORKDIR /home
|
||||
|
||||
@@ -68,7 +68,7 @@ services:
|
||||
- PENPOT_LDAP_ATTRS_PHOTO=jpegPhoto
|
||||
|
||||
minio:
|
||||
image: "minio/minio:RELEASE.2025-04-03T14-56-28Z"
|
||||
image: "minio/minio:RELEASE.2023-11-11T08-14-41Z"
|
||||
command: minio server /mnt/data --console-address ":9001"
|
||||
|
||||
volumes:
|
||||
@@ -83,7 +83,7 @@ services:
|
||||
- 9001:9001
|
||||
|
||||
postgres:
|
||||
image: postgres:16.8
|
||||
image: postgres:16
|
||||
command: postgres -c config_file=/etc/postgresql.conf
|
||||
restart: always
|
||||
stop_signal: SIGINT
|
||||
|
||||
@@ -3,6 +3,7 @@
|
||||
<head>
|
||||
<meta charset="utf-8">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1.0">
|
||||
<meta name="description" content="{{ description or metadata.description }}">
|
||||
<link rel="stylesheet" href="{{ '/css/index.css' | url }}">
|
||||
<link rel="stylesheet" href="{{ '/css/prism.css' | url }}">
|
||||
<link rel="shortcut icon" href="/img/favicon.png">
|
||||
@@ -14,7 +15,7 @@
|
||||
<link href="https://fonts.googleapis.com/css2?family=Work+Sans:ital,wght@0,100;0,200;0,300;0,400;0,500;0,600;0,700;0,800;0,900;1,100;1,200;1,300;1,400;1,500;1,600;1,700;1,800;1,900&display=swap" rel="stylesheet">
|
||||
{% metagen
|
||||
title=title or metadata.title,
|
||||
desc=desc or metadata.desc or description or metadata.description,
|
||||
desc=desc or metadata.desc,
|
||||
url="https://help.penpot.app" + page.url,
|
||||
img="https://help.penpot.app/img/th-help-center.jpg",
|
||||
img_alt=alt,
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
---
|
||||
title: 04· Code of Conduct
|
||||
desc: Learn about contributing to the Penpot project! This page outlines the Code of Conduct, reporting bugs, translations, core code contributions, & more.
|
||||
---
|
||||
|
||||
<h1 id="coc">Code of conduct</h1>
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
---
|
||||
title: 03· Core code contributions
|
||||
desc: Learn how to contribute to Penpot's open-source design collaboration platform. Find guidelines for bug reporting, code contributions & more.
|
||||
---
|
||||
|
||||
<h1 id="code-contributions">Core code contributions</h1>
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
---
|
||||
title: Contributing
|
||||
desc: Learn how to contribute to Penpot, the open-source design collaboration platform! Find guides on bug reporting, translations, code contributions, and more.
|
||||
eleventyNavigation:
|
||||
key: Contributing
|
||||
order: 3
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
---
|
||||
title: 05· Libraries & Templates
|
||||
desc: Contribute to Penpot's libraries & templates! Learn how to share your files and access resources. Try Penpot - It's free!
|
||||
---
|
||||
|
||||
<h1 id="libraries">Libraries & templates</h1>
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
---
|
||||
title: 01· Reporting bugs
|
||||
desc: Learn how to contribute to Penpot, the open-source design and prototyping platform! Find guidelines for reporting bugs, translations, & code contributions.
|
||||
---
|
||||
|
||||
<h1 id="reporting-bugs">Reporting bugs</h1>
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user