3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-16 19:16:11 +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.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.files.features :as ffeat] [app.common.files.features :as ffeat]
[app.common.files.migrations :as pmg]
[app.common.fressian :as fres] [app.common.fressian :as fres]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.pages.migrations :as pmg]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cf] [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 :as d]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.files.migrations :as pmg]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.pages.migrations :as pmg]
[app.common.schema :as sm] [app.common.schema :as sm]
[app.common.schema.desc-js-like :as-alias smdj] [app.common.schema.desc-js-like :as-alias smdj]
[app.common.schema.generators :as sg] [app.common.schema.generators :as sg]

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

@ -173,7 +173,7 @@
bounds bounds
(when (:show-content frame) (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 frame
(cond-> frame (cond-> frame

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

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

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

@ -9,7 +9,7 @@
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.pages.migrations :as pmg] [app.common.files.migrations :as pmg]
[app.common.schema :as sm] [app.common.schema :as sm]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [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.files.features :as ffeat]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.pages :as cp] [app.common.pages :as cp]
[app.common.pages.migrations :as pmg] [app.common.files.migrations :as pmg]
[app.common.pprint :refer [pprint]] [app.common.pprint :refer [pprint]]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [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)." inactivity (the default threshold is 72h)."
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.files.migrations :as pmg]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.pages.migrations :as pmg]
[app.common.types.components-list :as ctkl] [app.common.types.components-list :as ctkl]
[app.common.types.file :as ctf] [app.common.types.file :as ctf]
[app.common.types.shape-tree :as ctt] [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 (ns backend-tests.rpc-file-test
(:require (:require
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.common.types.shape :as cts]
[app.db :as db] [app.db :as db]
[app.db.sql :as sql] [app.db.sql :as sql]
[app.http :as http] [app.http :as http]
@ -187,11 +188,12 @@
:parent-id uuid/zero :parent-id uuid/zero
:frame-id uuid/zero :frame-id uuid/zero
:components-v2 true :components-v2 true
:obj {:id shape-id :obj (cts/setup-shape
{:id shape-id
:name "image" :name "image"
:frame-id uuid/zero :frame-id uuid/zero
:parent-id uuid/zero :parent-id uuid/zero
:type :rect}}]) :type :rect})}])
;; Check the number of fragments ;; Check the number of fragments
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})] (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
@ -282,12 +284,13 @@
:parent-id uuid/zero :parent-id uuid/zero
:frame-id uuid/zero :frame-id uuid/zero
:components-v2 true :components-v2 true
:obj {:id shid :obj (cts/setup-shape
{:id shid
:name "image" :name "image"
:frame-id uuid/zero :frame-id uuid/zero
:parent-id uuid/zero :parent-id uuid/zero
:type :image :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 ;; Check that reference storage objects on filemediaobjects
;; are the same because of deduplication feature. ;; are the same because of deduplication feature.
@ -551,34 +554,38 @@
:id frame1-id :id frame1-id
:parent-id uuid/zero :parent-id uuid/zero
:frame-id uuid/zero :frame-id uuid/zero
:obj {:id frame1-id :obj (cts/setup-shape
{:id frame1-id
:use-for-thumbnail? true :use-for-thumbnail? true
:name "test-frame1" :name "test-frame1"
:type :frame}} :type :frame})}
{:type :add-obj {:type :add-obj
:page-id page-id :page-id page-id
:id shape1-id :id shape1-id
:parent-id frame1-id :parent-id frame1-id
:frame-id frame1-id :frame-id frame1-id
:obj {:id shape1-id :obj (cts/setup-shape
{:id shape1-id
:name "test-shape1" :name "test-shape1"
:type :rect}} :type :rect})}
{:type :add-obj {:type :add-obj
:page-id page-id :page-id page-id
:id frame2-id :id frame2-id
:parent-id uuid/zero :parent-id uuid/zero
:frame-id uuid/zero :frame-id uuid/zero
:obj {:id frame2-id :obj (cts/setup-shape
{:id frame2-id
:name "test-frame2" :name "test-frame2"
:type :frame}} :type :frame})}
{:type :add-obj {:type :add-obj
:page-id page-id :page-id page-id
:id shape2-id :id shape2-id
:parent-id frame2-id :parent-id frame2-id
:frame-id frame2-id :frame-id frame2-id
:obj {:id shape2-id :obj (cts/setup-shape
{:id shape2-id
:name "test-shape2" :name "test-shape2"
:type :rect}}]] :type :rect})}]]
;; Update the file ;; Update the file
(th/update-file* {:file-id (:id file) (th/update-file* {:file-id (:id file)
:profile-id (:id prof) :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 (ns backend-tests.rpc-file-thumbnails-test
(:require (:require
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.common.types.shape :as cts]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
@ -46,11 +47,12 @@
:parent-id uuid/zero :parent-id uuid/zero
:frame-id uuid/zero :frame-id uuid/zero
:components-v2 true :components-v2 true
:obj {:id shid :obj (cts/setup-shape
{:id shid
:name "Artboard" :name "Artboard"
:frame-id uuid/zero :frame-id uuid/zero
:parent-id uuid/zero :parent-id uuid/zero
:type :frame}}]) :type :frame})}])
data1 {::th/type :create-file-object-thumbnail data1 {::th/type :create-file-object-thumbnail
::rpc/profile-id (:id profile) ::rpc/profile-id (:id profile)

7
common/dev/user.clj
View file

@ -6,13 +6,18 @@
(ns user (ns user
(:require (: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.java.io :as io]
[clojure.pprint :refer [pprint print-table]] [clojure.pprint :refer [pprint print-table]]
[clojure.repl :refer :all] [clojure.repl :refer :all]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[clojure.spec.gen.alpha :as sgen] [clojure.spec.gen.alpha :as sgen]
[clojure.test :as test] [clojure.test :as test]
[clojure.test.check.generators :as gen] [clojure.test.check.generators :as tgen]
[clojure.tools.namespace.repl :as repl] [clojure.tools.namespace.repl :as repl]
[clojure.walk :refer [macroexpand-all]] [clojure.walk :refer [macroexpand-all]]
[criterium.core :as crit])) [criterium.core :as crit]))

8
common/package.json
View file

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

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

@ -6,7 +6,7 @@
(ns app.common.attrs (ns app.common.attrs
(:require (:require
[app.common.geom.shapes.transforms :as gtr] [app.common.geom.shapes :as gsh]
[app.common.math :as mth])) [app.common.math :as mth]))
(defn- get-attr (defn- get-attr
@ -24,7 +24,8 @@
value value
(if-let [points (:points obj)] (if-let [points (:points obj)]
(if (not= points :multiple) (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))) (if (= attr :ox) (:x rect) (:y rect)))
:multiple) :multiple)
(get obj attr ::unset))) (get obj attr ::unset)))

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

