3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-14 18:26:38 +02:00
Code Issues Projects Releases Packages Wiki Activity

🎉 Add new shape & rect data structures

Browse source 
Also optimizes some functions for faster shape and rect props
access (there is still a lot of work ahead optimizing the rest of
the functions)

Also normalizes shape creation and validation for ensuring
correct setup of all the mandatory properties.
This commit is contained in:
Andrey Antukh 2023-05-26 16:37:15 +02:00
parent 9f5640c1db
commit 405aa66357
130 changed files with 3038 additions and 2901 deletions
Download patch file Download diff file Expand all files Collapse all files

2
backend/src/app/rpc/commands/binfile.clj
View file

@ -11,9 +11,9 @@
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.files.features :as ffeat]
[app.common.files.migrations :as pmg]
[app.common.fressian :as fres]
[app.common.logging :as l]
[app.common.pages.migrations :as pmg]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]

2
backend/src/app/rpc/commands/files.clj
View file

@ -9,8 +9,8 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.files.migrations :as pmg]
[app.common.pages.helpers :as cph]
[app.common.pages.migrations :as pmg]
[app.common.schema :as sm]
[app.common.schema.desc-js-like :as-alias smdj]
[app.common.schema.generators :as sg]

2
backend/src/app/rpc/commands/files_thumbnails.clj
View file