@ -9,7 +9,7 @@
data resources." data resources."
(:refer-clojure :exclude [read-string hash-map merge name update-vals (:refer-clojure :exclude [read-string hash-map merge name update-vals
parse-double group-by iteration concat mapcat parse-double group-by iteration concat mapcat
parse-uuid]) parse-uuid max min])
#?(:cljs #?(:cljs
(:require-macros [app.common.data])) (:require-macros [app.common.data]))
@ -590,23 +590,43 @@
([a] ([a]
(mth/finite? a)) (mth/finite? a))
([a b] ([a b]
(and (mth/finite? a) (and ^boolean (mth/finite? a)
(mth/finite? b))) ^boolean (mth/finite? b)))
([a b c] ([a b c]
(and (mth/finite? a) (and ^boolean (mth/finite? a)
(mth/finite? b) ^boolean (mth/finite? b)
(mth/finite? c))) ^boolean (mth/finite? c)))
([a b c d] ([a b c d]
(and (mth/finite? a) (and ^boolean (mth/finite? a)
(mth/finite? b) ^boolean (mth/finite? b)
(mth/finite? c) ^boolean (mth/finite? c)
(mth/finite? d))) ^boolean (mth/finite? d)))
([a b c d & others] ([a b c d & others]
(and (mth/finite? a) (and ^boolean (mth/finite? a)
(mth/finite? b) ^boolean (mth/finite? b)
(mth/finite? c) ^boolean (mth/finite? c)
(mth/finite? d) ^boolean (mth/finite? d)
(every? mth/finite? others)))) ^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 (defn check-num
"Function that checks if a number is nil or nan. Will return 0 when not "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 #_:clj-kondo/ignore
(ns app.common.data.macros (ns app.common.data.macros
"Data retrieval & manipulation specific 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])) #?(:cljs (:require-macros [app.common.data.macros]))
(:require (:require
#?(:clj [clojure.core :as c] #?(:clj [clojure.core :as c]
@ -154,7 +154,7 @@
(defmacro verify! (defmacro verify!
([expr] ([expr]
`(assert! nil ~expr)) `(verify! nil ~expr))
([hint expr] ([hint expr]
(let [hint (cond (let [hint (cond
(vector? hint) (vector? hint)

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

@ -32,11 +32,6 @@
[& params] [& params]
`(throw (error ~@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/ ;; http://clj-me.cgrand.net/2013/09/11/macros-closures-and-unexpected-object-retention/
;; Explains the use of ^:once metadata ;; 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 ;; Copyright (c) KALEIDOS INC
(ns app.common.file-builder (ns app.common.files.builder
"A version parsing helper."
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.pages.changes :as ch] [app.common.pages.changes :as ch]
[app.common.pprint :as pp] [app.common.pprint :as pp]
@ -25,9 +24,9 @@
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[cuerdas.core :as str])) [cuerdas.core :as str]))
(def root-frame uuid/zero) (def ^:private root-id uuid/zero)
(def conjv (fnil conj [])) (def ^:private conjv (fnil conj []))
(def conjs (fnil conj #{})) (def ^:private conjs (fnil conj #{}))
(defn- commit-change (defn- commit-change
([file change] ([file change]
@ -40,25 +39,23 @@
(let [component-id (:current-component-id file) (let [component-id (:current-component-id file)
change (cond-> change change (cond-> change
(and add-container? (some? component-id)) (and add-container? (some? component-id))
(cond-> (-> (assoc :component-id component-id)
:always (cond-> (some? (:current-frame-id file))
(assoc :component-id component-id) (assoc :frame-id (:current-frame-id file))))
(some? (:current-frame-id file))
(assoc :frame-id (:current-frame-id file)))
(and add-container? (nil? component-id)) (and add-container? (nil? component-id))
(assoc :page-id (:current-page-id file) (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? (when-not valid?
(pp/pprint change {:level 100}) (let [explain (sm/explain ::ch/change change)]
(sm/pretty-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 (cond-> file
valid? valid?
@ -66,7 +63,7 @@
(update :data ch/process-changes [change] false)) (update :data ch/process-changes [change] false))
(not valid?) (not valid?)
(update :errors conjv change)))))) (update :errors conjv change)))))
(defn- lookup-objects (defn- lookup-objects
([file] ([file]
@ -91,50 +88,6 @@
(commit-change file change {:add-container? true :fail-on-spec? fail-on-spec?}))) (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 (defn- generate-name
[type data] [type data]
(if (= type :svg-raw) (if (= type :svg-raw)
@ -203,10 +156,10 @@
(assoc :current-page-id page-id) (assoc :current-page-id page-id)
;; Current frame-id ;; Current frame-id
(assoc :current-frame-id root-frame) (assoc :current-frame-id root-id)
;; Current parent stack we'll be nesting ;; Current parent stack we'll be nesting
(assoc :parent-stack [root-frame]) (assoc :parent-stack [root-id])
;; Last object id added ;; Last object id added
(assoc :last-id nil)))) (assoc :last-id nil))))
@ -220,11 +173,8 @@
(clear-names))) (clear-names)))
(defn add-artboard [file data] (defn add-artboard [file data]
(let [obj (-> (cts/make-minimal-shape :frame) (let [obj (-> (cts/setup-shape (assoc data :type :frame))
(merge data) (check-name file :frame))]
(check-name file :frame)
(setup-selrect)
(d/without-nils))]
(-> file (-> file
(commit-shape obj) (commit-shape obj)
(assoc :current-frame-id (:id obj)) (assoc :current-frame-id (:id obj))
@ -237,19 +187,15 @@
parent (lookup-shape file parent-id) parent (lookup-shape file parent-id)
current-frame-id (or (:frame-id parent) current-frame-id (or (:frame-id parent)
(when (nil? (:current-component-id file)) (when (nil? (:current-component-id file))
root-frame))] root-id))]
(-> file (-> file
(assoc :current-frame-id current-frame-id) (assoc :current-frame-id current-frame-id)
(update :parent-stack pop)))) (update :parent-stack pop))))
(defn add-group [file data] (defn add-group [file data]
(let [frame-id (:current-frame-id file) (let [frame-id (:current-frame-id file)
selrect cts/empty-selrect obj (-> (cts/setup-shape (assoc data :type :group :frame-id frame-id))
name (:name data) (check-name file :group))]
obj (-> (cts/make-minimal-group frame-id selrect name)
(merge data)
(check-name file :group)
(d/without-nils))]
(-> file (-> file
(commit-shape obj) (commit-shape obj)
(assoc :last-id (:id obj)) (assoc :last-id (:id obj))
@ -309,15 +255,8 @@
(defn add-bool [file data] (defn add-bool [file data]
(let [frame-id (:current-frame-id file) (let [frame-id (:current-frame-id file)
name (:name data) obj (-> (cts/setup-shape (assoc data :type :bool :frame-id frame-id))
obj (-> {:id (uuid/next) (check-name file :bool))]
:type :bool
:name name
:shapes []
:frame-id frame-id}
(merge data)
(check-name file :bool)
(d/without-nils))]
(-> file (-> file
(commit-shape obj) (commit-shape obj)
(assoc :last-id (:id obj)) (assoc :last-id (:id obj))
@ -360,11 +299,8 @@
(update :parent-stack pop)))) (update :parent-stack pop))))
(defn create-shape [file type data] (defn create-shape [file type data]
(let [obj (-> (cts/make-minimal-shape type) (let [obj (-> (cts/setup-shape (assoc data :type type))
(merge data) (check-name file :type))]
(check-name file :type)
(setup-selrect)
(d/without-nils))]
(-> file (-> file
(commit-shape obj) (commit-shape obj)
(assoc :last-id (:id obj)) (assoc :last-id (:id obj))
@ -556,23 +492,33 @@
{:type :del-media {:type :del-media
:id id})))) :id id}))))
(defn start-component (defn start-component
([file data] (start-component file data :group)) ([file data] (start-component file data :group))
([file data root-type] ([file data root-type]
(let [selrect (or (gsh/make-selrect (:x data) (:y data) (:width data) (:height data)) ;; FIXME: data probably can be a shape instance, then we can use gsh/shape->rect
cts/empty-selrect) (let [selrect (or (grc/make-rect (:x data) (:y data) (:width data) (:height data))
grc/empty-rect)
name (:name data) name (:name data)
path (:path data) path (:path data)
main-instance-id (:main-instance-id data) main-instance-id (:main-instance-id data)
main-instance-page (:main-instance-page data) main-instance-page (:main-instance-page data)
obj (-> (cts/make-shape root-type selrect data) attrs (-> data
(dissoc :path (assoc :type root-type)
:main-instance-id (assoc :x (:x selrect))
:main-instance-page (assoc :y (:y selrect))
:main-instance-x (assoc :width (:width selrect))
:main-instance-y) (assoc :height (:height selrect))
(check-name file root-type) (assoc :selrect selrect)
(d/without-nils))] (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 (-> file
(commit-change (commit-change
{:type :add-component {:type :add-component
@ -734,7 +680,7 @@
(defn update-object (defn update-object
[file old-obj new-obj] [file old-obj new-obj]
(let [page-id (:current-page-id file) (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)) attrs (d/concat-set (keys old-obj) (keys new-obj))
generate-operation generate-operation
(fn [changes attr] (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 ;; Copyright (c) KALEIDOS INC
(ns app.common.pages.migrations (ns app.common.files.migrations
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.files.defaults :refer [version]]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.geom.shapes.path :as gsp] [app.common.geom.shapes.path :as gsp]
[app.common.geom.shapes.text :as gsht] [app.common.geom.shapes.text :as gsht]
[app.common.logging :as log] [app.common.logging :as log]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.pages :as cp] [app.common.pages.changes :as cpc]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.types.shape :as cts] [app.common.types.shape :as cts]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[cuerdas.core :as str])) [cuerdas.core :as str]))
;; TODO: revisit this and rename to file-migrations #?(:cljs (log/set-level! :info))
(defmulti migrate :version) (defmulti migrate :version)
(log/set-level! :info)
(defn migrate-data (defn migrate-data
([data] (migrate-data data cp/file-version)) ([data] (migrate-data data version))
([data to-version] ([data to-version]
(if (= (:version data) to-version) (if (= (:version data) to-version)
data data
@ -74,7 +74,7 @@
(if-not (contains? shape :content) (if-not (contains? shape :content)
(let [content (gsp/segments->content (:segments shape) (:close? shape)) (let [content (gsp/segments->content (:segments shape) (:close? shape))
selrect (gsh/content->selrect content) selrect (gsh/content->selrect content)
points (gsh/rect->points selrect)] points (grc/rect->points selrect)]
(-> shape (-> shape
(dissoc :segments) (dissoc :segments)
(dissoc :close?) (dissoc :close?)
@ -87,17 +87,17 @@
(fix-frames-selrects [frame] (fix-frames-selrects [frame]
(if (= (:id frame) uuid/zero) (if (= (:id frame) uuid/zero)
frame frame
(let [frame-rect (select-keys frame [:x :y :width :height])] (let [selrect (gsh/shape->rect frame)]
(-> frame (-> frame
(assoc :selrect (gsh/rect->selrect frame-rect)) (assoc :selrect selrect)
(assoc :points (gsh/rect->points frame-rect)))))) (assoc :points (grc/rect->points selrect))))))
(fix-empty-points [shape] (fix-empty-points [shape]
(let [shape (cond-> shape (let [shape (cond-> shape
(empty? (:selrect shape)) (cts/setup-rect-selrect))] (empty? (:selrect shape)) (cts/setup-rect))]
(cond-> shape (cond-> shape
(empty? (:points shape)) (empty? (:points shape))
(assoc :points (gsh/rect->points (:selrect shape)))))) (assoc :points (grc/rect->points (:selrect shape))))))
(update-object [object] (update-object [object]
(cond-> object (cond-> object
@ -141,10 +141,10 @@
;; Fixes issues with selrect/points for shapes with width/height = 0 (line-like paths)" ;; Fixes issues with selrect/points for shapes with width/height = 0 (line-like paths)"
(letfn [(fix-line-paths [shape] (letfn [(fix-line-paths [shape]
(if (= (:type shape) :path) (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)) (if (or (mth/almost-zero? width) (mth/almost-zero? height))
(let [selrect (gsh/content->selrect (:content shape)) (let [selrect (gsh/content->selrect (:content shape))
points (gsh/rect->points selrect) points (grc/rect->points selrect)
transform (gmt/matrix) transform (gmt/matrix)
transform-inv (gmt/matrix)] transform-inv (gmt/matrix)]
(assoc shape (assoc shape
@ -242,7 +242,7 @@
(loop [data data] (loop [data data]
(let [changes (mapcat calculate-changes (:pages-index data))] (let [changes (mapcat calculate-changes (:pages-index data))]
(if (seq changes) (if (seq changes)
(recur (cp/process-changes data changes)) (recur (cpc/process-changes data changes))
data))))) data)))))
(defmethod migrate 10 (defmethod migrate 10
@ -462,5 +462,31 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
;; TODO: pending to do a migration for delete already not used fill (defmethod migrate 21
;; and stroke props. This should be done for >1.14.x version. [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 (ns app.common.geom.align
(:require (:require
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.pages.helpers :refer [get-children]])) [app.common.pages.helpers :refer [get-children]]))
@ -30,7 +31,7 @@
the shape with the given rectangle. If the shape is a group, the shape with the given rectangle. If the shape is a group,
move also all of its recursive children." move also all of its recursive children."
[shape rect axis objects] [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) align-pos (calc-align-pos wrapper-rect rect axis)
delta {:x (- (:x align-pos) (:x wrapper-rect)) delta {:x (- (:x align-pos) (:x wrapper-rect))
:y (- (:y align-pos) (:y wrapper-rect))}] :y (- (:y align-pos) (:y wrapper-rect))}]
@ -78,11 +79,11 @@
other-coord (if (= axis :horizontal) :y :x) other-coord (if (= axis :horizontal) :y :x)
size (if (= axis :horizontal) :width :height) size (if (= axis :horizontal) :width :height)
; The rectangle that wraps the whole selection ; 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 ; 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 ; 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 ; The total space between shapes
space (reduce - (size wrapper-rect) (map size wrapped-shapes)) space (reduce - (size wrapper-rect) (map size wrapped-shapes))
unit-space (/ space (- (count wrapped-shapes) 1)) unit-space (/ space (- (count wrapped-shapes) 1))
@ -111,7 +112,8 @@
(defn adjust-to-viewport (defn adjust-to-viewport
([viewport srect] (adjust-to-viewport viewport srect nil)) ([viewport srect] (adjust-to-viewport viewport srect nil))
([viewport srect {:keys [padding] :or {padding 0}}] ([viewport srect {:keys [padding] :or {padding 0}}]
(let [gprop (/ (:width viewport) (:height viewport)) (let [gprop (/ (:width viewport)
(:height viewport))
srect (-> srect srect (-> srect
(update :x #(- % padding)) (update :x #(- % padding))
(update :y #(- % padding)) (update :y #(- % padding))
@ -126,13 +128,16 @@
padding (/ (- width' width) 2)] padding (/ (- width' width) 2)]
(-> srect (-> srect
(update :x #(- % padding)) (update :x #(- % padding))
(assoc :width width'))) (assoc :width width')
(grc/update-rect :position)))
(< gprop lprop) (< gprop lprop)
(let [height' (/ (* height lprop) gprop) (let [height' (/ (* height lprop) gprop)
padding (/ (- height' height) 2)] padding (/ (- height' height) 2)]
(-> srect (-> srect
(update :y #(- % padding)) (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 ;; Copyright (c) KALEIDOS INC
(ns app.util.geom.grid (ns app.common.geom.grid
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.geom.point :as gpt] [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 "Returns the addition of the supplied value to both
coordinates of the point as a new point." coordinates of the point as a new point."
[p1 p2] [p1 p2]
(assert (and (point? p1) (dm/assert!
(point? p2)) "arguments should be point instance"
"arguments should be pointer instance") (and (point? p1)
(point? p2)))
(Point. (+ (dm/get-prop p1 :x) (Point. (+ (dm/get-prop p1 :x)
(dm/get-prop p2 :x)) (dm/get-prop p2 :x))
(+ (dm/get-prop p1 :y) (+ (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 :as d]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes.bool :as gsb] [app.common.geom.shapes.bool :as gsb]
[app.common.geom.shapes.common :as gco] [app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.constraints :as gct] [app.common.geom.shapes.constraints :as gct]
@ -16,20 +17,11 @@
[app.common.geom.shapes.intersect :as gsi] [app.common.geom.shapes.intersect :as gsi]
[app.common.geom.shapes.modifiers :as gsm] [app.common.geom.shapes.modifiers :as gsm]
[app.common.geom.shapes.path :as gsp] [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.geom.shapes.transforms :as gtr]
[app.common.math :as mth])) [app.common.math :as mth]))
;; --- Outer Rect ;; --- 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 (defn translate-to-frame
[shape {:keys [x y]}] [shape {:keys [x y]}]
@ -39,13 +31,22 @@
[shape {:keys [x y]}] [shape {:keys [x y]}]
(gtr/move shape (gpt/point 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 ;; --- Helpers
(defn bounding-box (defn bounding-box
"Returns a rect that wraps the shape after all transformations applied." "Returns a rect that wraps the shape after all transformations applied."
[shape] [shape]
;; TODO: perhaps we need to store this calculation in a shape attribute ;; 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 (defn left-bound
"Returns the lowest x coord of the shape BEFORE applying transformations." "Returns the lowest x coord of the shape BEFORE applying transformations."
@ -82,21 +83,38 @@
(update :width (comp inc inc)) (update :width (comp inc inc))
(update :height (comp inc inc)))))) (update :height (comp inc inc))))))
(defn selrect->areas [bounds selrect] (defn get-areas
(let [{bound-x1 :x1 bound-x2 :x2 bound-y1 :y1 bound-y2 :y2} bounds [bounds selrect]
{sr-x1 :x1 sr-x2 :x2 sr-y1 :y1 sr-y2 :y2} selrect] (let [bound-x1 (dm/get-prop bounds :x1)
{:left (gpr/corners->selrect bound-x1 sr-y1 sr-x1 sr-y2) bound-x2 (dm/get-prop bounds :x2)
:top (gpr/corners->selrect sr-x1 bound-y1 sr-x2 sr-y1) bound-y1 (dm/get-prop bounds :y1)
:right (gpr/corners->selrect sr-x2 sr-y1 bound-x2 sr-y2) bound-y2 (dm/get-prop bounds :y2)
:bottom (gpr/corners->selrect sr-x1 sr-y2 sr-x2 bound-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] (defn distance-selrect
(let [{:keys [x1 y1]} other [selrect other]
{:keys [x2 y2]} selrect]
(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)))) (gpt/point (- x1 x2) (- y1 y2))))
(defn distance-shapes [shape other] (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? (defn close-attrs?
"Compares two shapes attributes to see if they are equal or almost "Compares two shapes attributes to see if they are equal or almost
@ -131,27 +149,11 @@
(= val1 val2))))) (= val1 val2)))))
;; EXPORTS ;; EXPORTS
(dm/export gco/center-shape) (dm/export gco/shape->center)
(dm/export gco/center-selrect) (dm/export gco/shapes->rect)
(dm/export gco/center-rect) (dm/export gco/points->center)
(dm/export gco/center-points)
(dm/export gco/transform-points) (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/move)
(dm/export gtr/absolute-move) (dm/export gtr/absolute-move)
(dm/export gtr/transform-matrix) (dm/export gtr/transform-matrix)
@ -173,6 +175,7 @@
(dm/export gct/calc-child-modifiers) (dm/export gct/calc-child-modifiers)
;; PATHS ;; PATHS
;; FIXME: rename
(dm/export gsp/content->selrect) (dm/export gsp/content->selrect)
(dm/export gsp/transform-content) (dm/export gsp/transform-content)
(dm/export gsp/open-path?) (dm/export gsp/open-path?)
@ -196,6 +199,3 @@
;; Modifiers ;; Modifiers
(dm/export gsm/set-objects-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 (ns app.common.geom.shapes.bounds
(:require (:require
[app.common.data :as d] [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.math :as mth]
[app.common.pages.helpers :as cph])) [app.common.pages.helpers :as cph]))
(defn shape-stroke-margin (defn shape-stroke-margin
[shape stroke-width] [shape stroke-width]
(if (= (:type shape) :path) (if (cph/path-shape? shape)
;; TODO: Calculate with the stroke offset (not implemented yet ;; TODO: Calculate with the stroke offset (not implemented yet
(mth/sqrt (* 2 stroke-width stroke-width)) (mth/sqrt (* 2 stroke-width stroke-width))
(- (mth/sqrt (* 2 stroke-width stroke-width)) stroke-width))) (- (mth/sqrt (* 2 stroke-width stroke-width)) stroke-width)))
(defn blur-filters [type value] (defn- apply-filters
(->> [value] [type filters]
(remove :hidden) (sequence
(filter #(= (:type %) type)) (comp
(map #(hash-map :id (str "filter_" (:id %))
:type (:type %)
:params %))))
(defn shadow-filters [type filters]
(->> filters
(remove :hidden) (remove :hidden)
(filter #(= (:style %) type)) (filter #(= (:style %) type))
(map #(hash-map :id (str "filter_" (:id %)) (map (fn [item]
:type (:style %) {:id (dm/str "filter_" (:id item))
:params %)))) :type type
:params item})))
filters))
(defn shape->filters (defn shape->filters
[shape] [shape]
@ -41,32 +38,38 @@
;; Background blur won't work in current SVG specification ;; Background blur won't work in current SVG specification
;; We can revisit this in the future ;; 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}] [{:id "shape" :type :blend-filters}]
(->> shape :shadow (shadow-filters :inner-shadow)) (->> shape :shadow (apply-filters :inner-shadow))
(->> shape :blur (blur-filters :layer-blur)))) (->> shape :blur (into []) (apply-filters :layer-blur))))
(defn calculate-filter-bounds [{:keys [x y width height]} filter-entry] (defn- calculate-filter-bounds
(let [{:keys [offset-x offset-y blur spread] :or {offset-x 0 offset-y 0 blur 0 spread 0}} (:params filter-entry) [selrect filter-entry]
filter-x (min x (+ x offset-x (- spread) (- blur) -5)) (let [x (dm/get-prop selrect :x)
filter-y (min y (+ y offset-y (- spread) (- blur) -5)) y (dm/get-prop selrect :y)
filter-width (+ width (mth/abs offset-x) (* spread 2) (* blur 2) 10) w (dm/get-prop selrect :width)
filter-height (+ height (mth/abs offset-y) (* spread 2) (* blur 2) 10)] h (dm/get-prop selrect :height)
(gsr/make-selrect filter-x filter-y filter-width filter-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 (defn get-rect-filter-bounds
[selrect filters blur-value] [selrect filters blur-value]
(let [filter-bounds (->> filters (let [bounds-xf (comp
(filter #(= :drop-shadow (:type %))) (filter #(= :drop-shadow (:type %)))
(map (partial calculate-filter-bounds selrect)) (map (partial calculate-filter-bounds selrect)))
(concat [selrect]) delta-blur (* blur-value 2)]
(gsr/join-selrects)) (-> (into [selrect] bounds-xf filters)
delta-blur (* blur-value 2) (grc/join-rects)
result
(-> filter-bounds
(update :x - delta-blur) (update :x - delta-blur)
(update :y - delta-blur) (update :y - delta-blur)
(update :x1 - delta-blur) (update :x1 - delta-blur)
@ -74,60 +77,73 @@
(update :x2 + delta-blur) (update :x2 + delta-blur)
(update :y2 + delta-blur) (update :y2 + delta-blur)
(update :width + (* delta-blur 2)) (update :width + (* delta-blur 2))
(update :height + (* delta-blur 2)))] (update :height + (* delta-blur 2)))))
result))
(defn get-shape-filter-bounds (defn get-shape-filter-bounds
([shape] [shape]
(let [svg-root? (and (= :svg-raw (:type shape)) (not= :svg (get-in shape [:content :tag])))] (if (and (cph/svg-raw-shape? shape)
(if svg-root? (not= :svg (dm/get-in shape [:content :tag])))
(:selrect shape) (dm/get-prop shape :selrect)
(let [filters (shape->filters shape) (let [filters (shape->filters shape)
blur-value (or (-> shape :blur :value) 0)] blur-value (or (-> shape :blur :value) 0)
(get-rect-filter-bounds (-> shape :points gsr/points->selrect) filters blur-value)))))) srect (-> (dm/get-prop shape :points)
(grc/points->rect))]
(get-rect-filter-bounds srect filters blur-value))))
(defn calculate-padding (defn calculate-padding
([shape] ([shape]
(calculate-padding shape false)) (calculate-padding shape false))
([shape ignore-margin?] ([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) :center (/ (:stroke-width % 0) 2)
:outer (:stroke-width % 0) :outer (:stroke-width % 0)
0) (:strokes shape))) 0))
(reduce d/max 0))
margin (if ignore-margin? margin
(if ignore-margin?
0 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) :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) :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) {:horizontal (+ stroke-width margin shadow-width)
:vertical (+ stroke-width margin shadow-height)}))) :vertical (+ stroke-width margin shadow-height)})))
(defn- add-padding (defn- add-padding
[bounds padding] [bounds padding]
(let [h-padding (:horizontal padding)
v-padding (:vertical padding)]
(-> bounds (-> bounds
(update :x - (:horizontal padding)) (update :x - h-padding)
(update :x1 - (:horizontal padding)) (update :x1 - h-padding)
(update :x2 + (:horizontal padding)) (update :x2 + h-padding)
(update :y - (:vertical padding)) (update :y - v-padding)
(update :y1 - (:vertical padding)) (update :y1 - v-padding)
(update :y2 + (:vertical padding)) (update :y2 + v-padding)
(update :width + (* 2 (:horizontal padding))) (update :width + (* 2 h-padding))
(update :height + (* 2 (:vertical padding))))) (update :height + (* 2 v-padding)))))
(defn get-object-bounds (defn get-object-bounds
[objects shape] [objects shape]
(let [calculate-base-bounds (let [calculate-base-bounds
(fn [shape] (fn [shape]
(-> (get-shape-filter-bounds shape) (-> (get-shape-filter-bounds shape)
@ -154,16 +170,14 @@
(or (not (cph/group-shape? shape)) (or (not (cph/group-shape? shape))
(not (:masked-group? shape))))) (not (:masked-group? shape)))))
(:id shape) (:id shape)
(fn [result child] (fn [result child]
(conj result (calculate-base-bounds child))) (conj result (calculate-base-bounds child)))
[(calculate-base-bounds shape)])) [(calculate-base-bounds shape)]))
children-bounds children-bounds
(cond->> (gsr/join-selrects bounds) (cond->> (grc/join-rects bounds)
(not (cph/frame-shape? shape)) (or (:children-bounds shape))) (not (cph/frame-shape? shape)) (or (:children-bounds shape)))
filters (shape->filters 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 (ns app.common.geom.shapes.common
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.shapes.rect :as gpr] [app.common.geom.rect :as grc]
[app.common.math :as mth])) [app.common.math :as mth]))
(defn center-rect (def ^:private xf-keep-x (keep #(dm/get-prop % :x)))
[{:keys [x y width height]}] (def ^:private xf-keep-y (keep #(dm/get-prop % :y)))
(when (d/num? x y width height)
(gpt/point (+ x (/ width 2.0))
(+ y (/ height 2.0)))))
(defn center-selrect (defn shapes->rect
"Calculate the center of the selrect." "Returns a rect that contains all the shapes and is aware of the
[selrect] rotation of each shape. Mainly used for multiple selection."
(center-rect selrect)) [shapes]
(->> shapes
(keep (fn [shape]
(-> (dm/get-prop shape :points)
(grc/points->rect))))
(grc/join-rects)))
(defn center-points [points] (defn points->center
(let [ptx (into [] (keep :x) points) [points]
pty (into [] (keep :y) points) (let [ptx (into [] xf-keep-x points)
minx (reduce min ##Inf ptx) pty (into [] xf-keep-y points)
miny (reduce min ##Inf pty) minx (reduce d/min ##Inf ptx)
maxx (reduce max ##-Inf ptx) miny (reduce d/min ##Inf pty)
maxy (reduce max ##-Inf pty)] maxx (reduce d/max ##-Inf ptx)
maxy (reduce d/max ##-Inf pty)]
(gpt/point (/ (+ minx maxx) 2.0) (gpt/point (/ (+ minx maxx) 2.0)
(/ (+ miny maxy) 2.0)))) (/ (+ miny maxy) 2.0))))
(defn center-bounds [[a b c d]] (defn shape->center
(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
"Calculate the center of the shape." "Calculate the center of the shape."
[shape] [shape]
(center-rect (:selrect shape))) (grc/rect->center (dm/get-prop shape :selrect)))
(defn transform-points (defn transform-points
([points matrix] ([points matrix]
(transform-points points nil matrix)) (transform-points points nil matrix))
([points center 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)) (let [prev (if center (gmt/translate-matrix center) (gmt/matrix))
post (if center (gmt/translate-matrix (gpt/negate center)) (gmt/matrix)) post (if center (gmt/translate-matrix (gpt/negate center)) (gmt/matrix))
tr-point #(gpt/transform % (gmt/multiply prev matrix post))]
tr-point (fn [point]
(gpt/transform point (gmt/multiply prev matrix post)))]
(mapv tr-point points)) (mapv tr-point points))
points))) points)))
(defn transform-selrect (defn transform-selrect
[{:keys [x1 y1 x2 y2] :as sr} matrix] [selrect matrix]
(let [[c1 c2] (transform-points [(gpt/point x1 y1) (gpt/point x2 y2)] matrix)]
(gpr/corners->selrect c1 c2))) (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? (defn invalid-geometry?
[{:keys [points selrect]}] [{:keys [points selrect]}]
(or (mth/nan? (:x selrect)) (or ^boolean (mth/nan? (:x selrect))
(mth/nan? (:y selrect)) ^boolean (mth/nan? (:y selrect))
(mth/nan? (:width selrect)) ^boolean (mth/nan? (:width selrect))
(mth/nan? (:height selrect)) ^boolean (mth/nan? (:height selrect))
(some (fn [p] ^boolean (some (fn [p]
(or (mth/nan? (:x p)) (or ^boolean (mth/nan? (:x p))
(mth/nan? (:y p)))) ^boolean (mth/nan? (:y p))))
points))) 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.data :as d]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes.common :as gco] [app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.flex-layout.lines :as fli] [app.common.geom.shapes.flex-layout.lines :as fli]
[app.common.geom.shapes.points :as gpo] [app.common.geom.shapes.points :as gpo]
[app.common.geom.shapes.rect :as gsr]
[app.common.geom.shapes.transforms :as gtr] [app.common.geom.shapes.transforms :as gtr]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.types.modifiers :as ctm] [app.common.types.modifiers :as ctm]
@ -59,16 +59,16 @@
(if row? (if row?
(let [half-point-width (+ (- box-x x) (/ box-width 2))] (let [half-point-width (+ (- box-x x) (/ box-width 2))]
[(gsr/make-rect x y width height) [(grc/make-rect x y width height)
(-> (gsr/make-rect x y half-point-width height) (-> (grc/make-rect x y half-point-width height)
(assoc :index (if reverse? (inc index) index))) (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))))]) (assoc :index (if reverse? index (inc index))))])
(let [half-point-height (+ (- box-y y) (/ box-height 2))] (let [half-point-height (+ (- box-y y) (/ box-height 2))]
[(gsr/make-rect x y width height) [(grc/make-rect x y width height)
(-> (gsr/make-rect x y width half-point-height) (-> (grc/make-rect x y width half-point-height)
(assoc :index (if reverse? (inc index) index))) (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))))])))) (assoc :index (if reverse? index (inc index))))]))))
(defn drop-line-area (defn drop-line-area
@ -83,7 +83,7 @@
v-center? (and col? (ctl/v-center? frame)) v-center? (and col? (ctl/v-center? frame))
v-end? (and row? (ctl/v-end? 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) start-p (gmt/transform-point-center start-p center transform-inverse)
line-width line-width
@ -136,7 +136,7 @@
:else :else
(+ line-height (- box-y prev-y) (/ layout-gap-row 2)))] (+ 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 (defn layout-drop-areas
"Retrieve the layout drop areas to move shapes inside layouts" "Retrieve the layout drop areas to move shapes inside layouts"
@ -190,7 +190,7 @@
(-> (ctm/empty) (-> (ctm/empty)
(ctm/resize (gpt/point (if flip-x -1.0 1.0) (ctm/resize (gpt/point (if flip-x -1.0 1.0)
(if flip-y -1.0 1.0)) (if flip-y -1.0 1.0))
(gco/center-shape shape) (gco/shape->center shape)
transform transform
transform-inverse))] transform-inverse))]
[(gtr/transform-shape shape modifiers) modifiers]) [(gtr/transform-shape shape modifiers) modifiers])
@ -212,6 +212,6 @@
[frame-id objects position] [frame-id objects position]
(let [frame (get objects frame-id) (let [frame (get objects frame-id)
drop-areas (get-drop-areas frame objects) drop-areas (get-drop-areas frame objects)
position (gmt/transform-point-center position (gco/center-shape frame) (:transform-inverse frame)) position (gmt/transform-point-center position (gco/shape->center frame) (:transform-inverse frame))
area (d/seek #(gsr/contains-point? % position) drop-areas)] area (d/seek #(grc/contains-point? % position) drop-areas)]
(:index area))) (:index area)))

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

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

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

@ -29,7 +29,7 @@
;; [(get-in objects [k :name]) v])) ;; [(get-in objects [k :name]) v]))
;; modif-tree)))) ;; modif-tree))))
(defn children-sequence (defn- get-children-seq
"Given an id returns a sequence of its children" "Given an id returns a sequence of its children"
[id objects] [id objects]
@ -39,61 +39,63 @@
id) id)
(map #(get objects %)))) (map #(get objects %))))
(defn resolve-tree-sequence (defn- resolve-tree
"Given the ids that have changed search for layout roots to recalculate" "Given the ids that have changed search for layout roots to recalculate"
[ids objects] [ids objects]
(dm/assert! (or (nil? ids) (set? ids))) (dm/assert! (or (nil? ids) (set? ids)))
(let [get-tree-root (let [;; Finds the tree root for the current id
(fn ;; Finds the tree root for the current id get-tree-root
[id] (fn [id]
(loop [current id (loop [current id
result id] result id]
(let [shape (get objects current) (let [shape (get objects current)]
parent (get objects (:parent-id shape))] (if (or (not ^boolean shape) (= uuid/zero current))
(cond
(or (not shape) (= uuid/zero current))
result 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) ;; Frame found, but not layout we return the last layout found (or the id)
(and (= :frame (:type parent)) (and ^boolean (cph/frame-shape? parent)
(not (ctl/any-layout? parent))) (not ^boolean (ctl/any-layout? parent)))
result result
;; Layout found. We continue upward but we mark this layout ;; Layout found. We continue upward but we mark this layout
(ctl/any-layout? parent) (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 ;; If group or boolean or other type of group we continue with the last result
:else :else
(recur (:id parent) result))))) (recur parent-id result)))))))
is-child? #(cph/is-child? objects %1 %2) ;; Given some roots retrieves the minimum number of tree roots
search-common-roots
calculate-common-roots (fn [result id]
(fn ;; Given some roots retrieves the minimum number of tree roots
[result id]
(if (= id uuid/zero) (if (= id uuid/zero)
result result
(let [root (get-tree-root id) (let [root (get-tree-root id)
;; Remove the children from the current root ;; Remove the children from the current root
result result
(if (cph/has-children? objects root) (if ^boolean (cph/has-children? objects root)
(into #{} (remove #(is-child? root %)) result) (into #{} (remove (partial cph/is-child? objects root)) result)
result) result)
root-parents (cph/get-parent-ids objects root) contains-parent?
contains-parent? (some #(contains? result %) root-parents)] (->> (cph/get-parent-ids objects root)
(cond-> result (some (partial contains? result)))]
(not contains-parent?)
(conj root)))))
roots (->> ids (reduce calculate-common-roots #{}))] (if (not contains-parent?)
(concat (conj result root)
(when (contains? ids uuid/zero) [(get objects uuid/zero)]) result))))
(mapcat #(children-sequence % objects) roots))))
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 (defn- set-children-modifiers
"Propagates the modifiers from a parent too its children applying constraints if necesary" "Propagates the modifiers from a parent too its children applying constraints if necesary"
@ -371,7 +373,7 @@
(defn reflow-layout (defn reflow-layout
[objects old-modif-tree bounds ignore-constraints id] [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 _] [modif-tree _]
(reduce (reduce
@ -416,7 +418,7 @@
(let [resize-modif-tree {current {:modifiers auto-resize-modifiers}} (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 _] [resize-modif-tree _]
(reduce (reduce
@ -440,7 +442,7 @@
;; Step-2: After resizing we still need to reflow the layout parents that are not auto-width/height ;; 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 _] [reflow-modif-tree _]
(reduce (reduce
@ -476,7 +478,7 @@
(some? old-modif-tree) (some? old-modif-tree)
(transform-bounds objects 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 ;; Calculate the input transformation and constraints
modif-tree (reduce #(propagate-modifiers-constraints objects bounds ignore-constraints %1 %2) modif-tree shapes-tree) 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.data :as d]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.shapes.common :as gsc] [app.common.geom.rect :as grc]
[app.common.geom.shapes.rect :as gpr] [app.common.geom.shapes.common :as gco]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.path.commands :as upc] [app.common.path.commands :as upc]
[app.common.path.subpaths :as sp])) [app.common.path.subpaths :as sp]))
@ -334,7 +334,7 @@
(->> (curve-extremities curve) (->> (curve-extremities curve)
(mapv #(curve-values curve %))))) (mapv #(curve-values curve %)))))
[])] [])]
(gpr/points->selrect points)))) (grc/points->rect points))))
(defn content->selrect [content] (defn content->selrect [content]
(let [calc-extremities (let [calc-extremities
@ -360,7 +360,7 @@
extremities (mapcat calc-extremities extremities (mapcat calc-extremities
content content
(concat [nil] content))] (concat [nil] content))]
(gpr/points->selrect extremities))) (grc/points->rect extremities)))
(defn move-content [content move-vec] (defn move-content [content move-vec]
(let [dx (:x 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) (let [[from-p to-p :as curve] (subcurve-range curve from-t to-t)
extremes (->> (curve-extremities curve) extremes (->> (curve-extremities curve)
(mapv #(curve-values 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? (defn line-has-point?
"Using the line equation we put the x value and check if matches with "Using the line equation we put the x value and check if matches with
@ -623,7 +623,7 @@
[point curve] [point curve]
(letfn [(check-range [from-t to-t] (letfn [(check-range [from-t to-t]
(let [r (curve-range->rect curve 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) (if (s= from-t to-t)
(< (gpt/distance (curve-values curve from-t) point) 0.1) (< (gpt/distance (curve-values curve from-t) point) 0.1)
@ -760,7 +760,7 @@
(let [r1 (curve-range->rect c1 c1-from c1-to) (let [r1 (curve-range->rect c1 c1-from c1-to)
r2 (curve-range->rect c2 c2-from c2-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) (let [p1 (curve-values c1 c1-from)
p2 (curve-values c2 c2-from)] p2 (curve-values c2 c2-from)]
@ -811,7 +811,7 @@
[[from-p to-p :as curve]] [[from-p to-p :as curve]]
(let [extremes (->> (curve-extremities curve) (let [extremes (->> (curve-extremities curve)
(mapv #(curve-values 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? (defn is-point-in-border?
@ -943,7 +943,7 @@
[content] [content]
(-> content (-> content
content->selrect content->selrect
gsc/center-selrect)) grc/rect->center))
(defn content->points+selrect (defn content->points+selrect
"Given the content of a shape, calculate its points and selrect" "Given the content of a shape, calculate its points and selrect"
@ -960,7 +960,7 @@
flip-y (gmt/scale (gpt/point 1 -1)) flip-y (gmt/scale (gpt/point 1 -1))
:always (gmt/multiply (:transform-inverse shape (gmt/matrix)))) :always (gmt/multiply (:transform-inverse shape (gmt/matrix))))
center (or (gsc/center-shape shape) center (or (gco/shape->center shape)
(content-center content)) (content-center content))
base-content (transform-content base-content (transform-content
@ -969,16 +969,16 @@
;; Calculates the new selrect with points given the old center ;; Calculates the new selrect with points given the old center
points (-> (content->selrect base-content) points (-> (content->selrect base-content)
(gpr/rect->points) (grc/rect->points)
(gsc/transform-points center transform)) (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 ;; Points is now the selrect but the center is different so we can create the selrect
;; through points ;; through points
selrect (-> points selrect (-> points
(gsc/transform-points points-center transform-inverse) (gco/transform-points points-center transform-inverse)
(gpr/points->selrect))] (grc/points->rect))]
[points selrect])) [points selrect]))
(defn open-path? (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 :as d]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes.common :as gco] [app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.points :as gpo] [app.common.geom.shapes.points :as gpo]
[app.common.geom.shapes.rect :as gpr]
[app.common.geom.shapes.transforms :as gtr] [app.common.geom.shapes.transforms :as gtr]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
@ -40,7 +40,7 @@
(defn position-pixel-precision (defn position-pixel-precision
[modifiers _ points precision ignore-axis] [modifiers _ points precision ignore-axis]
(let [bounds (gpr/bounds->rect points) (let [bounds (grc/bounds->rect points)
corner (gpt/point bounds) corner (gpt/point bounds)
target-corner target-corner
(cond-> corner (cond-> corner

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

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

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

@ -4,221 +4,4 @@
;; ;;
;; Copyright (c) KALEIDOS INC ;; Copyright (c) KALEIDOS INC
(ns app.common.geom.shapes.rect (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)))))

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

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

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

@ -13,10 +13,10 @@
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes.bool :as gshb] [app.common.geom.shapes.bool :as gshb]
[app.common.geom.shapes.common :as gco] [app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.path :as gpa] [app.common.geom.shapes.path :as gpa]
[app.common.geom.shapes.rect :as gpr]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.types.modifiers :as ctm] [app.common.types.modifiers :as ctm]
@ -24,25 +24,47 @@
#?(:clj (set! *warn-on-reflection* true)) #?(: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 ;; --- Relative Movement
(defn- move-selrect [{:keys [x y x1 y1 x2 y2 width height] :as selrect} {dx :x dy :y :as pt}] (defn- move-selrect
(if (and (some? selrect) (some? pt) (d/num? dx dy)) [selrect pt]
{:x (if (d/num? x) (+ dx x) x) (if (and ^boolean (some? selrect)
:y (if (d/num? y) (+ dy y) y) ^boolean (valid-point? pt))
:x1 (if (d/num? x1) (+ dx x1) x1) (let [x (dm/get-prop selrect :x)
:y1 (if (d/num? y1) (+ dy y1) y1) y (dm/get-prop selrect :y)
:x2 (if (d/num? x2) (+ dx x2) x2) w (dm/get-prop selrect :width)
:y2 (if (d/num? y2) (+ dy y2) y2) h (dm/get-prop selrect :height)
:width width x1 (dm/get-prop selrect :x1)
:height height} 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)) selrect))
(defn- move-points [points move-vec] (defn- move-points
(cond->> points [points move-vec]
(d/num? (:x move-vec) (:y move-vec)) (if (valid-point? move-vec)
(mapv #(gpt/add % move-vec)))) (mapv #(gpt/add % move-vec) points)
points))
;; FIXME: revisit performance
(defn move-position-data (defn move-position-data
([position-data {:keys [x y]}] ([position-data {:keys [x y]}]
(move-position-data position-data x y)) (move-position-data position-data x y))
@ -105,7 +127,7 @@
(transform-matrix shape nil)) (transform-matrix shape nil))
([shape params] ([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] ([{:keys [flip-x flip-y transform] :as shape} {:keys [no-flip]} shape-center]
(-> (gmt/matrix) (-> (gmt/matrix)
@ -136,7 +158,7 @@
(defn inverse-transform-matrix (defn inverse-transform-matrix
([shape] ([shape]
(let [shape-center (or (gco/center-shape shape) (let [shape-center (or (gco/shape->center shape)
(gpt/point 0 0))] (gpt/point 0 0))]
(inverse-transform-matrix shape shape-center))) (inverse-transform-matrix shape shape-center)))
([{:keys [flip-x flip-y] :as shape} center] ([{:keys [flip-x flip-y] :as shape} center]
@ -152,9 +174,9 @@
"Transform a rectangles and changes its attributes" "Transform a rectangles and changes its attributes"
[rect matrix] [rect matrix]
(let [points (-> (gpr/rect->points rect) (let [points (-> (grc/rect->points rect)
(gco/transform-points matrix))] (gco/transform-points matrix))]
(gpr/points->rect points))) (grc/points->rect points)))
(defn transform-points-matrix (defn transform-points-matrix
"Calculate the transform matrix to convert from the selrect to the points bounds "Calculate the transform matrix to convert from the selrect to the points bounds
@ -238,8 +260,10 @@
[points] [points]
(let [width (calculate-width points) (let [width (calculate-width points)
height (calculate-height 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) points-transform-mtx (transform-points-matrix sr points)
@ -385,7 +409,7 @@
(let [;; Points for every shape inside the group (let [;; Points for every shape inside the group
points (->> children (mapcat :points)) 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) ;; Fixed problem with empty groups. Should not happen (but it does)
points (if (empty? points) (:points group) points) points (if (empty? points) (:points group) points)
@ -393,13 +417,14 @@
;; Invert to get the points minus the transforms applied to the group ;; 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))) 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 ;; Defines the new selection rect with its transformations
new-points (-> (gpr/points->selrect base-points) new-points (-> (grc/points->rect base-points)
(gpr/rect->points) (grc/rect->points)
(gco/transform-points shape-center (:transform group (gmt/matrix)))) (gco/transform-points shape-center (:transform group (gmt/matrix))))
;; Calculate the new selrect ;; 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 ;; Updates the shape and the applytransform-rect will update the other properties
(-> group (-> group
@ -492,24 +517,17 @@
(defn transform-selrect (defn transform-selrect
[selrect modifiers] [selrect modifiers]
(-> selrect (-> selrect
(gpr/rect->points) (grc/rect->points)
(transform-bounds modifiers) (transform-bounds modifiers)
(gpr/points->selrect))) (grc/points->rect)))
(defn transform-selrect-matrix (defn transform-selrect-matrix
[selrect mtx] [selrect mtx]
(-> selrect (-> selrect
(gpr/rect->points) (grc/rect->points)
(gco/transform-points mtx) (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) (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 (ns app.common.math
"A collection of math utils." "A collection of math utils."
(:refer-clojure :exclude [abs]) (:refer-clojure :exclude [abs min max])
#?(:cljs #?(: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 (def PI
#?(:cljs (.-PI js/Math) #?(:cljs (.-PI js/Math)
@ -198,10 +213,12 @@
(defn max-abs (defn max-abs
[a b] [a b]
(max (abs a) (abs b))) (max (abs a)
(abs b)))
(defn sign (defn sign
"Get the sign (+1 / -1) for the number" "Get the sign (+1 / -1) for the number"
[n] [n]
(if (neg? n) -1 1)) (if (neg? n) -1 1))

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

@ -9,34 +9,11 @@
(:require (:require
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.pages.changes :as changes] [app.common.pages.changes :as changes]
[app.common.pages.common :as common] [app.common.pages.indices :as indices]))
[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?)
;; 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-all-parents-index)
(dm/export indices/generate-child-parent-index)
(dm/export indices/create-clip-index) (dm/export indices/create-clip-index)
;; Process changes ;; Process changes
(dm/export changes/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.exceptions :as ex]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.pages.common :refer [component-sync-attrs]]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.schema :as sm] [app.common.schema :as sm]
[app.common.schema.desc-native :as smd] [app.common.schema.desc-native :as smd]
@ -20,6 +19,7 @@
[app.common.types.colors-list :as ctcl] [app.common.types.colors-list :as ctcl]
[app.common.types.component :as ctk] [app.common.types.component :as ctk]
[app.common.types.components-list :as ctkl] [app.common.types.components-list :as ctkl]
[app.common.types.component :as ctk]
[app.common.types.container :as ctn] [app.common.types.container :as ctn]
[app.common.types.file :as ctf] [app.common.types.file :as ctf]
[app.common.types.page :as ctp] [app.common.types.page :as ctp]
@ -68,7 +68,7 @@
[:map {:title "AddObjChange"} [:map {:title "AddObjChange"}
[:type [:= :add-obj]] [:type [:= :add-obj]]
[:id ::sm/uuid] [:id ::sm/uuid]
[:obj [:map-of {:gen/max 10} :keyword :any]] [:obj :map]
[:page-id {:optional true} ::sm/uuid] [:page-id {:optional true} ::sm/uuid]
[:component-id {:optional true} ::sm/uuid] [:component-id {:optional true} ::sm/uuid]
[:frame-id {:optional true} ::sm/uuid] [:frame-id {:optional true} ::sm/uuid]
@ -228,10 +228,10 @@
(sm/def! ::changes (sm/def! ::changes
[:sequential {:gen/max 2} ::change]) [:sequential {:gen/max 2} ::change])
(def change? (def valid-change?
(sm/pred-fn ::change)) (sm/pred-fn ::change))
(def changes? (def valid-changes?
(sm/pred-fn [:sequential ::change])) (sm/pred-fn [:sequential ::change]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -249,6 +249,9 @@
;; Changes Processing Impl ;; Changes Processing Impl
(def valid-shape?
(sm/pred-fn ::cts/shape))
(defn validate-shapes! (defn validate-shapes!
[data-old data-new items] [data-old data-new items]
(letfn [(validate-shape! [[page-id id]] (letfn [(validate-shape! [[page-id id]]
@ -258,7 +261,8 @@
;; If object has changed or is new verify is correct ;; If object has changed or is new verify is correct
(when (and (some? shape-new) (when (and (some? shape-new)
(not= shape-old 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) (->> (into #{} (map :page-id) items)
(mapcat (fn [page-id] (mapcat (fn [page-id]
@ -283,7 +287,7 @@
;; When verify? false we spec the schema validation. Currently used to make just ;; When verify? false we spec the schema validation. Currently used to make just
;; 1 validation even if the changes are applied twice ;; 1 validation even if the changes are applied twice
(when verify? (when verify?
(dm/verify! (changes? items))) (dm/verify! (valid-changes? items)))
(let [result (reduce #(or (process-change %1 %2) %1) data items)] (let [result (reduce #(or (process-change %1 %2) %1) data items)]
;; Validate result shapes (only on the backend) ;; Validate result shapes (only on the backend)
@ -639,7 +643,7 @@
(defmethod process-operation :set (defmethod process-operation :set
[on-changed shape op] [on-changed shape op]
(let [attr (:attr op) (let [attr (:attr op)
group (get component-sync-attrs attr) group (get ctk/sync-attrs attr)
val (:val op) val (:val op)
shape-val (get shape attr) shape-val (get shape attr)
ignore (:ignore-touched op) ignore (:ignore-touched op)
@ -725,7 +729,7 @@
; We need to trigger a sync if the shape has changed any ; We need to trigger a sync if the shape has changed any
; attribute that participates in components synchronization. ; attribute that participates in components synchronization.
(and (= (:type operation) :set) (and (= (:type operation) :set)
(component-sync-attrs (:attr operation)))) (get ctk/sync-attrs (:attr operation))))
any-sync? (some need-sync? operations)] any-sync? (some need-sync? operations)]
(when any-sync? (when any-sync?
(let [xform (comp (filter :main-instance?) ; Select shapes that are main component instances (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.files.features :as ffeat]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.pages :as cp] [app.common.pages :as cp]
@ -217,6 +218,9 @@
(add-object changes obj nil)) (add-object changes obj nil))
([changes obj {:keys [index ignore-touched] :or {index ::undefined ignore-touched false}}] ([changes obj {:keys [index ignore-touched] :or {index ::undefined ignore-touched false}}]
;; FIXME: add shape validation
(assert-page-id changes) (assert-page-id changes)
(assert-objects changes) (assert-objects changes)
(let [obj (cond-> obj (let [obj (cond-> obj
@ -234,7 +238,7 @@
:frame-id (:frame-id obj) :frame-id (:frame-id obj)
:index (::index obj) :index (::index obj)
:ignore-touched ignore-touched :ignore-touched ignore-touched
:obj (dissoc obj ::index :parent-id)} :obj (dissoc obj ::index)}
del-change del-change
{:type :del-obj {:type :del-obj
@ -469,7 +473,7 @@
(every? #(apply gpt/close? %) (d/zip old-val new-val)) (every? #(apply gpt/close? %) (d/zip old-val new-val))
(= attr :selrect) (= attr :selrect)
(gsh/close-selrect? old-val new-val) (grc/close-rect? old-val new-val)
:else :else
(= old-val new-val))] (= old-val new-val))]

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

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

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

@ -8,8 +8,8 @@
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes.path :as gsp] [app.common.geom.shapes.path :as gsp]
[app.common.geom.shapes.rect :as gpr]
[app.common.path.commands :as upc] [app.common.path.commands :as upc]
[app.common.path.subpaths :as ups])) [app.common.path.subpaths :as ups]))
@ -101,7 +101,7 @@
(if (= :move-to (:command segment)) (if (= :move-to (:command segment))
false false
(let [r1 (command->selrect segment)] (let [r1 (command->selrect segment)]
(gpr/overlaps-rects? r1 selrect)))) (grc/overlaps-rects? r1 selrect))))
(overlap-segments? (overlap-segments?
[seg-1 seg-2] [seg-1 seg-2]
@ -110,7 +110,7 @@
false false
(let [r1 (command->selrect seg-1) (let [r1 (command->selrect seg-1)
r2 (command->selrect seg-2)] r2 (command->selrect seg-2)]
(gpr/overlaps-rects? r1 r2)))) (grc/overlaps-rects? r1 r2))))
(split (split
[seg-1 seg-2] [seg-1 seg-2]
@ -156,7 +156,7 @@
:curve-to (-> (gsp/command->bezier segment) :curve-to (-> (gsp/command->bezier segment)
(gsp/curve-values 0.5)))] (gsp/curve-values 0.5)))]
(and (gpr/contains-point? content-sr point) (and (grc/contains-point? content-sr point)
(or (or
(gsp/is-point-in-geom-data? point content-geom) (gsp/is-point-in-geom-data? point content-geom)
(gsp/is-point-in-border? point content))))) (gsp/is-point-in-border? point content)))))
@ -170,7 +170,7 @@
:curve-to (-> (gsp/command->bezier segment) :curve-to (-> (gsp/command->bezier segment)
(gsp/curve-values 0.5)))] (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)))) (gsp/is-point-in-geom-data? point content-geom))))
(defn overlap-segment? (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.data :as d]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [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.corners :as gso]
[app.common.geom.shapes.path :as gsp] [app.common.geom.shapes.path :as gsp]
[app.common.path.bool :as pb] [app.common.path.bool :as pb]
@ -231,7 +231,7 @@
new-content (cond-> new-content new-content (cond-> new-content
(some? transform) (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 (-> shape
(assoc :type :path) (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"])] ext (tg/elements ["net" "com" "org" "app" "io"])]
(u/uri (str scheme "://" domain "." ext)))) (u/uri (str scheme "://" domain "." ext))))
;; FIXME: revisit
(defn uuid (defn uuid
[] []
(->> tg/small-integer (->> tg/small-integer

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

@ -6,6 +6,86 @@
(ns app.common.types.component) (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? (defn instance-root?
"Check if this shape is the head of a top instance." "Check if this shape is the head of a top instance."
[shape] [shape]

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

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

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

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

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

@ -412,7 +412,7 @@
(defn rotation-modifiers (defn rotation-modifiers
[shape center angle] [shape center angle]
(let [shape-center (gco/center-shape shape) (let [shape-center (gco/shape->center shape)
;; Translation caused by the rotation ;; Translation caused by the rotation
move-vec move-vec
(gpt/transform (gpt/transform
@ -502,7 +502,7 @@
shape-transform (:transform shape) shape-transform (:transform shape)
shape-transform-inv (:transform-inverse 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) {sr-width :width sr-height :height} (:selrect shape)
origin (cond-> (gpt/point (: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 (def empty-page-data
{:options {} {:options {}
:objects {root :objects {root
{:id root (cts/setup-shape {:id root
:type :frame :type :frame
:name "Root Frame"}}}) :parent-id root
:frame-id root
:name "Root Frame"})}})
(defn make-empty-page (defn make-empty-page
[id name] [id name]

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

@ -6,16 +6,21 @@
(ns app.common.types.shape (ns app.common.types.shape
(:require (:require
#?(:clj [app.common.fressian :as fres])
[app.common.colors :as clr] [app.common.colors :as clr]
[app.common.data :as d] [app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [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.geom.shapes :as gsh]
[app.common.pages.common :refer [default-color]] [app.common.record :as cr]
[app.common.schema :as sm] [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.color :as ctc]
[app.common.types.grid :as ctg] [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.blur :as ctsb]
[app.common.types.shape.export :as ctse] [app.common.types.shape.export :as ctse]
[app.common.types.shape.interactions :as ctsi] [app.common.types.shape.interactions :as ctsi]
@ -25,10 +30,26 @@
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[clojure.set :as set])) [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-line #{:round :square})
(def stroke-caps-marker #{:line-arrow :triangle-arrow :square-marker :circle-marker :diamond-marker}) (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 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 (def blend-modes
#{:normal #{:normal
:darken :darken
@ -57,7 +78,15 @@
#{"left" "right" "center" "justify"}) #{"left" "right" "center" "justify"})
(sm/def! ::selrect (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] [:x ::sm/safe-number]
[:y ::sm/safe-number] [:y ::sm/safe-number]
[:x1 ::sm/safe-number] [:x1 ::sm/safe-number]
@ -65,10 +94,10 @@
[:y1 ::sm/safe-number] [:y1 ::sm/safe-number]
[:y2 ::sm/safe-number] [:y2 ::sm/safe-number]
[:width ::sm/safe-number] [:width ::sm/safe-number]
[:height ::sm/safe-number]]) [:height ::sm/safe-number]]])
(sm/def! ::points (sm/def! ::points
[:vector {:gen/max 5} ::gpt/point]) [:vector {:gen/max 4 :gen/min 4} ::gpt/point])
(sm/def! ::fill (sm/def! ::fill
[:map {:title "Fill" :min 1} [:map {:title "Fill" :min 1}
@ -95,6 +124,22 @@
[::sm/one-of stroke-caps]] [::sm/one-of stroke-caps]]
[:stroke-color-gradient {:optional true} ::ctc/gradient]]) [: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 (sm/def! ::shape-attrs
[:map {:title "ShapeAttrs"} [:map {:title "ShapeAttrs"}
[:name {:optional true} :string] [:name {:optional true} :string]
@ -125,10 +170,10 @@
[:r2 {:optional true} ::sm/safe-number] [:r2 {:optional true} ::sm/safe-number]
[:r3 {:optional true} ::sm/safe-number] [:r3 {:optional true} ::sm/safe-number]
[:r4 {:optional true} ::sm/safe-number] [:r4 {:optional true} ::sm/safe-number]
[:x {:optional true} ::sm/safe-number] [:x {:optional true} [:maybe ::sm/safe-number]]
[:y {:optional true} ::sm/safe-number] [:y {:optional true} [:maybe ::sm/safe-number]]
[:width {:optional true} ::sm/safe-number] [:width {:optional true} [:maybe ::sm/safe-number]]
[:height {:optional true} ::sm/safe-number] [:height {:optional true} [:maybe ::sm/safe-number]]
[:opacity {:optional true} ::sm/safe-number] [:opacity {:optional true} ::sm/safe-number]
[:grids {:optional true} [:grids {:optional true}
[:vector {:gen/max 2} ::ctg/grid]] [:vector {:gen/max 2} ::ctg/grid]]
@ -148,21 +193,18 @@
[::sm/one-of #{:auto-width :auto-height :fixed}]] [::sm/one-of #{:auto-width :auto-height :fixed}]]
]) ])
(def shape-attrs? (def valid-shape-attrs?
(sm/pred-fn ::shape-attrs)) (sm/pred-fn ::shape-attrs))
(sm/def! ::group-attrs (sm/def! ::group-attrs
[:map {:title "GroupAttrs"} [:map {:title "GroupAttrs"}
[:type [:= :group]] [:type [:= :group]]
[:id ::sm/uuid]
[:shapes [:vector {:min 1 :gen/max 10 :gen/min 1} ::sm/uuid]]]) [:shapes [:vector {:min 1 :gen/max 10 :gen/min 1} ::sm/uuid]]])
(sm/def! ::frame-attrs (sm/def! ::frame-attrs
[:map {:title "FrameAttrs"} [:map {:title "FrameAttrs"}
[:type [:= :frame]] [:type [:= :frame]]
[:id ::sm/uuid] [:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
[:shapes {:optional true} [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
[:file-thumbnail {:optional true} :boolean]
[:hide-fill-on-export {:optional true} :boolean] [:hide-fill-on-export {:optional true} :boolean]
[:show-content {:optional true} :boolean] [:show-content {:optional true} :boolean]
[:hide-in-viewer {:optional true} :boolean]]) [:hide-in-viewer {:optional true} :boolean]])
@ -170,7 +212,6 @@
(sm/def! ::bool-attrs (sm/def! ::bool-attrs
[:map {:title "BoolAttrs"} [:map {:title "BoolAttrs"}
[:type [:= :bool]] [:type [:= :bool]]
[:id ::sm/uuid]
[:shapes [:vector {:min 1 :gen/max 10 :gen/min 1} ::sm/uuid]] [:shapes [:vector {:min 1 :gen/max 10 :gen/min 1} ::sm/uuid]]
;; FIXME: improve this schema ;; FIXME: improve this schema
@ -186,23 +227,19 @@
(sm/def! ::rect-attrs (sm/def! ::rect-attrs
[:map {:title "RectAttrs"} [:map {:title "RectAttrs"}
[:type [:= :rect]] [:type [:= :rect]]])
[:id ::sm/uuid]])
(sm/def! ::circle-attrs (sm/def! ::circle-attrs
[:map {:title "CircleAttrs"} [:map {:title "CircleAttrs"}
[:type [:= :circle]] [:type [:= :circle]]])
[:id ::sm/uuid]])
(sm/def! ::svg-raw-attrs (sm/def! ::svg-raw-attrs
[:map {:title "SvgRawAttrs"} [:map {:title "SvgRawAttrs"}
[:type [:= :svg-raw]] [:type [:= :svg-raw]]])
[:id ::sm/uuid]])
(sm/def! ::image-attrs (sm/def! ::image-attrs
[:map {:title "ImageAttrs"} [:map {:title "ImageAttrs"}
[:type [:= :image]] [:type [:= :image]]
[:id ::sm/uuid]
[:metadata [:metadata
[:map [:map
[:width :int] [:width :int]
@ -213,7 +250,6 @@
(sm/def! ::path-attrs (sm/def! ::path-attrs
[:map {:title "PathAttrs"} [:map {:title "PathAttrs"}
[:type [:= :path]] [:type [:= :path]]
[:id ::sm/uuid]
[:content [:content
[:vector [:vector
[:map [:map
@ -222,21 +258,21 @@
(sm/def! ::text-attrs (sm/def! ::text-attrs
[:map {:title "TextAttrs"} [:map {:title "TextAttrs"}
[:id ::sm/uuid]
[:type [:= :text]] [:type [:= :text]]
[:content {:optional true} [:maybe ::ctsx/content]]]) [:content {:optional true} [:maybe ::ctsx/content]]])
(sm/def! ::shape (sm/def! ::shape-map
[:multi {:dispatch :type :title "Shape"} [:multi {:dispatch :type :title "Shape"}
[:group [:group
[:merge {:title "GroupShape"} [:merge {:title "GroupShape"}
::shape-attrs ::shape-attrs
::minimal-shape-attrs
::group-attrs ::group-attrs
::ctsl/layout-child-attrs]] ::ctsl/layout-child-attrs]]
[:frame [:frame
[:merge {:title "FrameShape"} [:merge {:title "FrameShape"}
::shape-attrs ::minimal-shape-attrs
::frame-attrs ::frame-attrs
::ctsl/layout-attrs ::ctsl/layout-attrs
::ctsl/layout-child-attrs]] ::ctsl/layout-child-attrs]]
@ -244,82 +280,112 @@
[:bool [:bool
[:merge {:title "BoolShape"} [:merge {:title "BoolShape"}
::shape-attrs ::shape-attrs
::minimal-shape-attrs
::bool-attrs ::bool-attrs
::ctsl/layout-child-attrs]] ::ctsl/layout-child-attrs]]
[:rect [:rect
[:merge {:title "RectShape"} [:merge {:title "RectShape"}
::shape-attrs ::shape-attrs
::minimal-shape-attrs
::rect-attrs ::rect-attrs
::ctsl/layout-child-attrs]] ::ctsl/layout-child-attrs]]
[:circle [:circle
[:merge {:title "CircleShape"} [:merge {:title "CircleShape"}
::shape-attrs ::shape-attrs
::minimal-shape-attrs
::circle-attrs ::circle-attrs
::ctsl/layout-child-attrs]] ::ctsl/layout-child-attrs]]
[:image [:image
[:merge {:title "ImageShape"} [:merge {:title "ImageShape"}
::shape-attrs ::shape-attrs
::minimal-shape-attrs
::image-attrs ::image-attrs
::ctsl/layout-child-attrs]] ::ctsl/layout-child-attrs]]
[:svg-raw [:svg-raw
[:merge {:title "SvgRawShape"} [:merge {:title "SvgRawShape"}
::shape-attrs ::shape-attrs
::minimal-shape-attrs
::svg-raw-attrs ::svg-raw-attrs
::ctsl/layout-child-attrs]] ::ctsl/layout-child-attrs]]
[:path [:path
[:merge {:title "PathShape"} [:merge {:title "PathShape"}
::shape-attrs ::shape-attrs
::minimal-shape-attrs
::path-attrs ::path-attrs
::ctsl/layout-child-attrs]] ::ctsl/layout-child-attrs]]
[:text [:text
[:merge {:title "TextShape"} [:merge {:title "TextShape"}
::shape-attrs ::shape-attrs
::minimal-shape-attrs
::text-attrs ::text-attrs
::ctsl/layout-child-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)) (sm/pred-fn ::shape))
;; --- Initialization ;; --- Initialization
(def default-shape-attrs (def ^:private minimal-rect-attrs
{}) {:type :rect
(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
:name "Rectangle" :name "Rectangle"
:fills [{:fill-color default-color :fills [{:fill-color default-color
:fill-opacity 1}] :fill-opacity 1}]
:strokes [] :strokes []
:rx 0 :rx 0
:ry 0} :ry 0})
(def ^:private minimal-image-attrs
{:type :image {:type :image
:rx 0 :rx 0
:ry 0 :ry 0
:fills [] :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 {:type :circle
:name "Ellipse" :name "Ellipse"
:fills [{:fill-color default-color :fills [{:fill-color default-color
:fill-opacity 1}] :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 {:type :path
:name "Path" :name "Path"
:fills [] :fills []
@ -327,113 +393,103 @@
:stroke-alignment :center :stroke-alignment :center
:stroke-width 2 :stroke-width 2
:stroke-color clr/black :stroke-color clr/black
:stroke-opacity 1}]} :stroke-opacity 1}]})
{:type :frame (def ^:private minimal-svg-raw-attrs
:name "Board" {:type :svg-raw
:fills [{:fill-color clr/white :fills []
:fill-opacity 1}] :strokes []})
:strokes []
:rx 0
:ry 0}
{:type :text (def ^:private minimal-multiple-attrs
:name "Text" {:type :multiple})
:content nil}
{:type :svg-raw}]) (defn- get-minimal-shape
(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
[type] [type]
(let [type (cond (= type :curve) :path (case type
:else type) :rect minimal-rect-attrs
shape (d/seek #(= type (:type %)) minimal-shapes)] :image minimal-image-attrs
(when-not shape :circle minimal-circle-attrs
(ex/raise :type :assertion :path minimal-path-attrs
:code :shape-type-not-implemented :frame minimal-frame-attrs
:context {:type type})) :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 :always
(assoc :id (uuid/next)) (assoc :id (uuid/next)
:rotation 0)
(not= :path (:type shape)) :always
(assoc :x 0 (map->Shape))))
: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}))))
(defn make-minimal-group (defn setup-rect
[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
"Initializes the selrect and points for a shape." "Initializes the selrect and points for a shape."
[shape] [{:keys [selrect points] :as shape}]
(let [selrect (gsh/rect->selrect shape) (let [selrect (or selrect (gsh/shape->rect shape))
points (gsh/rect->points shape) points (or points (grc/rect->points selrect))]
points (cond-> points
(:transform shape)
(gsh/transform-points (gsh/center-points points) (:transform shape)))]
(-> shape (-> shape
(assoc :selrect selrect (assoc :selrect selrect)
:points points)))) (assoc :points points))))
(defn- setup-rect (defn setup-path
"A specialized function for setup rect-like shapes." [{:keys [content selrect points] :as shape}]
[shape {:keys [x y width height]}] (let [selrect (or selrect (gsh/content->selrect content))
points (or points (grc/rect->points selrect))]
(-> shape (-> shape
(assoc :x x :y y :width width :height height) (assoc :selrect selrect)
(setup-rect-selrect))) (assoc :points points))))
(defn- setup-image (defn- setup-image
[shape props] [{:keys [metadata] :as shape}]
(let [metadata (or (:metadata shape) (:metadata props))] (-> shape
(-> (setup-rect shape props) (assoc :metadata metadata)
(assoc (assoc :proportion (/ (:width metadata)
:metadata metadata (:height metadata)))
:proportion (/ (:width metadata) (assoc :proportion-lock true)))
(:height metadata))
:proportion-lock true))))
(defn setup-shape (defn setup-shape
"A function that initializes the geometric data of "A function that initializes the geometric data of
the shape. The props must have :x :y :width :height." the shape. The props must have :x :y :width :height."
([props] [{:keys [type] :as props}]
(setup-shape {:type :rect} 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] ;; --- SHAPE SERIALIZATION
(case (:type shape)
:image (setup-image shape props)
(setup-rect shape props))))
(defn make-shape (t/add-handlers!
"Make a non group shape, ready to use." {:id "shape"
[type geom-props attrs] :class Shape
(-> (if-not (= type :group) :wfn #(into {} %)
(make-minimal-shape type) :rfn map->Shape})
(make-minimal-group uuid/zero geom-props (:name attrs)))
(setup-shape geom-props) #?(:clj
(merge attrs))) (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 ;; Copyright (c) KALEIDOS INC
(ns app.common.pages.common (ns app.common.types.shape.attrs
(:require (:require
[app.common.colors :as clr] [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]))
(def file-version 20)
(def default-color clr/gray-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 ;; Attributes that may directly be edited by the user with forms
(def editable-attrs (def editable-attrs
@ -594,33 +494,4 @@
:layout-item-min-w :layout-item-min-w
:layout-item-align-self}}) :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! (dm/assert!
"The `:after-delay` event type incompatible with frame shapes" "The `:after-delay` event type incompatible with frame shapes"
(or (not= event-type :after-delay) (or (not= event-type :after-delay)
(= (:type shape) :frame))) (cph/frame-shape? shape)))
(if (= (:event-type interaction) event-type) (if (= (:event-type interaction) event-type)
interaction interaction

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

@ -6,7 +6,7 @@
(ns app.common.types.shape.radius (ns app.common.types.shape.radius
(:require (: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 ;; 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: ;; 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)))) (not (mth/almost-zero? (:rotation frame 0))))
(defn clone-object (defn clone-object
"Gets a copy of the object and all its children, with new ids "Gets a copy of the object and all its children, with new ids and with
and with the parent-children links correctly set. Admits functions the parent-children links correctly set. Admits functions to make
to make more transformations to the cloned objects and the more transformations to the cloned objects and the original ones.
original ones.
Returns the cloned object, the list of all new objects (including Returns the cloned object, the list of all new objects (including
the cloned one), and possibly a list of original objects modified. the cloned one), and possibly a list of original objects modified.
@ -357,7 +356,7 @@
(if (empty? child-ids) (if (empty? child-ids)
(let [new-object (cond-> object (let [new-object (cond-> object
true :always
(assoc :id new-id (assoc :id new-id
:parent-id parent-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 ;; Copyright (c) KALEIDOS INC
(ns common-tests.pages-migrations-test (ns common-tests.files-migrations-test
(:require (:require
[clojure.test :as t]
[clojure.pprint :refer [pprint]]
[app.common.data :as d] [app.common.data :as d]
[app.common.files.migrations :as cpm]
[app.common.pages :as cp] [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 (t/deftest test-migration-8-1
(let [page-id (uuid/custom 0 0) (let [page-id (uuid/custom 0 0)

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

@ -8,6 +8,7 @@
(:require (:require
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.geom.shapes.transforms :as gsht] [app.common.geom.shapes.transforms :as gsht]
[app.common.math :as mth :refer [close?]] [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 :curve-to :params {:x 40 :y 40 :c1x 35 :c1y 35 :c2x 45 :c2y 45}}
{:command :close-path}]) {: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 (defn create-test-shape
([type] (create-test-shape type {})) ([type] (create-test-shape type {}))
([type params] ([type params]
(-> (cts/make-minimal-shape type) (if (= type :path)
(merge params) (cts/setup-shape
(cond-> (merge
(= type :path) (add-path-data) {:type :path
(not= type :path) (add-rect-data))))) :content (:content params default-path)}
params))
(cts/setup-shape
(merge
{:type type
:width 20
:height 20}
params)))))
(t/deftest transform-shapes (t/deftest transform-shapes
(t/testing "Shape without modifiers should stay the same" (t/testing "Shape without modifiers should stay the same"
@ -62,10 +49,11 @@
:rect :path)) :rect :path))
(t/testing "Transform shape with translation modifiers" (t/testing "Transform shape with translation modifiers"
(t/are [type] (doseq [type [:rect :path]]
(let [modifiers (ctm/move-modifiers (gpt/point 10 -10))] (let [modifiers (ctm/move-modifiers (gpt/point 10 -10))
(let [shape-before (create-test-shape type {:modifiers modifiers}) shape-before (create-test-shape type {:modifiers modifiers})
shape-after (gsh/transform-shape shape-before)] shape-after (gsh/transform-shape shape-before)]
(t/is (not= shape-before shape-after)) (t/is (not= shape-before shape-after))
(t/is (close? (get-in shape-before [:selrect :x]) (t/is (close? (get-in shape-before [:selrect :x])
@ -78,9 +66,8 @@
(get-in shape-after [:selrect :width]))) (get-in shape-after [:selrect :width])))
(t/is (close? (get-in shape-before [:selrect :height]) (t/is (close? (get-in shape-before [:selrect :height])
(get-in shape-after [:selrect :height]))))) (get-in shape-after [:selrect :height])))
)))
:rect :path))
(t/testing "Transform with empty translation" (t/testing "Transform with empty translation"
(t/are [type] (t/are [type]
@ -138,7 +125,7 @@
(t/testing "Transform shape with rotation modifiers" (t/testing "Transform shape with rotation modifiers"
(t/are [type] (t/are [type]
(let [shape-before (create-test-shape 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-before (assoc shape-before :modifiers modifiers)
shape-after (gsh/transform-shape shape-before)] shape-after (gsh/transform-shape shape-before)]
@ -160,7 +147,7 @@
(t/testing "Transform shape with rotation = 0 should leave equal selrect" (t/testing "Transform shape with rotation = 0 should leave equal selrect"
(t/are [type] (t/are [type]
(let [shape-before (create-test-shape 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))] shape-after (gsh/transform-shape (assoc shape-before :modifiers modifiers))]
(t/are [prop] (t/are [prop]
(t/is (close? (get-in shape-before [:selrect prop]) (t/is (close? (get-in shape-before [:selrect prop])
@ -171,23 +158,23 @@
(t/testing "Transform shape with invalid selrect fails gracefully" (t/testing "Transform shape with invalid selrect fails gracefully"
(t/are [type selrect] (t/are [type selrect]
(let [modifiers (ctm/move-modifiers 0 0) (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)] shape-after (gsh/transform-shape shape-before modifiers)]
(t/is (= (:selrect shape-before) (t/is (grc/close-rect? (:selrect shape-before)
(:selrect shape-after)))) (:selrect shape-after))))
:rect {:x 0.0 :y 0.0 :x1 0.0 :y1 0.0 :x2 ##Inf :y2 ##Inf :width ##Inf :height ##Inf} :rect (grc/make-rect 0 0 ##Inf ##Inf)
:path {:x 0.0 :y 0.0 :x1 0.0 :y1 0.0 :x2 ##Inf :y2 ##Inf :width ##Inf :height ##Inf} :path (grc/make-rect 0 0 ##Inf ##Inf)
:rect nil ))
:path nil))) )
(t/deftest points-to-selrect (t/deftest points-to-selrect
(let [points [(gpt/point 0.5 0.5) (let [points [(gpt/point 0.5 0.5)
(gpt/point -1 -2) (gpt/point -1 -2)
(gpt/point 20 65.2) (gpt/point 20 65.2)
(gpt/point 12 -10)] (gpt/point 12 -10)]
result (gsh/points->rect points) result (grc/points->rect points)
expect {:x -1, :y -10, :width 21, :height 75.2}] expect {:x -1, :y -10, :width 21, :height 75.2}]
(t/is (= (:x expect) (:x result))) (t/is (= (:x expect) (:x result)))
@ -204,39 +191,39 @@
(t/is (gmt/close? expected result))) (t/is (gmt/close? expected result)))
;; No transformation ;; No transformation
(gsh/make-selrect 0 0 10 10) (grc/make-rect 0 0 10 10)
(-> (gsh/make-selrect 0 0 10 10) (-> (grc/make-rect 0 0 10 10)
(gsh/rect->points)) (grc/rect->points))
(gmt/matrix) (gmt/matrix)
;; Displacement ;; Displacement
(gsh/make-selrect 0 0 10 10) (grc/make-rect 0 0 10 10)
(-> (gsh/make-selrect 20 20 10 10) (-> (grc/make-rect 20 20 10 10)
(gsh/rect->points )) (grc/rect->points ))
(gmt/matrix 1 0 0 1 20 20) (gmt/matrix 1 0 0 1 20 20)
;; Resize ;; Resize
(gsh/make-selrect 0 0 10 10) (grc/make-rect 0 0 10 10)
(-> (gsh/make-selrect 0 0 20 40) (-> (grc/make-rect 0 0 20 40)
(gsh/rect->points)) (grc/rect->points))
(gmt/matrix 2 0 0 4 0 0) (gmt/matrix 2 0 0 4 0 0)
;; Displacement+Resize ;; Displacement+Resize
(gsh/make-selrect 0 0 10 10) (grc/make-rect 0 0 10 10)
(-> (gsh/make-selrect 10 10 20 40) (-> (grc/make-rect 10 10 20 40)
(gsh/rect->points)) (grc/rect->points))
(gmt/matrix 2 0 0 4 10 10) (gmt/matrix 2 0 0 4 10 10)
;; Rotation ;; Rotation
(gsh/make-selrect 0 0 10 10) (grc/make-rect 0 0 10 10)
(-> (gsh/make-selrect 0 0 10 10) (-> (grc/make-rect 0 0 10 10)
(gsh/rect->points) (grc/rect->points)
(gsh/transform-points (gmt/rotate-matrix 45))) (gsh/transform-points (gmt/rotate-matrix 45)))
(gmt/matrix (mth/cos g45) (mth/sin g45) (- (mth/sin g45)) (mth/cos g45) 0 0) (gmt/matrix (mth/cos g45) (mth/sin g45) (- (mth/sin g45)) (mth/cos g45) 0 0)
;; Rotation + Resize ;; Rotation + Resize
(gsh/make-selrect 0 0 10 10) (grc/make-rect 0 0 10 10)
(-> (gsh/make-selrect 0 0 20 40) (-> (grc/make-rect 0 0 20 40)
(gsh/rect->points) (grc/rect->points)
(gsh/transform-points (gmt/rotate-matrix 45))) (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)))) (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] (fn [file-data]
(let [frame-id (get props :frame-id uuid/zero) (let [frame-id (get props :frame-id uuid/zero)
parent-id (get props :parent-id uuid/zero) parent-id (get props :parent-id uuid/zero)
shape (if (= type :group) shape (cts/setup-shape
(cts/make-minimal-group frame-id (-> {:type type
{:x 0 :y 0 :width 1 :height 1} :width 1
(get props :name "Group1")) :height 1}
(cts/make-shape type (merge props)))]
{:x 0 :y 0 :width 1 :height 1}
props))]
(swap! idmap assoc label (:id shape)) (swap! idmap assoc label (:id shape))
(ctpl/update-page file-data (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 (ns common-tests.types-shape-interactions-test
(:require (:require
[app.common.geom.shapes :as gsh]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.geom.point :as gpt] [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 :as cts]
[app.common.types.shape.interactions :as ctsi] [app.common.types.shape.interactions :as ctsi]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
@ -17,8 +18,8 @@
(t/deftest set-event-type (t/deftest set-event-type
(let [interaction ctsi/default-interaction (let [interaction ctsi/default-interaction
shape (cts/make-minimal-shape :rect) shape (cts/setup-shape {:type :rect})
frame (cts/make-minimal-shape :frame)] frame (cts/setup-shape {:type :frame})]
(t/testing "Set event type unchanged" (t/testing "Set event type unchanged"
(let [new-interaction (let [new-interaction
@ -46,7 +47,8 @@
new-interaction new-interaction
(ctsi/set-event-type interaction :after-delay frame)] (ctsi/set-event-type interaction :after-delay frame)]
(t/is (= :after-delay (:event-type new-interaction))) (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 (t/deftest set-action-type
@ -148,7 +150,7 @@
(t/is (= "https://example.com" (:url new-interaction))))))) (t/is (= "https://example.com" (:url new-interaction)))))))
(t/deftest option-delay (t/deftest option-delay
(let [frame (cts/make-minimal-shape :frame) (let [frame (cts/setup-shape {:type :frame})
i1 ctsi/default-interaction i1 ctsi/default-interaction
i2 (ctsi/set-event-type i1 :after-delay frame)] i2 (ctsi/set-event-type i1 :after-delay frame)]
@ -160,7 +162,6 @@
(let [new-interaction (ctsi/set-delay i2 1000)] (let [new-interaction (ctsi/set-delay i2 1000)]
(t/is (= 1000 (:delay new-interaction))))))) (t/is (= 1000 (:delay new-interaction)))))))
(t/deftest option-destination (t/deftest option-destination
(let [destination (uuid/next) (let [destination (uuid/next)
i1 ctsi/default-interaction i1 ctsi/default-interaction
@ -211,10 +212,10 @@
(t/deftest option-overlay-opts (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 :width] 100)
(assoc-in [:selrect :height] 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 :width] 30)
(assoc-in [:selrect :height] 20)) (assoc-in [:selrect :height] 20))
objects {(:id base-frame) base-frame objects {(:id base-frame) base-frame
@ -277,37 +278,35 @@
(t/is (= relative-to-id (:position-relative-to new-interaction))))))) (t/is (= relative-to-id (:position-relative-to new-interaction)))))))
(defn setup-selrect [{:keys [x y width height] :as obj}] (defn setup-selrect [{:keys [x y width height] :as obj}]
(let [rect (gsh/make-rect x y width height) (let [rect (grc/make-rect x y width height)
center (gsh/center-rect rect) center (grc/rect->center rect)
selrect (gsh/rect->selrect rect) points (grc/rect->points rect)]
points (gsh/rect->points rect)]
(-> obj (-> obj
(assoc :selrect selrect) (assoc :selrect rect)
(assoc :points points)))) (assoc :points points))))
(t/deftest calc-overlay-position (t/deftest calc-overlay-position
(let [base-frame (-> (cts/make-minimal-shape :frame) (let [base-frame (cts/setup-shape
(assoc :width 100) {:type :frame
(assoc :height 100) :width 100
(setup-selrect)) :height 100})
popup (-> (cts/make-minimal-shape :frame) popup (cts/setup-shape
(assoc :width 50) {:type :frame
(assoc :height 50) :width 50
(assoc :x 10) :height 50
(assoc :y 10) :x 10
(setup-selrect)) :y 10})
rect (cts/setup-shape
{:type :rect
:width 50
:height 50
:x 10
:y 10})
rect (-> (cts/make-minimal-shape :rect) overlay-frame (cts/setup-shape
(assoc :width 50) {:type :frame
(assoc :height 50) :width 30
(assoc :x 10) :height 20})
(assoc :y 10)
(setup-selrect))
overlay-frame (-> (cts/make-minimal-shape :frame)
(assoc :width 30)
(assoc :height 20)
(setup-selrect))
objects {(:id base-frame) base-frame objects {(:id base-frame) base-frame
(:id popup) popup (:id popup) popup
@ -798,12 +797,12 @@
(t/deftest remap-interactions (t/deftest remap-interactions
(let [frame1 (cts/make-minimal-shape :frame) (let [frame1 (cts/setup-shape {:type :frame})
frame2 (cts/make-minimal-shape :frame) frame2 (cts/setup-shape {:type :frame})
frame3 (cts/make-minimal-shape :frame) frame3 (cts/setup-shape {:type :frame})
frame4 (cts/make-minimal-shape :frame) frame4 (cts/setup-shape {:type :frame})
frame5 (cts/make-minimal-shape :frame) frame5 (cts/setup-shape {:type :frame})
frame6 (cts/make-minimal-shape :frame) frame6 (cts/setup-shape {:type :frame})
objects {(:id frame3) frame3 objects {(:id frame3) frame3
(:id frame4) frame4 (:id frame4) frame4

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

@ -24,7 +24,8 @@
(t/deftest types-shape-spec (t/deftest types-shape-spec
(sg/check! (sg/check!
(sg/for [fdata (sg/generator ::cts/shape)] (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 (t/deftest types-page-spec
(-> (sg/for [fdata (sg/generator ::ctp/page)] (-> (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 (ns app.libs.file-builder
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.file-builder :as fb] [app.common.files.builder :as fb]
[app.common.media :as cm] [app.common.media :as cm]
[app.common.types.components-list :as ctkl] [app.common.types.components-list :as ctkl]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]

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

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

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

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

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

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

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

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

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

@ -6,12 +6,13 @@
(ns app.main.data.workspace.drawing.box (ns app.main.data.workspace.drawing.box
(:require (:require
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.geom.shapes.flex-layout :as gslf] [app.common.geom.shapes.flex-layout :as gslf]
[app.common.geom.shapes.grid-layout :as gslg] [app.common.geom.shapes.grid-layout :as gslg]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.pages.helpers :as cph]
[app.common.types.modifiers :as ctm] [app.common.types.modifiers :as ctm]
[app.common.types.shape :as cts] [app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst] [app.common.types.shape-tree :as ctst]
@ -42,13 +43,16 @@
(defn resize-shape [{:keys [x y width height] :as shape} initial point lock?] (defn resize-shape [{:keys [x y width height] :as shape} initial point lock?]
(if (and (some? x) (some? y) (some? width) (some? height)) (if (and (some? x) (some? y) (some? width) (some? height))
(let [draw-rect (gsh/make-rect initial (cond-> point lock? (adjust-ratio initial))) (let [draw-rect (grc/make-rect initial (cond-> point lock? (adjust-ratio initial)))
shape-rect (gsh/make-rect x y width height) shape-rect (grc/make-rect x y width height)
scalev (gpt/point (/ (:width draw-rect) (:width shape-rect)) scalev (gpt/point (/ (:width draw-rect)
(/ (:height draw-rect) (:height shape-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 (-> shape
(assoc :click-draw? false) (assoc :click-draw? false)
@ -65,18 +69,18 @@
(fn [state] (fn [state]
(update-in state [:workspace-drawing :object] gsh/absolute-move (gpt/point x y)))) (update-in state [:workspace-drawing :object] gsh/absolute-move (gpt/point x y))))
(defn handle-drawing-box [] (defn handle-drawing
(ptk/reify ::handle-drawing-box [type]
(ptk/reify ::handle-drawing
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [stoper? #(or (ms/mouse-up? %) (= % :interrupt)) (let [stoper (rx/filter #(or (ms/mouse-up? %) (= % :interrupt)) stream)
stoper (rx/filter stoper? stream)
layout (get state :workspace-layout) layout (get state :workspace-layout)
zoom (get-in state [:workspace-local :zoom] 1) zoom (dm/get-in state [:workspace-local :zoom] 1)
snap-pixel? (contains? layout :snap-pixel-grid)
snap-precision (if (>= zoom zoom-half-pixel-precision) 0.5 1) snap-pixel? (contains? layout :snap-pixel-grid)
initial (cond-> @ms/mouse-position snap-pixel? (gpt/round-step snap-precision)) 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) page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id) 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-index (when flex-layout? (gslf/get-drop-index fid objects initial))
drop-cell (when grid-layout? (gslg/get-drop-cell fid objects initial)) drop-cell (when grid-layout? (gslg/get-drop-cell fid objects initial))
shape (get-in state [:workspace-drawing :object]) shape (-> (cts/setup-shape {:type type
shape (-> shape :x (:x initial)
(cts/setup-shape {:x (:x initial)
:y (:y initial) :y (:y initial)
:width 0.01 :frame-id fid
:height 0.01}) :parent-id fid
(cond-> (and (cph/frame-shape? shape) :initialized? true
(not= fid uuid/zero)) :click-draw? true
(assoc :fills [] :hide-in-viewer true)) :hide-in-viewer (and (= type :frame) (not= fid uuid/zero))})
(assoc :frame-id fid)
(cond-> (some? drop-index) (cond-> (some? drop-index)
(with-meta {:index drop-index})) (with-meta {:index drop-index}))
(cond-> (some? drop-cell) (cond-> (some? drop-cell)
(with-meta {:cell drop-cell})) (with-meta {:cell drop-cell})))
]
(assoc :initialized? true)
(assoc :click-draw? true))]
(rx/concat (rx/concat
;; Add shape to drawing state ;; Add shape to drawing state
(rx/of #(assoc-in state [:workspace-drawing :object] shape)) (rx/of #(update % :workspace-drawing assoc :object shape))
;; Initial SNAP ;; Initial SNAP
(->> (->> (rx/concat
(rx/concat
(->> (snap/closest-snap-point page-id [shape] objects layout zoom focus initial) (->> (snap/closest-snap-point page-id [shape] objects layout zoom focus initial)
(rx/map move-drawing)) (rx/map move-drawing))
@ -129,7 +126,8 @@
(rx/map #(conj current %))))) (rx/map #(conj current %)))))
(rx/map (rx/map
(fn [[_ shift? point]] (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/take-until stoper))
(->> (rx/of (common/handle-finish-drawing)) (->> (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 (ns app.main.data.workspace.drawing.common
(:require (:require
[app.common.data.macros :as dm]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
@ -30,46 +31,46 @@
(ptk/reify ::handle-finish-drawing (ptk/reify ::handle-finish-drawing
ptk/WatchEvent ptk/WatchEvent
(watch [_ state _] (watch [_ state _]
(let [tool (get-in state [:workspace-drawing :tool]) (let [tool (dm/get-in state [:workspace-drawing :tool])
shape (get-in state [:workspace-drawing :object]) shape (dm/get-in state [:workspace-drawing :object])
objects (wsh/lookup-page-objects state)] objects (wsh/lookup-page-objects state)
page-id (:current-page-id state)]
(rx/concat (rx/concat
(when (:initialized? shape) (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) min-side (mth/min 100
text? (= :text (:type shape)) (mth/floor (dm/get-prop vbox :width))
(mth/floor (dm/get-prop vbox :height)))
min-side (min 100
(mth/floor (get-in state [:workspace-local :vbox :width]))
(mth/floor (get-in state [:workspace-local :vbox :height])))
shape shape
(cond-> shape (cond-> shape
(not click-draw?) (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) (-> (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))))) (gsh/transform-shape (ctm/move-modifiers (- (/ min-side 2)) (- (/ min-side 2)))))
(and click-draw? text?) (and click-draw? text?)
(-> (assoc :height 17 :width 4 :grow-type :auto-width) (-> (assoc :height 17 :width 4 :grow-type :auto-width)
(cts/setup-rect-selrect)) (cts/setup-shape))
:always :always
(dissoc :initialized? :click-draw?))] (dissoc :initialized? :click-draw?))]
;; Add & select the created shape to the workspace ;; Add & select the created shape to the workspace
(rx/concat (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/of (dwu/start-undo-transaction (:id shape)))
(rx/empty)) (rx/empty))
(rx/of (dwsh/add-shape shape {:no-select? (= tool :curve)})) (rx/of (dwsh/add-shape shape {:no-select? (= tool :curve)}))
(if (cph/frame-shape? shape)
(if (= :frame (:type shape))
(rx/concat (rx/concat
(->> (uw/ask! {:cmd :selection/query (->> (uw/ask! {:cmd :selection/query
:page-id page-id :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 (ns app.main.data.workspace.drawing.curve
(:require (:require
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.geom.shapes.flex-layout :as gslf] [app.common.geom.shapes.flex-layout :as gslf]
[app.common.geom.shapes.grid-layout :as gslg] [app.common.geom.shapes.grid-layout :as gslg]
[app.common.geom.shapes.path :as gsp] [app.common.geom.shapes.path :as gsp]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst] [app.common.types.shape-tree :as ctst]
[app.common.types.shape.layout :as ctl] [app.common.types.shape.layout :as ctl]
[app.main.data.workspace.drawing.common :as common] [app.main.data.workspace.drawing.common :as common]
@ -22,85 +25,91 @@
(def simplify-tolerance 0.3) (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)) (ms/mouse-event? event) (= type :up))
(defn initialize-drawing [state] (defn- insert-point
(assoc-in state [:workspace-drawing :object :initialized?] true)) [point]
(ptk/reify ::insert-point
(defn insert-point-segment [state point] ptk/UpdateEvent
(let [segments (-> state (update [_ state]
(get-in [:workspace-drawing :object :segments]) (update-in state [:workspace-drawing :object]
(or []) (fn [object]
(let [segments (-> (:segments object)
(conj point)) (conj point))
content (gsp/segments->content segments) content (gsp/segments->content segments)
selrect (gsh/content->selrect content) selrect (gsh/content->selrect content)
points (gsh/rect->points selrect)] points (grc/rect->points selrect)]
(-> state (-> object
(update-in [:workspace-drawing :object] assoc (assoc :segments segments)
:segments segments (assoc :content content)
:content content (assoc :selrect selrect)
:selrect selrect (assoc :points points))))))))
:points points))))
(defn setup-frame-curve [] (defn- setup-frame
(ptk/reify ::setup-frame-path []
(ptk/reify ::setup-frame
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(let [objects (wsh/lookup-page-objects state) (let [objects (wsh/lookup-page-objects state)
content (get-in state [:workspace-drawing :object :content] []) content (dm/get-in state [:workspace-drawing :object :content] [])
start (get-in content [0 :params] nil) start (dm/get-in content [0 :params] nil)
position (when start (gpt/point start)) position (when start (gpt/point start))
frame-id (ctst/top-nested-frame objects position) frame-id (ctst/top-nested-frame objects position)
flex-layout? (ctl/flex-layout? objects frame-id) flex-layout? (ctl/flex-layout? objects frame-id)
grid-layout? (ctl/grid-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-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))] drop-cell (when grid-layout? (gslg/get-drop-cell frame-id objects position))]
(-> state (update-in state [:workspace-drawing :object]
(assoc-in [:workspace-drawing :object :frame-id] frame-id) (fn [object]
(-> object
(assoc :frame-id frame-id)
(assoc :parent-id frame-id)
(cond-> (some? drop-index) (cond-> (some? drop-index)
(update-in [:workspace-drawing :object] with-meta {:index drop-index})) (with-meta {:index drop-index}))
(cond-> (some? drop-cell) (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}] (defn finish-drawing
(let [content (gsp/segments->content segments) []
(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) selrect (gsh/content->selrect content)
points (gsh/rect->points selrect)] points (grc/rect->points selrect)]
(-> shape (-> shape
(dissoc :segments) (dissoc :segments)
(assoc :content content) (assoc :content content)
(assoc :selrect selrect) (assoc :selrect selrect)
(assoc :points points) (assoc :points points)
(cond-> (or (empty? points)
(nil? selrect)
(<= (count content) 1))
(assoc :initialized? false)))))))))
(cond-> (or (empty? points) (nil? selrect) (<= (count content) 1)) (defn handle-drawing []
(assoc :initialized? false))))) (ptk/reify ::handle-drawing
(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
ptk/WatchEvent ptk/WatchEvent
(watch [_ _ stream] (watch [_ _ stream]
(let [stoper (rx/filter stoper-event? 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/concat
(rx/of initialize-drawing) (rx/of #(update % :workspace-drawing assoc :object shape))
(->> mouse (->> mouse
(rx/map (fn [pt] #(insert-point-segment % pt))) (rx/map insert-point)
(rx/take-until stoper)) (rx/take-until stoper))
(rx/of (setup-frame-curve) (rx/of
(finish-drawing-curve) (setup-frame)
(finish-drawing)
(common/handle-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 (ns app.main.data.workspace.grid-layout.editor
(:require (:require
[app.common.geom.shapes :as gsh] [app.common.geom.rect :as grc]
[app.main.data.workspace.state-helpers :as wsh] [app.main.data.workspace.state-helpers :as wsh]
[potok.core :as ptk])) [potok.core :as ptk]))
@ -58,7 +58,7 @@
(let [{:keys [x y width height]} srect (let [{:keys [x y width height]} srect
x (+ x (/ width 2) (- (/ (:width vport) 2 zoom))) x (+ x (/ width 2) (- (/ (:width vport) 2 zoom)))
y (+ y (/ height 2) (- (/ (:height 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 (-> local
(update :vbox merge (select-keys srect [:x :y :x1 :x2 :y1 :y2]))))))))))) (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)) (:name (first shapes))
base-name) base-name)
selrect (gsh/selection-rect shapes) selrect (gsh/shapes->rect shapes)
group-idx (->> shapes group-idx (->> shapes
last last
:id :id
(cph/get-position-on-parent objects) (cph/get-position-on-parent objects)
inc) inc)
group (-> (cts/make-minimal-group frame-id selrect gname)
(cts/setup-shape selrect) group (cts/setup-shape {:type :group
(assoc :shapes (mapv :id shapes) :name gname
:shapes (mapv :id shapes)
:selrect selrect
:parent-id parent-id :parent-id parent-id
:frame-id frame-id :frame-id frame-id
:index group-idx)) :index group-idx})
;; Shapes that are in a component, but are not root, must be detached, ;; Shapes that are in a component, but are not root, must be detached,
;; because they will be now children of a non instance group. ;; 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 (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb] [app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.types.page :as ctp] [app.common.types.page :as ctp]
@ -33,8 +33,8 @@
(let [page (wsh/lookup-page state) (let [page (wsh/lookup-page state)
flows (get-in page [:options :flows] []) flows (get-in page [:options :flows] [])
unames (into #{} (map :name flows)) unames (cfh/get-used-names flows)
name (cp/generate-unique-name unames "Flow 1") name (cfh/generate-unique-name unames "Flow 1")
new-flow {:id (uuid/next) new-flow {:id (uuid/next)
:name name :name name

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

@ -24,9 +24,11 @@
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.main.data.events :as ev] [app.main.data.events :as ev]
[app.main.data.messages :as msg] [app.main.data.messages :as msg]
[app.main.data.workspace :as-alias dw]
[app.main.data.workspace.changes :as dch] [app.main.data.workspace.changes :as dch]
[app.main.data.workspace.groups :as dwg] [app.main.data.workspace.groups :as dwg]
[app.main.data.workspace.libraries-helpers :as dwlh] [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.selection :as dws]
[app.main.data.workspace.shapes :as dwsh] [app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.state-helpers :as wsh] [app.main.data.workspace.state-helpers :as wsh]
@ -562,7 +564,7 @@
(defn ext-library-changed (defn ext-library-changed
[file-id modified-at revn changes] [file-id modified-at revn changes]
(dm/assert! (uuid? file-id)) (dm/assert! (uuid? file-id))
(dm/assert! (ch/changes? changes)) (dm/assert! (ch/valid-changes? changes))
(ptk/reify ::ext-library-changed (ptk/reify ::ext-library-changed
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
@ -901,11 +903,11 @@
(ptk/reify ::watch-component-changes (ptk/reify ::watch-component-changes
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [components-v2 (features/active-feature? state :components-v2) (let [components-v2? (features/active-feature? state :components-v2)
stopper stopper
(->> stream (->> 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 %))))) (= ::watch-component-changes (ptk/type %)))))
workspace-data-s workspace-data-s
@ -914,35 +916,36 @@
(rx/from-atom refs/workspace-data {:emit-current-value? true})) (rx/from-atom refs/workspace-data {:emit-current-value? true}))
;; Need to get the file data before the change, so deleted shapes ;; Need to get the file data before the change, so deleted shapes
;; still exist, for example ;; still exist, for example
(rx/buffer 3 1)) (rx/buffer 3 1)
(rx/filter (fn [[old-data]] (some? old-data))))
change-s change-s
(->> stream (->> stream
(rx/filter #(or (dch/commit-changes? %) (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)) (rx/observe-on :async))
check-changes check-changes
(fn [[event [old-data _mid_data _new-data]]] (fn [[event [old-data _mid_data _new-data]]]
(when old-data (when old-data
(let [{:keys [file-id changes save-undo? undo-group]} (let [{:keys [file-id changes save-undo? undo-group]} (deref event)
(deref event)
components-changed changed-components
(when (or (nil? file-id) (= file-id (:id old-data))) (when (or (nil? file-id) (= file-id (:id old-data)))
(reduce #(into %1 (ch/components-changed old-data %2)) (->> changes
#{} (map (partial ch/components-changed old-data))
changes))] (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" (log/info :msg "DETECTED COMPONENTS CHANGED"
:ids (map str components-changed) :ids (map str changed-components)
:undo-group undo-group) :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 (->> change-s
(rx/with-latest-from workspace-data-s) (rx/with-latest-from workspace-data-s)
(rx/map check-changes) (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.point :as gpt]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.logging :as log] [app.common.logging :as log]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb] [app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.spec :as us] [app.common.spec :as us]
@ -181,8 +180,9 @@
(not (nil? parent-id)) (not (nil? parent-id))
(assoc :parent-id 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}) 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 (reduce #(pcb/add-object %1 %2 {:ignore-touched true})
changes changes
@ -1158,7 +1158,7 @@
origin-shape (reposition-shape origin-shape origin-root dest-root) origin-shape (reposition-shape origin-shape origin-root dest-root)
touched (get dest-shape :touched #{})] touched (get dest-shape :touched #{})]
(loop [attrs (seq (keys cp/component-sync-attrs)) (loop [attrs (seq (keys ctk/sync-attrs))
roperations [] roperations []
uoperations []] uoperations []]
@ -1196,7 +1196,7 @@
:val (get dest-shape attr) :val (get dest-shape attr)
:ignore-touched true} :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)) (if (or (= (get origin-shape attr) (get dest-shape attr))
(and (touched attr-group) omit-touched?)) (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, "Convert a media object that contains a bitmap image into shapes,
one shape of type :image and one group that contains it." one shape of type :image and one group that contains it."
[pos {:keys [name width height id mtype] :as media-obj}] [pos {:keys [name width height id mtype] :as media-obj}]
(let [group-shape (cts/make-shape :group (let [group-shape (cts/setup-shape
{:x (:x pos) {:type :group
:x (:x pos)
:y (:y pos) :y (:y pos)
:width width :width width
:height height} :height height
{:name name :name name
:frame-id uuid/zero :frame-id uuid/zero
:parent-id uuid/zero}) :parent-id uuid/zero})
img-shape (cts/make-shape :image img-shape (cts/setup-shape
{:x (:x pos) {:type :image
:x (:x pos)
:y (:y pos) :y (:y pos)
:width width :width width
:height height :height height
:metadata {:id id :metadata {:id id
:width width :width width
:height height :height height
:mtype mtype}} :mtype mtype}
{:name name :name name
:frame-id uuid/zero :frame-id uuid/zero
:parent-id (:id group-shape)})] :parent-id (:id group-shape)})]
(rx/of [group-shape [img-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 :as d]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.pages.common :as cpc]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.types.container :as ctn] [app.common.types.container :as ctn]
[app.common.types.modifiers :as ctm] [app.common.types.modifiers :as ctm]
[app.common.types.shape.attrs :refer [editable-attrs]]
[app.common.types.shape.layout :as ctl] [app.common.types.shape.layout :as ctl]
[app.main.constants :refer [zoom-half-pixel-precision]] [app.main.constants :refer [zoom-half-pixel-precision]]
[app.main.data.workspace.changes :as dch] [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). ;; Rotation use different algorithm to calculate children modifiers (and do not use child constraints).
(defn set-rotation-modifiers (defn set-rotation-modifiers
([angle shapes] ([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] ([angle shapes center]
(ptk/reify ::set-rotation-modifiers (ptk/reify ::set-rotation-modifiers
@ -389,7 +390,7 @@
ids ids
(->> shapes (->> shapes
(remove #(get % :blocked false)) (remove #(get % :blocked false))
(filter #((cpc/editable-attrs (:type %)) :rotation)) (filter #(:rotation (get editable-attrs (:type %))))
(map :id)) (map :id))
get-modifier 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.geom.shapes.flex-layout :as gsl]
[app.common.path.commands :as upc] [app.common.path.commands :as upc]
[app.common.path.shapes-to-path :as upsp] [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-tree :as ctst]
[app.common.types.shape.layout :as ctl] [app.common.types.shape.layout :as ctl]
[app.main.data.workspace.changes :as dch] [app.main.data.workspace.changes :as dch]
@ -196,14 +197,13 @@
drag-events drag-events
(rx/of (finish-drag))))))) (rx/of (finish-drag)))))))
(defn handle-drawing-path (defn handle-drawing
[_id] [_id]
(ptk/reify ::handle-drawing-path (ptk/reify ::handle-drawing
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(let [id (st/get-path-id state)] (let [id (st/get-path-id state)]
(-> state (assoc-in state [:workspace-local :edit-path id :edit-mode] :draw)))
(assoc-in [:workspace-local :edit-path id :edit-mode] :draw))))
ptk/WatchEvent ptk/WatchEvent
(watch [_ _ stream] (watch [_ _ stream]
@ -234,9 +234,8 @@
mousedown-events) mousedown-events)
(rx/of (common/finish-path "after-events"))))))) (rx/of (common/finish-path "after-events")))))))
(defn setup-frame []
(defn setup-frame-path [] (ptk/reify ::setup-frame
(ptk/reify ::setup-frame-path
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(let [objects (wsh/lookup-page-objects state) (let [objects (wsh/lookup-page-objects state)
@ -245,10 +244,14 @@
frame-id (ctst/top-nested-frame objects position) frame-id (ctst/top-nested-frame objects position)
flex-layout? (ctl/flex-layout? objects frame-id) flex-layout? (ctl/flex-layout? objects frame-id)
drop-index (when flex-layout? (gsl/get-drop-index frame-id objects position))] 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) (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] (defn handle-new-shape-result [shape-id]
(ptk/reify ::handle-new-shape-result (ptk/reify ::handle-new-shape-result
@ -264,7 +267,7 @@
(watch [_ state _] (watch [_ state _]
(let [content (get-in state [:workspace-drawing :object :content] [])] (let [content (get-in state [:workspace-drawing :object :content] [])]
(if (seq content) (if (seq content)
(rx/of (setup-frame-path) (rx/of (setup-frame)
(dwdc/handle-finish-drawing) (dwdc/handle-finish-drawing)
(dwe/start-edition-mode shape-id) (dwe/start-edition-mode shape-id)
(change-edit-mode :draw)) (change-edit-mode :draw))
@ -276,15 +279,17 @@
(ptk/reify ::handle-new-shape (ptk/reify ::handle-new-shape
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(let [id (st/get-path-id state)] (let [id (st/get-path-id state)
shape (cts/setup-shape {:type :path})]
(-> state (-> 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 ptk/WatchEvent
(watch [_ state stream] (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/concat
(rx/of (handle-drawing-path shape-id)) (rx/of (handle-drawing shape-id))
(->> stream (->> stream
(rx/filter (ptk/type? ::common/finish-path)) (rx/filter (ptk/type? ::common/finish-path))
(rx/take 1) (rx/take 1)
@ -310,7 +315,7 @@
(if (= :draw edit-mode) (if (= :draw edit-mode)
(rx/concat (rx/concat
(rx/of (dch/update-shapes [id] upsp/convert-to-path)) (rx/of (dch/update-shapes [id] upsp/convert-to-path))
(rx/of (handle-drawing-path id)) (rx/of (handle-drawing id))
(->> stream (->> stream
(rx/filter (ptk/type? ::common/finish-path)) (rx/filter (ptk/type? ::common/finish-path))
(rx/take 1) (rx/take 1)

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

@ -8,6 +8,7 @@
(:require (:require
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.path.commands :as upc] [app.common.path.commands :as upc]
@ -28,7 +29,7 @@
[content] [content]
(-> content (-> content
gsh/content->selrect gsh/content->selrect
gsh/center-selrect)) grc/rect->center))
(defn content->points+selrect (defn content->points+selrect
"Given the content of a shape, calculate its points and selrect" "Given the content of a shape, calculate its points and selrect"
@ -45,7 +46,7 @@
flip-y (gmt/scale (gpt/point 1 -1)) flip-y (gmt/scale (gpt/point 1 -1))
:always (gmt/multiply (:transform-inverse shape (gmt/matrix)))) :always (gmt/multiply (:transform-inverse shape (gmt/matrix))))
center (or (gsh/center-shape shape) center (or (gsh/shape->center shape)
(content-center content)) (content-center content))
base-content (gsh/transform-content base-content (gsh/transform-content
@ -54,16 +55,16 @@
;; Calculates the new selrect with points given the old center ;; Calculates the new selrect with points given the old center
points (-> (gsh/content->selrect base-content) points (-> (gsh/content->selrect base-content)
(gsh/rect->points) (grc/rect->points)
(gsh/transform-points center transform)) (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 ;; Points is now the selrect but the center is different so we can create the selrect
;; through points ;; through points
selrect (-> points selrect (-> points
(gsh/transform-points points-center transform-inverse) (gsh/transform-points points-center transform-inverse)
(gsh/points->selrect))] (grc/points->rect))]
[points selrect])) [points selrect]))
(defn update-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 (ns app.main.data.workspace.path.selection
(:require (:require
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.main.data.workspace.common :as dwc] [app.main.data.workspace.common :as dwc]
[app.main.data.workspace.path.state :as st] [app.main.data.workspace.path.state :as st]
@ -116,7 +117,7 @@
(rx/concat (rx/concat
(->> ms/mouse-position (->> ms/mouse-position
(rx/take-until stoper) (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/filter (partial valid-rect? zoom))
(rx/map update-area-selection)) (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]}] [file-id {:keys [revn changes]}]
(dm/assert! (uuid? file-id)) (dm/assert! (uuid? file-id))
(dm/assert! (int? revn)) (dm/assert! (int? revn))
(dm/assert! (cpc/changes? changes)) (dm/assert! (cpc/valid-changes? changes))
(ptk/reify ::shapes-changes-persisted (ptk/reify ::shapes-changes-persisted
ptk/UpdateEvent ptk/UpdateEvent

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

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

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

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

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

@ -8,21 +8,21 @@
(:require (:require
[app.common.colors :as clr] [app.common.colors :as clr]
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.files.helpers :as cfh]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb] [app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph] [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 :as cts]
[app.common.types.shape-tree :as ctst] [app.common.types.shape-tree :as ctst]
[app.common.uuid :as uuid]
[app.main.data.workspace.changes :as dch] [app.main.data.workspace.changes :as dch]
[app.main.data.workspace.selection :as dws] [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.state-helpers :as wsh]
[app.main.data.workspace.undo :as dwu] [app.main.data.workspace.undo :as dwu]
[app.main.repo :as rp] [app.main.repo :as rp]
@ -34,9 +34,8 @@
[cuerdas.core :as str] [cuerdas.core :as str]
[potok.core :as ptk])) [potok.core :as ptk]))
(defonce default-rect {:x 0 :y 0 :width 1 :height 1 :rx 0 :ry 0}) (def default-rect
(defonce default-circle {:r 0 :cx 0 :cy 0}) {:x 0 :y 0 :width 1 :height 1})
(defonce default-image {:x 0 :y 0 :width 1 :height 1 :rx 0 :ry 0})
(defn- assert-valid-num [attr num] (defn- assert-valid-num [attr num]
(when-not (and (d/num? num) (when-not (and (d/num? num)
@ -73,9 +72,9 @@
clean-value)) clean-value))
(defn- svg-dimensions [data] (defn- svg-dimensions [data]
(let [width (get-in data [:attrs :width] 100) (let [width (dm/get-in data [:attrs :width] 100)
height (get-in data [:attrs :height] 100) height (dm/get-in data [:attrs :height] 100)
viewbox (get-in data [:attrs :viewBox] (str "0 0 " width " " height)) viewbox (dm/get-in data [:attrs :viewBox] (str "0 0 " width " " height))
[x y width height] (->> (str/split viewbox #"\s+") [x y width height] (->> (str/split viewbox #"\s+")
(map d/parse-double)) (map d/parse-double))
width (if (= width 0) 1 width) width (if (= width 0) 1 width)
@ -94,9 +93,9 @@
:else (str tag)))) :else (str tag))))
(defn setup-fill [shape] (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-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)] color-style (if (= color-style "currentColor") clr/black color-style)]
(cond-> shape (cond-> shape
;; Color present as attribute ;; Color present as attribute
@ -111,26 +110,26 @@
(update :svg-attrs dissoc :fill) (update :svg-attrs dissoc :fill)
(assoc-in [:fills 0 :fill-color] (uc/parse-color color-style))) (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 :svg-attrs dissoc :fill-opacity)
(update-in [:svg-attrs :style] 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)))) (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-in [:svg-attrs :style] dissoc :fill-opacity)
(update :svg-attrs 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))))))) (d/parse-double 1)))))))
(defn setup-stroke [shape] (defn setup-stroke [shape]
(let [stroke-linecap (-> (or (get-in shape [:svg-attrs :stroke-linecap]) (let [stroke-linecap (-> (or (dm/get-in shape [:svg-attrs :stroke-linecap])
(get-in shape [:svg-attrs :style :stroke-linecap])) (dm/get-in shape [:svg-attrs :style :stroke-linecap]))
((d/nilf str/trim)) ((d/nilf str/trim))
((d/nilf keyword))) ((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-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) color-style (if (= color-style "currentColor") clr/black color-style)
shape shape
@ -145,24 +144,24 @@
(-> (update-in [:svg-attrs :style] dissoc :stroke) (-> (update-in [:svg-attrs :style] dissoc :stroke)
(assoc-in [:strokes 0 :stroke-color] (uc/parse-color color-style))) (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) (-> (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)))) (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) (-> (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)))) (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) (-> (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)))) (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) (-> (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)))) (d/parse-double))))
(and stroke-linecap (= (:type shape) :path)) (and stroke-linecap (= (:type shape) :path))
@ -172,34 +171,33 @@
:stroke-cap-end stroke-linecap))))] :stroke-cap-end stroke-linecap))))]
(cond-> shape (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)))) (assoc-in [:strokes 0 :stroke-style] :svg))))
(defn setup-opacity [shape] (defn setup-opacity [shape]
(cond-> shape (cond-> shape
(get-in shape [:svg-attrs :opacity]) (dm/get-in shape [:svg-attrs :opacity])
(-> (update :svg-attrs dissoc :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)))) (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) (-> (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)))) (d/parse-double 1))))
(dm/get-in shape [:svg-attrs :mix-blend-mode])
(get-in shape [:svg-attrs :mix-blend-mode])
(-> (update :svg-attrs dissoc :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) (-> (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}] (defn create-raw-svg
(let [{:keys [x y width height offset-x offset-y]} svg-data] [name frame-id {:keys [x y width height offset-x offset-y]} {:keys [attrs] :as data}]
(-> {:id (uuid/next) (cts/setup-shape
:type :svg-raw {:type :svg-raw
:name name :name name
:frame-id frame-id :frame-id frame-id
:width width :width width
@ -207,47 +205,51 @@
:x x :x x
:y y :y y
:content (cond-> data :content (cond-> data
(map? data) (update :attrs usvg/clean-attrs))} (map? data) (update :attrs usvg/clean-attrs))
(assoc :svg-attrs attrs) :svg-attrs attrs
(assoc :svg-viewbox (-> (select-keys svg-data [:width :height]) :svg-viewbox {:width width
(assoc :x offset-x :y offset-y))) :height height
(cts/setup-rect-selrect)))) :x offset-x
:y offset-y}}))
(defn create-svg-root [frame-id parent-id svg-data] (defn create-svg-root
(let [{:keys [name x y width height offset-x offset-y]} svg-data] [frame-id parent-id {:keys [name x y width height offset-x offset-y attrs]}]
(-> {:id (uuid/next) (cts/setup-shape
:type :group {:type :group
:name name :name name
:frame-id frame-id :frame-id frame-id
:parent-id parent-id :parent-id parent-id
:width width :width width
:height height :height height
:x (+ x offset-x) :x (+ x offset-x)
:y (+ y offset-y)} :y (+ y offset-y)
(cts/setup-rect-selrect) :svg-attrs (-> attrs
(assoc :svg-attrs (-> (:attrs svg-data) (dissoc :viewBox)
(dissoc :viewBox :xmlns) (dissoc :xmlns)
(d/without-keys usvg/inheritable-props)))))) (d/without-keys usvg/inheritable-props))}))
(defn create-group [name frame-id svg-data {:keys [attrs]}] (defn create-group
(let [svg-transform (usvg/parse-transform (:transform attrs)) [name frame-id {:keys [x y width height offset-x offset-y] :as svg-data} {:keys [attrs]}]
{:keys [x y width height offset-x offset-y]} svg-data] (let [svg-transform (usvg/parse-transform (:transform attrs))]
(-> {:id (uuid/next) (cts/setup-shape
:type :group {:type :group
:name name :name name
:frame-id frame-id :frame-id frame-id
:x (+ x offset-x) :x (+ x offset-x)
:y (+ y offset-y) :y (+ y offset-y)
:width width :width width
:height height} :height height
(assoc :svg-transform svg-transform) :svg-transform svg-transform
(assoc :svg-attrs (d/without-keys attrs usvg/inheritable-props)) :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))) :svg-viewbox {:width width
(cts/setup-rect-selrect)))) :height height
:x offset-x
:y offset-y}})))
(defn create-path-shape [name frame-id svg-data {:keys [attrs] :as data}] (defn create-path-shape [name frame-id svg-data {:keys [attrs] :as data}]
(when (and (contains? attrs :d) (seq (:d attrs))) (when (and (contains? attrs :d) (seq (:d attrs)))
(let [svg-transform (usvg/parse-transform (:transform attrs)) (let [svg-transform (usvg/parse-transform (:transform attrs))
path-content (upp/parse-path (:d attrs)) path-content (upp/parse-path (:d attrs))
content (cond-> path-content content (cond-> path-content
@ -255,23 +257,25 @@
(gsh/transform-content svg-transform)) (gsh/transform-content svg-transform))
selrect (gsh/content->selrect content) selrect (gsh/content->selrect content)
points (gsh/rect->points selrect) points (grc/rect->points selrect)
origin (gpt/negate (gpt/point svg-data))] origin (gpt/negate (gpt/point svg-data))]
(-> {:id (uuid/next)
:type :path (-> (cts/setup-shape
{:type :path
:name name :name name
:frame-id frame-id :frame-id frame-id
:content content :content content
:selrect selrect :selrect selrect
:points points} :points points
(assoc :svg-viewbox (select-keys selrect [:x :y :width :height])) :svg-viewbox (select-keys selrect [:x :y :width :height])
(assoc :svg-attrs (dissoc attrs :d :transform)) :svg-attrs (dissoc attrs :d :transform)
(assoc :svg-transform svg-transform) :svg-transform svg-transform})
(gsh/translate-to-frame origin))))) (gsh/translate-to-frame origin)))))
(defn calculate-rect-metadata [rect-data transform] (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)) (gsh/transform-points transform))
[selrect transform transform-inverse] (gsh/calculate-geometry points)] [selrect transform transform-inverse] (gsh/calculate-geometry points)]
@ -285,112 +289,103 @@
:transform transform :transform transform
:transform-inverse transform-inverse})) :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}] (defn create-rect-shape [name frame-id svg-data {:keys [attrs] :as data}]
(let [svg-transform (usvg/parse-transform (:transform attrs)) (let [transform (->> (usvg/parse-transform (:transform attrs))
transform (->> svg-transform
(gmt/transform-in (gpt/point svg-data))) (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)) origin (gpt/negate (gpt/point svg-data))
rect-data (-> (merge default-rect rect) rect-data (-> (parse-rect-attrs attrs)
(update :x - (:x origin)) (update :x - (:x origin))
(update :y - (:y origin))) (update :y - (:y origin)))]
metadata (calculate-rect-metadata rect-data transform)] (cts/setup-shape
(-> {:id (uuid/next) (-> (calculate-rect-metadata rect-data transform)
:type :rect (assoc :type :rect)
:name name (assoc :name name)
:frame-id frame-id} (assoc :frame-id frame-id)
(cond-> (assoc :svg-viewbox (select-keys rect-data [:x :y :width :height]))
(contains? attrs :rx) (assoc :rx (d/parse-double (:rx attrs 0))) (assoc :svg-attrs (dissoc attrs :x :y :width :height :rx :ry :transform))
(contains? attrs :ry) (assoc :ry (d/parse-double (:ry attrs 0)))) (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}] (defn create-circle-shape [name frame-id svg-data {:keys [attrs] :as data}]
(let [svg-transform (usvg/parse-transform (:transform attrs)) (let [[cx cy r rx ry]
transform (->> svg-transform (parse-circle-attrs attrs)
transform (->> (usvg/parse-transform (:transform attrs))
(gmt/transform-in (gpt/point svg-data))) (gmt/transform-in (gpt/point svg-data)))
circle (->> (select-keys attrs [:r :ry :rx :cx :cy]) rx (or r rx)
(d/mapm #(d/parse-double %2))) ry (or r ry)
{: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)}
origin (gpt/negate (gpt/point svg-data)) origin (gpt/negate (gpt/point svg-data))
rect-data (-> rect rect-data {:x (- cx rx (:x origin))
(update :x - (:x origin)) :y (- cy ry (:y origin))
(update :y - (:y origin))) :width (* 2 rx)
:height (* 2 ry)}]
metadata (calculate-rect-metadata rect-data transform)] (cts/setup-shape
(-> {:id (uuid/next) (-> (calculate-rect-metadata rect-data transform)
:type :circle (assoc :type :circle)
:name name (assoc :name name)
:frame-id frame-id} (assoc :frame-id frame-id)
(assoc :svg-viewbox rect-data)
(merge metadata) (assoc :svg-attrs (dissoc attrs :cx :cy :r :rx :ry :transform))))))
(assoc :svg-viewbox (select-keys rect [:x :y :width :height]))
(assoc :svg-attrs (dissoc attrs :cx :cy :r :rx :ry :transform)))))
(defn create-image-shape [name frame-id svg-data {:keys [attrs] :as data}] (defn create-image-shape [name frame-id svg-data {:keys [attrs] :as data}]
(let [svg-transform (usvg/parse-transform (:transform attrs)) (let [transform (->> (usvg/parse-transform (:transform attrs))
transform (->> svg-transform
(gmt/transform-in (gpt/point svg-data))) (gmt/transform-in (gpt/point svg-data)))
image-url (or (:href attrs) (:xlink:href attrs)) 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)) metadata {:width (:width image-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)
:height (:height image-data) :height (:height image-data)
:mtype (:mtype image-data) :mtype (:mtype image-data)
:id (:id image-data)}} :id (:id image-data)}
(merge rect-metadata) origin (gpt/negate (gpt/point svg-data))
(assoc :svg-viewbox (select-keys rect [:x :y :width :height])) rect-data (-> (parse-rect-attrs attrs)
(assoc :svg-attrs (dissoc attrs :x :y :width :height :href :xlink:href)))))) (update :x - (:x origin))
(update :y - (:y origin)))]
(defn parse-svg-element [frame-id svg-data element-data unames] (when (some? image-data)
(let [{:keys [tag attrs hidden]} element-data (cts/setup-shape
attrs (usvg/format-styles attrs) (-> (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)) element-data (cond-> element-data (map? element-data) (assoc :attrs attrs))
name (or (:id attrs) (tag->name tag)) name (or (:id attrs) (tag->name tag))
att-refs (usvg/find-attr-references attrs) att-refs (usvg/find-attr-references attrs)
references (usvg/find-def-references (:defs svg-data) att-refs) references (usvg/find-def-references (:defs svg-data) att-refs)
href-id (-> (or (:href attrs) (:xlink:href attrs) "") href-id (-> (or (:href attrs) (:xlink:href attrs) "") (subs 1))
(subs 1))
defs (:defs svg-data) defs (:defs svg-data)
use-tag? (and (= :use tag) (contains? defs href-id))] use-tag? (and (= :use tag) (contains? defs href-id))]
@ -423,37 +418,32 @@
#_other (create-raw-svg name frame-id svg-data element-data)))] #_other (create-raw-svg name frame-id svg-data element-data)))]
(when (some? shape) (when (some? shape)
(let [shape (-> shape (let [shape (-> shape
(assoc :fills [])
(assoc :strokes [])
(assoc :svg-defs (select-keys (:defs svg-data) references)) (assoc :svg-defs (select-keys (:defs svg-data) references))
(setup-fill) (setup-fill)
(setup-stroke) (setup-stroke)
(setup-opacity)) (setup-opacity))]
shape (cond-> shape [(cond-> shape
hidden (assoc :hidden true)) hidden (assoc :hidden true))
children (cond->> (:content element-data) (cond->> (:content element-data)
(contains? usvg/parent-tags tag) (contains? usvg/parent-tags tag)
(mapv #(usvg/inherit-attributes attrs %)))] (mapv #(usvg/inherit-attributes attrs %)))]))))))
[shape children]))))))
(defn create-svg-children (defn create-svg-children
[objects selected frame-id parent-id svg-data [unames children] [_index svg-element]] [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)] (let [[shape new-children] (parse-svg-element frame-id svg-data svg-element unames)]
(if (some? new-shape) (if (some? shape)
(let [shape-id (:id new-shape) (let [shape-id (:id shape)
shape (-> shape
new-shape' (-> (dwsh/make-new-shape new-shape objects selected) (assoc :frame-id frame-id)
(assoc :parent-id parent-id)) (assoc :parent-id parent-id))
children (conj children shape)
unames (conj unames (:name shape))]
children (conj children new-shape') (reduce (partial create-svg-children objects selected frame-id shape-id svg-data)
unames (conj unames (:name new-shape')) [unames children]
(d/enumerate new-children)))
reducer-fn (partial create-svg-children objects selected frame-id shape-id svg-data)]
(reduce reducer-fn [unames children] (d/enumerate new-children)))
[unames children]))) [unames children])))
@ -502,48 +492,50 @@
(rx/map #(vector (:url uri-data) %))))) (rx/map #(vector (:url uri-data) %)))))
(rx/reduce (fn [acc [url image]] (assoc acc url image)) {}))) (rx/reduce (fn [acc [url image]] (assoc acc url image)) {})))
(defn create-svg-shapes (defn create-svg-shapes
[svg-data {:keys [x y]} objects frame-id parent-id selected center?] [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) (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-name (str/replace (:name svg-data) ".svg" "")
svg-data (-> svg-data svg-data (-> svg-data
(assoc :x x (assoc :x (mth/round
:y y (if center?
:offset-x vb-x (- x vb-x (/ vb-width 2))
:offset-y vb-y x)))
:width vb-width (assoc :y (mth/round
:height vb-height (if center?
:name svg-name)) (- 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-default-values)
(usvg/fix-percents) (usvg/fix-percents)
(usvg/extract-defs)) (usvg/extract-defs))
svg-data (assoc svg-data :defs def-nodes) svg-data (assoc svg-data :defs def-nodes)
root-shape (create-svg-root frame-id parent-id svg-data) root-shape (create-svg-root frame-id parent-id svg-data)
root-id (:id root-shape) root-id (:id root-shape)
;; In penpot groups have the size of their children. To respect the imported ;; In penpot groups have the size of their children. To
;; svg size and empty space let's create a transparent shape as background to respect the imported size ;; respect the imported svg size and empty space let's create
base-background-shape {:tag :rect ;; a transparent shape as background to respect the imported
:attrs {:x (str vb-x) ;; size
:y (str vb-y) background
:width (str vb-width) {:tag :rect
:height (str vb-height) :attrs {:x (dm/str vb-x)
:y (dm/str vb-y)
:width (dm/str vb-width)
:height (dm/str vb-height)
:fill "none" :fill "none"
:id "base-background"} :id "base-background"}
:hidden true :hidden true
@ -551,24 +543,23 @@
svg-data (-> svg-data svg-data (-> svg-data
(assoc :defs def-nodes) (assoc :defs def-nodes)
(assoc :content (into [base-background-shape] (:content svg-data)))) (assoc :content (into [background] (:content svg-data))))
;; Create the root shape ;; Create the root shape
new-shape (dwsh/make-new-shape root-shape objects selected)
root-attrs (-> (:attrs svg-data) root-attrs (-> (:attrs svg-data)
(usvg/format-styles)) (usvg/format-styles))
[_ new-children] [_ children]
(reduce (partial create-svg-children objects selected frame-id root-id svg-data) (reduce (partial create-svg-children objects selected frame-id root-id svg-data)
[unames []] [unames []]
(d/enumerate (->> (:content svg-data) (d/enumerate (->> (:content svg-data)
(mapv #(usvg/inherit-attributes root-attrs %)))))] (mapv #(usvg/inherit-attributes root-attrs %)))))]
[new-shape new-children])) [root-shape children]))
(defn add-svg-shapes (defn add-svg-shapes
[svg-data position] [svg-data position]
;; (app.common.pprint/pprint svg-data {:length 100 :level 100})
(ptk/reify ::add-svg-shapes (ptk/reify ::add-svg-shapes
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
@ -577,13 +568,13 @@
objects (wsh/lookup-page-objects state page-id) objects (wsh/lookup-page-objects state page-id)
frame-id (ctst/top-nested-frame objects position) frame-id (ctst/top-nested-frame objects position)
selected (wsh/lookup-selected state) selected (wsh/lookup-selected state)
page-objects (wsh/lookup-page-objects state) base (cph/get-base-shape objects selected)
base (cph/get-base-shape page-objects selected)
selected-frame? (and (= 1 (count selected))
(= :frame (get-in objects [(first selected) :type])))
parent-id selected-id (first selected)
(if (or selected-frame? (empty? 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 frame-id
(:parent-id base)) (:parent-id base))
@ -594,18 +585,17 @@
(pcb/with-objects objects) (pcb/with-objects objects)
(pcb/add-object new-shape)) (pcb/add-object new-shape))
changes (reduce (fn [changes new-child]
(pcb/add-object changes new-child))
changes changes
(reduce (fn [changes new-child] new-children)
(-> changes (pcb/add-object new-child)))
changes new-children)
changes (pcb/resize-parents changes changes (pcb/resize-parents changes
(->> changes (->> (:redo-changes changes)
:redo-changes
(filter #(= :add-obj (:type %))) (filter #(= :add-obj (:type %)))
(map :id) (map :id)
reverse (reverse)
vec)) (vec)))
undo-id (js/Symbol)] undo-id (js/Symbol)]
(rx/of (dwu/start-undo-transaction undo-id) (rx/of (dwu/start-undo-transaction undo-id)
@ -614,7 +604,7 @@
(ptk/data-event :layout/update [(:id new-shape)]) (ptk/data-event :layout/update [(:id new-shape)])
(dwu/commit-undo-transaction undo-id))) (dwu/commit-undo-transaction undo-id)))
(catch :default e (catch :default cause
(.error js/console "Error SVG" e) (js/console.log (.-stack cause))
(rx/throw {:type :svg-parser (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.data.macros :as dm]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.geom.shapes.flex-layout :as gslf] [app.common.geom.shapes.flex-layout :as gslf]
[app.common.geom.shapes.grid-layout :as gslg] [app.common.geom.shapes.grid-layout :as gslg]
@ -109,7 +110,7 @@
(let [{:keys [width height]} (:selrect shape) (let [{:keys [width height]} (:selrect shape)
{:keys [rotation]} shape {:keys [rotation]} shape
shape-center (gsh/center-shape shape) shape-center (gsh/shape->center shape)
shape-transform (:transform shape) shape-transform (:transform shape)
shape-transform-inverse (:transform-inverse shape) shape-transform-inverse (:transform-inverse shape)
@ -304,8 +305,8 @@
ptk/WatchEvent ptk/WatchEvent
(watch [_ _ stream] (watch [_ _ stream]
(let [stoper (rx/filter ms/mouse-up? stream) (let [stoper (rx/filter ms/mouse-up? stream)
group (gsh/selection-rect shapes) group (gsh/shapes->rect shapes)
group-center (gsh/center-selrect group) group-center (grc/rect->center group)
initial-angle (gpt/angle @ms/mouse-position group-center) initial-angle (gpt/angle @ms/mouse-position group-center)
calculate-angle calculate-angle
@ -717,7 +718,8 @@
objects (wsh/lookup-page-objects state page-id) objects (wsh/lookup-page-objects state page-id)
shape (get objects 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)) cpos (gpt/point (:x bbox) (:y bbox))
pos (gpt/point (or (:x position) (:x bbox)) pos (gpt/point (or (:x position) (:x bbox))
@ -840,8 +842,8 @@
(let [objects (wsh/lookup-page-objects state) (let [objects (wsh/lookup-page-objects state)
selected (wsh/lookup-selected state {:omit-blocked? true}) selected (wsh/lookup-selected state {:omit-blocked? true})
shapes (map #(get objects %) selected) shapes (map #(get objects %) selected)
selrect (gsh/selection-rect shapes) selrect (gsh/shapes->rect shapes)
center (gsh/center-selrect selrect) center (grc/rect->center selrect)
modifiers (dwm/create-modif-tree selected (ctm/resize-modifiers (gpt/point -1.0 1.0) center))] modifiers (dwm/create-modif-tree selected (ctm/resize-modifiers (gpt/point -1.0 1.0) center))]
(rx/of (dwm/apply-modifiers {:modifiers modifiers})))))) (rx/of (dwm/apply-modifiers {:modifiers modifiers}))))))
@ -852,7 +854,7 @@
(let [objects (wsh/lookup-page-objects state) (let [objects (wsh/lookup-page-objects state)
selected (wsh/lookup-selected state {:omit-blocked? true}) selected (wsh/lookup-selected state {:omit-blocked? true})
shapes (map #(get objects %) selected) shapes (map #(get objects %) selected)
selrect (gsh/selection-rect shapes) selrect (gsh/shapes->rect shapes)
center (gsh/center-selrect selrect) center (grc/rect->center selrect)
modifiers (dwm/create-modif-tree selected (ctm/resize-modifiers (gpt/point 1.0 -1.0) center))] modifiers (dwm/create-modif-tree selected (ctm/resize-modifiers (gpt/point 1.0 -1.0) center))]
(rx/of (dwm/apply-modifiers {:modifiers modifiers})))))) (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.data.macros :as dm]
[app.common.geom.align :as gal] [app.common.geom.align :as gal]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as gpr]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
@ -21,6 +22,10 @@
(defn initialize-viewport (defn initialize-viewport
[{:keys [width height] :as size}] [{:keys [width height] :as size}]
(dm/assert!
"expected `size` to be a rect instance"
(gpr/rect? size))
(letfn [(update* [{:keys [vport] :as local}] (letfn [(update* [{:keys [vport] :as local}]
(let [wprop (/ (:width vport) width) (let [wprop (/ (:width vport) width)
hprop (/ (:height vport) height)] hprop (/ (:height vport) height)]
@ -29,13 +34,14 @@
(update :vbox (fn [vbox] (update :vbox (fn [vbox]
(-> vbox (-> vbox
(update :width #(/ % wprop)) (update :width #(/ % wprop))
(update :height #(/ % hprop)))))))) (update :height #(/ % hprop))
(gpr/update-rect :size)))))))
(initialize [state local] (initialize [state local]
(let [page-id (:current-page-id state) (let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id) objects (wsh/lookup-page-objects state page-id)
shapes (cph/get-immediate-children objects) 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)] local (assoc local :vport size :zoom 1 :zoom-inverse 1)]
(cond (cond
(or (not (d/num? (:width srect))) (or (not (d/num? (:width srect)))
@ -49,12 +55,20 @@
(-> local (-> local
(assoc :zoom zoom) (assoc :zoom zoom)
(assoc :zoom-inverse (/ 1 zoom)) (assoc :zoom-inverse (/ 1 zoom))
(update :vbox merge srect))) (update :vbox (fn [vbox]
(-> (merge vbox srect)
(gpr/make-rect))))))
:else :else
(assoc local :vbox (assoc size (let [vx (+ (:x srect)
:x (+ (:x srect) (/ (- (:width srect) width) 2)) (/ (- (:width srect) width) 2))
:y (+ (:y srect) (/ (- (:height srect) height) 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] (setup [state local]
(if (and (:vbox local) (:vport 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/. ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;; ;;
;; Copyright (c) KALEIDOS INC ;; Copyright (c) KALEIDOS INC
(ns app.main.data.workspace.zoom (ns app.main.data.workspace.zoom
(:require (:require
[app.common.geom.align :as gal] [app.common.geom.align :as gal]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.main.data.workspace.state-helpers :as wsh] [app.main.data.workspace.state-helpers :as wsh]
@ -19,7 +21,7 @@
[{:keys [vbox] :as local} center zoom] [{:keys [vbox] :as local} center zoom]
(let [new-zoom (if (fn? zoom) (zoom (:zoom local)) zoom) (let [new-zoom (if (fn? zoom) (zoom (:zoom local)) zoom)
old-zoom (:zoom local) 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) scale (/ old-zoom new-zoom)
mtx (gmt/scale-matrix (gpt/point scale) center) mtx (gmt/scale-matrix (gpt/point scale) center)
vbox' (gsh/transform-rect vbox mtx)] vbox' (gsh/transform-rect vbox mtx)]
@ -74,7 +76,7 @@
(let [page-id (:current-page-id state) (let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id) objects (wsh/lookup-page-objects state page-id)
shapes (cph/get-immediate-children objects) shapes (cph/get-immediate-children objects)
srect (gsh/selection-rect shapes)] srect (gsh/shapes->rect shapes)]
(if (empty? shapes) (if (empty? shapes)
state state
(update state :workspace-local (update state :workspace-local
@ -97,7 +99,7 @@
objects (wsh/lookup-page-objects state page-id) objects (wsh/lookup-page-objects state page-id)
srect (->> selected srect (->> selected
(map #(get objects %)) (map #(get objects %))
(gsh/selection-rect))] (gsh/shapes->rect))]
(update state :workspace-local (update state :workspace-local
(fn [{:keys [vport] :as local}] (fn [{:keys [vport] :as local}]
(let [srect (gal/adjust-to-viewport vport srect {:padding 40}) (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.colors :as clr]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.geom.shapes.bounds :as gsb] [app.common.geom.shapes.bounds :as gsb]
[app.common.math :as mth] [app.common.math :as mth]
@ -62,15 +63,15 @@
(defn- calculate-dimensions (defn- calculate-dimensions
[objects] [objects]
(let [bounds (let [bounds (->> (ctst/get-root-objects objects)
(->> (ctst/get-root-objects objects)
(map (partial gsb/get-object-bounds objects)) (map (partial gsb/get-object-bounds objects))
(gsh/join-rects))] (grc/join-rects))]
(-> bounds (-> bounds
(update :x mth/finite 0) (update :x mth/finite 0)
(update :y mth/finite 0) (update :y mth/finite 0)
(update :width mth/finite 100000) (update :width mth/finite 100000)
(update :height mth/finite 100000)))) (update :height mth/finite 100000)
(grc/update-rect :position))))
(declare shape-wrapper-factory) (declare shape-wrapper-factory)
@ -164,7 +165,7 @@
(defn adapt-root-frame (defn adapt-root-frame
[objects object] [objects object]
(let [shapes (cph/get-immediate-children objects) (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]))] object (merge object (select-keys srect [:x :y :width :height]))]
(assoc object :fill-color "#f0f0f0"))) (assoc object :fill-color "#f0f0f0")))

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

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

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

@ -7,7 +7,7 @@
(ns app.main.ui.hooks (ns app.main.ui.hooks
"A collection of general purpose react hooks." "A collection of general purpose react hooks."
(:require (:require
[app.common.pages :as cp] [app.common.pages.focus :as cpf]
[app.main.broadcast :as mbc] [app.main.broadcast :as mbc]
[app.main.data.shortcuts :as dsc] [app.main.data.shortcuts :as dsc]
[app.main.refs :as refs] [app.main.refs :as refs]
@ -256,7 +256,7 @@
([objects focus] ([objects focus]
(let [objects (mf/use-memo (let [objects (mf/use-memo
(mf/deps focus objects) (mf/deps focus objects)
#(cp/focus-objects objects focus))] #(cpf/focus-objects objects focus))]
objects))) objects)))
(defn use-debounce (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 :as d]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.geom.shapes.flex-layout :as gsl] [app.common.geom.shapes.flex-layout :as gsl]
[app.common.geom.shapes.points :as gpo] [app.common.geom.shapes.points :as gpo]
@ -248,8 +249,8 @@
(mf/defc measurement (mf/defc measurement
[{:keys [bounds frame selected-shapes hover-shape zoom]}] [{:keys [bounds frame selected-shapes hover-shape zoom]}]
(let [selected-ids (into #{} (map :id) selected-shapes) (let [selected-ids (into #{} (map :id) selected-shapes)
selected-selrect (gsh/selection-rect selected-shapes) selected-selrect (gsh/shapes->rect selected-shapes)
hover-selrect (-> hover-shape :points gsh/points->selrect) hover-selrect (-> hover-shape :points grc/points->rect)
bounds-selrect (bound->selrect bounds) bounds-selrect (bound->selrect bounds)
hover-selected-shape? (not (contains? selected-ids (:id hover-shape)))] hover-selected-shape? (not (contains? selected-ids (:id hover-shape)))]
@ -262,7 +263,7 @@
(if (or (not hover-shape) (not hover-selected-shape?)) (if (or (not hover-shape) (not hover-selected-shape?))
(when (and frame (not= uuid/zero (:id frame))) (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 [:g.hover-shapes
[:& selection-rect {:type :hover :selrect frame-bb :zoom zoom}] [:& selection-rect {:type :hover :selrect frame-bb :zoom zoom}]
[:& distance-display {:from frame-bb [:& distance-display {:from frame-bb

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

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

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

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

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

@ -7,6 +7,7 @@
(ns app.main.ui.shapes.frame (ns app.main.ui.shapes.frame
(:require (:require
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.types.shape.layout :as ctl] [app.common.types.shape.layout :as ctl]
@ -94,7 +95,7 @@
[props] [props]
(let [shape (unchecked-get props "shape") (let [shape (unchecked-get props "shape")
bounds (or (unchecked-get props "bounds") bounds (or (unchecked-get props "bounds")
(gsh/points->selrect (:points shape))) (grc/points->rect (:points shape)))
shape-id (:id shape) shape-id (:id shape)
thumb (:thumbnail shape) thumb (:thumbnail shape)
@ -107,6 +108,8 @@
{:id (dm/str "thumbnail-" shape-id) {:id (dm/str "thumbnail-" shape-id)
:href thumb :href thumb
:decoding "async" :decoding "async"
;; FIXME: ensure bounds is always a rect instance and
;; dm/get-prop for static attr access
:x (:x bounds) :x (:x bounds)
:y (:y bounds) :y (:y bounds)
:width (:width 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) 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 ;; Paths don't have a transform in SVG because we transform the points
;; we need to compensate the difference between the original rectangle ;; 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-origin (gpo/origin cell-bounds)
cell-width (gpo/width-points cell-bounds) cell-width (gpo/width-points cell-bounds)
cell-height (gpo/height-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)))] cell-origin (gpt/transform cell-origin (gmt/transform-in cell-center (:transform-inverse shape)))]
[:g.cell [:g.cell

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

@ -8,7 +8,7 @@
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.geom.shapes :as gsh] [app.common.geom.rect :as grc]
[app.main.ui.context :as muc] [app.main.ui.context :as muc]
[cuerdas.core :as str] [cuerdas.core :as str]
[rumext.v2 :as mf])) [rumext.v2 :as mf]))
@ -52,7 +52,7 @@
svg-text? (and (= :text (:type mask)) (some? (:position-data mask))) svg-text? (and (= :text (:type mask)) (some? (:position-data mask)))
mask-bb (:points mask) mask-bb (:points mask)
mask-bb-rect (gsh/points->rect mask-bb)] mask-bb-rect (grc/points->rect mask-bb)]
[:defs [:defs
[:filter {:id (filter-id render-id mask)} [:filter {:id (filter-id render-id mask)}
[:feFlood {:flood-color "white" [: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 :as d]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.geom.shapes.bounds :as gsb] [app.common.geom.shapes.bounds :as gsb]
[app.util.svg :as usvg] [app.util.svg :as usvg]
@ -92,7 +93,7 @@
(defn svg-def-bounds [svg-def shape transform] (defn svg-def-bounds [svg-def shape transform]
(let [{:keys [tag]} svg-def] (let [{:keys [tag]} svg-def]
(if (or (= tag :mask) (contains? usvg/filter-tags tag)) (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 :y]))
(d/parse-double (get-in svg-def [:attrs :width])) (d/parse-double (get-in svg-def [:attrs :width]))
(d/parse-double (get-in svg-def [:attrs :height]))) (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 (:require
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.main.data.comments :as dcm] [app.main.data.comments :as dcm]
[app.main.data.events :as ev] [app.main.data.events :as ev]
@ -103,7 +104,7 @@
threads-map (mf/deref refs/comment-threads) threads-map (mf/deref refs/comment-threads)
frame-corner (mf/with-memo [frame] 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] modifier1 (mf/with-memo [frame-corner]
(-> (gmt/matrix) (-> (gmt/matrix)

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