@ -173,7 +173,7 @@
bounds
(when (:show-content frame)
(gsh/selection-rect (concat [frame] (->> children-ids (map (d/getf objects))))))
(gsh/shapes->rect (cons frame (map (d/getf objects) children-ids))))
frame
(cond-> frame

3
backend/src/app/rpc/commands/files_update.clj
View file

@ -8,10 +8,10 @@
(:require
[app.common.exceptions :as ex]
[app.common.files.features :as ffeat]
[app.common.files.migrations :as pmg]
[app.common.logging :as l]
[app.common.pages :as cp]
[app.common.pages.changes :as cpc]
[app.common.pages.migrations :as pmg]
[app.common.schema :as sm]
[app.common.schema.generators :as smg]
[app.common.spec :as us]
@ -177,6 +177,7 @@
(db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id id)
(db/xact-lock! conn id)
(let [cfg (assoc cfg ::db/conn conn)
params (assoc params :profile-id profile-id)
tpoint (dt/tpoint)]

2
backend/src/app/rpc/commands/management.clj
View file

@ -9,7 +9,7 @@
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.pages.migrations :as pmg]
[app.common.files.migrations :as pmg]
[app.common.schema :as sm]
[app.common.spec :as us]
[app.common.uuid :as uuid]

2
backend/src/app/srepl/helpers.clj
View file

@ -14,7 +14,7 @@
[app.common.files.features :as ffeat]
[app.common.logging :as l]
[app.common.pages :as cp]
[app.common.pages.migrations :as pmg]
[app.common.files.migrations :as pmg]
[app.common.pprint :refer [pprint]]
[app.common.spec :as us]
[app.common.uuid :as uuid]

2
backend/src/app/tasks/file_gc.clj
View file

@ -11,8 +11,8 @@
inactivity (the default threshold is 72h)."
(:require
[app.common.data :as d]
[app.common.files.migrations :as pmg]
[app.common.logging :as l]
[app.common.pages.migrations :as pmg]
[app.common.types.components-list :as ctkl]
[app.common.types.file :as ctf]
[app.common.types.shape-tree :as ctt]

113
backend/src/app/util/async.clj
View file

@ -1,113 +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.util.async
(:require
[app.common.exceptions :as ex]
[clojure.core.async :as a]
[clojure.core.async.impl.protocols :as ap]
[clojure.spec.alpha :as s])
(:import
java.util.concurrent.Executor
java.util.concurrent.RejectedExecutionException))
(s/def ::executor #(instance? Executor %))
(s/def ::channel #(satisfies? ap/Channel %))
(defonce processors
(delay (.availableProcessors (Runtime/getRuntime))))
(defmacro go-try
[& body]
`(a/go
(try
~@body
(catch Exception e# e#))))
(defmacro thread
[& body]
`(a/thread
(try
~@body
(catch Exception e#
e#))))
(defmacro <?
[ch]
`(let [r# (a/<! ~ch)]
(if (instance? Exception r#)
(throw r#)
r#)))
(defmacro with-closing
[ch & body]
`(try
~@body
(finally
(some-> ~ch a/close!))))
(defn thread-call
[^Executor executor f]
(let [ch (a/chan 1)
f' (fn []
(try
(let [ret (ex/try* f identity)]
(when (some? ret) (a/>!! ch ret)))
(finally
(a/close! ch))))]
(try
(.execute executor f')
(catch RejectedExecutionException _cause
(a/close! ch)))
ch))
(defmacro with-thread
[executor & body]
(if (= executor ::default)
`(a/thread-call (^:once fn* [] (try ~@body (catch Exception e# e#))))
`(thread-call ~executor (^:once fn* [] ~@body))))
(defn batch
[in {:keys [max-batch-size
max-batch-age
buffer-size
init]
:or {max-batch-size 200
max-batch-age (* 30 1000)
buffer-size 128
init #{}}
:as opts}]
(let [out (a/chan buffer-size)]
(a/go-loop [tch (a/timeout max-batch-age) buf init]
(let [[val port] (a/alts! [tch in])]
(cond
(identical? port tch)
(if (empty? buf)
(recur (a/timeout max-batch-age) buf)
(do
(a/>! out [:timeout buf])
(recur (a/timeout max-batch-age) init)))
(nil? val)
(if (empty? buf)
(a/close! out)
(do
(a/offer! out [:timeout buf])
(a/close! out)))
(identical? port in)
(let [buf (conj buf val)]
(if (>= (count buf) max-batch-size)
(do
(a/>! out [:size buf])
(recur (a/timeout max-batch-age) init))
(recur tch buf))))))
out))
(defn thread-sleep
[ms]
(Thread/sleep (long ms)))

31
backend/test/backend_tests/rpc_file_test.clj
View file

@ -7,6 +7,7 @@
(ns backend-tests.rpc-file-test
(:require
[app.common.uuid :as uuid]
[app.common.types.shape :as cts]
[app.db :as db]
[app.db.sql :as sql]
[app.http :as http]
@ -187,11 +188,12 @@
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj {:id shape-id
:obj (cts/setup-shape
{:id shape-id
:name "image"
:frame-id uuid/zero
:parent-id uuid/zero
:type :rect}}])
:type :rect})}])
;; Check the number of fragments
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
@ -282,12 +284,13 @@
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj {:id shid
:obj (cts/setup-shape
{:id shid
:name "image"
:frame-id uuid/zero
:parent-id uuid/zero
:type :image
:metadata {:id (:id fmo1) :width 200 :height 200 :mtype "image/jpeg"}}}])
:metadata {:id (:id fmo1) :width 100 :height 100 :mtype "image/jpeg"}})}])
;; Check that reference storage objects on filemediaobjects
;; are the same because of deduplication feature.
@ -551,34 +554,38 @@
:id frame1-id
:parent-id uuid/zero
:frame-id uuid/zero
:obj {:id frame1-id
:obj (cts/setup-shape
{:id frame1-id
:use-for-thumbnail? true
:name "test-frame1"
:type :frame}}
:type :frame})}
{:type :add-obj
:page-id page-id
:id shape1-id
:parent-id frame1-id
:frame-id frame1-id
:obj {:id shape1-id
:obj (cts/setup-shape
{:id shape1-id
:name "test-shape1"
:type :rect}}
:type :rect})}
{:type :add-obj
:page-id page-id
:id frame2-id
:parent-id uuid/zero
:frame-id uuid/zero
:obj {:id frame2-id
:obj (cts/setup-shape
{:id frame2-id
:name "test-frame2"
:type :frame}}
:type :frame})}
{:type :add-obj
:page-id page-id
:id shape2-id
:parent-id frame2-id
:frame-id frame2-id
:obj {:id shape2-id
:obj (cts/setup-shape
{:id shape2-id
:name "test-shape2"
:type :rect}}]]
:type :rect})}]]
;; Update the file
(th/update-file* {:file-id (:id file)
:profile-id (:id prof)

6
backend/test/backend_tests/rpc_file_thumbnails_test.clj
View file

@ -7,6 +7,7 @@
(ns backend-tests.rpc-file-thumbnails-test
(:require
[app.common.uuid :as uuid]
[app.common.types.shape :as cts]
[app.config :as cf]
[app.db :as db]
[app.rpc :as-alias rpc]
@ -46,11 +47,12 @@
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj {:id shid
:obj (cts/setup-shape
{:id shid
:name "Artboard"
:frame-id uuid/zero
:parent-id uuid/zero
:type :frame}}])
:type :frame})}])
data1 {::th/type :create-file-object-thumbnail
::rpc/profile-id (:id profile)

7
common/dev/user.clj
View file

@ -6,13 +6,18 @@
(ns user
(:require
[app.common.schema :as sm]
[app.common.schema.desc-js-like :as smdj]
[app.common.schema.desc-native :as smdn]
[app.common.schema.generators :as sg]
[app.common.pprint :as pp]
[clojure.java.io :as io]
[clojure.pprint :refer [pprint print-table]]
[clojure.repl :refer :all]
[clojure.spec.alpha :as s]
[clojure.spec.gen.alpha :as sgen]
[clojure.test :as test]
[clojure.test.check.generators :as gen]
[clojure.test.check.generators :as tgen]
[clojure.tools.namespace.repl :as repl]
[clojure.walk :refer [macroexpand-all]]
[criterium.core :as crit]))

8
common/package.json
View file

@ -7,10 +7,10 @@
"luxon": "^3.3.0"
},
"scripts": {
"compile-and-watch-test": "clojure -M:dev:shadow-cljs watch test",
"compile-test": "clojure -M:dev:shadow-cljs compile test --config-merge '{:autorun false}'",
"run-test": "node target/test.js",
"test": "yarn run compile-test && yarn run run-test"
"test:watch": "clojure -M:dev:shadow-cljs watch test",
"test:compile": "clojure -M:dev:shadow-cljs compile test --config-merge '{:autorun false}'",
"test:run": "node target/test.js",
"test": "yarn run test:compile && yarn run test:run"
},
"devDependencies": {
"shadow-cljs": "2.20.16",

5
common/src/app/common/attrs.cljc
View file

@ -6,7 +6,7 @@
(ns app.common.attrs
(:require
[app.common.geom.shapes.transforms :as gtr]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]))
(defn- get-attr
@ -24,7 +24,8 @@
value
(if-let [points (:points obj)]
(if (not= points :multiple)
(let [rect (gtr/selection-rect [obj])]
;; FIXME: consider using gsh/shape->rect ??
(let [rect (gsh/shapes->rect [obj])]
(if (= attr :ox) (:x rect) (:y rect)))
:multiple)
(get obj attr ::unset)))

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

@ -9,7 +9,7 @@
data resources."
(:refer-clojure :exclude [read-string hash-map merge name update-vals
parse-double group-by iteration concat mapcat
parse-uuid])
parse-uuid max min])
#?(:cljs
(:require-macros [app.common.data]))
@ -590,23 +590,43 @@
([a]
(mth/finite? a))
([a b]
(and (mth/finite? a)
(mth/finite? b)))
(and ^boolean (mth/finite? a)
^boolean (mth/finite? b)))
([a b c]
(and (mth/finite? a)
(mth/finite? b)
(mth/finite? c)))
(and ^boolean (mth/finite? a)
^boolean (mth/finite? b)
^boolean (mth/finite? c)))
([a b c d]
(and (mth/finite? a)
(mth/finite? b)
(mth/finite? c)
(mth/finite? d)))
(and ^boolean (mth/finite? a)
^boolean (mth/finite? b)
^boolean (mth/finite? c)
^boolean (mth/finite? d)))
([a b c d & others]
(and (mth/finite? a)
(mth/finite? b)
(mth/finite? c)
(mth/finite? d)
(every? mth/finite? others))))
(and ^boolean (mth/finite? a)
^boolean (mth/finite? b)
^boolean (mth/finite? c)
^boolean (mth/finite? d)
^boolean (every? mth/finite? others))))
(defn max
([a] a)
([a b] (mth/max a b))
([a b c] (mth/max a b c))
([a b c d] (mth/max a b c d))
([a b c d e] (mth/max a b c d e))
([a b c d e f] (mth/max a b c d e f))
([a b c d e f & other]
(reduce max (mth/max a b c d e f) other)))
(defn min
([a] a)
([a b] (mth/min a b))
([a b c] (mth/min a b c))
([a b c d] (mth/min a b c d))
([a b c d e] (mth/min a b c d e))
([a b c d e f] (mth/min a b c d e f))
([a b c d e f & other]
(reduce min (mth/min a b c d e f) other)))
(defn check-num
"Function that checks if a number is nil or nan. Will return 0 when not

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

@ -7,7 +7,7 @@
#_:clj-kondo/ignore
(ns app.common.data.macros
"Data retrieval & manipulation specific macros."
(:refer-clojure :exclude [get-in select-keys str with-open])
(: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]
@ -154,7 +154,7 @@
(defmacro verify!
([expr]
`(assert! nil ~expr))
`(verify! nil ~expr))
([hint expr]
(let [hint (cond
(vector? hint)

5
common/src/app/common/exceptions.cljc
View file

@ -32,11 +32,6 @@
[& params]
`(throw (error ~@params)))
;; FIXME deprecate
(defn try*
[f on-error]
(try (f) (catch #?(:clj Throwable :cljs :default) e (on-error e))))
;; http://clj-me.cgrand.net/2013/09/11/macros-closures-and-unexpected-object-retention/
;; Explains the use of ^:once metadata

154
common/src/app/common/file_builder.cljc → common/src/app/common/files/builder.cljc
View file

@ -4,14 +4,13 @@
;;
;; Copyright (c) KALEIDOS INC
(ns app.common.file-builder
"A version parsing helper."
(ns app.common.files.builder
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.pages.changes :as ch]
[app.common.pprint :as pp]
@ -25,9 +24,9 @@
[app.common.uuid :as uuid]
[cuerdas.core :as str]))
(def root-frame uuid/zero)
(def conjv (fnil conj []))
(def conjs (fnil conj #{}))
(def ^:private root-id uuid/zero)
(def ^:private conjv (fnil conj []))
(def ^:private conjs (fnil conj #{}))
(defn- commit-change
([file change]
@ -40,25 +39,23 @@
(let [component-id (:current-component-id file)
change (cond-> change
(and add-container? (some? component-id))
(cond->
:always
(assoc :component-id component-id)
(some? (:current-frame-id file))
(assoc :frame-id (:current-frame-id file)))
(-> (assoc :component-id component-id)
(cond-> (some? (:current-frame-id file))
(assoc :frame-id (:current-frame-id file))))
(and add-container? (nil? component-id))
(assoc :page-id (:current-page-id file)
:frame-id (:current-frame-id file)))]
:frame-id (:current-frame-id file)))
valid? (ch/valid-change? change)]
(when fail-on-spec?
(dm/verify! (ch/change? change)))
(let [valid? (ch/change? change)]
(when-not valid?
(pp/pprint change {:level 100})
(sm/pretty-explain ::ch/change change))
(let [explain (sm/explain ::ch/change change)]
(pp/pprint (sm/humanize-data explain))
(when fail-on-spec?
(ex/raise :type :assertion
:code :data-validation
:hint "invalid change"
::sm/explain explain))))
(cond-> file
valid?
@ -66,7 +63,7 @@
(update :data ch/process-changes [change] false))
(not valid?)
(update :errors conjv change))))))
(update :errors conjv change)))))
(defn- lookup-objects
([file]
@ -91,50 +88,6 @@
(commit-change file change {:add-container? true :fail-on-spec? fail-on-spec?})))
(defn setup-rect-selrect [{:keys [x y width height transform] :as obj}]
(when-not (d/num? x y width height)
(ex/raise :type :assertion
:code :invalid-condition
:hint "Coords not valid for object"))
(let [rect (gsh/make-rect x y width height)
center (gsh/center-rect rect)
selrect (gsh/rect->selrect rect)
points (-> (gsh/rect->points rect)
(gsh/transform-points center transform))]
(-> obj
(assoc :selrect selrect)
(assoc :points points))))
(defn- setup-path-selrect
[{:keys [content center transform transform-inverse] :as obj}]
(when (or (empty? content) (nil? center))
(ex/raise :type :assertion
:code :invalid-condition
:hint "Path not valid"))
(let [transform (gmt/transform-in center transform)
transform-inverse (gmt/transform-in center transform-inverse)
content' (gsh/transform-content content transform-inverse)
selrect (gsh/content->selrect content')
points (-> (gsh/rect->points selrect)
(gsh/transform-points transform))]
(-> obj
(dissoc :center)
(assoc :selrect selrect)
(assoc :points points))))
(defn- setup-selrect
[obj]
(if (= (:type obj) :path)
(setup-path-selrect obj)
(setup-rect-selrect obj)))
(defn- generate-name
[type data]
(if (= type :svg-raw)
@ -203,10 +156,10 @@
(assoc :current-page-id page-id)
;; Current frame-id
(assoc :current-frame-id root-frame)
(assoc :current-frame-id root-id)
;; Current parent stack we'll be nesting
(assoc :parent-stack [root-frame])
(assoc :parent-stack [root-id])
;; Last object id added
(assoc :last-id nil))))
@ -220,11 +173,8 @@
(clear-names)))
(defn add-artboard [file data]
(let [obj (-> (cts/make-minimal-shape :frame)
(merge data)
(check-name file :frame)
(setup-selrect)
(d/without-nils))]
(let [obj (-> (cts/setup-shape (assoc data :type :frame))
(check-name file :frame))]
(-> file
(commit-shape obj)
(assoc :current-frame-id (:id obj))
@ -237,19 +187,15 @@
parent (lookup-shape file parent-id)
current-frame-id (or (:frame-id parent)
(when (nil? (:current-component-id file))
root-frame))]
root-id))]
(-> file
(assoc :current-frame-id current-frame-id)
(update :parent-stack pop))))
(defn add-group [file data]
(let [frame-id (:current-frame-id file)
selrect cts/empty-selrect
name (:name data)
obj (-> (cts/make-minimal-group frame-id selrect name)
(merge data)
(check-name file :group)
(d/without-nils))]
obj (-> (cts/setup-shape (assoc data :type :group :frame-id frame-id))
(check-name file :group))]
(-> file
(commit-shape obj)
(assoc :last-id (:id obj))
@ -309,15 +255,8 @@
(defn add-bool [file data]
(let [frame-id (:current-frame-id file)
name (:name data)
obj (-> {:id (uuid/next)
:type :bool
:name name
:shapes []
:frame-id frame-id}
(merge data)
(check-name file :bool)
(d/without-nils))]
obj (-> (cts/setup-shape (assoc data :type :bool :frame-id frame-id))
(check-name file :bool))]
(-> file
(commit-shape obj)
(assoc :last-id (:id obj))
@ -360,11 +299,8 @@
(update :parent-stack pop))))
(defn create-shape [file type data]
(let [obj (-> (cts/make-minimal-shape type)
(merge data)
(check-name file :type)
(setup-selrect)
(d/without-nils))]
(let [obj (-> (cts/setup-shape (assoc data :type type))
(check-name file :type))]
(-> file
(commit-shape obj)
(assoc :last-id (:id obj))
@ -556,23 +492,33 @@
{:type :del-media
:id id}))))
(defn start-component
([file data] (start-component file data :group))
([file data root-type]
(let [selrect (or (gsh/make-selrect (:x data) (:y data) (:width data) (:height data))
cts/empty-selrect)
;; FIXME: data probably can be a shape instance, then we can use gsh/shape->rect
(let [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 (-> (cts/make-shape root-type selrect data)
(dissoc :path
:main-instance-id
:main-instance-page
:main-instance-x
:main-instance-y)
(check-name file root-type)
(d/without-nils))]
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))]
(-> file
(commit-change
{:type :add-component
@ -734,7 +680,7 @@
(defn update-object
[file old-obj new-obj]
(let [page-id (:current-page-id file)
new-obj (setup-selrect new-obj)
new-obj (cts/setup-shape new-obj)
attrs (d/concat-set (keys old-obj) (keys new-obj))
generate-operation
(fn [changes attr]

9
common/src/app/common/files/defaults.cljc Normal file
View file

@ -0,0 +1,9 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.common.files.defaults)
(def version 22)

46
common/src/app/common/files/helpers.cljc Normal file
View file

@ -0,0 +1,46 @@
;; 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.helpers
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.schema :as sm]))
(defn get-used-names
"Return a set with the all unique names used in the
elements (any entity thas has a :name)"
[elements]
(let [elements (if (map? elements)
(vals elements)
elements)]
(into #{} (keep :name) elements)))
(defn- extract-numeric-suffix
[basename]
(if-let [[_ p1 p2] (re-find #"(.*) ([0-9]+)$" basename)]
[p1 (+ 1 (d/parse-integer p2))]
[basename 1]))
(defn generate-unique-name
"A unique name generator"
[used basename]
(dm/assert!
"expected a set of strings"
(sm/set-of-strings? used))
(dm/assert!
"expected a string for `basename`."
(string? basename))
(if-not (contains? used basename)
basename
(let [[prefix initial] (extract-numeric-suffix basename)]
(loop [counter initial]
(let [candidate (str prefix " " counter)]
(if (contains? used candidate)
(recur (inc counter))
candidate))))))

60
common/src/app/common/pages/migrations.cljc → common/src/app/common/files/migrations.cljc
View file

@ -4,30 +4,30 @@
;;
;; Copyright (c) KALEIDOS INC
(ns app.common.pages.migrations
(ns app.common.files.migrations
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.defaults :refer [version]]
[app.common.geom.matrix :as gmt]
[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 log]
[app.common.math :as mth]
[app.common.pages :as cp]
[app.common.pages.changes :as cpc]
[app.common.pages.helpers :as cph]
[app.common.types.shape :as cts]
[app.common.uuid :as uuid]
[cuerdas.core :as str]))
;; TODO: revisit this and rename to file-migrations
#?(:cljs (log/set-level! :info))
(defmulti migrate :version)
(log/set-level! :info)
(defn migrate-data
([data] (migrate-data data cp/file-version))
([data] (migrate-data data version))
([data to-version]
(if (= (:version data) to-version)
data
@ -74,7 +74,7 @@
(if-not (contains? shape :content)
(let [content (gsp/segments->content (:segments shape) (:close? shape))
selrect (gsh/content->selrect content)
points (gsh/rect->points selrect)]
points (grc/rect->points selrect)]
(-> shape
(dissoc :segments)
(dissoc :close?)
@ -87,17 +87,17 @@
(fix-frames-selrects [frame]
(if (= (:id frame) uuid/zero)
frame
(let [frame-rect (select-keys frame [:x :y :width :height])]
(let [selrect (gsh/shape->rect frame)]
(-> frame
(assoc :selrect (gsh/rect->selrect frame-rect))
(assoc :points (gsh/rect->points frame-rect))))))
(assoc :selrect selrect)
(assoc :points (grc/rect->points selrect))))))
(fix-empty-points [shape]
(let [shape (cond-> shape
(empty? (:selrect shape)) (cts/setup-rect-selrect))]
(empty? (:selrect shape)) (cts/setup-rect))]
(cond-> shape
(empty? (:points shape))
(assoc :points (gsh/rect->points (:selrect shape))))))
(assoc :points (grc/rect->points (:selrect shape))))))
(update-object [object]
(cond-> object
@ -141,10 +141,10 @@
;; Fixes issues with selrect/points for shapes with width/height = 0 (line-like paths)"
(letfn [(fix-line-paths [shape]
(if (= (:type shape) :path)
(let [{:keys [width height]} (gsh/points->rect (:points shape))]
(let [{:keys [width height]} (grc/points->rect (:points shape))]
(if (or (mth/almost-zero? width) (mth/almost-zero? height))
(let [selrect (gsh/content->selrect (:content shape))
points (gsh/rect->points selrect)
points (grc/rect->points selrect)
transform (gmt/matrix)
transform-inv (gmt/matrix)]
(assoc shape
@ -242,7 +242,7 @@
(loop [data data]
(let [changes (mapcat calculate-changes (:pages-index data))]
(if (seq changes)
(recur (cp/process-changes data changes))
(recur (cpc/process-changes data changes))
data)))))
(defmethod migrate 10
@ -462,5 +462,31 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
;; TODO: pending to do a migration for delete already not used fill
;; and stroke props. This should be done for >1.14.x version.
(defmethod migrate 21
[data]
(letfn [(update-object [object]
(-> object
(d/update-when :selrect grc/make-rect)
(cts/map->Shape)))
(update-container [container]
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 22
[data]
(letfn [(update-object [object]
(cond-> object
(nil? (:transform object))
(assoc :transform (gmt/matrix))
(nil? (:transform-inverse object))
(assoc :transform-inverse (gmt/matrix))))
(update-container [container]
(d/update-when container :objects update-vals update-object))]
(-> data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))

21
common/src/app/common/geom/align.cljc
View file

@ -6,6 +6,7 @@
(ns app.common.geom.align
(:require
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.pages.helpers :refer [get-children]]))
@ -30,7 +31,7 @@
the shape with the given rectangle. If the shape is a group,
move also all of its recursive children."
[shape rect axis objects]
(let [wrapper-rect (gsh/selection-rect [shape])
(let [wrapper-rect (gsh/shapes->rect [shape])
align-pos (calc-align-pos wrapper-rect rect axis)
delta {:x (- (:x align-pos) (:x wrapper-rect))
:y (- (:y align-pos) (:y wrapper-rect))}]
@ -78,11 +79,11 @@
other-coord (if (= axis :horizontal) :y :x)
size (if (= axis :horizontal) :width :height)
; The rectangle that wraps the whole selection
wrapper-rect (gsh/selection-rect shapes)
wrapper-rect (gsh/shapes->rect shapes)
; Sort shapes by the center point in the given axis
sorted-shapes (sort-by #(coord (gsh/center-shape %)) shapes)
sorted-shapes (sort-by #(coord (gsh/shape->center %)) shapes)
; Each shape wrapped in its own rectangle
wrapped-shapes (map #(gsh/selection-rect [%]) sorted-shapes)
wrapped-shapes (map #(gsh/shapes->rect [%]) sorted-shapes)
; The total space between shapes
space (reduce - (size wrapper-rect) (map size wrapped-shapes))
unit-space (/ space (- (count wrapped-shapes) 1))
@ -111,7 +112,8 @@
(defn adjust-to-viewport
([viewport srect] (adjust-to-viewport viewport srect nil))
([viewport srect {:keys [padding] :or {padding 0}}]
(let [gprop (/ (:width viewport) (:height viewport))
(let [gprop (/ (:width viewport)
(:height viewport))
srect (-> srect
(update :x #(- % padding))
(update :y #(- % padding))
@ -126,13 +128,16 @@
padding (/ (- width' width) 2)]
(-> srect
(update :x #(- % padding))
(assoc :width width')))
(assoc :width width')
(grc/update-rect :position)))
(< gprop lprop)
(let [height' (/ (* height lprop) gprop)
padding (/ (- height' height) 2)]
(-> srect
(update :y #(- % padding))
(assoc :height height')))
(assoc :height height')
(grc/update-rect :position)))
:else srect))))
:else
(grc/update-rect srect :position)))))

2
frontend/src/app/util/geom/grid.cljs → common/src/app/common/geom/grid.cljc
View file

@ -4,7 +4,7 @@
;;
;; Copyright (c) KALEIDOS INC
(ns app.util.geom.grid
(ns app.common.geom.grid
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]

8
common/src/app/common/geom/point.cljc
View file

@ -119,9 +119,11 @@
"Returns the addition of the supplied value to both
coordinates of the point as a new point."
[p1 p2]
(assert (and (point? p1)
(point? p2))
"arguments should be pointer instance")
(dm/assert!
"arguments should be point instance"
(and (point? p1)
(point? p2)))
(Point. (+ (dm/get-prop p1 :x)
(dm/get-prop p2 :x))
(+ (dm/get-prop p1 :y)

321
common/src/app/common/geom/rect.cljc Normal file
View file

@ -0,0 +1,321 @@
;; 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.rect
(:require
#?(:clj [app.common.fressian :as fres])
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.math :as mth]
[app.common.transit :as t]))
(defrecord Rect [x y width height x1 y1 x2 y2])
(defn rect?
[o]
(instance? Rect o))
#?(:clj
(fres/add-handlers!
{:name "penpot/geom/rect"
:class Rect
:wfn fres/write-map-like
:rfn (comp map->Rect fres/read-map-like)}))
(t/add-handlers!
{:id "rect"
:class Rect
:wfn #(into {} %)
:rfn map->Rect})
(defn make-rect
([data]
(if (rect? data)
data
(let [{:keys [x y width height]} data]
(make-rect (d/nilv x 0)
(d/nilv y 0)
(d/nilv width 0.01)
(d/nilv height 0.01)))))
([p1 p2]
(dm/assert!
"expected `p1` and `p2` to be points"
(and (gpt/point? p1)
(gpt/point? p2)))
(let [xp1 (dm/get-prop p1 :x)
yp1 (dm/get-prop p1 :y)
xp2 (dm/get-prop p2 :x)
yp2 (dm/get-prop p2 :y)
x1 (mth/min xp1 xp2)
y1 (mth/min yp1 yp2)
x2 (mth/max xp1 xp2)
y2 (mth/max yp1 yp2)]
(make-rect x1 y1 (- x2 x1) (- y2 y1))))
([x y width height]
(when (d/num? x y width height)
(let [w (mth/max width 0.01)
h (mth/max height 0.01)]
(->Rect x y w h x y (+ x w) (+ y h)))))
([x y w h x1 y1 x2 y2]
(->Rect x y w h x1 y1 x2 y2)))
(def empty-rect
(make-rect 0 0 0.01 0.01))
(defn update-rect
[rect type]
(case type
:size
(let [x (dm/get-prop rect :x)
y (dm/get-prop rect :y)
w (dm/get-prop rect :width)
h (dm/get-prop rect :height)]
(assoc rect
:x2 (+ x w)
:y2 (+ y h)))
:corners
(let [x1 (dm/get-prop rect :x1)
y1 (dm/get-prop rect :y1)
x2 (dm/get-prop rect :x2)
y2 (dm/get-prop rect :y2)]
(assoc rect
:x (mth/min x1 x2)
:y (mth/min y1 y2)
:width (mth/abs (- x2 x1))
:height (mth/abs (- y2 y1))))
:position
(let [x (dm/get-prop rect :x)
y (dm/get-prop rect :y)
w (dm/get-prop rect :width)
h (dm/get-prop rect :height)]
(assoc rect
:x1 x
:y1 y
:x2 (+ x w)
:y2 (+ y h)))))
(defn close-rect?
[rect1 rect2]
(dm/assert!
"expected two rects"
(and (rect? rect1)
(rect? rect2)))
(and ^boolean (mth/close? (dm/get-prop rect1 :x)
(dm/get-prop rect2 :x))
^boolean (mth/close? (dm/get-prop rect1 :y)
(dm/get-prop rect2 :y))
^boolean (mth/close? (dm/get-prop rect1 :width)
(dm/get-prop rect2 :width))
^boolean (mth/close? (dm/get-prop rect1 :height)
(dm/get-prop rect2 :height))))
(defn rect->points
[rect]
(dm/assert!
"expected rect instance"
(rect? rect))
(let [x (dm/get-prop rect :x)
y (dm/get-prop rect :y)
w (dm/get-prop rect :width)
h (dm/get-prop rect :height)]
(when (d/num? x y)
(let [w (mth/max w 0.01)
h (mth/max h 0.01)]
[(gpt/point x y)
(gpt/point (+ x w) y)
(gpt/point (+ x w) (+ y h))
(gpt/point x (+ y h))]))))
(defn rect->center
[rect]
(dm/assert! (rect? rect))
(let [x (dm/get-prop rect :x)
y (dm/get-prop rect :y)
w (dm/get-prop rect :width)
h (dm/get-prop rect :height)]
(when (d/num? x y w h)
(gpt/point (+ x (/ w 2.0))
(+ y (/ h 2.0))))))
(defn rect->lines
[rect]
(dm/assert! (rect? rect))
(let [x (dm/get-prop rect :x)
y (dm/get-prop rect :y)
w (dm/get-prop rect :width)
h (dm/get-prop rect :height)]
(when (d/num? x y)
(let [w (mth/max w 0.01)
h (mth/max h 0.01)]
[[(gpt/point x y) (gpt/point (+ x w) y)]
[(gpt/point (+ x w) y) (gpt/point (+ x w) (+ y h))]
[(gpt/point (+ x w) (+ y h)) (gpt/point x (+ y h))]
[(gpt/point x (+ y h)) (gpt/point x y)]]))))
(defn points->rect
[points]
(when-let [points (seq points)]
(loop [minx ##Inf
miny ##Inf
maxx ##-Inf
maxy ##-Inf
pts points]
(if-let [pt (first pts)]
(let [x (dm/get-prop pt :x)
y (dm/get-prop pt :y)]
(recur (mth/min minx x)
(mth/min miny y)
(mth/max maxx x)
(mth/max maxy y)
(rest pts)))
(when (d/num? minx miny maxx maxy)
(make-rect minx miny (- maxx minx) (- maxy miny)))))))
;; FIXME: measure performance
(defn bounds->rect
[[pa pb pc pd]]
(let [ax (dm/get-prop pa :x)
ay (dm/get-prop pa :y)
bx (dm/get-prop pb :x)
by (dm/get-prop pb :y)
cx (dm/get-prop pc :x)
cy (dm/get-prop pc :y)
dx (dm/get-prop pd :x)
dy (dm/get-prop pd :y)
minx (mth/min ax bx cx dx)
miny (mth/min ay by cy dy)
maxx (mth/max ax bx cx dx)
maxy (mth/max ay by cy dy)]
(when (d/num? minx miny maxx maxy)
(make-rect minx miny (- maxx minx) (- maxy miny)))))
(def ^:private xf-keep-x (keep #(dm/get-prop % :x)))
(def ^:private xf-keep-y (keep #(dm/get-prop % :y)))
(def ^:private xf-keep-x2 (keep #(dm/get-prop % :x2)))
(def ^:private xf-keep-y2 (keep #(dm/get-prop % :y2)))
(defn squared-points
[points]
(when (d/not-empty? points)
(let [minx (transduce xf-keep-x d/min ##Inf points)
miny (transduce xf-keep-y d/min ##Inf points)
maxx (transduce xf-keep-x2 d/max ##-Inf points)
maxy (transduce xf-keep-y2 d/max ##-Inf points)]
(when (d/num? minx miny maxx maxy)
[(gpt/point minx miny)
(gpt/point maxx miny)
(gpt/point maxx maxy)
(gpt/point minx maxy)]))))
(defn join-rects [rects]
(when (seq rects)
(let [minx (transduce xf-keep-x d/min ##Inf rects)
miny (transduce xf-keep-y d/min ##Inf rects)
maxx (transduce xf-keep-x2 d/max ##-Inf rects)
maxy (transduce xf-keep-y2 d/max ##-Inf rects)]
(when (d/num? minx miny maxx maxy)
(make-rect minx miny (- maxx minx) (- maxy miny))))))
(defn center->rect [{:keys [x y]} width height]
(when (d/num? x y width height)
(make-rect (- x (/ width 2))
(- y (/ height 2))
width
height)))
(defn s=
[a b]
(mth/almost-zero? (- a b)))
(defn overlaps-rects?
"Check for two rects to overlap. Rects won't overlap only if
one of them is fully to the left or the top"
[rect-a rect-b]
(let [x1a (:x rect-a)
y1a (:y rect-a)
x2a (+ (:x rect-a) (:width rect-a))
y2a (+ (:y rect-a) (:height rect-a))
x1b (:x rect-b)
y1b (:y rect-b)
x2b (+ (:x rect-b) (:width rect-b))
y2b (+ (:y rect-b) (:height rect-b))]
(and (or (> x2a x1b) (s= x2a x1b))
(or (>= x2b x1a) (s= x2b x1a))
(or (<= y1b y2a) (s= y1b y2a))
(or (<= y1a y2b) (s= y1a y2b)))))
(defn contains-point?
[rect point]
(assert (gpt/point? point))
(let [x1 (:x rect)
y1 (:y rect)
x2 (+ (:x rect) (:width rect))
y2 (+ (:y rect) (:height rect))
px (:x point)
py (:y point)]
(and (or (> px x1) (s= px x1))
(or (< px x2) (s= px x2))
(or (> py y1) (s= py y1))
(or (< py y2) (s= py y2)))))
(defn contains-rect?
"Check if a rect srb is contained inside sra"
[sra srb]
(let [ax1 (dm/get-prop sra :x1)
ax2 (dm/get-prop sra :x2)
ay1 (dm/get-prop sra :y1)
ay2 (dm/get-prop sra :y2)
bx1 (dm/get-prop srb :x1)
bx2 (dm/get-prop srb :x2)
by1 (dm/get-prop srb :y1)
by2 (dm/get-prop srb :y2)]
(and (>= bx1 ax1)
(<= bx2 ax2)
(>= by1 ay1)
(<= by2 ay2))))
(defn corners->rect
([p1 p2]
(corners->rect (:x p1) (:y p1) (:x p2) (:y p2)))
([xp1 yp1 xp2 yp2]
(make-rect (mth/min xp1 xp2)
(mth/min yp1 yp2)
(abs (- xp1 xp2))
(abs (- yp1 yp2)))))
(defn clip-rect
[selrect bounds]
(when (rect? selrect)
(dm/assert! (rect? bounds))
(let [x1 (dm/get-prop selrect :x1)
y1 (dm/get-prop selrect :y1)
x2 (dm/get-prop selrect :x2)
y2 (dm/get-prop selrect :y2)
bx1 (dm/get-prop bounds :x1)
by1 (dm/get-prop bounds :y1)
bx2 (dm/get-prop bounds :x2)
by2 (dm/get-prop bounds :y2)]
(corners->rect (mth/max bx1 x1)
(mth/max by1 y1)
(mth/min bx2 x2)
(mth/min by2 y2)))))

86
common/src/app/common/geom/shapes.cljc
View file

@ -9,6 +9,7 @@
[app.common.data :as d]
[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]
@ -16,20 +17,11 @@
[app.common.geom.shapes.intersect :as gsi]
[app.common.geom.shapes.modifiers :as gsm]
[app.common.geom.shapes.path :as gsp]
[app.common.geom.shapes.rect :as gpr]
[app.common.geom.shapes.text :as gst]
[app.common.geom.shapes.transforms :as gtr]
[app.common.math :as mth]))
;; --- Outer Rect
(defn selection-rect
"Returns a rect that contains all the shapes and is aware of the
rotation of each shape. Mainly used for multiple selection."
[shapes]
(->> shapes
(map (comp gpr/points->selrect :points))
(gpr/join-selrects)))
(defn translate-to-frame
[shape {:keys [x y]}]
@ -39,13 +31,22 @@
[shape {:keys [x y]}]
(gtr/move shape (gpt/point x y)) )
(defn shape->rect
[shape]
(let [x (dm/get-prop shape :x)
y (dm/get-prop shape :y)
w (dm/get-prop shape :width)
h (dm/get-prop shape :height)]
(when (d/num? x y w h)
(grc/make-rect x y w h))))
;; --- Helpers
(defn bounding-box
"Returns a rect that wraps the shape after all transformations applied."
[shape]
;; TODO: perhaps we need to store this calculation in a shape attribute
(gpr/points->rect (:points shape)))
(grc/points->rect (:points shape)))
(defn left-bound
"Returns the lowest x coord of the shape BEFORE applying transformations."
@ -82,21 +83,38 @@
(update :width (comp inc inc))
(update :height (comp inc inc))))))
(defn selrect->areas [bounds selrect]
(let [{bound-x1 :x1 bound-x2 :x2 bound-y1 :y1 bound-y2 :y2} bounds
{sr-x1 :x1 sr-x2 :x2 sr-y1 :y1 sr-y2 :y2} selrect]
{:left (gpr/corners->selrect bound-x1 sr-y1 sr-x1 sr-y2)
:top (gpr/corners->selrect sr-x1 bound-y1 sr-x2 sr-y1)
:right (gpr/corners->selrect sr-x2 sr-y1 bound-x2 sr-y2)
:bottom (gpr/corners->selrect sr-x1 sr-y2 sr-x2 bound-y2)}))
(defn get-areas
[bounds selrect]
(let [bound-x1 (dm/get-prop bounds :x1)
bound-x2 (dm/get-prop bounds :x2)
bound-y1 (dm/get-prop bounds :y1)
bound-y2 (dm/get-prop bounds :y2)
sr-x1 (dm/get-prop selrect :x1)
sr-x2 (dm/get-prop selrect :x2)
sr-y1 (dm/get-prop selrect :y1)
sr-y2 (dm/get-prop selrect :y2)]
{:left (grc/corners->rect bound-x1 sr-y1 sr-x1 sr-y2)
:top (grc/corners->rect sr-x1 bound-y1 sr-x2 sr-y1)
:right (grc/corners->rect sr-x2 sr-y1 bound-x2 sr-y2)
:bottom (grc/corners->rect sr-x1 sr-y2 sr-x2 bound-y2)}))
(defn distance-selrect [selrect other]
(let [{:keys [x1 y1]} other
{:keys [x2 y2]} selrect]
(defn distance-selrect
[selrect other]
(dm/assert!
(and (grc/rect? selrect)
(grc/rect? other)))
(let [x1 (dm/get-prop other :x1)
y1 (dm/get-prop other :y1)
x2 (dm/get-prop selrect :x2)
y2 (dm/get-prop selrect :y2)]
(gpt/point (- x1 x2) (- y1 y2))))
(defn distance-shapes [shape other]
(distance-selrect (:selrect shape) (:selrect other)))
(distance-selrect
(dm/get-prop shape :selrect)
(dm/get-prop other :selrect)))
(defn close-attrs?
"Compares two shapes attributes to see if they are equal or almost
@ -131,27 +149,11 @@
(= val1 val2)))))
;; EXPORTS
(dm/export gco/center-shape)
(dm/export gco/center-selrect)
(dm/export gco/center-rect)
(dm/export gco/center-points)
(dm/export gco/shape->center)
(dm/export gco/shapes->rect)
(dm/export gco/points->center)
(dm/export gco/transform-points)
(dm/export gpr/make-rect)
(dm/export gpr/make-selrect)
(dm/export gpr/rect->selrect)
(dm/export gpr/rect->points)
(dm/export gpr/points->selrect)
(dm/export gpr/points->rect)
(dm/export gpr/center->rect)
(dm/export gpr/center->selrect)
(dm/export gpr/join-rects)
(dm/export gpr/join-selrects)
(dm/export gpr/contains-selrect?)
(dm/export gpr/contains-point?)
(dm/export gpr/close-selrect?)
(dm/export gpr/clip-selrect)
(dm/export gtr/move)
(dm/export gtr/absolute-move)
(dm/export gtr/transform-matrix)
@ -173,6 +175,7 @@
(dm/export gct/calc-child-modifiers)
;; PATHS
;; FIXME: rename
(dm/export gsp/content->selrect)
(dm/export gsp/transform-content)
(dm/export gsp/open-path?)
@ -196,6 +199,3 @@
;; Modifiers
(dm/export gsm/set-objects-modifiers)
;; Text
(dm/export gst/position-data-selrect)

144
common/src/app/common/geom/shapes/bounds.cljc
View file

@ -7,32 +7,29 @@
(ns app.common.geom.shapes.bounds
(:require
[app.common.data :as d]
[app.common.geom.shapes.rect :as gsr]
[app.common.data.macros :as dm]
[app.common.geom.rect :as grc]
[app.common.math :as mth]
[app.common.pages.helpers :as cph]))
(defn shape-stroke-margin
[shape stroke-width]
(if (= (:type shape) :path)
(if (cph/path-shape? shape)
;; TODO: Calculate with the stroke offset (not implemented yet
(mth/sqrt (* 2 stroke-width stroke-width))
(- (mth/sqrt (* 2 stroke-width stroke-width)) stroke-width)))
(defn blur-filters [type value]
(->> [value]
(remove :hidden)
(filter #(= (:type %) type))
(map #(hash-map :id (str "filter_" (:id %))
:type (:type %)
:params %))))
(defn shadow-filters [type filters]
(->> filters
(defn- apply-filters
[type filters]
(sequence
(comp
(remove :hidden)
(filter #(= (:style %) type))
(map #(hash-map :id (str "filter_" (:id %))
:type (:style %)
:params %))))
(map (fn [item]
{:id (dm/str "filter_" (:id item))
:type type
:params item})))
filters))
(defn shape->filters
[shape]
@ -41,32 +38,38 @@
;; Background blur won't work in current SVG specification
;; We can revisit this in the future
#_(->> shape :blur (blur-filters :background-blur))
#_(->> shape :blur (into []) (blur-filters :background-blur))
(->> shape :shadow (shadow-filters :drop-shadow))
(->> shape :shadow (apply-filters :drop-shadow))
[{:id "shape" :type :blend-filters}]
(->> shape :shadow (shadow-filters :inner-shadow))
(->> shape :blur (blur-filters :layer-blur))))
(->> shape :shadow (apply-filters :inner-shadow))
(->> shape :blur (into []) (apply-filters :layer-blur))))
(defn calculate-filter-bounds [{:keys [x y width height]} filter-entry]
(let [{:keys [offset-x offset-y blur spread] :or {offset-x 0 offset-y 0 blur 0 spread 0}} (:params filter-entry)
filter-x (min x (+ x offset-x (- spread) (- blur) -5))
filter-y (min y (+ y offset-y (- spread) (- blur) -5))
filter-width (+ width (mth/abs offset-x) (* spread 2) (* blur 2) 10)
filter-height (+ height (mth/abs offset-y) (* spread 2) (* blur 2) 10)]
(gsr/make-selrect filter-x filter-y filter-width filter-height)))
(defn- calculate-filter-bounds
[selrect filter-entry]
(let [x (dm/get-prop selrect :x)
y (dm/get-prop selrect :y)
w (dm/get-prop selrect :width)
h (dm/get-prop selrect :height)
{:keys [offset-x offset-y blur spread]
:or {offset-x 0 offset-y 0 blur 0 spread 0}}
(:params filter-entry)
filter-x (mth/min x (+ x offset-x (- spread) (- blur) -5))
filter-y (mth/min y (+ y offset-y (- spread) (- blur) -5))
filter-w (+ w (mth/abs offset-x) (* spread 2) (* blur 2) 10)
filter-h (+ h (mth/abs offset-y) (* spread 2) (* blur 2) 10)]
(grc/make-rect filter-x filter-y filter-w filter-h)))
(defn get-rect-filter-bounds
[selrect filters blur-value]
(let [filter-bounds (->> filters
(let [bounds-xf (comp
(filter #(= :drop-shadow (:type %)))
(map (partial calculate-filter-bounds selrect))
(concat [selrect])
(gsr/join-selrects))
delta-blur (* blur-value 2)
result
(-> filter-bounds
(map (partial calculate-filter-bounds selrect)))
delta-blur (* blur-value 2)]
(-> (into [selrect] bounds-xf filters)
(grc/join-rects)
(update :x - delta-blur)
(update :y - delta-blur)
(update :x1 - delta-blur)
@ -74,60 +77,73 @@
(update :x2 + delta-blur)
(update :y2 + delta-blur)
(update :width + (* delta-blur 2))
(update :height + (* delta-blur 2)))]
result))
(update :height + (* delta-blur 2)))))
(defn get-shape-filter-bounds
([shape]
(let [svg-root? (and (= :svg-raw (:type shape)) (not= :svg (get-in shape [:content :tag])))]
(if svg-root?
(:selrect shape)
[shape]
(if (and (cph/svg-raw-shape? shape)
(not= :svg (dm/get-in shape [:content :tag])))
(dm/get-prop shape :selrect)
(let [filters (shape->filters shape)
blur-value (or (-> shape :blur :value) 0)]
(get-rect-filter-bounds (-> shape :points gsr/points->selrect) filters blur-value))))))
blur-value (or (-> shape :blur :value) 0)
srect (-> (dm/get-prop shape :points)
(grc/points->rect))]
(get-rect-filter-bounds srect filters blur-value))))
(defn calculate-padding
([shape]
(calculate-padding shape false))
([shape ignore-margin?]
(let [stroke-width (apply max 0 (map #(case (:stroke-alignment % :center)
(let [strokes (:strokes shape)
stroke-width
(->> strokes
(map #(case (get % :stroke-alignment :center)
:center (/ (:stroke-width % 0) 2)
:outer (:stroke-width % 0)
0) (:strokes shape)))
0))
(reduce d/max 0))
margin (if ignore-margin?
margin
(if ignore-margin?
0
(apply max 0 (map #(shape-stroke-margin % stroke-width) (:strokes shape))))
(->> strokes
(map #(shape-stroke-margin % stroke-width))
(reduce d/max 0)))
shadow-width (apply max 0 (map #(case (:style % :drop-shadow)
shadow-width
(->> (:shadow shape)
(map #(case (:style % :drop-shadow)
:drop-shadow (+ (mth/abs (:offset-x %)) (* (:spread %) 2) (* (:blur %) 2) 10)
0) (:shadow shape)))
0))
(reduce d/max 0))
shadow-height (apply max 0 (map #(case (:style % :drop-shadow)
shadow-height
(->> (:shadow shape)
(map #(case (:style % :drop-shadow)
:drop-shadow (+ (mth/abs (:offset-y %)) (* (:spread %) 2) (* (:blur %) 2) 10)
0) (:shadow shape)))]
0))
(reduce d/max 0))]
{:horizontal (+ stroke-width margin shadow-width)
:vertical (+ stroke-width margin shadow-height)})))
(defn- add-padding
[bounds padding]
(let [h-padding (:horizontal padding)
v-padding (:vertical padding)]
(-> bounds
(update :x - (:horizontal padding))
(update :x1 - (:horizontal padding))
(update :x2 + (:horizontal padding))
(update :y - (:vertical padding))
(update :y1 - (:vertical padding))
(update :y2 + (:vertical padding))
(update :width + (* 2 (:horizontal padding)))
(update :height + (* 2 (:vertical padding)))))
(update :x - h-padding)
(update :x1 - h-padding)
(update :x2 + h-padding)
(update :y - v-padding)
(update :y1 - v-padding)
(update :y2 + v-padding)
(update :width + (* 2 h-padding))
(update :height + (* 2 v-padding)))))
(defn get-object-bounds
[objects shape]
(let [calculate-base-bounds
(fn [shape]
(-> (get-shape-filter-bounds shape)
@ -154,16 +170,14 @@
(or (not (cph/group-shape? shape))
(not (:masked-group? shape)))))
(:id shape)
(fn [result child]
(conj result (calculate-base-bounds child)))
[(calculate-base-bounds shape)]))
children-bounds
(cond->> (gsr/join-selrects bounds)
(cond->> (grc/join-rects bounds)
(not (cph/frame-shape? shape)) (or (:children-bounds shape)))
filters (shape->filters shape)

92
common/src/app/common/geom/shapes/common.cljc
View file

@ -7,80 +7,74 @@
(ns app.common.geom.shapes.common
(: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.shapes.rect :as gpr]
[app.common.geom.rect :as grc]
[app.common.math :as mth]))
(defn center-rect
[{:keys [x y width height]}]
(when (d/num? x y width height)
(gpt/point (+ x (/ width 2.0))
(+ y (/ height 2.0)))))
(def ^:private xf-keep-x (keep #(dm/get-prop % :x)))
(def ^:private xf-keep-y (keep #(dm/get-prop % :y)))
(defn center-selrect
"Calculate the center of the selrect."
[selrect]
(center-rect selrect))
(defn shapes->rect
"Returns a rect that contains all the shapes and is aware of the
rotation of each shape. Mainly used for multiple selection."
[shapes]
(->> shapes
(keep (fn [shape]
(-> (dm/get-prop shape :points)
(grc/points->rect))))
(grc/join-rects)))
(defn center-points [points]
(let [ptx (into [] (keep :x) points)
pty (into [] (keep :y) points)
minx (reduce min ##Inf ptx)
miny (reduce min ##Inf pty)
maxx (reduce max ##-Inf ptx)
maxy (reduce max ##-Inf pty)]
(defn points->center
[points]
(let [ptx (into [] xf-keep-x points)
pty (into [] xf-keep-y points)
minx (reduce d/min ##Inf ptx)
miny (reduce d/min ##Inf pty)
maxx (reduce d/max ##-Inf ptx)
maxy (reduce d/max ##-Inf pty)]
(gpt/point (/ (+ minx maxx) 2.0)
(/ (+ miny maxy) 2.0))))
(defn center-bounds [[a b c d]]
(let [xa (:x a)
ya (:y a)
xb (:x b)
yb (:y b)
xc (:x c)
yc (:y c)
xd (:x d)
yd (:y d)
minx (min xa xb xc xd)
miny (min ya yb yc yd)
maxx (max xa xb xc xd)
maxy (max ya yb yc yd)]
(gpt/point (/ (+ minx maxx) 2.0)
(/ (+ miny maxy) 2.0))))
(defn center-shape
(defn shape->center
"Calculate the center of the shape."
[shape]
(center-rect (:selrect shape)))
(grc/rect->center (dm/get-prop shape :selrect)))
(defn transform-points
([points matrix]
(transform-points points nil matrix))
([points center matrix]
(if (and (d/not-empty? points) (gmt/matrix? matrix))
(if (and (gmt/matrix? matrix) (seq points))
(let [prev (if center (gmt/translate-matrix center) (gmt/matrix))
post (if center (gmt/translate-matrix (gpt/negate center)) (gmt/matrix))
tr-point (fn [point]
(gpt/transform point (gmt/multiply prev matrix post)))]
tr-point #(gpt/transform % (gmt/multiply prev matrix post))]
(mapv tr-point points))
points)))
(defn transform-selrect
[{:keys [x1 y1 x2 y2] :as sr} matrix]
(let [[c1 c2] (transform-points [(gpt/point x1 y1) (gpt/point x2 y2)] matrix)]
(gpr/corners->selrect c1 c2)))
[selrect matrix]
(dm/assert! (grc/rect? selrect))
(let [x1 (dm/get-prop selrect :x1)
y1 (dm/get-prop selrect :y1)
x2 (dm/get-prop selrect :x2)
y2 (dm/get-prop selrect :y2)
[c1 c2] (transform-points [(gpt/point x1 y1) (gpt/point x2 y2)] matrix)]
(grc/corners->rect c1 c2)))
(defn invalid-geometry?
[{:keys [points selrect]}]
(or (mth/nan? (:x selrect))
(mth/nan? (:y selrect))
(mth/nan? (:width selrect))
(mth/nan? (:height selrect))
(some (fn [p]
(or (mth/nan? (:x p))
(mth/nan? (:y p))))
(or ^boolean (mth/nan? (:x selrect))
^boolean (mth/nan? (:y selrect))
^boolean (mth/nan? (:width selrect))
^boolean (mth/nan? (:height selrect))
^boolean (some (fn [p]
(or ^boolean (mth/nan? (:x p))
^boolean (mth/nan? (:y p))))
points)))

24
common/src/app/common/geom/shapes/flex_layout/drop_area.cljc
View file

@ -9,10 +9,10 @@
[app.common.data :as d]
[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.geom.shapes.flex-layout.lines :as fli]
[app.common.geom.shapes.points :as gpo]
[app.common.geom.shapes.rect :as gsr]
[app.common.geom.shapes.transforms :as gtr]
[app.common.pages.helpers :as cph]
[app.common.types.modifiers :as ctm]
@ -59,16 +59,16 @@
(if row?
(let [half-point-width (+ (- box-x x) (/ box-width 2))]
[(gsr/make-rect x y width height)
(-> (gsr/make-rect x y half-point-width height)
[(grc/make-rect x y width height)
(-> (grc/make-rect x y half-point-width height)
(assoc :index (if reverse? (inc index) index)))
(-> (gsr/make-rect (+ x half-point-width) y (- width half-point-width) height)
(-> (grc/make-rect (+ x half-point-width) y (- width half-point-width) height)
(assoc :index (if reverse? index (inc index))))])
(let [half-point-height (+ (- box-y y) (/ box-height 2))]
[(gsr/make-rect x y width height)
(-> (gsr/make-rect x y width half-point-height)
[(grc/make-rect x y width height)
(-> (grc/make-rect x y width half-point-height)
(assoc :index (if reverse? (inc index) index)))
(-> (gsr/make-rect x (+ y half-point-height) width (- height half-point-height))
(-> (grc/make-rect x (+ y half-point-height) width (- height half-point-height))
(assoc :index (if reverse? index (inc index))))]))))
(defn drop-line-area
@ -83,7 +83,7 @@
v-center? (and col? (ctl/v-center? frame))
v-end? (and row? (ctl/v-end? frame))
center (gco/center-shape frame)
center (gco/shape->center frame)
start-p (gmt/transform-point-center start-p center transform-inverse)
line-width
@ -136,7 +136,7 @@
:else
(+ line-height (- box-y prev-y) (/ layout-gap-row 2)))]
(gsr/make-rect x y width height)))
(grc/make-rect x y width height)))
(defn layout-drop-areas
"Retrieve the layout drop areas to move shapes inside layouts"
@ -190,7 +190,7 @@
(-> (ctm/empty)
(ctm/resize (gpt/point (if flip-x -1.0 1.0)
(if flip-y -1.0 1.0))
(gco/center-shape shape)
(gco/shape->center shape)
transform
transform-inverse))]
[(gtr/transform-shape shape modifiers) modifiers])
@ -212,6 +212,6 @@
[frame-id objects position]
(let [frame (get objects frame-id)
drop-areas (get-drop-areas frame objects)
position (gmt/transform-point-center position (gco/center-shape frame) (:transform-inverse frame))
area (d/seek #(gsr/contains-point? % position) drop-areas)]
position (gmt/transform-point-center position (gco/shape->center frame) (:transform-inverse frame))
area (d/seek #(grc/contains-point? % position) drop-areas)]
(:index area)))

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

@ -9,9 +9,9 @@
[app.common.data :as d]
[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.geom.shapes.path :as gpp]
[app.common.geom.shapes.rect :as gpr]
[app.common.geom.shapes.text :as gte]
[app.common.math :as mth]))
@ -163,7 +163,7 @@
"Checks if the given rect intersects with the selrect"
[rect points]
(let [rect-points (gpr/rect->points rect)
(let [rect-points (grc/rect->points rect)
rect-lines (points->lines rect-points)
points-lines (points->lines points)]
@ -182,7 +182,7 @@
;; TODO: Look for ways to optimize this operation
simple? (> (count (:content shape)) 100)
rect-points (gpr/rect->points rect)
rect-points (grc/rect->points rect)
rect-lines (points->lines rect-points)
path-lines (if simple?
(points->lines (:points shape))
@ -268,7 +268,7 @@
"Checks if the given rect overlaps with an ellipse"
[shape rect]
(let [rect-points (gpr/rect->points rect)
(let [rect-points (grc/rect->points rect)
rect-lines (points->lines rect-points)
{:keys [x y width height]} shape
@ -289,7 +289,7 @@
[{:keys [position-data] :as shape} rect]
(if (and (some? position-data) (d/not-empty? position-data))
(let [center (gco/center-shape shape)
(let [center (gco/shape->center shape)
transform-rect
(fn [rect-points]
@ -297,7 +297,7 @@
(->> position-data
(map (comp transform-rect
gpr/rect->points
grc/rect->points
gte/position-data->rect))
(some #(overlaps-rect-points? rect %))))
(overlaps-rect-points? rect (:points shape))))
@ -332,7 +332,7 @@
(defn has-point-rect?
[rect point]
(let [lines (gpr/rect->lines rect)]
(let [lines (grc/rect->lines rect)]
(is-point-inside-evenodd? point lines)))
(defn has-point?

72
common/src/app/common/geom/shapes/modifiers.cljc
View file

@ -29,7 +29,7 @@
;; [(get-in objects [k :name]) v]))
;; modif-tree))))
(defn children-sequence
(defn- get-children-seq
"Given an id returns a sequence of its children"
[id objects]
@ -39,61 +39,63 @@
id)
(map #(get objects %))))
(defn resolve-tree-sequence
(defn- resolve-tree
"Given the ids that have changed search for layout roots to recalculate"
[ids objects]
(dm/assert! (or (nil? ids) (set? ids)))
(let [get-tree-root
(fn ;; Finds the tree root for the current id
[id]
(let [;; Finds the tree root for the current id
get-tree-root
(fn [id]
(loop [current id
result id]
(let [shape (get objects current)
parent (get objects (:parent-id shape))]
(cond
(or (not shape) (= uuid/zero current))
(let [shape (get objects current)]
(if (or (not ^boolean shape) (= uuid/zero current))
result
(let [parent-id (dm/get-prop shape :parent-id)
parent (get objects parent-id)]
(cond
;; Frame found, but not layout we return the last layout found (or the id)
(and (= :frame (:type parent))
(not (ctl/any-layout? parent)))
(and ^boolean (cph/frame-shape? parent)
(not ^boolean (ctl/any-layout? parent)))
result
;; Layout found. We continue upward but we mark this layout
(ctl/any-layout? parent)
(recur (:id parent) (:id parent))
(recur parent-id parent-id)
;; If group or boolean or other type of group we continue with the last result
:else
(recur (:id parent) result)))))
(recur parent-id result)))))))
is-child? #(cph/is-child? objects %1 %2)
calculate-common-roots
(fn ;; Given some roots retrieves the minimum number of tree roots
[result id]
;; Given some roots retrieves the minimum number of tree roots
search-common-roots
(fn [result id]
(if (= id uuid/zero)
result
(let [root (get-tree-root id)
;; Remove the children from the current root
result
(if (cph/has-children? objects root)
(into #{} (remove #(is-child? root %)) result)
(if ^boolean (cph/has-children? objects root)
(into #{} (remove (partial cph/is-child? objects root)) result)
result)
root-parents (cph/get-parent-ids objects root)
contains-parent? (some #(contains? result %) root-parents)]
(cond-> result
(not contains-parent?)
(conj root)))))
contains-parent?
(->> (cph/get-parent-ids objects root)
(some (partial contains? result)))]
roots (->> ids (reduce calculate-common-roots #{}))]
(concat
(when (contains? ids uuid/zero) [(get objects uuid/zero)])
(mapcat #(children-sequence % objects) roots))))
(if (not contains-parent?)
(conj result root)
result))))
result
(->> (reduce search-common-roots #{} ids)
(mapcat #(get-children-seq % objects)))]
(if (contains? ids uuid/zero)
(cons (get objects uuid/zero) result)
result)))
(defn- set-children-modifiers
"Propagates the modifiers from a parent too its children applying constraints if necesary"
@ -371,7 +373,7 @@
(defn reflow-layout
[objects old-modif-tree bounds ignore-constraints id]
(let [tree-seq (children-sequence id objects)
(let [tree-seq (get-children-seq id objects)
[modif-tree _]
(reduce
@ -416,7 +418,7 @@
(let [resize-modif-tree {current {:modifiers auto-resize-modifiers}}
tree-seq (children-sequence current objects)
tree-seq (get-children-seq current objects)
[resize-modif-tree _]
(reduce
@ -440,7 +442,7 @@
;; Step-2: After resizing we still need to reflow the layout parents that are not auto-width/height
tree-seq (resolve-tree-sequence to-reflow objects)
tree-seq (resolve-tree to-reflow objects)
[reflow-modif-tree _]
(reduce
@ -476,7 +478,7 @@
(some? old-modif-tree)
(transform-bounds objects old-modif-tree))
shapes-tree (resolve-tree-sequence (-> modif-tree keys set) objects)
shapes-tree (resolve-tree (-> modif-tree keys set) objects)
;; Calculate the input transformation and constraints
modif-tree (reduce #(propagate-modifiers-constraints objects bounds ignore-constraints %1 %2) modif-tree shapes-tree)

30
common/src/app/common/geom/shapes/path.cljc
View file

@ -9,8 +9,8 @@
[app.common.data :as d]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.common :as gsc]
[app.common.geom.shapes.rect :as gpr]
[app.common.geom.rect :as grc]
[app.common.geom.shapes.common :as gco]
[app.common.math :as mth]
[app.common.path.commands :as upc]
[app.common.path.subpaths :as sp]))
@ -334,7 +334,7 @@
(->> (curve-extremities curve)
(mapv #(curve-values curve %)))))
[])]
(gpr/points->selrect points))))
(grc/points->rect points))))
(defn content->selrect [content]
(let [calc-extremities
@ -360,7 +360,7 @@
extremities (mapcat calc-extremities
content
(concat [nil] content))]
(gpr/points->selrect extremities)))
(grc/points->rect extremities)))
(defn move-content [content move-vec]
(let [dx (:x move-vec)
@ -591,7 +591,7 @@
(let [[from-p to-p :as curve] (subcurve-range curve from-t to-t)
extremes (->> (curve-extremities curve)
(mapv #(curve-values curve %)))]
(gpr/points->rect (into [from-p to-p] extremes))))
(grc/points->rect (into [from-p to-p] extremes))))
(defn line-has-point?
"Using the line equation we put the x value and check if matches with
@ -623,7 +623,7 @@
[point curve]
(letfn [(check-range [from-t to-t]
(let [r (curve-range->rect curve from-t to-t)]
(when (gpr/contains-point? r point)
(when (grc/contains-point? r point)
(if (s= from-t to-t)
(< (gpt/distance (curve-values curve from-t) point) 0.1)
@ -760,7 +760,7 @@
(let [r1 (curve-range->rect c1 c1-from c1-to)
r2 (curve-range->rect c2 c2-from c2-to)]
(when (gpr/overlaps-rects? r1 r2)
(when (grc/overlaps-rects? r1 r2)
(let [p1 (curve-values c1 c1-from)
p2 (curve-values c2 c2-from)]
@ -811,7 +811,7 @@
[[from-p to-p :as curve]]
(let [extremes (->> (curve-extremities curve)
(mapv #(curve-values curve %)))]
(gpr/points->rect (into [from-p to-p] extremes))))
(grc/points->rect (into [from-p to-p] extremes))))
(defn is-point-in-border?
@ -943,7 +943,7 @@
[content]
(-> content
content->selrect
gsc/center-selrect))
grc/rect->center))
(defn content->points+selrect
"Given the content of a shape, calculate its points and selrect"
@ -960,7 +960,7 @@
flip-y (gmt/scale (gpt/point 1 -1))
:always (gmt/multiply (:transform-inverse shape (gmt/matrix))))
center (or (gsc/center-shape shape)
center (or (gco/shape->center shape)
(content-center content))
base-content (transform-content
@ -969,16 +969,16 @@
;; Calculates the new selrect with points given the old center
points (-> (content->selrect base-content)
(gpr/rect->points)
(gsc/transform-points center transform))
(grc/rect->points)
(gco/transform-points center transform))
points-center (gsc/center-points points)
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
(gsc/transform-points points-center transform-inverse)
(gpr/points->selrect))]
(gco/transform-points points-center transform-inverse)
(grc/points->rect))]
[points selrect]))
(defn open-path?

4
common/src/app/common/geom/shapes/pixel_precision.cljc
View file

@ -9,9 +9,9 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.points :as gpo]
[app.common.geom.shapes.rect :as gpr]
[app.common.geom.shapes.transforms :as gtr]
[app.common.math :as mth]
[app.common.pages.helpers :as cph]
@ -40,7 +40,7 @@
(defn position-pixel-precision
[modifiers _ points precision ignore-axis]
(let [bounds (gpr/bounds->rect points)
(let [bounds (grc/bounds->rect points)
corner (gpt/point bounds)
target-corner
(cond-> corner

18
common/src/app/common/geom/shapes/points.cljc
View file

@ -8,9 +8,7 @@
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.intersect :as gsi]
[app.common.geom.shapes.rect :as gre]
[app.common.math :as mth]))
(defn origin
@ -104,7 +102,6 @@
(defn parent-coords-bounds
[child-bounds [p1 p2 _ p4 :as parent-bounds]]
(if (empty? child-bounds)
parent-bounds
@ -121,10 +118,10 @@
(fn [[th-min th-max tv-min tv-max] current-point]
(let [cth (project-t current-point rh vv)
ctv (project-t current-point rv hv)]
[(min th-min cth)
(max th-max cth)
(min tv-min ctv)
(max tv-max ctv)]))
[(mth/min th-min cth)
(mth/max th-max cth)
(mth/min tv-min ctv)
(mth/max tv-max ctv)]))
[th-min th-max tv-min tv-max]
(->> child-bounds
@ -152,13 +149,6 @@
[bounds parent-bounds]
(parent-coords-bounds (flatten bounds) parent-bounds))
(defn points->selrect
[points]
(let [width (width-points points)
height (height-points points)
center (gco/center-points points)]
(gre/center->selrect center width height)))
(defn move
[bounds vector]
(->> bounds

219
common/src/app/common/geom/shapes/rect.cljc
View file

@ -4,221 +4,4 @@
;;
;; Copyright (c) KALEIDOS INC
(ns app.common.geom.shapes.rect
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.math :as mth]))
(defn make-rect
([p1 p2]
(let [xp1 (:x p1)
yp1 (:y p1)
xp2 (:x p2)
yp2 (:y p2)
x1 (min xp1 xp2)
y1 (min yp1 yp2)
x2 (max xp1 xp2)
y2 (max yp1 yp2)]
(make-rect x1 y1 (- x2 x1) (- y2 y1))))
([x y width height]
(when (d/num? x y width height)
(let [width (max width 0.01)
height (max height 0.01)]
{:x x
:y y
:width width
:height height}))))
(defn make-selrect
[x y width height]
(when (d/num? x y width height)
(let [width (max width 0.01)
height (max height 0.01)]
{:x x
:y y
:x1 x
:y1 y
:x2 (+ x width)
:y2 (+ y height)
:width width
:height height})))
(defn close-rect?
[rect1 rect2]
(and (mth/close? (:x rect1) (:x rect2))
(mth/close? (:y rect1) (:y rect2))
(mth/close? (:width rect1) (:width rect2))
(mth/close? (:height rect1) (:height rect2))))
(defn close-selrect?
[selrect1 selrect2]
(and (mth/close? (:x selrect1) (:x selrect2))
(mth/close? (:y selrect1) (:y selrect2))
(mth/close? (:x1 selrect1) (:x1 selrect2))
(mth/close? (:y1 selrect1) (:y1 selrect2))
(mth/close? (:x2 selrect1) (:x2 selrect2))
(mth/close? (:y2 selrect1) (:y2 selrect2))
(mth/close? (:width selrect1) (:width selrect2))
(mth/close? (:height selrect1) (:height selrect2))))
(defn rect->points [{:keys [x y width height]}]
(when (d/num? x y)
(let [width (max width 0.01)
height (max height 0.01)]
[(gpt/point x y)
(gpt/point (+ x width) y)
(gpt/point (+ x width) (+ y height))
(gpt/point x (+ y height))])))
(defn rect->lines [{:keys [x y width height]}]
(when (d/num? x y)
(let [width (max width 0.01)
height (max height 0.01)]
[[(gpt/point x y) (gpt/point (+ x width) y)]
[(gpt/point (+ x width) y) (gpt/point (+ x width) (+ y height))]
[(gpt/point (+ x width) (+ y height)) (gpt/point x (+ y height))]
[(gpt/point x (+ y height)) (gpt/point x y)]])))
(defn points->rect
[points]
(when-let [points (seq points)]
(loop [minx ##Inf
miny ##Inf
maxx ##-Inf
maxy ##-Inf
pts points]
(if-let [pt (first pts)]
(let [x (dm/get-prop pt :x)
y (dm/get-prop pt :y)]
(recur (min minx x)
(min miny y)
(max maxx x)
(max maxy y)
(rest pts)))
(when (d/num? minx miny maxx maxy)
(make-rect minx miny (- maxx minx) (- maxy miny)))))))
(defn bounds->rect
[[{ax :x ay :y} {bx :x by :y} {cx :x cy :y} {dx :x dy :y}]]
(let [minx (min ax bx cx dx)
miny (min ay by cy dy)
maxx (max ax bx cx dx)
maxy (max ay by cy dy)]
(when (d/num? minx miny maxx maxy)
(make-rect minx miny (- maxx minx) (- maxy miny)))))
(defn squared-points
[points]
(when (d/not-empty? points)
(let [minx (transduce (keep :x) min ##Inf points)
miny (transduce (keep :y) min ##Inf points)
maxx (transduce (keep :x) max ##-Inf points)
maxy (transduce (keep :y) max ##-Inf points)]
(when (d/num? minx miny maxx maxy)
[(gpt/point minx miny)
(gpt/point maxx miny)
(gpt/point maxx maxy)
(gpt/point minx maxy)]))))
(defn points->selrect [points]
(when-let [rect (points->rect points)]
(let [{:keys [x y width height]} rect]
(make-selrect x y width height))))
(defn rect->selrect [rect]
(-> rect rect->points points->selrect))
(defn join-rects [rects]
(when (d/not-empty? rects)
(let [minx (transduce (keep :x) min ##Inf rects)
miny (transduce (keep :y) min ##Inf rects)
maxx (transduce (keep #(when (and (:x %) (:width %)) (+ (:x %) (:width %)))) max ##-Inf rects)
maxy (transduce (keep #(when (and (:y %) (:height %))(+ (:y %) (:height %)))) max ##-Inf rects)]
(when (d/num? minx miny maxx maxy)
(make-rect minx miny (- maxx minx) (- maxy miny))))))
(defn join-selrects [selrects]
(when (d/not-empty? selrects)
(let [minx (transduce (keep :x1) min ##Inf selrects)
miny (transduce (keep :y1) min ##Inf selrects)
maxx (transduce (keep :x2) max ##-Inf selrects)
maxy (transduce (keep :y2) max ##-Inf selrects)]
(when (d/num? minx miny maxx maxy)
(make-selrect minx miny (- maxx minx) (- maxy miny))))))
(defn center->rect [{:keys [x y]} width height]
(when (d/num? x y width height)
(make-rect (- x (/ width 2))
(- y (/ height 2))
width
height)))
(defn center->selrect [{:keys [x y]} width height]
(when (d/num? x y width height)
(make-selrect (- x (/ width 2))
(- y (/ height 2))
width
height)))
(defn s=
[a b]
(mth/almost-zero? (- a b)))
(defn overlaps-rects?
"Check for two rects to overlap. Rects won't overlap only if
one of them is fully to the left or the top"
[rect-a rect-b]
(let [x1a (:x rect-a)
y1a (:y rect-a)
x2a (+ (:x rect-a) (:width rect-a))
y2a (+ (:y rect-a) (:height rect-a))
x1b (:x rect-b)
y1b (:y rect-b)
x2b (+ (:x rect-b) (:width rect-b))
y2b (+ (:y rect-b) (:height rect-b))]
(and (or (> x2a x1b) (s= x2a x1b))
(or (>= x2b x1a) (s= x2b x1a))
(or (<= y1b y2a) (s= y1b y2a))
(or (<= y1a y2b) (s= y1a y2b)))))
(defn contains-point?
[rect point]
(assert (gpt/point? point))
(let [x1 (:x rect)
y1 (:y rect)
x2 (+ (:x rect) (:width rect))
y2 (+ (:y rect) (:height rect))
px (:x point)
py (:y point)]
(and (or (> px x1) (s= px x1))
(or (< px x2) (s= px x2))
(or (> py y1) (s= py y1))
(or (< py y2) (s= py y2)))))
(defn contains-selrect?
"Check if a selrect sr2 is contained inside sr1"
[sr1 sr2]
(and (>= (:x1 sr2) (:x1 sr1))
(<= (:x2 sr2) (:x2 sr1))
(>= (:y1 sr2) (:y1 sr1))
(<= (:y2 sr2) (:y2 sr1))))
(defn corners->selrect
([p1 p2]
(corners->selrect (:x p1) (:y p1) (:x p2) (:y p2)))
([xp1 yp1 xp2 yp2]
(make-selrect (min xp1 xp2) (min yp1 yp2) (abs (- xp1 xp2)) (abs (- yp1 yp2)))))
(defn clip-selrect
[{:keys [x1 y1 x2 y2] :as sr} clip-rect]
(when (some? sr)
(let [{bx1 :x1 by1 :y1 bx2 :x2 by2 :y2 :as sr2} (rect->selrect clip-rect)]
(corners->selrect (max bx1 x1) (max by1 y1) (min bx2 x2) (min by2 y2)))))
(ns app.common.geom.shapes.rect)

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

@ -6,41 +6,36 @@
(ns app.common.geom.shapes.text
(:require
[app.common.data.macros :as dm]
[app.common.geom.rect :as grc]
[app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.rect :as gpr]
[app.common.geom.shapes.transforms :as gtr]))
(defn position-data->rect
[{:keys [x y width height]}]
{:x x
:y (- y height)
:width width
:height height})
(grc/make-rect x (- y height) width height))
(defn position-data-selrect
(defn shape->rect
[shape]
(let [points (->> shape
:position-data
(mapcat (comp gpr/rect->points position-data->rect)))]
(if (empty? points)
(:selrect shape)
(-> points (gpr/points->selrect)))))
(let [points (->> (:position-data shape)
(mapcat (comp grc/rect->points position-data->rect)))]
(if (seq points)
(grc/points->rect points)
(dm/get-prop shape :selrect))))
(defn position-data-bounding-box
(defn shape->bounds
[shape]
(let [points (->> shape
:position-data
(mapcat (comp gpr/rect->points position-data->rect)))
transform (gtr/transform-matrix shape)]
(let [points (->> (:position-data shape)
(mapcat (comp grc/rect->points position-data->rect)))]
(-> points
(gco/transform-points transform)
(gpr/points->selrect ))))
(gco/transform-points (gtr/transform-matrix shape))
(grc/points->rect))))
(defn overlaps-position-data?
"Checks if the given position data is inside the shape"
[{:keys [points]} position-data]
(let [bounding-box (gpr/points->selrect points)
(let [bounding-box (grc/points->rect points)
fix-rect #(assoc % :y (- (:y %) (:height %)))]
(->> position-data
(some #(gpr/overlaps-rects? bounding-box (fix-rect %)))
(some #(grc/overlaps-rects? bounding-box (fix-rect %)))
(boolean))))

90
common/src/app/common/geom/shapes/transforms.cljc
View file

@ -13,10 +13,10 @@
[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.geom.shapes.bool :as gshb]
[app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.path :as gpa]
[app.common.geom.shapes.rect :as gpr]
[app.common.math :as mth]
[app.common.pages.helpers :as cph]
[app.common.types.modifiers :as ctm]
@ -24,25 +24,47 @@
#?(:clj (set! *warn-on-reflection* true))
(defn- valid-point?
[o]
(and ^boolean (gpt/point? o)
^boolean (d/num? (dm/get-prop o :x)
(dm/get-prop o :y))))
;; --- Relative Movement
(defn- move-selrect [{:keys [x y x1 y1 x2 y2 width height] :as selrect} {dx :x dy :y :as pt}]
(if (and (some? selrect) (some? pt) (d/num? dx dy))
{:x (if (d/num? x) (+ dx x) x)
:y (if (d/num? y) (+ dy y) y)
:x1 (if (d/num? x1) (+ dx x1) x1)
:y1 (if (d/num? y1) (+ dy y1) y1)
:x2 (if (d/num? x2) (+ dx x2) x2)
:y2 (if (d/num? y2) (+ dy y2) y2)
:width width
:height height}
(defn- move-selrect
[selrect pt]
(if (and ^boolean (some? selrect)
^boolean (valid-point? pt))
(let [x (dm/get-prop selrect :x)
y (dm/get-prop selrect :y)
w (dm/get-prop selrect :width)
h (dm/get-prop selrect :height)
x1 (dm/get-prop selrect :x1)
y1 (dm/get-prop selrect :y1)
x2 (dm/get-prop selrect :x2)
y2 (dm/get-prop selrect :y2)
dx (dm/get-prop pt :x)
dy (dm/get-prop pt :y)]
(grc/make-rect
(if ^boolean (d/num? x) (+ dx x) x)
(if ^boolean (d/num? y) (+ dy y) y)
w
h
(if ^boolean (d/num? x1) (+ dx x1) x1)
(if ^boolean (d/num? y1) (+ dy y1) y1)
(if ^boolean (d/num? x2) (+ dx x2) x2)
(if ^boolean (d/num? y2) (+ dy y2) y2)))
selrect))
(defn- move-points [points move-vec]
(cond->> points
(d/num? (:x move-vec) (:y move-vec))
(mapv #(gpt/add % move-vec))))
(defn- move-points
[points move-vec]
(if (valid-point? move-vec)
(mapv #(gpt/add % move-vec) points)
points))
;; FIXME: revisit performance
(defn move-position-data
([position-data {:keys [x y]}]
(move-position-data position-data x y))
@ -105,7 +127,7 @@
(transform-matrix shape nil))
([shape params]
(transform-matrix shape params (or (gco/center-shape shape) (gpt/point 0 0))))
(transform-matrix shape params (or (gco/shape->center shape) (gpt/point 0 0))))
([{:keys [flip-x flip-y transform] :as shape} {:keys [no-flip]} shape-center]
(-> (gmt/matrix)
@ -136,7 +158,7 @@
(defn inverse-transform-matrix
([shape]
(let [shape-center (or (gco/center-shape shape)
(let [shape-center (or (gco/shape->center shape)
(gpt/point 0 0))]
(inverse-transform-matrix shape shape-center)))
([{:keys [flip-x flip-y] :as shape} center]
@ -152,9 +174,9 @@
"Transform a rectangles and changes its attributes"
[rect matrix]
(let [points (-> (gpr/rect->points rect)
(let [points (-> (grc/rect->points rect)
(gco/transform-points matrix))]
(gpr/points->rect points)))
(grc/points->rect points)))
(defn transform-points-matrix
"Calculate the transform matrix to convert from the selrect to the points bounds
@ -238,8 +260,10 @@
[points]
(let [width (calculate-width points)
height (calculate-height points)
center (gco/center-points points)
sr (gpr/center->selrect center width height)
;; FIXME: looks redundant, we can convert points to rect directly
center (gco/points->center points)
sr (grc/center->rect center width height)
points-transform-mtx (transform-points-matrix sr points)
@ -385,7 +409,7 @@
(let [;; Points for every shape inside the group
points (->> children (mapcat :points))
shape-center (gco/center-points points)
shape-center (gco/points->center points)
;; Fixed problem with empty groups. Should not happen (but it does)
points (if (empty? points) (:points group) points)
@ -393,13 +417,14 @@
;; Invert to get the points minus the transforms applied to the group
base-points (gco/transform-points points shape-center (:transform-inverse group (gmt/matrix)))
;; FIXME: looks redundant operation points -> rect -> points
;; Defines the new selection rect with its transformations
new-points (-> (gpr/points->selrect base-points)
(gpr/rect->points)
new-points (-> (grc/points->rect base-points)
(grc/rect->points)
(gco/transform-points shape-center (:transform group (gmt/matrix))))
;; Calculate the new selrect
new-selrect (gpr/points->selrect base-points)]
new-selrect (grc/points->rect base-points)]
;; Updates the shape and the applytransform-rect will update the other properties
(-> group
@ -492,24 +517,17 @@
(defn transform-selrect
[selrect modifiers]
(-> selrect
(gpr/rect->points)
(grc/rect->points)
(transform-bounds modifiers)
(gpr/points->selrect)))
(grc/points->rect)))
(defn transform-selrect-matrix
[selrect mtx]
(-> selrect
(gpr/rect->points)
(grc/rect->points)
(gco/transform-points mtx)
(gpr/points->selrect)))
(grc/points->rect)))
(defn selection-rect
"Returns a rect that contains all the shapes and is aware of the
rotation of each shape. Mainly used for multiple selection."
[shapes]
(->> shapes
(map (comp gpr/points->selrect :points transform-shape))
(gpr/join-selrects)))
(declare apply-group-modifiers)

61
common/src/app/common/geom/snap.cljc Normal file
View file

@ -0,0 +1,61 @@
;; 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.snap
(:require
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.pages.helpers :as cph]
[app.common.types.shape-tree :as ctst]))
(defn rect->snap-points
[rect]
(let [x (dm/get-prop rect :x)
y (dm/get-prop rect :y)
w (dm/get-prop rect :width)
h (dm/get-prop rect :height)]
#{(gpt/point x y)
(gpt/point (+ x w) y)
(gpt/point (+ x w) (+ y h))
(gpt/point x (+ y h))
(grc/rect->center rect)}))
(defn- frame->snap-points
[frame]
(let [points (dm/get-prop frame :points)
rect (grc/points->rect points)
x (dm/get-prop rect :x)
y (dm/get-prop rect :y)
w (dm/get-prop rect :width)
h (dm/get-prop rect :height)]
(into (rect->snap-points rect)
#{(gpt/point (+ x (/ w 2)) y)
(gpt/point (+ x w) (+ y (/ h 2)))
(gpt/point (+ x (/ w 2)) (+ y h))
(gpt/point x (+ y (/ h 2)))})))
(defn shape->snap-points
[shape]
(if ^boolean (cph/frame-shape? shape)
(frame->snap-points shape)
(->> (dm/get-prop shape :points)
(into #{(gsh/shape->center shape)}))))
(defn guide->snap-points
[guide frame]
(cond
(and (some? frame)
(not ^boolean (ctst/rotated-frame? frame))
(not ^boolean (cph/root-frame? frame)))
#{}
(= :x (:axis guide))
#{(gpt/point (:position guide) 0)}
:else
#{(gpt/point 0 (:position guide))}))

23
common/src/app/common/math.cljc
View file

@ -6,9 +6,24 @@
(ns app.common.math
"A collection of math utils."
(:refer-clojure :exclude [abs])
(:refer-clojure :exclude [abs min max])
#?(:cljs
(:require [goog.math :as math])))
(:require-macros [app.common.math :refer [min max]]))
(:require
#?(:cljs [goog.math :as math])
[clojure.core :as c]))
(defmacro min
[& params]
(if (:ns &env)
`(js/Math.min ~@params)
`(c/min ~@params)))
(defmacro max
[& params]
(if (:ns &env)
`(js/Math.max ~@params)
`(c/max ~@params)))
(def PI
#?(:cljs (.-PI js/Math)
@ -198,10 +213,12 @@
(defn max-abs
[a b]
(max (abs a) (abs b)))
(max (abs a)
(abs b)))
(defn sign
"Get the sign (+1 / -1) for the number"
[n]
(if (neg? n) -1 1))

25
common/src/app/common/pages.cljc
View file

@ -9,34 +9,11 @@
(:require
[app.common.data.macros :as dm]
[app.common.pages.changes :as changes]
[app.common.pages.common :as common]
[app.common.pages.focus :as focus]
[app.common.pages.indices :as indices]
[app.common.types.file :as ctf]))
;; Common
(dm/export common/root)
(dm/export common/file-version)
(dm/export common/default-color)
(dm/export common/component-sync-attrs)
(dm/export common/retrieve-used-names)
(dm/export common/generate-unique-name)
;; Focus
(dm/export focus/focus-objects)
(dm/export focus/filter-not-focus)
(dm/export focus/is-in-focus?)
[app.common.pages.indices :as indices]))
;; Indices
#_(dm/export indices/calculate-z-index)
#_(dm/export indices/update-z-index)
(dm/export indices/generate-child-all-parents-index)
(dm/export indices/generate-child-parent-index)
(dm/export indices/create-clip-index)
;; Process changes
(dm/export changes/process-changes)
;; Initialization
(dm/export ctf/make-file-data)
(dm/export ctf/empty-file-data)

20
common/src/app/common/pages/changes.cljc
View file

@ -12,7 +12,6 @@
[app.common.exceptions :as ex]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages.common :refer [component-sync-attrs]]
[app.common.pages.helpers :as cph]
[app.common.schema :as sm]
[app.common.schema.desc-native :as smd]
@ -20,6 +19,7 @@
[app.common.types.colors-list :as ctcl]
[app.common.types.component :as ctk]
[app.common.types.components-list :as ctkl]
[app.common.types.component :as ctk]
[app.common.types.container :as ctn]
[app.common.types.file :as ctf]
[app.common.types.page :as ctp]
@ -68,7 +68,7 @@
[:map {:title "AddObjChange"}
[:type [:= :add-obj]]
[:id ::sm/uuid]
[:obj [:map-of {:gen/max 10} :keyword :any]]
[:obj :map]
[:page-id {:optional true} ::sm/uuid]
[:component-id {:optional true} ::sm/uuid]
[:frame-id {:optional true} ::sm/uuid]
@ -228,10 +228,10 @@
(sm/def! ::changes
[:sequential {:gen/max 2} ::change])
(def change?
(def valid-change?
(sm/pred-fn ::change))
(def changes?
(def valid-changes?
(sm/pred-fn [:sequential ::change]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -249,6 +249,9 @@
;; Changes Processing Impl
(def valid-shape?
(sm/pred-fn ::cts/shape))
(defn validate-shapes!
[data-old data-new items]
(letfn [(validate-shape! [[page-id id]]
@ -258,7 +261,8 @@
;; If object has changed or is new verify is correct
(when (and (some? shape-new)
(not= shape-old shape-new))
(dm/verify! (cts/shape? shape-new)))))]
(dm/verify! (and (cts/shape? shape-new)
(valid-shape? shape-new))))))]
(->> (into #{} (map :page-id) items)
(mapcat (fn [page-id]
@ -283,7 +287,7 @@
;; When verify? false we spec the schema validation. Currently used to make just
;; 1 validation even if the changes are applied twice
(when verify?
(dm/verify! (changes? items)))
(dm/verify! (valid-changes? items)))
(let [result (reduce #(or (process-change %1 %2) %1) data items)]
;; Validate result shapes (only on the backend)
@ -639,7 +643,7 @@
(defmethod process-operation :set
[on-changed shape op]
(let [attr (:attr op)
group (get component-sync-attrs attr)
group (get ctk/sync-attrs attr)
val (:val op)
shape-val (get shape attr)
ignore (:ignore-touched op)
@ -725,7 +729,7 @@
; We need to trigger a sync if the shape has changed any
; attribute that participates in components synchronization.
(and (= (:type operation) :set)
(component-sync-attrs (:attr operation))))
(get ctk/sync-attrs (:attr operation))))
any-sync? (some need-sync? operations)]
(when any-sync?
(let [xform (comp (filter :main-instance?) ; Select shapes that are main component instances

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

@ -11,6 +11,7 @@
[app.common.files.features :as ffeat]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages :as cp]
@ -217,6 +218,9 @@
(add-object changes obj nil))
([changes obj {:keys [index ignore-touched] :or {index ::undefined ignore-touched false}}]
;; FIXME: add shape validation
(assert-page-id changes)
(assert-objects changes)
(let [obj (cond-> obj
@ -234,7 +238,7 @@
:frame-id (:frame-id obj)
:index (::index obj)
:ignore-touched ignore-touched
:obj (dissoc obj ::index :parent-id)}
:obj (dissoc obj ::index)}
del-change
{:type :del-obj
@ -469,7 +473,7 @@
(every? #(apply gpt/close? %) (d/zip old-val new-val))
(= attr :selrect)
(gsh/close-selrect? old-val new-val)
(grc/close-rect? old-val new-val)
:else
(= old-val new-val))]

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

@ -35,60 +35,71 @@
(defn frame-shape?
([objects id]
(frame-shape? (get objects id)))
([{:keys [type]}]
(= type :frame)))
([shape]
(and (some? shape)
(= :frame (dm/get-prop shape :type)))))
(defn group-shape?
([objects id]
(group-shape? (get objects id)))
([{:keys [type]}]
(= type :group)))
([shape]
(and (some? shape)
(= :group (dm/get-prop shape :type)))))
(defn mask-shape?
([shape]
(and ^boolean (group-shape? shape)
^boolean (:masked-group? shape)))
([objects id]
(mask-shape? (get objects id)))
([{:keys [type masked-group?]}]
(and (= type :group) masked-group?)))
(mask-shape? (get objects id))))
(defn bool-shape?
[{:keys [type]}]
(= type :bool))
[shape]
(and (some? shape)
(= :bool (dm/get-prop shape :type))))
(defn group-like-shape?
[{:keys [type]}]
(or (= :group type) (= :bool type)))
[shape]
(or ^boolean (group-shape? shape)
^boolean (bool-shape? shape)))
(defn text-shape?
[{:keys [type]}]
(= type :text))
[shape]
(and (some? shape)
(= :text (dm/get-prop shape :type))))
(defn rect-shape?
[{:keys [type]}]
(= type :rect))
[shape]
(and (some? shape)
(= :rect (dm/get-prop shape :type))))
(defn circle-shape?
[{:keys [type]}]
(= type :circle))
(defn image-shape?
[{:keys [type]}]
(= type :image))
[shape]
(and (some? shape)
(= :image (dm/get-prop shape :type))))
(defn svg-raw-shape?
[{:keys [type]}]
(= type :svg-raw))
[shape]
(and (some? shape)
(= :svg-raw (dm/get-prop shape :type))))
(defn path-shape?
([objects id]
(path-shape? (get objects id)))
([{:keys [type]}]
(= type :path)))
([shape]
(and (some? shape)
(= :path (dm/get-prop shape :type)))))
(defn unframed-shape?
"Checks if it's a non-frame shape in the top level."
[shape]
(and (not (frame-shape? shape))
(= (:frame-id shape) uuid/zero)))
(and (some? shape)
(not (frame-shape? shape))
(= (dm/get-prop shape :frame-id) uuid/zero)))
(defn has-children?
([objects id]
@ -96,10 +107,11 @@
([shape]
(d/not-empty? (:shapes shape))))
;; ---- ACCESSORS
(defn get-children-ids
[objects id]
(letfn [(get-children-ids-rec
[id processed]
(letfn [(get-children-ids-rec [id processed]
(when (not (contains? processed id))
(when-let [shapes (-> (get objects id) :shapes (some-> vec))]
(into shapes (mapcat #(get-children-ids-rec % (conj processed id))) shapes))))]
@ -120,19 +132,21 @@
(defn get-parent
"Retrieve the id of the parent for the shape-id (if exists)"
[objects id]
(let [lookup (d/getf objects)]
(-> id lookup :parent-id lookup)))
(when-let [shape (get objects id)]
(get objects (dm/get-prop shape :parent-id))))
(defn get-parent-id
"Retrieve the id of the parent for the shape-id (if exists)"
[objects id]
(-> objects (get id) :parent-id))
(when-let [shape (get objects id)]
(dm/get-prop shape :parent-id)))
(defn get-parent-ids
"Returns a vector of parents of the specified shape."
[objects shape-id]
(loop [result [] id shape-id]
(let [parent-id (dm/get-in objects [id :parent-id])]
(loop [result []
id shape-id]
(let [parent-id (get-parent-id objects id)]
(if (and (some? parent-id) (not= parent-id id))
(recur (conj result parent-id) parent-id)
result))))
@ -154,12 +168,12 @@
(defn hidden-parent?
"Checks the parent for the hidden property"
[objects shape-id]
(let [parent-id (dm/get-in objects [shape-id :parent-id])]
(cond
(or (nil? parent-id) (nil? shape-id) (= shape-id uuid/zero) (= parent-id uuid/zero)) false
(dm/get-in objects [parent-id :hidden]) true
:else
(recur objects parent-id))))
(let [parent-id (get-parent-id objects shape-id)]
(if (or (nil? parent-id) (nil? shape-id) (= shape-id uuid/zero) (= parent-id uuid/zero))
false
(if ^boolean (dm/get-in objects [parent-id :hidden])
true
(recur objects parent-id)))))
(defn get-parent-ids-with-index
"Returns a tuple with the list of parents and a map with the position within each parent"
@ -167,7 +181,7 @@
(loop [parent-list []
parent-indices {}
current shape-id]
(let [parent-id (dm/get-in objects [current :parent-id])
(let [parent-id (get-parent-id objects current)
parent (get objects parent-id)]
(if (and (some? parent) (not= parent-id current))
(let [parent-list (conj parent-list parent-id)
@ -178,7 +192,7 @@
(defn get-siblings-ids
[objects id]
(let [parent (get-parent objects id)]
(into [] (->> (:shapes parent) (remove #(= % id))))))
(into [] (remove #(= % id)) (:shapes parent))))
(defn get-frame
"Get the frame that contains the shape. If the shape is already a
@ -190,7 +204,7 @@
(map? shape-or-id)
(if (frame-shape? shape-or-id)
shape-or-id
(get objects (:frame-id shape-or-id)))
(get objects (dm/get-prop shape-or-id :frame-id)))
(= uuid/zero shape-or-id)
(get objects uuid/zero)

7
common/src/app/common/pages/indices.cljc
View file

@ -9,13 +9,6 @@
[app.common.pages.helpers :as cph]
[app.common.uuid :as uuid]))
(defn generate-child-parent-index
[objects]
(reduce-kv
(fn [index id obj]
(assoc index id (:parent-id obj)))
{} objects))
(defn generate-child-all-parents-index
"Creates an index where the key is the shape id and the value is a set
with all the parents"

10
common/src/app/common/path/bool.cljc
View file

@ -8,8 +8,8 @@
(: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.geom.shapes.rect :as gpr]
[app.common.path.commands :as upc]
[app.common.path.subpaths :as ups]))
@ -101,7 +101,7 @@
(if (= :move-to (:command segment))
false
(let [r1 (command->selrect segment)]
(gpr/overlaps-rects? r1 selrect))))
(grc/overlaps-rects? r1 selrect))))
(overlap-segments?
[seg-1 seg-2]
@ -110,7 +110,7 @@
false
(let [r1 (command->selrect seg-1)
r2 (command->selrect seg-2)]
(gpr/overlaps-rects? r1 r2))))
(grc/overlaps-rects? r1 r2))))
(split
[seg-1 seg-2]
@ -156,7 +156,7 @@
:curve-to (-> (gsp/command->bezier segment)
(gsp/curve-values 0.5)))]
(and (gpr/contains-point? content-sr point)
(and (grc/contains-point? content-sr point)
(or
(gsp/is-point-in-geom-data? point content-geom)
(gsp/is-point-in-border? point content)))))
@ -170,7 +170,7 @@
:curve-to (-> (gsp/command->bezier segment)
(gsp/curve-values 0.5)))]
(and (gpr/contains-point? content-sr point)
(and (grc/contains-point? content-sr point)
(gsp/is-point-in-geom-data? point content-geom))))
(defn overlap-segment?

4
common/src/app/common/path/shapes_to_path.cljc
View file

@ -10,7 +10,7 @@
[app.common.data :as d]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.common :as gsc]
[app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.corners :as gso]
[app.common.geom.shapes.path :as gsp]
[app.common.path.bool :as pb]
@ -231,7 +231,7 @@
new-content (cond-> new-content
(some? transform)
(gsp/transform-content (gmt/transform-in (gsc/center-shape shape) transform)))]
(gsp/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
(-> shape
(assoc :type :path)

1
common/src/app/common/schema/generators.cljc
View file

@ -82,7 +82,6 @@
ext (tg/elements ["net" "com" "org" "app" "io"])]
(u/uri (str scheme "://" domain "." ext))))
;; FIXME: revisit
(defn uuid
[]
(->> tg/small-integer

80
common/src/app/common/types/component.cljc
View file

@ -6,6 +6,86 @@
(ns app.common.types.component)
;; Attributes that may be synced in components, and the group they belong to.
;; When one attribute is modified in a shape inside a component, the corresponding
;; group is marked as :touched. Then, if the shape is synced with the remote shape
;; in the main component, none of the attributes of the same group is changed.
(def sync-attrs
{:name :name-group
:fills :fill-group
:hide-fill-on-export :fill-group
:content :content-group
:position-data :content-group
:hidden :visibility-group
:blocked :modifiable-group
:grow-type :text-font-group
:font-family :text-font-group
:font-size :text-font-group
:font-style :text-font-group
:font-weight :text-font-group
:letter-spacing :text-display-group
:line-height :text-display-group
:text-align :text-display-group
:strokes :stroke-group
:rx :radius-group
:ry :radius-group
:r1 :radius-group
:r2 :radius-group
:r3 :radius-group
:r4 :radius-group
:type :geometry-group
:selrect :geometry-group
:points :geometry-group
:locked :geometry-group
:proportion :geometry-group
:proportion-lock :geometry-group
:x :geometry-group
:y :geometry-group
:width :geometry-group
:height :geometry-group
:rotation :geometry-group
:transform :geometry-group
:transform-inverse :geometry-group
:opacity :layer-effects-group
:blend-mode :layer-effects-group
:shadow :shadow-group
:blur :blur-group
:masked-group? :mask-group
:constraints-h :constraints-group
:constraints-v :constraints-group
:fixed-scroll :constraints-group
:exports :exports-group
:layout :layout-container
:layout-align-content :layout-container
:layout-align-items :layout-container
:layout-flex-dir :layout-container
:layout-gap :layout-container
:layout-gap-type :layout-container
:layout-justify-content :layout-container
:layout-justify-items :layout-container
:layout-wrap-type :layout-container
:layout-padding-type :layout-container
:layout-padding :layout-container
:layout-h-orientation :layout-container
:layout-v-orientation :layout-container
:layout-grid-dir :layout-container
:layout-grid-rows :layout-container
:layout-grid-columns :layout-container
:layout-grid-cells :layout-container
:layout-item-margin :layout-item
:layout-item-margin-type :layout-item
:layout-item-h-sizing :layout-item
:layout-item-v-sizing :layout-item
:layout-item-max-h :layout-item
:layout-item-min-h :layout-item
:layout-item-max-w :layout-item
:layout-item-min-w :layout-item
:layout-item-align-self :layout-item})
(defn instance-root?
"Check if this shape is the head of a top instance."
[shape]

16
common/src/app/common/types/container.cljc
View file

@ -7,9 +7,10 @@
(ns app.common.types.container
(:require
[app.common.data.macros :as dm]
[app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.pages.common :as common]
[app.common.pages.helpers :as cph]
[app.common.schema :as sm]
[app.common.types.component :as ctk]
[app.common.types.components-list :as ctkl]
@ -100,7 +101,7 @@
(nil? shape)
nil
(= uuid/zero (:id shape))
(cph/root-frame? shape)
nil
(and (not (ctk/in-component-copy? shape)) (not allow-main?))
@ -186,9 +187,10 @@
(defn make-component-instance
"Generate a new instance of the component inside the given container.
Clone the shapes of the component, generating new names and ids, and linking
each new shape to the corresponding one of the component. Place the new instance
coordinates in the given position."
Clone the shapes of the component, generating new names and ids, and
linking each new shape to the corresponding one of the
component. Place the new instance coordinates in the given
position."
([container component library-data position components-v2]
(make-component-instance container component library-data position components-v2 {}))
@ -197,17 +199,19 @@
:or {main-instance? false force-id nil force-frame-id nil keep-ids? false}}]
(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)
(assoc :frame-id uuid/zero))
(get-shape component (:id component)))
orig-pos (gpt/point (:x component-shape) (:y component-shape))
delta (gpt/subtract position orig-pos)
objects (:objects container)
unames (volatile! (common/retrieve-used-names objects))
unames (volatile! (cfh/get-used-names objects))
frame-id (or force-frame-id
(ctst/frame-id-by-position objects

8
common/src/app/common/types/file.cljc
View file

@ -8,10 +8,10 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.defaults :refer [version]]
[app.common.files.features :as ffeat]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.pages.common :refer [file-version]]
[app.common.pages.helpers :as cph]
[app.common.schema :as sm]
[app.common.types.color :as ctc]
@ -68,7 +68,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def empty-file-data
{:version file-version
{:version version
:pages []
:pages-index {}})
@ -79,9 +79,8 @@
([file-id page-id]
(let [page (when (some? page-id)
(ctp/make-empty-page page-id "Page 1"))]
(cond-> (-> empty-file-data
(assoc :id file-id))
(cond-> (assoc empty-file-data :id file-id)
(some? page-id)
(ctpl/add-page page)
@ -672,4 +671,3 @@
(show-shape (:id component) 0 (:objects component)))
(when (:main-instance-page component)
(show-component-instance component)))))))))

4
common/src/app/common/types/modifiers.cljc
View file

@ -412,7 +412,7 @@
(defn rotation-modifiers
[shape center angle]
(let [shape-center (gco/center-shape shape)
(let [shape-center (gco/shape->center shape)
;; Translation caused by the rotation
move-vec
(gpt/transform
@ -502,7 +502,7 @@
shape-transform (:transform shape)
shape-transform-inv (:transform-inverse shape)
shape-center (gco/center-shape shape)
shape-center (gco/shape->center shape)
{sr-width :width sr-height :height} (:selrect shape)
origin (cond-> (gpt/point (:selrect shape))

6
common/src/app/common/types/page.cljc
View file

@ -66,9 +66,11 @@
(def empty-page-data
{:options {}
:objects {root
{:id root
(cts/setup-shape {:id root
:type :frame
:name "Root Frame"}}})
:parent-id root
:frame-id root
:name "Root Frame"})}})
(defn make-empty-page
[id name]

322
common/src/app/common/types/shape.cljc
View file

@ -6,16 +6,21 @@
(ns app.common.types.shape
(:require
#?(:clj [app.common.fressian :as fres])
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.proportions :as gpr]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.pages.common :refer [default-color]]
[app.common.record :as cr]
[app.common.schema :as sm]
[app.common.schema.generators :as sg]
[app.common.transit :as t]
[app.common.types.color :as ctc]
[app.common.types.grid :as ctg]
[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]
@ -25,10 +30,26 @@
[app.common.uuid :as uuid]
[clojure.set :as set]))
(cr/defrecord Shape [id name type x y width height rotation selrect points transform transform-inverse parent-id frame-id])
(defn shape?
[o]
(instance? Shape o))
(def stroke-caps-line #{:round :square})
(def stroke-caps-marker #{:line-arrow :triangle-arrow :square-marker :circle-marker :diamond-marker})
(def stroke-caps (set/union stroke-caps-line stroke-caps-marker))
(def shape-types
#{:frame
:group
:bool
:rect
:path
:circle
:svg-raw
:image})
(def blend-modes
#{:normal
:darken
@ -57,7 +78,15 @@
#{"left" "right" "center" "justify"})
(sm/def! ::selrect
[:map {:title "Selrect"}
[:and
{:title "Selrect"
:gen/gen (->> (sg/tuple (sg/small-double)
(sg/small-double)
(sg/small-double)
(sg/small-double))
(sg/fmap #(apply grc/make-rect %)))}
[:fn grc/rect?]
[:map
[:x ::sm/safe-number]
[:y ::sm/safe-number]
[:x1 ::sm/safe-number]
@ -65,10 +94,10 @@
[:y1 ::sm/safe-number]
[:y2 ::sm/safe-number]
[:width ::sm/safe-number]
[:height ::sm/safe-number]])
[:height ::sm/safe-number]]])
(sm/def! ::points
[:vector {:gen/max 5} ::gpt/point])
[:vector {:gen/max 4 :gen/min 4} ::gpt/point])
(sm/def! ::fill
[:map {:title "Fill" :min 1}
@ -95,6 +124,22 @@
[::sm/one-of stroke-caps]]
[:stroke-color-gradient {:optional true} ::ctc/gradient]])
(sm/def! ::minimal-shape-attrs
[:map {:title "ShapeMinimalRecord"}
[:id {:optional false} ::sm/uuid]
[:name {:optional false} :string]
[:type {:optional false} [::sm/one-of shape-types]]
[:x {:optional false} [:maybe ::sm/safe-number]]
[:y {:optional false} [:maybe ::sm/safe-number]]
[:width {:optional false} [:maybe ::sm/safe-number]]
[:height {:optional false} [:maybe ::sm/safe-number]]
[:selrect {:optional false} ::selrect]
[:points {:optional false} ::points]
[:transform {:optional false} ::gmt/matrix]
[:transform-inverse {:optional false} ::gmt/matrix]
[:parent-id {:optional false} ::sm/uuid]
[:frame-id {:optional false} ::sm/uuid]])
(sm/def! ::shape-attrs
[:map {:title "ShapeAttrs"}
[:name {:optional true} :string]
@ -125,10 +170,10 @@
[:r2 {:optional true} ::sm/safe-number]
[:r3 {:optional true} ::sm/safe-number]
[:r4 {:optional true} ::sm/safe-number]
[:x {:optional true} ::sm/safe-number]
[:y {:optional true} ::sm/safe-number]
[:width {:optional true} ::sm/safe-number]
[:height {:optional true} ::sm/safe-number]
[:x {:optional true} [:maybe ::sm/safe-number]]
[:y {:optional true} [:maybe ::sm/safe-number]]
[:width {:optional true} [:maybe ::sm/safe-number]]
[:height {:optional true} [:maybe ::sm/safe-number]]
[:opacity {:optional true} ::sm/safe-number]
[:grids {:optional true}
[:vector {:gen/max 2} ::ctg/grid]]
@ -148,21 +193,18 @@
[::sm/one-of #{:auto-width :auto-height :fixed}]]
])
(def shape-attrs?
(def valid-shape-attrs?
(sm/pred-fn ::shape-attrs))
(sm/def! ::group-attrs
[:map {:title "GroupAttrs"}
[:type [:= :group]]
[:id ::sm/uuid]
[:shapes [:vector {:min 1 :gen/max 10 :gen/min 1} ::sm/uuid]]])
(sm/def! ::frame-attrs
[:map {:title "FrameAttrs"}
[:type [:= :frame]]
[:id ::sm/uuid]
[:shapes {:optional true} [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
[:file-thumbnail {:optional true} :boolean]
[:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
[:hide-fill-on-export {:optional true} :boolean]
[:show-content {:optional true} :boolean]
[:hide-in-viewer {:optional true} :boolean]])
@ -170,7 +212,6 @@
(sm/def! ::bool-attrs
[:map {:title "BoolAttrs"}
[:type [:= :bool]]
[:id ::sm/uuid]
[:shapes [:vector {:min 1 :gen/max 10 :gen/min 1} ::sm/uuid]]
;; FIXME: improve this schema
@ -186,23 +227,19 @@
(sm/def! ::rect-attrs
[:map {:title "RectAttrs"}
[:type [:= :rect]]
[:id ::sm/uuid]])
[:type [:= :rect]]])
(sm/def! ::circle-attrs
[:map {:title "CircleAttrs"}
[:type [:= :circle]]
[:id ::sm/uuid]])
[:type [:= :circle]]])
(sm/def! ::svg-raw-attrs
[:map {:title "SvgRawAttrs"}
[:type [:= :svg-raw]]
[:id ::sm/uuid]])
[:type [:= :svg-raw]]])
(sm/def! ::image-attrs
[:map {:title "ImageAttrs"}
[:type [:= :image]]
[:id ::sm/uuid]
[:metadata
[:map
[:width :int]
@ -213,7 +250,6 @@
(sm/def! ::path-attrs
[:map {:title "PathAttrs"}
[:type [:= :path]]
[:id ::sm/uuid]
[:content
[:vector
[:map
@ -222,21 +258,21 @@
(sm/def! ::text-attrs
[:map {:title "TextAttrs"}
[:id ::sm/uuid]
[:type [:= :text]]
[:content {:optional true} [:maybe ::ctsx/content]]])
(sm/def! ::shape
(sm/def! ::shape-map
[:multi {:dispatch :type :title "Shape"}
[:group
[:merge {:title "GroupShape"}
::shape-attrs
::minimal-shape-attrs
::group-attrs
::ctsl/layout-child-attrs]]
[:frame
[:merge {:title "FrameShape"}
::shape-attrs
::minimal-shape-attrs
::frame-attrs
::ctsl/layout-attrs
::ctsl/layout-child-attrs]]
@ -244,82 +280,112 @@
[:bool
[:merge {:title "BoolShape"}
::shape-attrs
::minimal-shape-attrs
::bool-attrs
::ctsl/layout-child-attrs]]
[:rect
[:merge {:title "RectShape"}
::shape-attrs
::minimal-shape-attrs
::rect-attrs
::ctsl/layout-child-attrs]]
[:circle
[:merge {:title "CircleShape"}
::shape-attrs
::minimal-shape-attrs
::circle-attrs
::ctsl/layout-child-attrs]]
[:image
[:merge {:title "ImageShape"}
::shape-attrs
::minimal-shape-attrs
::image-attrs
::ctsl/layout-child-attrs]]
[:svg-raw
[:merge {:title "SvgRawShape"}
::shape-attrs
::minimal-shape-attrs
::svg-raw-attrs
::ctsl/layout-child-attrs]]
[:path
[:merge {:title "PathShape"}
::shape-attrs
::minimal-shape-attrs
::path-attrs
::ctsl/layout-child-attrs]]
[:text
[:merge {:title "TextShape"}
::shape-attrs
::minimal-shape-attrs
::text-attrs
::ctsl/layout-child-attrs]]])
(def shape?
(sm/def! ::shape
[:and
{:title "Shape"
:gen/gen (->> (sg/generator ::shape-map)
(sg/fmap map->Shape))}
::shape-map
[:fn shape?]])
(def valid-shape?
(sm/pred-fn ::shape))
;; --- Initialization
(def default-shape-attrs
{})
(def default-frame-attrs
{:frame-id uuid/zero
:fills [{:fill-color clr/white
:fill-opacity 1}]
:strokes []
:shapes []
:hide-fill-on-export false})
(def ^:private minimal-shapes
[{:type :rect
(def ^:private minimal-rect-attrs
{:type :rect
:name "Rectangle"
:fills [{:fill-color default-color
:fill-opacity 1}]
:strokes []
:rx 0
:ry 0}
:ry 0})
(def ^:private minimal-image-attrs
{:type :image
:rx 0
:ry 0
:fills []
:strokes []}
:strokes []})
(def ^:private minimal-frame-attrs
{:frame-id uuid/zero
:fills [{:fill-color clr/white
:fill-opacity 1}]
:name "Board"
:strokes []
:shapes []
:hide-fill-on-export false})
(def ^:private minimal-circle-attrs
{:type :circle
:name "Ellipse"
:fills [{:fill-color default-color
:fill-opacity 1}]
:strokes []}
:strokes []})
(def ^:private minimal-group-attrs
{:type :group
:name "Group"
:shapes []})
(def ^:private minimal-bool-attrs
{:type :bool
:name "Bool"
:shapes []})
(def ^:private minimal-text-attrs
{:type :text
:name "Text"})
(def ^:private minimal-path-attrs
{:type :path
:name "Path"
:fills []
@ -327,113 +393,103 @@
:stroke-alignment :center
:stroke-width 2
:stroke-color clr/black
:stroke-opacity 1}]}
:stroke-opacity 1}]})
{:type :frame
:name "Board"
:fills [{:fill-color clr/white
:fill-opacity 1}]
:strokes []
:rx 0
:ry 0}
(def ^:private minimal-svg-raw-attrs
{:type :svg-raw
:fills []
:strokes []})
{:type :text
:name "Text"
:content nil}
(def ^:private minimal-multiple-attrs
{:type :multiple})
{:type :svg-raw}])
(def empty-selrect
{:x 0 :y 0
:x1 0 :y1 0
:x2 0.01 :y2 0.01
:width 0.01 :height 0.01})
(defn make-minimal-shape
(defn- get-minimal-shape
[type]
(let [type (cond (= type :curve) :path
:else type)
shape (d/seek #(= type (:type %)) minimal-shapes)]
(when-not shape
(ex/raise :type :assertion
:code :shape-type-not-implemented
:context {:type type}))
(case type
:rect minimal-rect-attrs
:image minimal-image-attrs
:circle minimal-circle-attrs
:path minimal-path-attrs
:frame minimal-frame-attrs
:bool minimal-bool-attrs
:group minimal-group-attrs
:text minimal-text-attrs
:svg-raw minimal-svg-raw-attrs
;; NOTE: used for create ephimeral shapes for multiple selection
:multiple minimal-multiple-attrs))
(defn- make-minimal-shape
[type]
(let [type (if (= type :curve) :path type)
attrs (get-minimal-shape type)]
(cond-> attrs
(not= :path type)
(-> (assoc :x 0)
(assoc :y 0)
(assoc :width 0.01)
(assoc :height 0.01))
(cond-> shape
:always
(assoc :id (uuid/next))
(assoc :id (uuid/next)
:rotation 0)
(not= :path (:type shape))
(assoc :x 0
:y 0
:width 0.01
:height 0.01
:selrect {:x 0
:y 0
:x1 0
:y1 0
:x2 0.01
:y2 0.01
:width 0.01
:height 0.01}))))
:always
(map->Shape))))
(defn make-minimal-group
[frame-id rect group-name]
{:id (uuid/next)
:type :group
:name group-name
:shapes []
:frame-id frame-id
:x (:x rect)
:y (:y rect)
:width (:width rect)
:height (:height rect)})
(defn setup-rect-selrect
(defn setup-rect
"Initializes the selrect and points for a shape."
[shape]
(let [selrect (gsh/rect->selrect shape)
points (gsh/rect->points shape)
points (cond-> points
(:transform shape)
(gsh/transform-points (gsh/center-points points) (:transform shape)))]
[{:keys [selrect points] :as shape}]
(let [selrect (or selrect (gsh/shape->rect shape))
points (or points (grc/rect->points selrect))]
(-> shape
(assoc :selrect selrect
:points points))))
(assoc :selrect selrect)
(assoc :points points))))
(defn- setup-rect
"A specialized function for setup rect-like shapes."
[shape {:keys [x y width height]}]
(defn setup-path
[{:keys [content selrect points] :as shape}]
(let [selrect (or selrect (gsh/content->selrect content))
points (or points (grc/rect->points selrect))]
(-> shape
(assoc :x x :y y :width width :height height)
(setup-rect-selrect)))
(assoc :selrect selrect)
(assoc :points points))))
(defn- setup-image
[shape props]
(let [metadata (or (:metadata shape) (:metadata props))]
(-> (setup-rect shape props)
(assoc
:metadata metadata
:proportion (/ (:width metadata)
(:height metadata))
:proportion-lock true))))
[{:keys [metadata] :as shape}]
(-> shape
(assoc :metadata metadata)
(assoc :proportion (/ (:width metadata)
(:height metadata)))
(assoc :proportion-lock true)))
(defn setup-shape
"A function that initializes the geometric data of
the shape. The props must have :x :y :width :height."
([props]
(setup-shape {:type :rect} props))
[{:keys [type] :as props}]
(let [shape (make-minimal-shape type)
shape (merge shape (d/without-nils props))
shape (case (:type shape)
:path (setup-path shape)
:image (-> shape setup-rect setup-image)
(setup-rect shape))]
(-> shape
(cond-> (nil? (:transform shape))
(assoc :transform (gmt/matrix)))
(cond-> (nil? (:transform-inverse shape))
(assoc :transform-inverse (gmt/matrix)))
(gpr/setup-proportions))))
([shape props]
(case (:type shape)
:image (setup-image shape props)
(setup-rect shape props))))
;; --- SHAPE SERIALIZATION
(defn make-shape
"Make a non group shape, ready to use."
[type geom-props attrs]
(-> (if-not (= type :group)
(make-minimal-shape type)
(make-minimal-group uuid/zero geom-props (:name attrs)))
(setup-shape geom-props)
(merge attrs)))
(t/add-handlers!
{:id "shape"
:class Shape
:wfn #(into {} %)
:rfn map->Shape})
#?(:clj
(fres/add-handlers!
{:name "penpot/shape"
:class Shape
:wfn fres/write-map-like
:rfn (comp map->Shape fres/read-map-like)}))

133
common/src/app/common/pages/common.cljc → common/src/app/common/types/shape/attrs.cljc
View file

@ -4,111 +4,11 @@
;;
;; Copyright (c) KALEIDOS INC
(ns app.common.pages.common
(ns app.common.types.shape.attrs
(:require
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.schema :as sm]
[app.common.uuid :as uuid]))
[app.common.colors :as clr]))
(def file-version 20)
(def default-color clr/gray-20)
(def root uuid/zero)
;; Attributes that may be synced in components, and the group they belong to.
;; When one attribute is modified in a shape inside a component, the corresponding
;; group is marked as :touched. Then, if the shape is synced with the remote shape
;; in the main component, none of the attributes of the same group is changed.
(def component-sync-attrs
{:name :name-group
:fills :fill-group
:fill-color :fill-group
:fill-opacity :fill-group
:fill-color-gradient :fill-group
:fill-color-ref-file :fill-group
:fill-color-ref-id :fill-group
:hide-fill-on-export :fill-group
:content :content-group
:position-data :content-group
:hidden :visibility-group
:blocked :modifiable-group
:grow-type :text-font-group
:font-family :text-font-group
:font-size :text-font-group
:font-style :text-font-group
:font-weight :text-font-group
:letter-spacing :text-display-group
:line-height :text-display-group
:text-align :text-display-group
:strokes :stroke-group
:stroke-color :stroke-group
:stroke-color-gradient :stroke-group
:stroke-color-ref-file :stroke-group
:stroke-color-ref-id :stroke-group
:stroke-opacity :stroke-group
:stroke-style :stroke-group
:stroke-width :stroke-group
:stroke-alignment :stroke-group
:stroke-cap-start :stroke-group
:stroke-cap-end :stroke-group
:rx :radius-group
:ry :radius-group
:r1 :radius-group
:r2 :radius-group
:r3 :radius-group
:r4 :radius-group
:type :geometry-group
:selrect :geometry-group
:points :geometry-group
:locked :geometry-group
:proportion :geometry-group
:proportion-lock :geometry-group
:x :geometry-group
:y :geometry-group
:width :geometry-group
:height :geometry-group
:rotation :geometry-group
:transform :geometry-group
:transform-inverse :geometry-group
:opacity :layer-effects-group
:blend-mode :layer-effects-group
:shadow :shadow-group
:blur :blur-group
:masked-group? :mask-group
:constraints-h :constraints-group
:constraints-v :constraints-group
:fixed-scroll :constraints-group
:exports :exports-group
:layout :layout-container
:layout-align-content :layout-container
:layout-align-items :layout-container
:layout-flex-dir :layout-container
:layout-gap :layout-container
:layout-gap-type :layout-container
:layout-justify-content :layout-container
:layout-justify-items :layout-container
:layout-wrap-type :layout-container
:layout-padding-type :layout-container
:layout-padding :layout-container
:layout-h-orientation :layout-container
:layout-v-orientation :layout-container
:layout-grid-dir :layout-container
:layout-grid-rows :layout-container
:layout-grid-columns :layout-container
:layout-grid-cells :layout-container
:layout-item-margin :layout-item
:layout-item-margin-type :layout-item
:layout-item-h-sizing :layout-item
:layout-item-v-sizing :layout-item
:layout-item-max-h :layout-item
:layout-item-min-h :layout-item
:layout-item-max-w :layout-item
:layout-item-min-w :layout-item
:layout-item-align-self :layout-item})
;; Attributes that may directly be edited by the user with forms
(def editable-attrs
@ -594,33 +494,4 @@
:layout-item-min-w
:layout-item-align-self}})
(defn retrieve-used-names
"Return a set with the all unique names used in the
elements (any entity thas has a :name)"
[elements]
(into #{} (comp (map :name) (remove nil?)) (vals elements)))
(defn- extract-numeric-suffix
[basename]
(if-let [[_ p1 p2] (re-find #"(.*) ([0-9]+)$" basename)]
[p1 (+ 1 (d/parse-integer p2))]
[basename 1]))
(defn generate-unique-name
"A unique name generator"
[used basename]
(dm/assert!
"expected a set of strings"
(sm/set-of-strings? used))
(dm/assert!
"expected a string for `basename`."
(string? basename))
(if-not (contains? used basename)
basename
(let [[prefix initial] (extract-numeric-suffix basename)]
(loop [counter initial]
(let [candidate (str prefix " " counter)]
(if (contains? used candidate)
(recur (inc counter))
candidate))))))

2
common/src/app/common/types/shape/interactions.cljc
View file

@ -182,7 +182,7 @@
(dm/assert!
"The `:after-delay` event type incompatible with frame shapes"
(or (not= event-type :after-delay)
(= (:type shape) :frame)))
(cph/frame-shape? shape)))
(if (= (:event-type interaction) event-type)
interaction

2
common/src/app/common/types/shape/radius.cljc
View file

@ -6,7 +6,7 @@
(ns app.common.types.shape.radius
(:require
[app.common.pages.common :refer [editable-attrs]]))
[app.common.types.shape.attrs :refer [editable-attrs]]))
;; There are some shapes that admit border radius, as rectangles
;; frames and images. Those shapes may define the radius of the corners in two modes:

9
common/src/app/common/types/shape_tree.cljc
View file

@ -322,10 +322,9 @@
(not (mth/almost-zero? (:rotation frame 0))))
(defn clone-object
"Gets a copy of the object and all its children, with new ids
and with the parent-children links correctly set. Admits functions
to make more transformations to the cloned objects and the
original ones.
"Gets a copy of the object and all its children, with new ids and with
the parent-children links correctly set. Admits functions to make
more transformations to the cloned objects and the original ones.
Returns the cloned object, the list of all new objects (including
the cloned one), and possibly a list of original objects modified.
@ -357,7 +356,7 @@
(if (empty? child-ids)
(let [new-object (cond-> object
true
:always
(assoc :id new-id
:parent-id parent-id)

10
common/test/common_tests/pages_migrations_test.cljc → common/test/common_tests/files_migrations_test.cljc
View file

@ -4,14 +4,14 @@
;;
;; Copyright (c) KALEIDOS INC
(ns common-tests.pages-migrations-test
(ns common-tests.files-migrations-test
(:require
[clojure.test :as t]
[clojure.pprint :refer [pprint]]
[app.common.data :as d]
[app.common.files.migrations :as cpm]
[app.common.pages :as cp]
[app.common.pages.migrations :as cpm]
[app.common.uuid :as uuid]))
[app.common.uuid :as uuid]
[clojure.pprint :refer [pprint]]
[clojure.test :as t]))
(t/deftest test-migration-8-1
(let [page-id (uuid/custom 0 0)

105
common/test/common_tests/geom_shapes_test.cljc
View file

@ -8,6 +8,7 @@
(:require
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.transforms :as gsht]
[app.common.math :as mth :refer [close?]]
@ -22,35 +23,21 @@
{:command :curve-to :params {:x 40 :y 40 :c1x 35 :c1y 35 :c2x 45 :c2y 45}}
{:command :close-path}])
(defn add-path-data
[shape]
(let [content (:content shape default-path)
selrect (gsh/content->selrect content)
points (gsh/rect->points selrect)]
(assoc shape
:content content
:selrect selrect
:points points)))
(defn add-rect-data
[shape]
(let [shape (-> shape
(assoc :width 20 :height 20))
selrect (gsh/rect->selrect shape)
points (gsh/rect->points selrect)]
(assoc shape
:selrect selrect
:points points)))
(defn create-test-shape
([type] (create-test-shape type {}))
([type params]
(-> (cts/make-minimal-shape type)
(merge params)
(cond->
(= type :path) (add-path-data)
(not= type :path) (add-rect-data)))))
(if (= type :path)
(cts/setup-shape
(merge
{:type :path
:content (:content params default-path)}
params))
(cts/setup-shape
(merge
{:type type
:width 20
:height 20}
params)))))
(t/deftest transform-shapes
(t/testing "Shape without modifiers should stay the same"
@ -62,10 +49,11 @@
:rect :path))
(t/testing "Transform shape with translation modifiers"
(t/are [type]
(let [modifiers (ctm/move-modifiers (gpt/point 10 -10))]
(let [shape-before (create-test-shape type {:modifiers modifiers})
(doseq [type [:rect :path]]
(let [modifiers (ctm/move-modifiers (gpt/point 10 -10))
shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)]
(t/is (not= shape-before shape-after))
(t/is (close? (get-in shape-before [:selrect :x])
@ -78,9 +66,8 @@
(get-in shape-after [:selrect :width])))
(t/is (close? (get-in shape-before [:selrect :height])
(get-in shape-after [:selrect :height])))))
:rect :path))
(get-in shape-after [:selrect :height])))
)))
(t/testing "Transform with empty translation"
(t/are [type]
@ -138,7 +125,7 @@
(t/testing "Transform shape with rotation modifiers"
(t/are [type]
(let [shape-before (create-test-shape type)
modifiers (ctm/rotation-modifiers shape-before (gsh/center-shape shape-before) 30)
modifiers (ctm/rotation-modifiers shape-before (gsh/shape->center shape-before) 30)
shape-before (assoc shape-before :modifiers modifiers)
shape-after (gsh/transform-shape shape-before)]
@ -160,7 +147,7 @@
(t/testing "Transform shape with rotation = 0 should leave equal selrect"
(t/are [type]
(let [shape-before (create-test-shape type)
modifiers (ctm/rotation-modifiers shape-before (gsh/center-shape shape-before) 0)
modifiers (ctm/rotation-modifiers shape-before (gsh/shape->center shape-before) 0)
shape-after (gsh/transform-shape (assoc shape-before :modifiers modifiers))]
(t/are [prop]
(t/is (close? (get-in shape-before [:selrect prop])
@ -171,23 +158,23 @@
(t/testing "Transform shape with invalid selrect fails gracefully"
(t/are [type selrect]
(let [modifiers (ctm/move-modifiers 0 0)
shape-before (-> (create-test-shape type) (assoc :selrect selrect))
shape-before (create-test-shape type {:selrect selrect})
shape-after (gsh/transform-shape shape-before modifiers)]
(t/is (= (:selrect shape-before)
(t/is (grc/close-rect? (:selrect shape-before)
(:selrect shape-after))))
:rect {:x 0.0 :y 0.0 :x1 0.0 :y1 0.0 :x2 ##Inf :y2 ##Inf :width ##Inf :height ##Inf}
:path {:x 0.0 :y 0.0 :x1 0.0 :y1 0.0 :x2 ##Inf :y2 ##Inf :width ##Inf :height ##Inf}
:rect nil
:path nil)))
:rect (grc/make-rect 0 0 ##Inf ##Inf)
:path (grc/make-rect 0 0 ##Inf ##Inf)
))
)
(t/deftest points-to-selrect
(let [points [(gpt/point 0.5 0.5)
(gpt/point -1 -2)
(gpt/point 20 65.2)
(gpt/point 12 -10)]
result (gsh/points->rect points)
result (grc/points->rect points)
expect {:x -1, :y -10, :width 21, :height 75.2}]
(t/is (= (:x expect) (:x result)))
@ -204,39 +191,39 @@
(t/is (gmt/close? expected result)))
;; No transformation
(gsh/make-selrect 0 0 10 10)
(-> (gsh/make-selrect 0 0 10 10)
(gsh/rect->points))
(grc/make-rect 0 0 10 10)
(-> (grc/make-rect 0 0 10 10)
(grc/rect->points))
(gmt/matrix)
;; Displacement
(gsh/make-selrect 0 0 10 10)
(-> (gsh/make-selrect 20 20 10 10)
(gsh/rect->points ))
(grc/make-rect 0 0 10 10)
(-> (grc/make-rect 20 20 10 10)
(grc/rect->points ))
(gmt/matrix 1 0 0 1 20 20)
;; Resize
(gsh/make-selrect 0 0 10 10)
(-> (gsh/make-selrect 0 0 20 40)
(gsh/rect->points))
(grc/make-rect 0 0 10 10)
(-> (grc/make-rect 0 0 20 40)
(grc/rect->points))
(gmt/matrix 2 0 0 4 0 0)
;; Displacement+Resize
(gsh/make-selrect 0 0 10 10)
(-> (gsh/make-selrect 10 10 20 40)
(gsh/rect->points))
(grc/make-rect 0 0 10 10)
(-> (grc/make-rect 10 10 20 40)
(grc/rect->points))
(gmt/matrix 2 0 0 4 10 10)
;; Rotation
(gsh/make-selrect 0 0 10 10)
(-> (gsh/make-selrect 0 0 10 10)
(gsh/rect->points)
(grc/make-rect 0 0 10 10)
(-> (grc/make-rect 0 0 10 10)
(grc/rect->points)
(gsh/transform-points (gmt/rotate-matrix 45)))
(gmt/matrix (mth/cos g45) (mth/sin g45) (- (mth/sin g45)) (mth/cos g45) 0 0)
;; Rotation + Resize
(gsh/make-selrect 0 0 10 10)
(-> (gsh/make-selrect 0 0 20 40)
(gsh/rect->points)
(grc/make-rect 0 0 10 10)
(-> (grc/make-rect 0 0 20 40)
(grc/rect->points)
(gsh/transform-points (gmt/rotate-matrix 45)))
(gmt/matrix (* (mth/cos g45) 2) (* (mth/sin g45) 2) (* (- (mth/sin g45)) 4) (* (mth/cos g45) 4) 0 0))))

12
common/test/common_tests/helpers/files.cljc
View file

@ -49,13 +49,11 @@
(fn [file-data]
(let [frame-id (get props :frame-id uuid/zero)
parent-id (get props :parent-id uuid/zero)
shape (if (= type :group)
(cts/make-minimal-group frame-id
{:x 0 :y 0 :width 1 :height 1}
(get props :name "Group1"))
(cts/make-shape type
{:x 0 :y 0 :width 1 :height 1}
props))]
shape (cts/setup-shape
(-> {:type type
:width 1
:height 1}
(merge props)))]
(swap! idmap assoc label (:id shape))
(ctpl/update-page file-data

1057
common/test/common_tests/pages_test.cljc
View file

File diff suppressed because it is too large Load diff

79
common/test/common_tests/types_shape_interactions_test.cljc
View file

@ -6,9 +6,10 @@
(ns common-tests.types-shape-interactions-test
(:require
[app.common.geom.shapes :as gsh]
[app.common.exceptions :as ex]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.types.shape :as cts]
[app.common.types.shape.interactions :as ctsi]
[app.common.uuid :as uuid]
@ -17,8 +18,8 @@
(t/deftest set-event-type
(let [interaction ctsi/default-interaction
shape (cts/make-minimal-shape :rect)
frame (cts/make-minimal-shape :frame)]
shape (cts/setup-shape {:type :rect})
frame (cts/setup-shape {:type :frame})]
(t/testing "Set event type unchanged"
(let [new-interaction
@ -46,7 +47,8 @@
new-interaction
(ctsi/set-event-type interaction :after-delay frame)]
(t/is (= :after-delay (:event-type new-interaction)))
(t/is (= 300 (:delay new-interaction)))))))
(t/is (= 300 (:delay new-interaction)))))
))
(t/deftest set-action-type
@ -148,7 +150,7 @@
(t/is (= "https://example.com" (:url new-interaction)))))))
(t/deftest option-delay
(let [frame (cts/make-minimal-shape :frame)
(let [frame (cts/setup-shape {:type :frame})
i1 ctsi/default-interaction
i2 (ctsi/set-event-type i1 :after-delay frame)]
@ -160,7 +162,6 @@
(let [new-interaction (ctsi/set-delay i2 1000)]
(t/is (= 1000 (:delay new-interaction)))))))
(t/deftest option-destination
(let [destination (uuid/next)
i1 ctsi/default-interaction
@ -211,10 +212,10 @@
(t/deftest option-overlay-opts
(let [base-frame (-> (cts/make-minimal-shape :frame)
(let [base-frame (-> (cts/setup-shape {:type :frame})
(assoc-in [:selrect :width] 100)
(assoc-in [:selrect :height] 100))
overlay-frame (-> (cts/make-minimal-shape :frame)
overlay-frame (-> (cts/setup-shape {:type :frame})
(assoc-in [:selrect :width] 30)
(assoc-in [:selrect :height] 20))
objects {(:id base-frame) base-frame
@ -277,37 +278,35 @@
(t/is (= relative-to-id (:position-relative-to new-interaction)))))))
(defn setup-selrect [{:keys [x y width height] :as obj}]
(let [rect (gsh/make-rect x y width height)
center (gsh/center-rect rect)
selrect (gsh/rect->selrect rect)
points (gsh/rect->points rect)]
(let [rect (grc/make-rect x y width height)
center (grc/rect->center rect)
points (grc/rect->points rect)]
(-> obj
(assoc :selrect selrect)
(assoc :selrect rect)
(assoc :points points))))
(t/deftest calc-overlay-position
(let [base-frame (-> (cts/make-minimal-shape :frame)
(assoc :width 100)
(assoc :height 100)
(setup-selrect))
popup (-> (cts/make-minimal-shape :frame)
(assoc :width 50)
(assoc :height 50)
(assoc :x 10)
(assoc :y 10)
(setup-selrect))
(let [base-frame (cts/setup-shape
{:type :frame
:width 100
:height 100})
popup (cts/setup-shape
{:type :frame
:width 50
:height 50
:x 10
:y 10})
rect (cts/setup-shape
{:type :rect
:width 50
:height 50
:x 10
:y 10})
rect (-> (cts/make-minimal-shape :rect)
(assoc :width 50)
(assoc :height 50)
(assoc :x 10)
(assoc :y 10)
(setup-selrect))
overlay-frame (-> (cts/make-minimal-shape :frame)
(assoc :width 30)
(assoc :height 20)
(setup-selrect))
overlay-frame (cts/setup-shape
{:type :frame
:width 30
:height 20})
objects {(:id base-frame) base-frame
(:id popup) popup
@ -798,12 +797,12 @@
(t/deftest remap-interactions
(let [frame1 (cts/make-minimal-shape :frame)
frame2 (cts/make-minimal-shape :frame)
frame3 (cts/make-minimal-shape :frame)
frame4 (cts/make-minimal-shape :frame)
frame5 (cts/make-minimal-shape :frame)
frame6 (cts/make-minimal-shape :frame)
(let [frame1 (cts/setup-shape {:type :frame})
frame2 (cts/setup-shape {:type :frame})
frame3 (cts/setup-shape {:type :frame})
frame4 (cts/setup-shape {:type :frame})
frame5 (cts/setup-shape {:type :frame})
frame6 (cts/setup-shape {:type :frame})
objects {(:id frame3) frame3
(:id frame4) frame4

3
common/test/common_tests/types_test.cljc
View file

@ -24,7 +24,8 @@
(t/deftest types-shape-spec
(sg/check!
(sg/for [fdata (sg/generator ::cts/shape)]
(t/is (sm/validate ::cts/shape fdata)))))
(binding [app.common.data.macros/*assert-context* true]
(t/is (sm/valid? ::cts/shape fdata))))))
(t/deftest types-page-spec
(-> (sg/for [fdata (sg/generator ::ctp/page)]

2
frontend/src/app/libs/file_builder.cljs
View file

@ -7,7 +7,7 @@
(ns app.libs.file-builder
(:require
[app.common.data :as d]
[app.common.file-builder :as fb]
[app.common.files.builder :as fb]
[app.common.media :as cm]
[app.common.types.components-list :as ctkl]
[app.common.uuid :as uuid]

18
frontend/src/app/main/data/dashboard.cljs
View file

@ -8,7 +8,7 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.pages :as cp]
[app.common.files.helpers :as cfh]
[app.common.schema :as sm]
[app.common.time :as dt]
[app.common.uri :as u]
@ -607,8 +607,8 @@
ptk/WatchEvent
(watch [_ state _]
(let [projects (get state :dashboard-projects)
unames (cp/retrieve-used-names projects)
name (cp/generate-unique-name unames (str (tr "dashboard.new-project-prefix") " 1"))
unames (cfh/get-used-names projects)
name (cfh/generate-unique-name unames (str (tr "dashboard.new-project-prefix") " 1"))
team-id (:current-team-id state)
params {:name name
:team-id team-id}
@ -823,8 +823,8 @@
on-error rx/throw}} (meta params)
files (get state :dashboard-files)
unames (cp/retrieve-used-names files)
name (cp/generate-unique-name unames (str (tr "dashboard.new-file-prefix") " 1"))
unames (cfh/get-used-names files)
name (cfh/generate-unique-name unames (str (tr "dashboard.new-file-prefix") " 1"))
features (cond-> #{}
(features/active-feature? state :components-v2)
(conj "components/v2"))
@ -1033,11 +1033,11 @@
in-project? (contains? pparams :project-id)
name (if in-project?
(let [files (get state :dashboard-files)
unames (cp/retrieve-used-names files)]
(cp/generate-unique-name unames (str (tr "dashboard.new-file-prefix") " 1")))
unames (cfh/get-used-names files)]
(cfh/generate-unique-name unames (str (tr "dashboard.new-file-prefix") " 1")))
(let [projects (get state :dashboard-projects)
unames (cp/retrieve-used-names projects)]
(cp/generate-unique-name unames (str (tr "dashboard.new-project-prefix") " 1"))))
unames (cfh/get-used-names projects)]
(cfh/generate-unique-name unames (str (tr "dashboard.new-project-prefix") " 1"))))
params (if in-project?
{:project-id (:project-id pparams)
:name name}

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

@ -10,13 +10,14 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.features :as ffeat]
[app.common.files.helpers :as cfh]
[app.common.geom.align :as gal]
[app.common.geom.point :as gpt]
[app.common.geom.proportions :as gpp]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.grid-layout :as gslg]
[app.common.logging :as log]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.text :as txt]
@ -436,8 +437,8 @@
ptk/WatchEvent
(watch [it state _]
(let [pages (get-in state [:workspace-data :pages-index])
unames (cp/retrieve-used-names pages)
name (cp/generate-unique-name unames "Page 1")
unames (cfh/get-used-names pages)
name (cfh/generate-unique-name unames "Page 1")
changes (-> (pcb/empty-changes it)
(pcb/add-empty-page id name))]
@ -451,9 +452,9 @@
(watch [it state _]
(let [id (uuid/next)
pages (get-in state [:workspace-data :pages-index])
unames (cp/retrieve-used-names pages)
unames (cfh/get-used-names pages)
page (get-in state [:workspace-data :pages-index page-id])
name (cp/generate-unique-name unames (:name page))
name (cfh/generate-unique-name unames (:name page))
page (-> page
(assoc :name name)
@ -597,7 +598,7 @@
(defn update-shape
[id attrs]
(dm/assert! (uuid? id))
(dm/assert! (cts/shape-attrs? attrs))
(dm/assert! (cts/valid-shape-attrs? attrs))
(ptk/reify ::update-shape
ptk/WatchEvent
(watch [_ _ _]
@ -641,7 +642,7 @@
(defn update-selected-shapes
[attrs]
(dm/assert! (cts/shape-attrs? attrs))
(dm/assert! (cts/valid-shape-attrs? attrs))
(ptk/reify ::update-selected-shapes
ptk/WatchEvent
(watch [_ state _]
@ -990,7 +991,7 @@
(defn- move-shape
[shape]
(let [bbox (-> shape :points gsh/points->selrect)
(let [bbox (-> shape :points grc/points->rect)
pos (gpt/point (:x bbox) (:y bbox))]
(dwt/update-position (:id shape) pos)))
@ -1029,7 +1030,7 @@
(defn align-objects-list
[objects selected axis]
(let [selected-objs (map #(get objects %) selected)
rect (gsh/selection-rect selected-objs)]
rect (gsh/shapes->rect selected-objs)]
(mapcat #(gal/align-to-rect % rect axis objects) selected-objs)))
(defn can-distribute? [selected]
@ -1671,7 +1672,7 @@
selected-objs (map #(get paste-objects %) selected)
first-selected-obj (first selected-objs)
page-selected (wsh/lookup-selected state)
wrapper (gsh/selection-rect selected-objs)
wrapper (gsh/shapes->rect selected-objs)
orig-pos (gpt/point (:x1 wrapper) (:y1 wrapper))
frame-id (first page-selected)
frame-object (get page-objects frame-id)
@ -1728,8 +1729,11 @@
delta (if (= origin-frame-id uuid/zero)
;; When the origin isn't in a frame the result is pasted in the center.
(gpt/subtract (gsh/center-shape frame-object) (gsh/center-selrect wrapper))
;; When pasting from one frame to another frame the object position must be limited to container boundaries. If the pasted object doesn't fit we try to:
(gpt/subtract (gsh/shape->center frame-object) (grc/rect->center wrapper))
;; When pasting from one frame to another frame the object
;; position must be limited to container boundaries. If
;; the pasted object doesn't fit we try to:
;;
;; - Align it to the limits on the x and y axis
;; - Respect the distance of the object to the right and bottom in the original frame
(gpt/point paste-x paste-y))]
@ -1876,7 +1880,7 @@
page-objects (wsh/lookup-page-objects state)
frame-id (first page-selected)
frame-object (get page-objects frame-id)]
(gsh/center-shape frame-object))
(gsh/shape->center frame-object))
:else
(deref ms/mouse-position)))
@ -2057,6 +2061,7 @@
(log/error :msg (str "Error removing " (:name media-obj))
:hint (ex-message %)
:error %)
(js/console.log (.-stack %))
(rx/of (error-in-remove-graphics)))))))
(defn- remove-graphics
@ -2076,10 +2081,8 @@
media (vals (:media file-data'))
media-points
(map #(assoc % :points (gsh/rect->points {:x 0
:y 0
:width (:width %)
:height (:height %)}))
(map #(assoc % :points (-> (grc/make-rect 0 0 (:width %) (:height %))
(grc/rect->points)))
media)
shape-grid

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

@ -207,8 +207,8 @@
(try
(dm/assert!
"expect valid vector of changes"
(and (cpc/changes? redo-changes)
(cpc/changes? undo-changes)))
(and (cpc/valid-changes? redo-changes)
(cpc/valid-changes? undo-changes)))
(update-in state path (fn [file]
(-> file

35
frontend/src/app/main/data/workspace/drawing.cljs
View file

@ -7,7 +7,7 @@
(ns app.main.data.workspace.drawing
"Drawing interactions."
(:require
[app.common.types.shape :as cts]
[app.common.data.macros :as dm]
[app.common.uuid :as uuid]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.drawing.box :as box]
@ -23,13 +23,12 @@
;; --- Select for Drawing
(defn select-for-drawing
([tool] (select-for-drawing tool nil))
([tool data]
[tool]
(ptk/reify ::select-for-drawing
ptk/UpdateEvent
(update [_ state]
(-> state
(update :workspace-drawing assoc :tool tool :object data)
(update :workspace-drawing assoc :tool tool)
;; When changing drawing tool disable "scale text" mode
;; automatically, to help users that ignore how this
;; mode works.
@ -45,13 +44,14 @@
(let [stopper (->> stream (rx/filter dwc/interrupt?))]
(->> stream
(rx/filter (ptk/type? ::common/handle-finish-drawing))
(rx/map (constantly tool))
(rx/take 1)
(rx/observe-on :async)
(rx/map #(select-for-drawing tool data))
(rx/map select-for-drawing)
(rx/take-until stopper))))
;; NOTE: comments are a special case and they manage they
;; own interrupt cycle.q
;; own interrupt cycle.
(when (and (not= tool :comments)
(not= tool :path))
(let [stopper (rx/filter (ptk/type? ::clear-drawing) stream)]
@ -59,8 +59,7 @@
(rx/filter dwc/interrupt?)
(rx/take 1)
(rx/map common/clear-drawing)
(rx/take-until stopper)))))))))
(rx/take-until stopper))))))))
;; NOTE/TODO: when an exception is raised in some point of drawing the
;; draw lock is not released so the user need to refresh in order to
@ -68,7 +67,7 @@
(defn start-drawing
[type]
{:pre [(keyword? type)]}
(dm/assert! (keyword? type))
(let [lock-id (uuid/next)]
(ptk/reify ::start-drawing
ptk/UpdateEvent
@ -77,7 +76,7 @@
ptk/WatchEvent
(watch [_ state stream]
(let [lock (get-in state [:workspace-drawing :lock])]
(let [lock (dm/get-in state [:workspace-drawing :lock])]
(when (= lock lock-id)
(rx/merge
(rx/of (handle-drawing type))
@ -89,23 +88,13 @@
(defn handle-drawing
[type]
(ptk/reify ::handle-drawing
ptk/UpdateEvent
(update [_ state]
(let [data (cts/make-minimal-shape type)]
(update-in state [:workspace-drawing :object] merge data)))
ptk/WatchEvent
(watch [_ _ _]
(rx/of
(case type
:path
(path/handle-new-shape)
:curve
(curve/handle-drawing-curve)
;; default
(box/handle-drawing-box))))))
:path (path/handle-new-shape)
:curve (curve/handle-drawing)
(box/handle-drawing type))))))

66
frontend/src/app/main/data/workspace/drawing/box.cljs
View file

@ -6,12 +6,13 @@
(ns app.main.data.workspace.drawing.box
(:require
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.flex-layout :as gslf]
[app.common.geom.shapes.grid-layout :as gslg]
[app.common.math :as mth]
[app.common.pages.helpers :as cph]
[app.common.types.modifiers :as ctm]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst]
@ -42,13 +43,16 @@
(defn resize-shape [{:keys [x y width height] :as shape} initial point lock?]
(if (and (some? x) (some? y) (some? width) (some? height))
(let [draw-rect (gsh/make-rect initial (cond-> point lock? (adjust-ratio initial)))
shape-rect (gsh/make-rect x y width height)
(let [draw-rect (grc/make-rect initial (cond-> point lock? (adjust-ratio initial)))
shape-rect (grc/make-rect x y width height)
scalev (gpt/point (/ (:width draw-rect) (:width shape-rect))
(/ (:height draw-rect) (:height shape-rect)))
scalev (gpt/point (/ (:width draw-rect)
(:width shape-rect))
(/ (:height draw-rect)
(:height shape-rect)))
movev (gpt/to-vec (gpt/point shape-rect) (gpt/point draw-rect))]
movev (gpt/to-vec (gpt/point shape-rect)
(gpt/point draw-rect))]
(-> shape
(assoc :click-draw? false)
@ -65,18 +69,18 @@
(fn [state]
(update-in state [:workspace-drawing :object] gsh/absolute-move (gpt/point x y))))
(defn handle-drawing-box []
(ptk/reify ::handle-drawing-box
(defn handle-drawing
[type]
(ptk/reify ::handle-drawing
ptk/WatchEvent
(watch [_ state stream]
(let [stoper? #(or (ms/mouse-up? %) (= % :interrupt))
stoper (rx/filter stoper? stream)
(let [stoper (rx/filter #(or (ms/mouse-up? %) (= % :interrupt)) stream)
layout (get state :workspace-layout)
zoom (get-in state [:workspace-local :zoom] 1)
snap-pixel? (contains? layout :snap-pixel-grid)
zoom (dm/get-in state [:workspace-local :zoom] 1)
snap-precision (if (>= zoom zoom-half-pixel-precision) 0.5 1)
initial (cond-> @ms/mouse-position snap-pixel? (gpt/round-step snap-precision))
snap-pixel? (contains? layout :snap-pixel-grid)
snap-prec (if (>= zoom zoom-half-pixel-precision) 0.5 1)
initial (cond-> @ms/mouse-position snap-pixel? (gpt/round-step snap-prec))
page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
@ -90,33 +94,26 @@
drop-index (when flex-layout? (gslf/get-drop-index fid objects initial))
drop-cell (when grid-layout? (gslg/get-drop-cell fid objects initial))
shape (get-in state [:workspace-drawing :object])
shape (-> shape
(cts/setup-shape {:x (:x initial)
shape (-> (cts/setup-shape {:type type
:x (:x initial)
:y (:y initial)
:width 0.01
:height 0.01})
(cond-> (and (cph/frame-shape? shape)
(not= fid uuid/zero))
(assoc :fills [] :hide-in-viewer true))
(assoc :frame-id fid)
:frame-id fid
:parent-id fid
:initialized? true
:click-draw? true
:hide-in-viewer (and (= type :frame) (not= fid uuid/zero))})
(cond-> (some? drop-index)
(with-meta {:index drop-index}))
(cond-> (some? drop-cell)
(with-meta {:cell drop-cell}))
(with-meta {:cell drop-cell})))
]
(assoc :initialized? true)
(assoc :click-draw? true))]
(rx/concat
;; Add shape to drawing state
(rx/of #(assoc-in state [:workspace-drawing :object] shape))
(rx/of #(update % :workspace-drawing assoc :object shape))
;; Initial SNAP
(->>
(rx/concat
(->> (rx/concat
(->> (snap/closest-snap-point page-id [shape] objects layout zoom focus initial)
(rx/map move-drawing))
@ -129,7 +126,8 @@
(rx/map #(conj current %)))))
(rx/map
(fn [[_ shift? point]]
#(update-drawing % initial (cond-> point snap-pixel? (gpt/round-step snap-precision)) shift?)))))
#(update-drawing % initial (cond-> point snap-pixel? (gpt/round-step snap-prec)) shift?)))))
(rx/take-until stoper))
(->> (rx/of (common/handle-finish-drawing))

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

@ -6,6 +6,7 @@
(ns app.main.data.workspace.drawing.common
(:require
[app.common.data.macros :as dm]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages.helpers :as cph]
@ -30,46 +31,46 @@
(ptk/reify ::handle-finish-drawing
ptk/WatchEvent
(watch [_ state _]
(let [tool (get-in state [:workspace-drawing :tool])
shape (get-in state [:workspace-drawing :object])
objects (wsh/lookup-page-objects state)]
(let [tool (dm/get-in state [:workspace-drawing :tool])
shape (dm/get-in state [:workspace-drawing :object])
objects (wsh/lookup-page-objects state)
page-id (:current-page-id state)]
(rx/concat
(when (:initialized? shape)
(let [page-id (:current-page-id state)
(let [click-draw? (:click-draw? shape)
text? (cph/text-shape? shape)
vbox (dm/get-in state [:workspace-local :vbox])
click-draw? (:click-draw? shape)
text? (= :text (:type shape))
min-side (min 100
(mth/floor (get-in state [:workspace-local :vbox :width]))
(mth/floor (get-in state [:workspace-local :vbox :height])))
min-side (mth/min 100
(mth/floor (dm/get-prop vbox :width))
(mth/floor (dm/get-prop vbox :height)))
shape
(cond-> shape
(not click-draw?)
(-> (assoc :grow-type :fixed))
(assoc :grow-type :fixed)
(and click-draw? (not text?))
(and ^boolean click-draw? (not ^boolean text?))
(-> (assoc :width min-side :height min-side)
(cts/setup-rect-selrect)
(cts/setup-shape)
(gsh/transform-shape (ctm/move-modifiers (- (/ min-side 2)) (- (/ min-side 2)))))
(and click-draw? text?)
(-> (assoc :height 17 :width 4 :grow-type :auto-width)
(cts/setup-rect-selrect))
(cts/setup-shape))
:always
(dissoc :initialized? :click-draw?))]
;; Add & select the created shape to the workspace
(rx/concat
(if (or (= :text (:type shape)) (= :frame (:type shape)))
(if (or (cph/text-shape? shape) (cph/frame-shape? shape))
(rx/of (dwu/start-undo-transaction (:id shape)))
(rx/empty))
(rx/of (dwsh/add-shape shape {:no-select? (= tool :curve)}))
(if (= :frame (:type shape))
(if (cph/frame-shape? shape)
(rx/concat
(->> (uw/ask! {:cmd :selection/query
:page-id page-id

107
frontend/src/app/main/data/workspace/drawing/curve.cljs
View file

@ -6,11 +6,14 @@
(ns app.main.data.workspace.drawing.curve
(:require
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.flex-layout :as gslf]
[app.common.geom.shapes.grid-layout :as gslg]
[app.common.geom.shapes.path :as gsp]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst]
[app.common.types.shape.layout :as ctl]
[app.main.data.workspace.drawing.common :as common]
@ -22,85 +25,91 @@
(def simplify-tolerance 0.3)
(defn stoper-event? [{:keys [type] :as event}]
(defn stoper-event?
[{:keys [type] :as event}]
(ms/mouse-event? event) (= type :up))
(defn initialize-drawing [state]
(assoc-in state [:workspace-drawing :object :initialized?] true))
(defn insert-point-segment [state point]
(let [segments (-> state
(get-in [:workspace-drawing :object :segments])
(or [])
(defn- insert-point
[point]
(ptk/reify ::insert-point
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-drawing :object]
(fn [object]
(let [segments (-> (:segments object)
(conj point))
content (gsp/segments->content segments)
selrect (gsh/content->selrect content)
points (gsh/rect->points selrect)]
(-> state
(update-in [:workspace-drawing :object] assoc
:segments segments
:content content
:selrect selrect
:points points))))
points (grc/rect->points selrect)]
(-> object
(assoc :segments segments)
(assoc :content content)
(assoc :selrect selrect)
(assoc :points points))))))))
(defn setup-frame-curve []
(ptk/reify ::setup-frame-path
(defn- setup-frame
[]
(ptk/reify ::setup-frame
ptk/UpdateEvent
(update [_ state]
(let [objects (wsh/lookup-page-objects state)
content (get-in state [:workspace-drawing :object :content] [])
start (get-in content [0 :params] nil)
content (dm/get-in state [:workspace-drawing :object :content] [])
start (dm/get-in content [0 :params] nil)
position (when start (gpt/point start))
frame-id (ctst/top-nested-frame objects position)
flex-layout? (ctl/flex-layout? objects frame-id)
grid-layout? (ctl/grid-layout? objects frame-id)
drop-index (when flex-layout? (gslf/get-drop-index frame-id objects position))
drop-cell (when grid-layout? (gslg/get-drop-cell frame-id objects position))]
(-> state
(assoc-in [:workspace-drawing :object :frame-id] frame-id)
(update-in state [:workspace-drawing :object]
(fn [object]
(-> object
(assoc :frame-id frame-id)
(assoc :parent-id frame-id)
(cond-> (some? drop-index)
(update-in [:workspace-drawing :object] with-meta {:index drop-index}))
(with-meta {:index drop-index}))
(cond-> (some? drop-cell)
(update-in [:workspace-drawing :object] with-meta {:cell drop-cell})))))))
(with-meta {:cell drop-cell})))))))))
(defn curve-to-path [{:keys [segments] :as shape}]
(let [content (gsp/segments->content segments)
(defn finish-drawing
[]
(ptk/reify ::finish-drawing
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-drawing :object]
(fn [{:keys [segments] :as shape}]
(let [segments (ups/simplify segments simplify-tolerance)
content (gsp/segments->content segments)
selrect (gsh/content->selrect content)
points (gsh/rect->points selrect)]
points (grc/rect->points selrect)]
(-> shape
(dissoc :segments)
(assoc :content content)
(assoc :selrect selrect)
(assoc :points points)
(cond-> (or (empty? points)
(nil? selrect)
(<= (count content) 1))
(assoc :initialized? false)))))))))
(cond-> (or (empty? points) (nil? selrect) (<= (count content) 1))
(assoc :initialized? false)))))
(defn finish-drawing-curve
[]
(ptk/reify ::finish-drawing-curve
ptk/UpdateEvent
(update [_ state]
(letfn [(update-curve [shape]
(-> shape
(update :segments #(ups/simplify % simplify-tolerance))
(curve-to-path)))]
(-> state
(update-in [:workspace-drawing :object] update-curve))))))
(defn handle-drawing-curve []
(ptk/reify ::handle-drawing-curve
(defn handle-drawing []
(ptk/reify ::handle-drawing
ptk/WatchEvent
(watch [_ _ stream]
(let [stoper (rx/filter stoper-event? stream)
mouse (rx/sample 10 ms/mouse-position)]
mouse (rx/sample 10 ms/mouse-position)
shape (cts/setup-shape {:type :path
:initialized? true
:segments []})]
(rx/concat
(rx/of initialize-drawing)
(rx/of #(update % :workspace-drawing assoc :object shape))
(->> mouse
(rx/map (fn [pt] #(insert-point-segment % pt)))
(rx/map insert-point)
(rx/take-until stoper))
(rx/of (setup-frame-curve)
(finish-drawing-curve)
(rx/of
(setup-frame)
(finish-drawing)
(common/handle-finish-drawing)))))))

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

@ -6,7 +6,7 @@
(ns app.main.data.workspace.grid-layout.editor
(:require
[app.common.geom.shapes :as gsh]
[app.common.geom.rect :as grc]
[app.main.data.workspace.state-helpers :as wsh]
[potok.core :as ptk]))
@ -58,7 +58,7 @@
(let [{:keys [x y width height]} srect
x (+ x (/ width 2) (- (/ (:width vport) 2 zoom)))
y (+ y (/ height 2) (- (/ (:height vport) 2 zoom)))
srect (gsh/make-selrect x y width height)]
srect (grc/make-rect x y width height)]
(-> local
(update :vbox merge (select-keys srect [:x :y :x1 :x2 :y1 :y2])))))))))))

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

@ -80,18 +80,20 @@
(:name (first shapes))
base-name)
selrect (gsh/selection-rect shapes)
selrect (gsh/shapes->rect shapes)
group-idx (->> shapes
last
:id
(cph/get-position-on-parent objects)
inc)
group (-> (cts/make-minimal-group frame-id selrect gname)
(cts/setup-shape selrect)
(assoc :shapes (mapv :id shapes)
group (cts/setup-shape {:type :group
:name gname
:shapes (mapv :id shapes)
:selrect selrect
:parent-id parent-id
:frame-id frame-id
:index group-idx))
:index group-idx})
;; Shapes that are in a component, but are not root, must be detached,
;; because they will be now children of a non instance group.

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

@ -8,8 +8,8 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.types.page :as ctp]
@ -33,8 +33,8 @@
(let [page (wsh/lookup-page state)
flows (get-in page [:options :flows] [])
unames (into #{} (map :name flows))
name (cp/generate-unique-name unames "Flow 1")
unames (cfh/get-used-names flows)
name (cfh/generate-unique-name unames "Flow 1")
new-flow {:id (uuid/next)
:name name

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

@ -24,9 +24,11 @@
[app.common.uuid :as uuid]
[app.main.data.events :as ev]
[app.main.data.messages :as msg]
[app.main.data.workspace :as-alias dw]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.groups :as dwg]
[app.main.data.workspace.libraries-helpers :as dwlh]
[app.main.data.workspace.notifications :as-alias dwn]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.state-helpers :as wsh]
@ -562,7 +564,7 @@
(defn ext-library-changed
[file-id modified-at revn changes]
(dm/assert! (uuid? file-id))
(dm/assert! (ch/changes? changes))
(dm/assert! (ch/valid-changes? changes))
(ptk/reify ::ext-library-changed
ptk/UpdateEvent
(update [_ state]
@ -901,11 +903,11 @@
(ptk/reify ::watch-component-changes
ptk/WatchEvent
(watch [_ state stream]
(let [components-v2 (features/active-feature? state :components-v2)
(let [components-v2? (features/active-feature? state :components-v2)
stopper
(->> stream
(rx/filter #(or (= :app.main.data.workspace/finalize-page (ptk/type %))
(rx/filter #(or (= ::dw/finalize-page (ptk/type %))
(= ::watch-component-changes (ptk/type %)))))
workspace-data-s
@ -914,35 +916,36 @@
(rx/from-atom refs/workspace-data {:emit-current-value? true}))
;; Need to get the file data before the change, so deleted shapes
;; still exist, for example
(rx/buffer 3 1))
(rx/buffer 3 1)
(rx/filter (fn [[old-data]] (some? old-data))))
change-s
(->> stream
(rx/filter #(or (dch/commit-changes? %)
(= (ptk/type %) :app.main.data.workspace.notifications/handle-file-change)))
(ptk/type? % ::dwn/handle-file-change)))
(rx/observe-on :async))
check-changes
(fn [[event [old-data _mid_data _new-data]]]
(when old-data
(let [{:keys [file-id changes save-undo? undo-group]}
(deref event)
(let [{:keys [file-id changes save-undo? undo-group]} (deref event)
components-changed
changed-components
(when (or (nil? file-id) (= file-id (:id old-data)))
(reduce #(into %1 (ch/components-changed old-data %2))
#{}
changes))]
(->> changes
(map (partial ch/components-changed old-data))
(reduce into #{})))]
(when (and (d/not-empty? components-changed) save-undo?)
(when (and (d/not-empty? changed-components) save-undo?)
(log/info :msg "DETECTED COMPONENTS CHANGED"
:ids (map str components-changed)
:ids (map str changed-components)
:undo-group undo-group)
(run! st/emit!
(map #(launch-component-sync % (:id old-data) undo-group)
components-changed))))))]
(when components-v2
(->> changed-components
(map #(launch-component-sync % (:id old-data) undo-group))
(run! st/emit!))))))]
(when components-v2?
(->> change-s
(rx/with-latest-from workspace-data-s)
(rx/map check-changes)

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

@ -11,7 +11,6 @@
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.logging :as log]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
@ -181,8 +180,9 @@
(not (nil? parent-id))
(assoc :parent-id parent-id))
;; on copy/paste old id is used later to reorder the paster layers
changes (cond-> (pcb/add-object changes first-shape {:ignore-touched true})
(some? old-id) (pcb/amend-last-change #(assoc % :old-id old-id))) ; on copy/paste old id is used later to reorder the paster layers
(some? old-id) (pcb/amend-last-change #(assoc % :old-id old-id)))
changes (reduce #(pcb/add-object %1 %2 {:ignore-touched true})
changes
@ -1158,7 +1158,7 @@
origin-shape (reposition-shape origin-shape origin-root dest-root)
touched (get dest-shape :touched #{})]
(loop [attrs (seq (keys cp/component-sync-attrs))
(loop [attrs (seq (keys ctk/sync-attrs))
roperations []
uoperations []]
@ -1196,7 +1196,7 @@
:val (get dest-shape attr)
:ignore-touched true}
attr-group (get cp/component-sync-attrs attr)]
attr-group (get ctk/sync-attrs attr)]
(if (or (= (get origin-shape attr) (get dest-shape attr))
(and (touched attr-group) omit-touched?))

18
frontend/src/app/main/data/workspace/media.cljs
View file

@ -259,25 +259,27 @@
"Convert a media object that contains a bitmap image into shapes,
one shape of type :image and one group that contains it."
[pos {:keys [name width height id mtype] :as media-obj}]
(let [group-shape (cts/make-shape :group
{:x (:x pos)
(let [group-shape (cts/setup-shape
{:type :group
:x (:x pos)
:y (:y pos)
:width width
:height height}
{:name name
:height height
:name name
:frame-id uuid/zero
:parent-id uuid/zero})
img-shape (cts/make-shape :image
{:x (:x pos)
img-shape (cts/setup-shape
{:type :image
:x (:x pos)
:y (:y pos)
:width width
:height height
:metadata {:id id
:width width
:height height
:mtype mtype}}
{:name name
:mtype mtype}
:name name
:frame-id uuid/zero
:parent-id (:id group-shape)})]
(rx/of [group-shape [img-shape]])))

7
frontend/src/app/main/data/workspace/modifiers.cljs
View file

@ -10,12 +10,13 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages.common :as cpc]
[app.common.pages.helpers :as cph]
[app.common.types.container :as ctn]
[app.common.types.modifiers :as ctm]
[app.common.types.shape.attrs :refer [editable-attrs]]
[app.common.types.shape.layout :as ctl]
[app.main.constants :refer [zoom-half-pixel-precision]]
[app.main.data.workspace.changes :as dch]
@ -379,7 +380,7 @@
;; Rotation use different algorithm to calculate children modifiers (and do not use child constraints).
(defn set-rotation-modifiers
([angle shapes]
(set-rotation-modifiers angle shapes (-> shapes gsh/selection-rect gsh/center-selrect)))
(set-rotation-modifiers angle shapes (-> shapes gsh/shapes->rect grc/rect->center)))
([angle shapes center]
(ptk/reify ::set-rotation-modifiers
@ -389,7 +390,7 @@
ids
(->> shapes
(remove #(get % :blocked false))
(filter #((cpc/editable-attrs (:type %)) :rotation))
(filter #(:rotation (get editable-attrs (:type %))))
(map :id))
get-modifier

37
frontend/src/app/main/data/workspace/path/drawing.cljs
View file

@ -11,6 +11,7 @@
[app.common.geom.shapes.flex-layout :as gsl]
[app.common.path.commands :as upc]
[app.common.path.shapes-to-path :as upsp]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst]
[app.common.types.shape.layout :as ctl]
[app.main.data.workspace.changes :as dch]
@ -196,14 +197,13 @@
drag-events
(rx/of (finish-drag)))))))
(defn handle-drawing-path
(defn handle-drawing
[_id]
(ptk/reify ::handle-drawing-path
(ptk/reify ::handle-drawing
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
(-> state
(assoc-in [:workspace-local :edit-path id :edit-mode] :draw))))
(assoc-in state [:workspace-local :edit-path id :edit-mode] :draw)))
ptk/WatchEvent
(watch [_ _ stream]
@ -234,9 +234,8 @@
mousedown-events)
(rx/of (common/finish-path "after-events")))))))
(defn setup-frame-path []
(ptk/reify ::setup-frame-path
(defn setup-frame []
(ptk/reify ::setup-frame
ptk/UpdateEvent
(update [_ state]
(let [objects (wsh/lookup-page-objects state)
@ -245,10 +244,14 @@
frame-id (ctst/top-nested-frame objects position)
flex-layout? (ctl/flex-layout? objects frame-id)
drop-index (when flex-layout? (gsl/get-drop-index frame-id objects position))]
(-> state
(assoc-in [:workspace-drawing :object :frame-id] frame-id)
(update-in state [:workspace-drawing :object]
(fn [object]
(-> object
(assoc :frame-id frame-id)
(assoc :parent-id frame-id)
(cond-> (some? drop-index)
(update-in [:workspace-drawing :object] with-meta {:index drop-index})))))))
(with-meta {:index drop-index})))))))))
(defn handle-new-shape-result [shape-id]
(ptk/reify ::handle-new-shape-result
@ -264,7 +267,7 @@
(watch [_ state _]
(let [content (get-in state [:workspace-drawing :object :content] [])]
(if (seq content)
(rx/of (setup-frame-path)
(rx/of (setup-frame)
(dwdc/handle-finish-drawing)
(dwe/start-edition-mode shape-id)
(change-edit-mode :draw))
@ -276,15 +279,17 @@
(ptk/reify ::handle-new-shape
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
(let [id (st/get-path-id state)
shape (cts/setup-shape {:type :path})]
(-> state
(assoc-in [:workspace-local :edit-path id :snap-toggled] false))))
(assoc-in [:workspace-local :edit-path id :snap-toggled] false)
(update :workspace-drawing assoc :object shape))))
ptk/WatchEvent
(watch [_ state stream]
(let [shape-id (get-in state [:workspace-drawing :object :id])]
(let [shape-id (dm/get-in state [:workspace-drawing :object :id])]
(rx/concat
(rx/of (handle-drawing-path shape-id))
(rx/of (handle-drawing shape-id))
(->> stream
(rx/filter (ptk/type? ::common/finish-path))
(rx/take 1)
@ -310,7 +315,7 @@
(if (= :draw edit-mode)
(rx/concat
(rx/of (dch/update-shapes [id] upsp/convert-to-path))
(rx/of (handle-drawing-path id))
(rx/of (handle-drawing id))
(->> stream
(rx/filter (ptk/type? ::common/finish-path))
(rx/take 1)

11
frontend/src/app/main/data/workspace/path/helpers.cljs
View file

@ -8,6 +8,7 @@
(:require
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.path.commands :as upc]
@ -28,7 +29,7 @@
[content]
(-> content
gsh/content->selrect
gsh/center-selrect))
grc/rect->center))
(defn content->points+selrect
"Given the content of a shape, calculate its points and selrect"
@ -45,7 +46,7 @@
flip-y (gmt/scale (gpt/point 1 -1))
:always (gmt/multiply (:transform-inverse shape (gmt/matrix))))
center (or (gsh/center-shape shape)
center (or (gsh/shape->center shape)
(content-center content))
base-content (gsh/transform-content
@ -54,16 +55,16 @@
;; Calculates the new selrect with points given the old center
points (-> (gsh/content->selrect base-content)
(gsh/rect->points)
(grc/rect->points)
(gsh/transform-points center transform))
points-center (gsh/center-points points)
points-center (gsh/points->center points)
;; Points is now the selrect but the center is different so we can create the selrect
;; through points
selrect (-> points
(gsh/transform-points points-center transform-inverse)
(gsh/points->selrect))]
(grc/points->rect))]
[points selrect]))
(defn update-selrect

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

@ -7,6 +7,7 @@
(ns app.main.data.workspace.path.selection
(:require
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.path.state :as st]
@ -116,7 +117,7 @@
(rx/concat
(->> ms/mouse-position
(rx/take-until stoper)
(rx/map #(gsh/points->rect [from-p %]))
(rx/map #(grc/points->rect [from-p %]))
(rx/filter (partial valid-rect? zoom))
(rx/map update-area-selection))

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

@ -235,7 +235,7 @@
[file-id {:keys [revn changes]}]
(dm/assert! (uuid? file-id))
(dm/assert! (int? revn))
(dm/assert! (cpc/changes? changes))
(dm/assert! (cpc/valid-changes? changes))
(ptk/reify ::shapes-changes-persisted
ptk/UpdateEvent

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

@ -8,11 +8,12 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.focus :as cpf]
[app.common.pages.helpers :as cph]
[app.common.types.component :as ctk]
[app.common.types.file :as ctf]
@ -54,33 +55,28 @@
(ptk/reify ::handle-area-selection
ptk/WatchEvent
(watch [_ state stream]
(let [zoom (get-in state [:workspace-local :zoom] 1)
(let [zoom (dm/get-in state [:workspace-local :zoom] 1)
stop? (fn [event] (or (interrupt? event) (ms/mouse-up? event)))
stoper (->> stream (rx/filter stop?))
stoper (rx/filter stop? stream)
init-selrect
{:type :rect
:x1 (:x @ms/mouse-position)
:y1 (:y @ms/mouse-position)
:x2 (:x @ms/mouse-position)
:y2 (:y @ms/mouse-position)}
init-position @ms/mouse-position
init-selrect (grc/make-rect
(dm/get-prop init-position :x)
(dm/get-prop init-position :y)
0 0)
calculate-selrect
(fn [selrect [delta space?]]
(let [result
(cond-> selrect
:always
(-> (update :x2 + (:x delta))
(let [selrect (-> selrect
(update :x2 + (:x delta))
(update :y2 + (:y delta)))
space?
(-> (update :x1 + (:x delta))
(update :y1 + (:y delta))))]
(assoc result
:x (min (:x1 result) (:x2 result))
:y (min (:y1 result) (:y2 result))
:width (mth/abs (- (:x2 result) (:x1 result)))
:height (mth/abs (- (:y2 result) (:y1 result))))))
selrect (if ^boolean space?
(-> selrect
(update :x1 + (:x delta))
(update :y1 + (:y delta)))
selrect)]
(grc/update-rect selrect :corners)))
selrect-stream
(->> ms/mouse-position
@ -89,9 +85,10 @@
(rx/filter some?)
(rx/with-latest-from ms/keyboard-space)
(rx/scan calculate-selrect init-selrect)
(rx/filter #(or (> (:width %) (/ 10 zoom))
(> (:height %) (/ 10 zoom))))
(rx/filter #(or (> (dm/get-prop % :width) (/ 10 zoom))
(> (dm/get-prop % :height) (/ 10 zoom))))
(rx/take-until stoper))]
(rx/concat
(if preserve?
(rx/empty)
@ -217,7 +214,7 @@
(let [objects (wsh/lookup-page-objects state)
focus (:workspace-focus-selected state)
ids (if (d/not-empty? focus)
(cp/filter-not-focus objects focus ids)
(cpf/filter-not-focus objects focus ids)
ids)]
(assoc-in state [:workspace-local :selected] ids)))
@ -236,7 +233,7 @@
;; mode is active
focus (:workspace-focus-selected state)
objects (-> (wsh/lookup-page-objects state)
(cp/focus-objects focus))
(cpf/focus-objects focus))
lookup (d/getf objects)
parents (->> (wsh/lookup-selected state)
@ -288,8 +285,9 @@
initial-set (if preserve?
selected
lks/empty-linked-set)
selrect (get-in state [:workspace-local :selrect])
blocked? (fn [id] (get-in objects [id :blocked] false))]
selrect (dm/get-in state [:workspace-local :selrect])
blocked? (fn [id] (dm/get-in objects [id :blocked] false))]
(when selrect
(rx/empty)
(->> (uw/ask-buffered!
@ -353,7 +351,7 @@
([all-objects page ids delta it libraries library-data file-id init-changes]
(let [shapes (map (d/getf all-objects) ids)
unames (volatile! (cp/retrieve-used-names (:objects page)))
unames (volatile! (cfh/get-used-names (:objects page)))
update-unames! (fn [new-name] (vswap! unames conj new-name))
all-ids (reduce #(into %1 (cons %2 (cph/get-children-ids all-objects %2))) (d/ordered-set) ids)
ids-map (into {} (map #(vector % (uuid/next))) all-ids)
@ -486,7 +484,7 @@
(let [update-flows (fn [flows]
(reduce
(fn [flows frame]
(let [name (cp/generate-unique-name @unames "Flow 1")
(let [name (cfh/generate-unique-name @unames "Flow 1")
_ (vswap! unames conj name)
new-flow {:id (uuid/next)
:name name

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

@ -93,7 +93,7 @@
(->> shapes
(map :id)
(ctt/sort-z-index objects)
(map (comp gsh/center-shape (d/getf objects))))
(map (comp gsh/shape->center (d/getf objects))))
start (first points)
end (reduce (fn [acc p] (gpt/add acc (gpt/to-vec start p))) points)

163
frontend/src/app/main/data/workspace/shapes.cljs
View file

@ -8,7 +8,6 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.proportions :as gpp]
[app.common.geom.shapes :as gsh]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
@ -28,61 +27,19 @@
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.undo :as dwu]
[app.main.features :as features]
[app.main.streams :as ms]
[beicon.core :as rx]
[potok.core :as ptk]))
(defn get-shape-layer-position
[objects selected attrs]
;; Calculate the frame over which we're drawing
(let [position @ms/mouse-position
frame-id (:frame-id attrs (ctst/top-nested-frame objects position))
shape (when-not (empty? selected)
(cph/get-base-shape objects selected))]
;; When no shapes has been selected or we're over a different frame
;; we add it as the latest shape of that frame
(if (or (not shape) (not= (:frame-id shape) frame-id))
[frame-id frame-id nil]
;; Otherwise, we add it to next to the selected shape
(let [index (cph/get-position-on-parent objects (:id shape))
{:keys [frame-id parent-id]} shape]
[frame-id parent-id (inc index)]))))
(defn make-new-shape
[attrs objects selected]
(let [default-attrs (if (= :frame (:type attrs))
cts/default-frame-attrs
cts/default-shape-attrs)
selected-non-frames
(into #{} (comp (map (d/getf objects))
(remove cph/frame-shape?))
selected)
[frame-id parent-id index]
(get-shape-layer-position objects selected-non-frames attrs)]
(-> (merge default-attrs attrs)
(gpp/setup-proportions)
(assoc :frame-id frame-id
:parent-id parent-id
:index index))))
(def valid-shape-map?
(sm/pred-fn ::cts/shape))
(defn prepare-add-shape
[changes attrs objects selected]
(let [id (or (:id attrs) (uuid/next))
name (:name attrs)
[changes shape objects _selected]
(let [index (:index (meta shape))
;; FIXME: revisit
id (:id shape)
shape (make-new-shape
(assoc attrs :id id :name name)
objects
selected)
index (:index (meta attrs))
[row column :as cell] (:cell (meta attrs))
[row column :as cell] (:cell (meta shape))
changes (-> changes
(pcb/with-objects objects)
@ -90,8 +47,8 @@
(pcb/add-object shape {:index index}))
(cond-> (nil? index)
(pcb/add-object shape))
(cond-> (some? (:parent-id attrs))
(pcb/change-parent (:parent-id attrs) [shape] index))
(cond-> (some? (:parent-id shape))
(pcb/change-parent (:parent-id shape) [shape] index))
(cond-> (some? cell)
(pcb/update-shapes [(:parent-id shape)] #(ctl/push-into-cell % [id] row column)))
(cond-> (ctl/grid-layout? objects (:parent-id shape))
@ -100,10 +57,14 @@
[shape changes]))
(defn add-shape
([attrs]
(add-shape attrs {}))
([attrs {:keys [no-select? no-update-layout?]}]
(dm/assert! (cts/shape-attrs? attrs))
([shape]
(add-shape shape {}))
([shape {:keys [no-select? no-update-layout?]}]
(dm/verify!
"expected a valid shape"
(cts/valid-shape? shape))
(ptk/reify ::add-shape
ptk/WatchEvent
(watch [it state _]
@ -111,11 +72,10 @@
objects (wsh/lookup-page-objects state page-id)
selected (wsh/lookup-selected state)
changes (-> (pcb/empty-changes it page-id)
(pcb/with-objects objects))
[shape changes]
(prepare-add-shape changes attrs objects selected)
(-> (pcb/empty-changes it page-id)
(pcb/with-objects objects)
(prepare-add-shape shape objects selected))
undo-id (js/Symbol)]
@ -127,7 +87,7 @@
(when-not no-select?
(dws/select-shapes (d/ordered-set (:id shape))))
(dwu/commit-undo-transaction undo-id))
(when (= :text (:type attrs))
(when (cph/text-shape? shape)
(->> (rx/of (dwe/start-edition-mode (:id shape)))
(rx/observe-on :async)))))))))
@ -363,59 +323,78 @@
(defn create-and-add-shape
[type frame-x frame-y data]
[type frame-x frame-y {:keys [width height] :as attrs}]
(ptk/reify ::create-and-add-shape
ptk/WatchEvent
(watch [_ state _]
(let [{:keys [width height]} data
vbc (wsh/viewport-center state)
x (:x data (- (:x vbc) (/ width 2)))
y (:y data (- (:y vbc) (/ height 2)))
(let [vbc (wsh/viewport-center state)
x (:x attrs (- (:x vbc) (/ width 2)))
y (:y attrs (- (:y vbc) (/ height 2)))
page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
frame-id (-> (wsh/lookup-page-objects state page-id)
(ctst/top-nested-frame {:x frame-x :y frame-y}))
selected (wsh/lookup-selected state)
page-objects (wsh/lookup-page-objects state)
base (cph/get-base-shape page-objects selected)
selected-frame? (and (= 1 (count selected))
(= :frame (get-in objects [(first selected) :type])))
parent-id (if
(or selected-frame? (empty? selected)) frame-id
base (cph/get-base-shape objects selected)
parent-id (if (or (and (= 1 (count selected))
(cph/frame-shape? (get objects (first selected))))
(empty? selected))
frame-id
(:parent-id base))
shape (-> (cts/make-minimal-shape type)
(merge data)
(merge {:x x :y y})
(assoc :frame-id frame-id :parent-id parent-id)
(cts/setup-rect-selrect))]
shape (cts/setup-shape
(-> attrs
(assoc :type type)
(assoc :x x)
(assoc :y y)
(assoc :frame-id frame-id)
(assoc :parent-id parent-id)))]
(rx/of (add-shape shape))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Artboard
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FIXME: looks
(defn prepare-create-artboard-from-selection
[changes id parent-id objects selected index frame-name without-fill?]
(let [selected-objs (map #(get objects %) selected)
new-index (or index
(cph/get-index-replacement selected objects))]
(when (d/not-empty? selected)
(let [srect (gsh/selection-rect selected-objs)
frame-id (get-in objects [(first selected) :frame-id])
parent-id (or parent-id (get-in objects [(first selected) :parent-id]))
shape (-> (cts/make-minimal-shape :frame)
(merge {:x (:x srect) :y (:y srect) :width (:width srect) :height (:height srect)})
(cond-> id
(assoc :id id))
(cond-> frame-name
(assoc :name frame-name))
(assoc :frame-id frame-id :parent-id parent-id)
(let [srect (gsh/shapes->rect selected-objs)
selected-id (first selected)
frame-id (dm/get-in objects [selected-id :frame-id])
parent-id (or parent-id (dm/get-in objects [selected-id :parent-id]))
attrs {:type :frame
:x (:x srect)
:y (:y srect)
:width (:width srect)
:height (:height srect)}
shape (cts/setup-shape
(cond-> attrs
(some? id)
(assoc :id id)
(some? frame-name)
(assoc :name frame-name)
:always
(assoc :frame-id frame-id
:parent-id parent-id)
:always
(with-meta {:index new-index})
(cond-> (or (not= frame-id uuid/zero) without-fill?)
(assoc :fills [] :hide-in-viewer true))
(cts/setup-rect-selrect))
(or (not= frame-id uuid/zero) without-fill?)
(assoc :fills [] :hide-in-viewer true)))
[shape changes]
(prepare-add-shape changes shape objects selected)
@ -476,7 +455,7 @@
(dm/assert!
"expected valid shape-attrs value for `flags`"
(cts/shape-attrs? flags))
(cts/valid-shape-attrs? flags))
(ptk/reify ::update-shape-flags
ptk/WatchEvent

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

@ -8,21 +8,21 @@
(:require
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.files.helpers :as cfh]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us :refer [max-safe-int min-safe-int]]
[app.common.schema :as sm :refer [max-safe-int min-safe-int]]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst]
[app.common.uuid :as uuid]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.undo :as dwu]
[app.main.repo :as rp]
@ -34,9 +34,8 @@
[cuerdas.core :as str]
[potok.core :as ptk]))
(defonce default-rect {:x 0 :y 0 :width 1 :height 1 :rx 0 :ry 0})
(defonce default-circle {:r 0 :cx 0 :cy 0})
(defonce default-image {:x 0 :y 0 :width 1 :height 1 :rx 0 :ry 0})
(def default-rect
{:x 0 :y 0 :width 1 :height 1})
(defn- assert-valid-num [attr num]
(when-not (and (d/num? num)
@ -73,9 +72,9 @@
clean-value))
(defn- svg-dimensions [data]
(let [width (get-in data [:attrs :width] 100)
height (get-in data [:attrs :height] 100)
viewbox (get-in data [:attrs :viewBox] (str "0 0 " width " " height))
(let [width (dm/get-in data [:attrs :width] 100)
height (dm/get-in data [:attrs :height] 100)
viewbox (dm/get-in data [:attrs :viewBox] (str "0 0 " width " " height))
[x y width height] (->> (str/split viewbox #"\s+")
(map d/parse-double))
width (if (= width 0) 1 width)
@ -94,9 +93,9 @@
:else (str tag))))
(defn setup-fill [shape]
(let [color-attr (str/trim (get-in shape [:svg-attrs :fill]))
(let [color-attr (str/trim (dm/get-in shape [:svg-attrs :fill]))
color-attr (if (= color-attr "currentColor") clr/black color-attr)
color-style (str/trim (get-in shape [:svg-attrs :style :fill]))
color-style (str/trim (dm/get-in shape [:svg-attrs :style :fill]))
color-style (if (= color-style "currentColor") clr/black color-style)]
(cond-> shape
;; Color present as attribute
@ -111,26 +110,26 @@
(update :svg-attrs dissoc :fill)
(assoc-in [:fills 0 :fill-color] (uc/parse-color color-style)))
(get-in shape [:svg-attrs :fill-opacity])
(dm/get-in shape [:svg-attrs :fill-opacity])
(-> (update :svg-attrs dissoc :fill-opacity)
(update-in [:svg-attrs :style] dissoc :fill-opacity)
(assoc-in [:fills 0 :fill-opacity] (-> (get-in shape [:svg-attrs :fill-opacity])
(assoc-in [:fills 0 :fill-opacity] (-> (dm/get-in shape [:svg-attrs :fill-opacity])
(d/parse-double 1))))
(get-in shape [:svg-attrs :style :fill-opacity])
(dm/get-in shape [:svg-attrs :style :fill-opacity])
(-> (update-in [:svg-attrs :style] dissoc :fill-opacity)
(update :svg-attrs dissoc :fill-opacity)
(assoc-in [:fills 0 :fill-opacity] (-> (get-in shape [:svg-attrs :style :fill-opacity])
(assoc-in [:fills 0 :fill-opacity] (-> (dm/get-in shape [:svg-attrs :style :fill-opacity])
(d/parse-double 1)))))))
(defn setup-stroke [shape]
(let [stroke-linecap (-> (or (get-in shape [:svg-attrs :stroke-linecap])
(get-in shape [:svg-attrs :style :stroke-linecap]))
(let [stroke-linecap (-> (or (dm/get-in shape [:svg-attrs :stroke-linecap])
(dm/get-in shape [:svg-attrs :style :stroke-linecap]))
((d/nilf str/trim))
((d/nilf keyword)))
color-attr (str/trim (get-in shape [:svg-attrs :stroke]))
color-attr (str/trim (dm/get-in shape [:svg-attrs :stroke]))
color-attr (if (= color-attr "currentColor") clr/black color-attr)
color-style (str/trim (get-in shape [:svg-attrs :style :stroke]))
color-style (str/trim (dm/get-in shape [:svg-attrs :style :stroke]))
color-style (if (= color-style "currentColor") clr/black color-style)
shape
@ -145,24 +144,24 @@
(-> (update-in [:svg-attrs :style] dissoc :stroke)
(assoc-in [:strokes 0 :stroke-color] (uc/parse-color color-style)))
(get-in shape [:svg-attrs :stroke-opacity])
(dm/get-in shape [:svg-attrs :stroke-opacity])
(-> (update :svg-attrs dissoc :stroke-opacity)
(assoc-in [:strokes 0 :stroke-opacity] (-> (get-in shape [:svg-attrs :stroke-opacity])
(assoc-in [:strokes 0 :stroke-opacity] (-> (dm/get-in shape [:svg-attrs :stroke-opacity])
(d/parse-double 1))))
(get-in shape [:svg-attrs :style :stroke-opacity])
(dm/get-in shape [:svg-attrs :style :stroke-opacity])
(-> (update-in [:svg-attrs :style] dissoc :stroke-opacity)
(assoc-in [:strokes 0 :stroke-opacity] (-> (get-in shape [:svg-attrs :style :stroke-opacity])
(assoc-in [:strokes 0 :stroke-opacity] (-> (dm/get-in shape [:svg-attrs :style :stroke-opacity])
(d/parse-double 1))))
(get-in shape [:svg-attrs :stroke-width])
(dm/get-in shape [:svg-attrs :stroke-width])
(-> (update :svg-attrs dissoc :stroke-width)
(assoc-in [:strokes 0 :stroke-width] (-> (get-in shape [:svg-attrs :stroke-width])
(assoc-in [:strokes 0 :stroke-width] (-> (dm/get-in shape [:svg-attrs :stroke-width])
(d/parse-double))))
(get-in shape [:svg-attrs :style :stroke-width])
(dm/get-in shape [:svg-attrs :style :stroke-width])
(-> (update-in [:svg-attrs :style] dissoc :stroke-width)
(assoc-in [:strokes 0 :stroke-width] (-> (get-in shape [:svg-attrs :style :stroke-width])
(assoc-in [:strokes 0 :stroke-width] (-> (dm/get-in shape [:svg-attrs :style :stroke-width])
(d/parse-double))))
(and stroke-linecap (= (:type shape) :path))
@ -172,34 +171,33 @@
:stroke-cap-end stroke-linecap))))]
(cond-> shape
(d/any-key? (get-in shape [:strokes 0]) :stroke-color :stroke-opacity :stroke-width :stroke-cap-start :stroke-cap-end)
(d/any-key? (dm/get-in shape [:strokes 0]) :stroke-color :stroke-opacity :stroke-width :stroke-cap-start :stroke-cap-end)
(assoc-in [:strokes 0 :stroke-style] :svg))))
(defn setup-opacity [shape]
(cond-> shape
(get-in shape [:svg-attrs :opacity])
(dm/get-in shape [:svg-attrs :opacity])
(-> (update :svg-attrs dissoc :opacity)
(assoc :opacity (-> (get-in shape [:svg-attrs :opacity])
(assoc :opacity (-> (dm/get-in shape [:svg-attrs :opacity])
(d/parse-double 1))))
(get-in shape [:svg-attrs :style :opacity])
(dm/get-in shape [:svg-attrs :style :opacity])
(-> (update-in [:svg-attrs :style] dissoc :opacity)
(assoc :opacity (-> (get-in shape [:svg-attrs :style :opacity])
(assoc :opacity (-> (dm/get-in shape [:svg-attrs :style :opacity])
(d/parse-double 1))))
(get-in shape [:svg-attrs :mix-blend-mode])
(dm/get-in shape [:svg-attrs :mix-blend-mode])
(-> (update :svg-attrs dissoc :mix-blend-mode)
(assoc :blend-mode (-> (get-in shape [:svg-attrs :mix-blend-mode]) assert-valid-blend-mode)))
(assoc :blend-mode (-> (dm/get-in shape [:svg-attrs :mix-blend-mode]) assert-valid-blend-mode)))
(get-in shape [:svg-attrs :style :mix-blend-mode])
(dm/get-in shape [:svg-attrs :style :mix-blend-mode])
(-> (update-in [:svg-attrs :style] dissoc :mix-blend-mode)
(assoc :blend-mode (-> (get-in shape [:svg-attrs :style :mix-blend-mode]) assert-valid-blend-mode)))))
(assoc :blend-mode (-> (dm/get-in shape [:svg-attrs :style :mix-blend-mode]) assert-valid-blend-mode)))))
(defn create-raw-svg [name frame-id svg-data {:keys [attrs] :as data}]
(let [{:keys [x y width height offset-x offset-y]} svg-data]
(-> {:id (uuid/next)
:type :svg-raw
(defn create-raw-svg
[name frame-id {:keys [x y width height offset-x offset-y]} {:keys [attrs] :as data}]
(cts/setup-shape
{:type :svg-raw
:name name
:frame-id frame-id
:width width
@ -207,47 +205,51 @@
:x x
:y y
:content (cond-> data
(map? data) (update :attrs usvg/clean-attrs))}
(assoc :svg-attrs attrs)
(assoc :svg-viewbox (-> (select-keys svg-data [:width :height])
(assoc :x offset-x :y offset-y)))
(cts/setup-rect-selrect))))
(map? data) (update :attrs usvg/clean-attrs))
:svg-attrs attrs
:svg-viewbox {:width width
:height height
:x offset-x
:y offset-y}}))
(defn create-svg-root [frame-id parent-id svg-data]
(let [{:keys [name x y width height offset-x offset-y]} svg-data]
(-> {:id (uuid/next)
:type :group
(defn create-svg-root
[frame-id parent-id {:keys [name x y width height offset-x offset-y attrs]}]
(cts/setup-shape
{:type :group
:name name
:frame-id frame-id
:parent-id parent-id
:width width
:height height
:x (+ x offset-x)
:y (+ y offset-y)}
(cts/setup-rect-selrect)
(assoc :svg-attrs (-> (:attrs svg-data)
(dissoc :viewBox :xmlns)
(d/without-keys usvg/inheritable-props))))))
:y (+ y offset-y)
:svg-attrs (-> attrs
(dissoc :viewBox)
(dissoc :xmlns)
(d/without-keys usvg/inheritable-props))}))
(defn create-group [name frame-id svg-data {:keys [attrs]}]
(let [svg-transform (usvg/parse-transform (:transform attrs))
{:keys [x y width height offset-x offset-y]} svg-data]
(-> {:id (uuid/next)
:type :group
(defn create-group
[name frame-id {:keys [x y width height offset-x offset-y] :as svg-data} {:keys [attrs]}]
(let [svg-transform (usvg/parse-transform (:transform attrs))]
(cts/setup-shape
{:type :group
:name name
:frame-id frame-id
:x (+ x offset-x)
:y (+ y offset-y)
:width width
:height height}
(assoc :svg-transform svg-transform)
(assoc :svg-attrs (d/without-keys attrs usvg/inheritable-props))
(assoc :svg-viewbox (-> (select-keys svg-data [:width :height])
(assoc :x offset-x :y offset-y)))
(cts/setup-rect-selrect))))
:height height
:svg-transform svg-transform
:svg-attrs (d/without-keys attrs usvg/inheritable-props)
:svg-viewbox {:width width
:height height
:x offset-x
:y offset-y}})))
(defn create-path-shape [name frame-id svg-data {:keys [attrs] :as data}]
(when (and (contains? attrs :d) (seq (:d attrs)))
(let [svg-transform (usvg/parse-transform (:transform attrs))
path-content (upp/parse-path (:d attrs))
content (cond-> path-content
@ -255,23 +257,25 @@
(gsh/transform-content svg-transform))
selrect (gsh/content->selrect content)
points (gsh/rect->points selrect)
points (grc/rect->points selrect)
origin (gpt/negate (gpt/point svg-data))]
(-> {:id (uuid/next)
:type :path
(-> (cts/setup-shape
{:type :path
:name name
:frame-id frame-id
:content content
:selrect selrect
:points points}
(assoc :svg-viewbox (select-keys selrect [:x :y :width :height]))
(assoc :svg-attrs (dissoc attrs :d :transform))
(assoc :svg-transform svg-transform)
:points points
:svg-viewbox (select-keys selrect [:x :y :width :height])
:svg-attrs (dissoc attrs :d :transform)
:svg-transform svg-transform})
(gsh/translate-to-frame origin)))))
(defn calculate-rect-metadata [rect-data transform]
(let [points (-> (gsh/rect->points rect-data)
(let [points (-> (grc/make-rect rect-data)
(grc/rect->points)
(gsh/transform-points transform))
[selrect transform transform-inverse] (gsh/calculate-geometry points)]
@ -285,112 +289,103 @@
:transform transform
:transform-inverse transform-inverse}))
(defn- parse-rect-attrs
[{:keys [x y width height]}]
{:x (d/parse-double x 0)
:y (d/parse-double y 0)
:width (d/parse-double width 1)
:height (d/parse-double height 1)})
(defn create-rect-shape [name frame-id svg-data {:keys [attrs] :as data}]
(let [svg-transform (usvg/parse-transform (:transform attrs))
transform (->> svg-transform
(let [transform (->> (usvg/parse-transform (:transform attrs))
(gmt/transform-in (gpt/point svg-data)))
rect (->> (select-keys attrs [:x :y :width :height])
(d/mapm #(d/parse-double %2)))
origin (gpt/negate (gpt/point svg-data))
rect-data (-> (merge default-rect rect)
rect-data (-> (parse-rect-attrs attrs)
(update :x - (:x origin))
(update :y - (:y origin)))
(update :y - (:y origin)))]
metadata (calculate-rect-metadata rect-data transform)]
(-> {:id (uuid/next)
:type :rect
:name name
:frame-id frame-id}
(cond->
(contains? attrs :rx) (assoc :rx (d/parse-double (:rx attrs 0)))
(contains? attrs :ry) (assoc :ry (d/parse-double (:ry attrs 0))))
(cts/setup-shape
(-> (calculate-rect-metadata rect-data transform)
(assoc :type :rect)
(assoc :name name)
(assoc :frame-id frame-id)
(assoc :svg-viewbox (select-keys rect-data [:x :y :width :height]))
(assoc :svg-attrs (dissoc attrs :x :y :width :height :rx :ry :transform))
(cond-> (contains? attrs :rx)
(assoc :rx (d/parse-double (:rx attrs) 0)))
(cond-> (contains? attrs :ry)
(assoc :ry (d/parse-double (:ry attrs) 0)))))))
(merge metadata)
(assoc :svg-viewbox (select-keys rect [:x :y :width :height]))
(assoc :svg-attrs (dissoc attrs :x :y :width :height :rx :ry :transform)))))
(defn- parse-circle-attrs
[attrs]
(into [] (comp (map (d/getf attrs))
(map d/parse-double))
[:cx :cy :r :rx :ry]))
(defn create-circle-shape [name frame-id svg-data {:keys [attrs] :as data}]
(let [svg-transform (usvg/parse-transform (:transform attrs))
transform (->> svg-transform
(let [[cx cy r rx ry]
(parse-circle-attrs attrs)
transform (->> (usvg/parse-transform (:transform attrs))
(gmt/transform-in (gpt/point svg-data)))
circle (->> (select-keys attrs [:r :ry :rx :cx :cy])
(d/mapm #(d/parse-double %2)))
{:keys [cx cy]} circle
rx (or (:r circle) (:rx circle))
ry (or (:r circle) (:ry circle))
rect {:x (- cx rx)
:y (- cy ry)
:width (* 2 rx)
:height (* 2 ry)}
rx (or r rx)
ry (or r ry)
origin (gpt/negate (gpt/point svg-data))
rect-data (-> rect
(update :x - (:x origin))
(update :y - (:y origin)))
rect-data {:x (- cx rx (:x origin))
:y (- cy ry (:y origin))
:width (* 2 rx)
:height (* 2 ry)}]
metadata (calculate-rect-metadata rect-data transform)]
(-> {:id (uuid/next)
:type :circle
:name name
:frame-id frame-id}
(merge metadata)
(assoc :svg-viewbox (select-keys rect [:x :y :width :height]))
(assoc :svg-attrs (dissoc attrs :cx :cy :r :rx :ry :transform)))))
(cts/setup-shape
(-> (calculate-rect-metadata rect-data transform)
(assoc :type :circle)
(assoc :name name)
(assoc :frame-id frame-id)
(assoc :svg-viewbox rect-data)
(assoc :svg-attrs (dissoc attrs :cx :cy :r :rx :ry :transform))))))
(defn create-image-shape [name frame-id svg-data {:keys [attrs] :as data}]
(let [svg-transform (usvg/parse-transform (:transform attrs))
transform (->> svg-transform
(let [transform (->> (usvg/parse-transform (:transform attrs))
(gmt/transform-in (gpt/point svg-data)))
image-url (or (:href attrs) (:xlink:href attrs))
image-data (get-in svg-data [:image-data image-url])
image-data (dm/get-in svg-data [:image-data image-url])
rect (->> (select-keys attrs [:x :y :width :height])
(d/mapm #(d/parse-double %2)))
origin (gpt/negate (gpt/point svg-data))
rect-data (-> (merge default-image rect)
(update :x - (:x origin))
(update :y - (:y origin)))
rect-metadata (calculate-rect-metadata rect-data transform)]
(when (some? image-data)
(-> {:id (uuid/next)
:type :image
:name name
:frame-id frame-id
:metadata {:width (:width image-data)
metadata {:width (:width image-data)
:height (:height image-data)
:mtype (:mtype image-data)
:id (:id image-data)}}
:id (:id image-data)}
(merge rect-metadata)
(assoc :svg-viewbox (select-keys rect [:x :y :width :height]))
(assoc :svg-attrs (dissoc attrs :x :y :width :height :href :xlink:href))))))
origin (gpt/negate (gpt/point svg-data))
rect-data (-> (parse-rect-attrs attrs)
(update :x - (:x origin))
(update :y - (:y origin)))]
(defn parse-svg-element [frame-id svg-data element-data unames]
(let [{:keys [tag attrs hidden]} element-data
attrs (usvg/format-styles attrs)
(when (some? image-data)
(cts/setup-shape
(-> (calculate-rect-metadata rect-data transform)
(assoc :type :image)
(assoc :name name)
(assoc :frame-id frame-id)
(assoc :metadata metadata)
(assoc :svg-viewbox (select-keys rect-data [:x :y :width :height]))
(assoc :svg-attrs (dissoc attrs :x :y :width :height :href :xlink:href)))))))
(defn parse-svg-element [frame-id svg-data {:keys [tag attrs hidden] :as element-data} unames]
(let [attrs (usvg/format-styles attrs)
element-data (cond-> element-data (map? element-data) (assoc :attrs attrs))
name (or (:id attrs) (tag->name tag))
att-refs (usvg/find-attr-references attrs)
references (usvg/find-def-references (:defs svg-data) att-refs)
href-id (-> (or (:href attrs) (:xlink:href attrs) "")
(subs 1))
href-id (-> (or (:href attrs) (:xlink:href attrs) "") (subs 1))
defs (:defs svg-data)
use-tag? (and (= :use tag) (contains? defs href-id))]
@ -423,37 +418,32 @@
#_other (create-raw-svg name frame-id svg-data element-data)))]
(when (some? shape)
(let [shape (-> shape
(assoc :fills [])
(assoc :strokes [])
(assoc :svg-defs (select-keys (:defs svg-data) references))
(setup-fill)
(setup-stroke)
(setup-opacity))
(setup-opacity))]
shape (cond-> shape
[(cond-> shape
hidden (assoc :hidden true))
children (cond->> (:content element-data)
(cond->> (:content element-data)
(contains? usvg/parent-tags tag)
(mapv #(usvg/inherit-attributes attrs %)))]
[shape children]))))))
(mapv #(usvg/inherit-attributes attrs %)))]))))))
(defn create-svg-children
[objects selected frame-id parent-id svg-data [unames children] [_index svg-element]]
(let [[new-shape new-children] (parse-svg-element frame-id svg-data svg-element unames)]
(if (some? new-shape)
(let [shape-id (:id new-shape)
new-shape' (-> (dwsh/make-new-shape new-shape objects selected)
(let [[shape new-children] (parse-svg-element frame-id svg-data svg-element unames)]
(if (some? shape)
(let [shape-id (:id shape)
shape (-> shape
(assoc :frame-id frame-id)
(assoc :parent-id parent-id))
children (conj children shape)
unames (conj unames (:name shape))]
children (conj children new-shape')
unames (conj unames (:name new-shape'))
reducer-fn (partial create-svg-children objects selected frame-id shape-id svg-data)]
(reduce reducer-fn [unames children] (d/enumerate new-children)))
(reduce (partial create-svg-children objects selected frame-id shape-id svg-data)
[unames children]
(d/enumerate new-children)))
[unames children])))
@ -502,48 +492,50 @@
(rx/map #(vector (:url uri-data) %)))))
(rx/reduce (fn [acc [url image]] (assoc acc url image)) {})))
(defn create-svg-shapes
[svg-data {:keys [x y]} objects frame-id parent-id selected center?]
(let [[vb-x vb-y vb-width vb-height] (svg-dimensions svg-data)
x (mth/round
(if center?
(- x vb-x (/ vb-width 2))
x))
y (mth/round
(if center?
(- y vb-y (/ vb-height 2))
y))
unames (cp/retrieve-used-names objects)
unames (cfh/get-used-names objects)
svg-name (str/replace (:name svg-data) ".svg" "")
svg-data (-> svg-data
(assoc :x x
:y y
:offset-x vb-x
:offset-y vb-y
:width vb-width
:height vb-height
:name svg-name))
(assoc :x (mth/round
(if center?
(- x vb-x (/ vb-width 2))
x)))
(assoc :y (mth/round
(if center?
(- y vb-y (/ vb-height 2))
y)))
(assoc :offset-x vb-x)
(assoc :offset-y vb-y)
(assoc :width vb-width)
(assoc :height vb-height)
(assoc :name svg-name))
[def-nodes svg-data] (-> svg-data
[def-nodes svg-data]
(-> svg-data
(usvg/fix-default-values)
(usvg/fix-percents)
(usvg/extract-defs))
svg-data (assoc svg-data :defs def-nodes)
root-shape (create-svg-root frame-id parent-id svg-data)
root-id (:id root-shape)
;; In penpot groups have the size of their children. To respect the imported
;; svg size and empty space let's create a transparent shape as background to respect the imported size
base-background-shape {:tag :rect
:attrs {:x (str vb-x)
:y (str vb-y)
:width (str vb-width)
:height (str vb-height)
;; In penpot groups have the size of their children. To
;; respect the imported svg size and empty space let's create
;; a transparent shape as background to respect the imported
;; size
background
{:tag :rect
:attrs {:x (dm/str vb-x)
:y (dm/str vb-y)
:width (dm/str vb-width)
:height (dm/str vb-height)
:fill "none"
:id "base-background"}
:hidden true
@ -551,24 +543,23 @@
svg-data (-> svg-data
(assoc :defs def-nodes)
(assoc :content (into [base-background-shape] (:content svg-data))))
(assoc :content (into [background] (:content svg-data))))
;; Create the root shape
new-shape (dwsh/make-new-shape root-shape objects selected)
root-attrs (-> (:attrs svg-data)
(usvg/format-styles))
[_ new-children]
[_ children]
(reduce (partial create-svg-children objects selected frame-id root-id svg-data)
[unames []]
(d/enumerate (->> (:content svg-data)
(mapv #(usvg/inherit-attributes root-attrs %)))))]
[new-shape new-children]))
[root-shape children]))
(defn add-svg-shapes
[svg-data position]
;; (app.common.pprint/pprint svg-data {:length 100 :level 100})
(ptk/reify ::add-svg-shapes
ptk/WatchEvent
(watch [it state _]
@ -577,13 +568,13 @@
objects (wsh/lookup-page-objects state page-id)
frame-id (ctst/top-nested-frame objects position)
selected (wsh/lookup-selected state)
page-objects (wsh/lookup-page-objects state)
base (cph/get-base-shape page-objects selected)
selected-frame? (and (= 1 (count selected))
(= :frame (get-in objects [(first selected) :type])))
base (cph/get-base-shape objects selected)
parent-id
(if (or selected-frame? (empty? selected))
selected-id (first selected)
selected-frame? (and (= 1 (count selected))
(= :frame (dm/get-in objects [selected-id :type])))
parent-id (if (or selected-frame? (empty? selected))
frame-id
(:parent-id base))
@ -594,18 +585,17 @@
(pcb/with-objects objects)
(pcb/add-object new-shape))
changes (reduce (fn [changes new-child]
(pcb/add-object changes new-child))
changes
(reduce (fn [changes new-child]
(-> changes (pcb/add-object new-child)))
changes new-children)
new-children)
changes (pcb/resize-parents changes
(->> changes
:redo-changes
(->> (:redo-changes changes)
(filter #(= :add-obj (:type %)))
(map :id)
reverse
vec))
(reverse)
(vec)))
undo-id (js/Symbol)]
(rx/of (dwu/start-undo-transaction undo-id)
@ -614,7 +604,7 @@
(ptk/data-event :layout/update [(:id new-shape)])
(dwu/commit-undo-transaction undo-id)))
(catch :default e
(.error js/console "Error SVG" e)
(catch :default cause
(js/console.log (.-stack cause))
(rx/throw {:type :svg-parser
:data e}))))))
:data cause}))))))

18
frontend/src/app/main/data/workspace/transforms.cljs
View file

@ -11,6 +11,7 @@
[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.geom.shapes :as gsh]
[app.common.geom.shapes.flex-layout :as gslf]
[app.common.geom.shapes.grid-layout :as gslg]
@ -109,7 +110,7 @@
(let [{:keys [width height]} (:selrect shape)
{:keys [rotation]} shape
shape-center (gsh/center-shape shape)
shape-center (gsh/shape->center shape)
shape-transform (:transform shape)
shape-transform-inverse (:transform-inverse shape)
@ -304,8 +305,8 @@
ptk/WatchEvent
(watch [_ _ stream]
(let [stoper (rx/filter ms/mouse-up? stream)
group (gsh/selection-rect shapes)
group-center (gsh/center-selrect group)
group (gsh/shapes->rect shapes)
group-center (grc/rect->center group)
initial-angle (gpt/angle @ms/mouse-position group-center)
calculate-angle
@ -717,7 +718,8 @@
objects (wsh/lookup-page-objects state page-id)
shape (get objects id)
bbox (-> shape :points gsh/points->selrect)
;; FIXME: performance rect
bbox (-> shape :points grc/points->rect)
cpos (gpt/point (:x bbox) (:y bbox))
pos (gpt/point (or (:x position) (:x bbox))
@ -840,8 +842,8 @@
(let [objects (wsh/lookup-page-objects state)
selected (wsh/lookup-selected state {:omit-blocked? true})
shapes (map #(get objects %) selected)
selrect (gsh/selection-rect shapes)
center (gsh/center-selrect selrect)
selrect (gsh/shapes->rect shapes)
center (grc/rect->center selrect)
modifiers (dwm/create-modif-tree selected (ctm/resize-modifiers (gpt/point -1.0 1.0) center))]
(rx/of (dwm/apply-modifiers {:modifiers modifiers}))))))
@ -852,7 +854,7 @@
(let [objects (wsh/lookup-page-objects state)
selected (wsh/lookup-selected state {:omit-blocked? true})
shapes (map #(get objects %) selected)
selrect (gsh/selection-rect shapes)
center (gsh/center-selrect selrect)
selrect (gsh/shapes->rect shapes)
center (grc/rect->center selrect)
modifiers (dwm/create-modif-tree selected (ctm/resize-modifiers (gpt/point 1.0 -1.0) center))]
(rx/of (dwm/apply-modifiers {:modifiers modifiers}))))))

26
frontend/src/app/main/data/workspace/viewport.cljs
View file

@ -10,6 +10,7 @@
[app.common.data.macros :as dm]
[app.common.geom.align :as gal]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as gpr]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages.helpers :as cph]
@ -21,6 +22,10 @@
(defn initialize-viewport
[{:keys [width height] :as size}]
(dm/assert!
"expected `size` to be a rect instance"
(gpr/rect? size))
(letfn [(update* [{:keys [vport] :as local}]
(let [wprop (/ (:width vport) width)
hprop (/ (:height vport) height)]
@ -29,13 +34,14 @@
(update :vbox (fn [vbox]
(-> vbox
(update :width #(/ % wprop))
(update :height #(/ % hprop))))))))
(update :height #(/ % hprop))
(gpr/update-rect :size)))))))
(initialize [state local]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
shapes (cph/get-immediate-children objects)
srect (gsh/selection-rect shapes)
srect (gsh/shapes->rect shapes)
local (assoc local :vport size :zoom 1 :zoom-inverse 1)]
(cond
(or (not (d/num? (:width srect)))
@ -49,12 +55,20 @@
(-> local
(assoc :zoom zoom)
(assoc :zoom-inverse (/ 1 zoom))
(update :vbox merge srect)))
(update :vbox (fn [vbox]
(-> (merge vbox srect)
(gpr/make-rect))))))
:else
(assoc local :vbox (assoc size
:x (+ (:x srect) (/ (- (:width srect) width) 2))
:y (+ (:y srect) (/ (- (:height srect) height) 2)))))))
(let [vx (+ (:x srect)
(/ (- (:width srect) width) 2))
vy (+ (:y srect)
(/ (- (:height srect) height) 2))
vbox (-> size
(assoc :x vx)
(assoc :y vy)
(gpr/update-rect :position))]
(assoc local :vbox vbox)))))
(setup [state local]
(if (and (:vbox local) (:vport local))

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

@ -3,11 +3,13 @@
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.main.data.workspace.zoom
(:require
[app.common.geom.align :as gal]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.pages.helpers :as cph]
[app.main.data.workspace.state-helpers :as wsh]
@ -19,7 +21,7 @@
[{:keys [vbox] :as local} center zoom]
(let [new-zoom (if (fn? zoom) (zoom (:zoom local)) zoom)
old-zoom (:zoom local)
center (if center center (gsh/center-rect vbox))
center (if center center (grc/rect->center vbox))
scale (/ old-zoom new-zoom)
mtx (gmt/scale-matrix (gpt/point scale) center)
vbox' (gsh/transform-rect vbox mtx)]
@ -74,7 +76,7 @@
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
shapes (cph/get-immediate-children objects)
srect (gsh/selection-rect shapes)]
srect (gsh/shapes->rect shapes)]
(if (empty? shapes)
state
(update state :workspace-local
@ -97,7 +99,7 @@
objects (wsh/lookup-page-objects state page-id)
srect (->> selected
(map #(get objects %))
(gsh/selection-rect))]
(gsh/shapes->rect))]
(update state :workspace-local
(fn [{:keys [vport] :as local}]
(let [srect (gal/adjust-to-viewport vport srect {:padding 40})

11
frontend/src/app/main/render.cljs
View file

@ -16,6 +16,7 @@
[app.common.colors :as clr]
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.bounds :as gsb]
[app.common.math :as mth]
@ -62,15 +63,15 @@
(defn- calculate-dimensions
[objects]
(let [bounds
(->> (ctst/get-root-objects objects)
(let [bounds (->> (ctst/get-root-objects objects)
(map (partial gsb/get-object-bounds objects))
(gsh/join-rects))]
(grc/join-rects))]
(-> bounds
(update :x mth/finite 0)
(update :y mth/finite 0)
(update :width mth/finite 100000)
(update :height mth/finite 100000))))
(update :height mth/finite 100000)
(grc/update-rect :position))))
(declare shape-wrapper-factory)
@ -164,7 +165,7 @@
(defn adapt-root-frame
[objects object]
(let [shapes (cph/get-immediate-children objects)
srect (gsh/selection-rect shapes)
srect (gsh/shapes->rect shapes)
object (merge object (select-keys srect [:x :y :width :height]))]
(assoc object :fill-color "#f0f0f0")))

20
frontend/src/app/main/snap.cljs
View file

@ -7,15 +7,17 @@
(ns app.main.snap
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.geom.snap :as sp]
[app.common.math :as mth]
[app.common.pages :as cp]
[app.common.pages.focus :as cpf]
[app.common.pages.helpers :as cph]
[app.common.uuid :refer [zero]]
[app.main.refs :as refs]
[app.main.worker :as uw]
[app.util.geom.snap-points :as sp]
[app.util.range-tree :as rt]
[beicon.core :as rx]
[clojure.set :as set]))
@ -53,7 +55,7 @@
(or (contains? filter-shapes id)
(not (contains? layout :dynamic-alignment))
(and (d/not-empty? focus)
(not (cp/is-in-focus? objects focus id)))))))
(not (cpf/is-in-focus? objects focus id)))))))
(defn- calculate-distance [query-result point coord]
(->> query-result
@ -226,15 +228,15 @@
[page-id shapes objects zoom movev]
(let [frame-id (snap-frame-id shapes)
frame (get objects frame-id)
selrect (->> shapes (map #(gsh/move % movev)) gsh/selection-rect)]
selrect (->> shapes (map #(gsh/move % movev)) gsh/shapes->rect)]
(->> (rx/of (vector frame selrect))
(rx/merge-map
(fn [[frame selrect]]
(let [vbox (gsh/rect->selrect @refs/vbox)
(let [vbox (deref refs/vbox)
frame-id (->> shapes first :frame-id)
selected (into #{} (map :id shapes))
areas (->> (gsh/selrect->areas
(or (gsh/clip-selrect (:selrect frame) vbox)
areas (->> (gsh/get-areas
(or (grc/clip-rect (dm/get-prop frame :selrect) vbox)
vbox)
selrect)
(d/mapm #(select-shapes-area page-id frame-id selected objects %2)))
@ -272,8 +274,8 @@
snap-points
(->> shapes
(gsh/selection-rect)
(sp/selrect-snap-points)
(gsh/shapes->rect)
(sp/rect->snap-points)
;; Move the points in the translation vector
(map #(gpt/add % movev)))]

4
frontend/src/app/main/ui/hooks.cljs
View file

@ -7,7 +7,7 @@
(ns app.main.ui.hooks
"A collection of general purpose react hooks."
(:require
[app.common.pages :as cp]
[app.common.pages.focus :as cpf]
[app.main.broadcast :as mbc]
[app.main.data.shortcuts :as dsc]
[app.main.refs :as refs]
@ -256,7 +256,7 @@
([objects focus]
(let [objects (mf/use-memo
(mf/deps focus objects)
#(cp/focus-objects objects focus))]
#(cpf/focus-objects objects focus))]
objects)))
(defn use-debounce

7
frontend/src/app/main/ui/measurements.cljs
View file

@ -9,6 +9,7 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.flex-layout :as gsl]
[app.common.geom.shapes.points :as gpo]
@ -248,8 +249,8 @@
(mf/defc measurement
[{:keys [bounds frame selected-shapes hover-shape zoom]}]
(let [selected-ids (into #{} (map :id) selected-shapes)
selected-selrect (gsh/selection-rect selected-shapes)
hover-selrect (-> hover-shape :points gsh/points->selrect)
selected-selrect (gsh/shapes->rect selected-shapes)
hover-selrect (-> hover-shape :points grc/points->rect)
bounds-selrect (bound->selrect bounds)
hover-selected-shape? (not (contains? selected-ids (:id hover-shape)))]
@ -262,7 +263,7 @@
(if (or (not hover-shape) (not hover-selected-shape?))
(when (and frame (not= uuid/zero (:id frame)))
(let [frame-bb (-> (:points frame) (gsh/points->selrect))]
(let [frame-bb (-> (:points frame) (grc/points->rect))]
[:g.hover-shapes
[:& selection-rect {:type :hover :selrect frame-bb :zoom zoom}]
[:& distance-display {:from frame-bb

9
frontend/src/app/main/ui/shapes/custom_stroke.cljs
View file

@ -8,8 +8,10 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.bounds :as gsb]
[app.common.geom.shapes.text :as gst]
[app.common.pages.helpers :as cph]
[app.main.ui.context :as muc]
[app.main.ui.shapes.attrs :as attrs]
@ -50,15 +52,16 @@
selrect
(if (cph/text-shape? shape)
(gsh/position-data-selrect shape)
(gsh/points->selrect (:points shape)))
(gst/shape->rect shape)
(grc/points->rect (:points shape)))
bounding-box
(-> selrect
(update :x - (+ stroke-width margin))
(update :y - (+ stroke-width margin))
(update :width + (* 2 (+ stroke-width margin)))
(update :height + (* 2 (+ stroke-width margin))))]
(update :height + (* 2 (+ stroke-width margin)))
(grc/update-rect :position))]
[:mask {:id stroke-mask-id
:x (:x bounding-box)

2
frontend/src/app/main/ui/shapes/export.cljs
View file

@ -72,7 +72,7 @@
path? (= :path (:type shape))
mask? (and group? (:masked-group? shape))
bool? (= :bool (:type shape))
center (gsh/center-shape shape)]
center (gsh/shape->center shape)]
(-> props
(add! :name)
(add! :blocked)

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

@ -7,6 +7,7 @@
(ns app.main.ui.shapes.frame
(:require
[app.common.data.macros :as dm]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.pages.helpers :as cph]
[app.common.types.shape.layout :as ctl]
@ -94,7 +95,7 @@
[props]
(let [shape (unchecked-get props "shape")
bounds (or (unchecked-get props "bounds")
(gsh/points->selrect (:points shape)))
(grc/points->rect (:points shape)))
shape-id (:id shape)
thumb (:thumbnail shape)
@ -107,6 +108,8 @@
{:id (dm/str "thumbnail-" shape-id)
:href thumb
:decoding "async"
;; FIXME: ensure bounds is always a rect instance and
;; dm/get-prop for static attr access
:x (:x bounds)
:y (:y bounds)
:width (:width bounds)

2
frontend/src/app/main/ui/shapes/gradients.cljs
View file

@ -62,7 +62,7 @@
angle (+ (gpt/angle gradient-vec) 90)
bb-shape (gsh/selection-rect [shape])
bb-shape (gsh/shapes->rect [shape])
;; Paths don't have a transform in SVG because we transform the points
;; we need to compensate the difference between the original rectangle

2
frontend/src/app/main/ui/shapes/grid_layout_viewer.cljs
View file

@ -59,7 +59,7 @@
cell-origin (gpo/origin cell-bounds)
cell-width (gpo/width-points cell-bounds)
cell-height (gpo/height-points cell-bounds)
cell-center (gsh/center-points cell-bounds)
cell-center (gsh/points->center cell-bounds)
cell-origin (gpt/transform cell-origin (gmt/transform-in cell-center (:transform-inverse shape)))]
[:g.cell

4
frontend/src/app/main/ui/shapes/mask.cljs
View file

@ -8,7 +8,7 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.shapes :as gsh]
[app.common.geom.rect :as grc]
[app.main.ui.context :as muc]
[cuerdas.core :as str]
[rumext.v2 :as mf]))
@ -52,7 +52,7 @@
svg-text? (and (= :text (:type mask)) (some? (:position-data mask)))
mask-bb (:points mask)
mask-bb-rect (gsh/points->rect mask-bb)]
mask-bb-rect (grc/points->rect mask-bb)]
[:defs
[:filter {:id (filter-id render-id mask)}
[:feFlood {:flood-color "white"

3
frontend/src/app/main/ui/shapes/svg_defs.cljs
View file

@ -9,6 +9,7 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.bounds :as gsb]
[app.util.svg :as usvg]
@ -92,7 +93,7 @@
(defn svg-def-bounds [svg-def shape transform]
(let [{:keys [tag]} svg-def]
(if (or (= tag :mask) (contains? usvg/filter-tags tag))
(-> (gsh/make-rect (d/parse-double (get-in svg-def [:attrs :x]))
(-> (grc/make-rect (d/parse-double (get-in svg-def [:attrs :x]))
(d/parse-double (get-in svg-def [:attrs :y]))
(d/parse-double (get-in svg-def [:attrs :width]))
(d/parse-double (get-in svg-def [:attrs :height])))

3
frontend/src/app/main/ui/viewer/comments.cljs
View file

@ -8,6 +8,7 @@
(:require
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.main.data.comments :as dcm]
[app.main.data.events :as ev]
@ -103,7 +104,7 @@
threads-map (mf/deref refs/comment-threads)
frame-corner (mf/with-memo [frame]
(-> frame :points gsh/points->selrect gpt/point))
(-> frame :points grc/points->rect gpt/point))
modifier1 (mf/with-memo [frame-corner]
(-> (gmt/matrix)

Some files were not shown because too many files have changed in this diff Show more