mirror of
https://github.com/penpot/penpot.git
synced 2026-04-28 20:58:06 +00:00
Merge pull request #2610 from penpot/alotor-performance-enhance
Alotor performance enhance
This commit is contained in:
Andrey Antukh
GitHub
commit
c98635bca1
@ -57,9 +57,13 @@
|
||||
([a & more] (into (queue) (cons a more))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Data Structures Manipulation
|
||||
;; Data Structures Access & Manipulation
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn not-empty?
|
||||
[coll]
|
||||
(boolean (seq coll)))
|
||||
|
||||
(defn editable-collection?
|
||||
[m]
|
||||
#?(:clj (instance? clojure.lang.IEditableCollection m)
|
||||
@ -145,6 +149,16 @@
|
||||
(rest items)
|
||||
(conj! res [idx (first items)]))))))
|
||||
|
||||
(defn group-by
|
||||
([kf coll] (group-by kf identity [] coll))
|
||||
([kf vf coll] (group-by kf vf [] coll))
|
||||
([kf vf iv coll]
|
||||
(let [conj (fnil conj iv)]
|
||||
(reduce (fn [result item]
|
||||
(update result (kf item) conj (vf item)))
|
||||
{}
|
||||
coll))))
|
||||
|
||||
(defn seek
|
||||
([pred coll]
|
||||
(seek pred coll nil))
|
||||
@ -243,12 +257,12 @@
|
||||
(defn filterm
|
||||
"Filter values of a map that satisfy a predicate"
|
||||
[pred coll]
|
||||
(into {} (filter pred coll)))
|
||||
(into {} (filter pred) coll))
|
||||
|
||||
(defn removem
|
||||
"Remove values of a map that satisfy a predicate"
|
||||
[pred coll]
|
||||
(into {} (remove pred coll)))
|
||||
(into {} (remove pred) coll))
|
||||
|
||||
(defn map-perm
|
||||
"Maps a function to each pair of values that can be combined inside the
|
||||
@ -373,6 +387,81 @@
|
||||
(do (vswap! seen conj input*)
|
||||
(rf result input)))))))))
|
||||
|
||||
(defn with-next
|
||||
"Given a collection will return a new collection where each element
|
||||
is paired with the next item in the collection
|
||||
(with-next (range 5)) => [[0 1] [1 2] [2 3] [3 4] [4 nil]]"
|
||||
[coll]
|
||||
(map vector
|
||||
coll
|
||||
(c/concat (rest coll) [nil])))
|
||||
|
||||
(defn with-prev
|
||||
"Given a collection will return a new collection where each element
|
||||
is paired with the previous item in the collection
|
||||
(with-prev (range 5)) => [[0 nil] [1 0] [2 1] [3 2] [4 3]]"
|
||||
[coll]
|
||||
(map vector
|
||||
coll
|
||||
(c/cons nil coll)))
|
||||
|
||||
(defn with-prev-next
|
||||
"Given a collection will return a new collection where every item is paired
|
||||
with the previous and the next item of a collection
|
||||
(with-prev-next (range 5)) => [[0 nil 1] [1 0 2] [2 1 3] [3 2 4] [4 3 nil]]"
|
||||
[coll]
|
||||
(map vector
|
||||
coll
|
||||
(c/cons nil coll)
|
||||
(c/concat (rest coll) [nil])))
|
||||
|
||||
(defn deep-mapm
|
||||
"Applies a map function to an associative map and recurses over its children
|
||||
when it's a vector or a map"
|
||||
[mfn m]
|
||||
(let [do-map
|
||||
(fn [entry]
|
||||
(let [[k v] (mfn entry)]
|
||||
(cond
|
||||
(or (vector? v) (map? v))
|
||||
[k (deep-mapm mfn v)]
|
||||
|
||||
:else
|
||||
(mfn [k v]))))]
|
||||
(cond
|
||||
(map? m)
|
||||
(into {} (map do-map) m)
|
||||
|
||||
(vector? m)
|
||||
(into [] (map (partial deep-mapm mfn)) m)
|
||||
|
||||
:else
|
||||
m)))
|
||||
|
||||
(defn iteration
|
||||
"Creates a totally lazy seqable via repeated calls to step, a
|
||||
function of some (continuation token) 'k'. The first call to step
|
||||
will be passed initk, returning 'ret'. If (somef ret) is true, (vf
|
||||
ret) will be included in the iteration, else iteration will
|
||||
terminate and vf/kf will not be called. If (kf ret) is non-nil it
|
||||
will be passed to the next step call, else iteration will terminate.
|
||||
|
||||
This can be used e.g. to consume APIs that return paginated or batched data.
|
||||
|
||||
step - (possibly impure) fn of 'k' -> 'ret'
|
||||
:somef - fn of 'ret' -> logical true/false, default 'some?'
|
||||
:vf - fn of 'ret' -> 'v', a value produced by the iteration, default 'identity'
|
||||
:kf - fn of 'ret' -> 'next-k' or nil (signaling 'do not continue'), default 'identity'
|
||||
:initk - the first value passed to step, default 'nil'
|
||||
|
||||
It is presumed that step with non-initk is
|
||||
unreproducible/non-idempotent. If step with initk is unreproducible
|
||||
it is on the consumer to not consume twice."
|
||||
[& args]
|
||||
(->> (apply c/iteration args)
|
||||
(concat-all)))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Data Parsing / Conversion
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@ -439,8 +528,9 @@
|
||||
(or val default))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Data Parsing / Conversion
|
||||
;; Utilities
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn nilf
|
||||
"Returns a new function that if you pass nil as any argument will
|
||||
return nil"
|
||||
@ -457,22 +547,32 @@
|
||||
|
||||
(defn num?
|
||||
"Checks if a value `val` is a number but not an Infinite or NaN"
|
||||
([val]
|
||||
(and (number? val)
|
||||
(mth/finite? val)
|
||||
(not (mth/nan? val))))
|
||||
|
||||
([val & vals]
|
||||
(and (num? val)
|
||||
(->> vals (every? num?)))))
|
||||
([a]
|
||||
(mth/finite? a))
|
||||
([a b]
|
||||
(and (mth/finite? a)
|
||||
(mth/finite? b)))
|
||||
([a b c]
|
||||
(and (mth/finite? a)
|
||||
(mth/finite? b)
|
||||
(mth/finite? c)))
|
||||
([a b c d]
|
||||
(and (mth/finite? a)
|
||||
(mth/finite? b)
|
||||
(mth/finite? c)
|
||||
(mth/finite? d)))
|
||||
([a b c d & others]
|
||||
(and (mth/finite? a)
|
||||
(mth/finite? b)
|
||||
(mth/finite? c)
|
||||
(mth/finite? d)
|
||||
(every? mth/finite? others))))
|
||||
|
||||
(defn check-num
|
||||
"Function that checks if a number is nil or nan. Will return 0 when not
|
||||
valid and the number otherwise."
|
||||
([v]
|
||||
(check-num v 0))
|
||||
([v default]
|
||||
(if (num? v) v default)))
|
||||
([v] (mth/finite v 0))
|
||||
([v default] (mth/finite v default)))
|
||||
|
||||
(defn any-key? [element & rest]
|
||||
(some #(contains? element %) rest))
|
||||
@ -494,34 +594,6 @@
|
||||
(or default-value
|
||||
(str maybe-keyword)))))
|
||||
|
||||
(defn with-next
|
||||
"Given a collection will return a new collection where each element
|
||||
is paired with the next item in the collection
|
||||
(with-next (range 5)) => [[0 1] [1 2] [2 3] [3 4] [4 nil]]"
|
||||
[coll]
|
||||
(map vector
|
||||
coll
|
||||
(c/concat (rest coll) [nil])))
|
||||
|
||||
(defn with-prev
|
||||
"Given a collection will return a new collection where each element
|
||||
is paired with the previous item in the collection
|
||||
(with-prev (range 5)) => [[0 nil] [1 0] [2 1] [3 2] [4 3]]"
|
||||
[coll]
|
||||
(map vector
|
||||
coll
|
||||
(c/concat [nil] coll)))
|
||||
|
||||
(defn with-prev-next
|
||||
"Given a collection will return a new collection where every item is paired
|
||||
with the previous and the next item of a collection
|
||||
(with-prev-next (range 5)) => [[0 nil 1] [1 0 2] [2 1 3] [3 2 4] [4 3 nil]]"
|
||||
[coll]
|
||||
(map vector
|
||||
coll
|
||||
(c/concat [nil] coll)
|
||||
(c/concat (rest coll) [nil])))
|
||||
|
||||
(defn prefix-keyword
|
||||
"Given a keyword and a prefix will return a new keyword with the prefix attached
|
||||
(prefix-keyword \"prefix\" :test) => :prefix-test"
|
||||
@ -612,33 +684,6 @@
|
||||
(recur (inc counter))
|
||||
candidate))))))))
|
||||
|
||||
(defn deep-mapm
|
||||
"Applies a map function to an associative map and recurses over its children
|
||||
when it's a vector or a map"
|
||||
[mfn m]
|
||||
(let [do-map
|
||||
(fn [entry]
|
||||
(let [[k v] (mfn entry)]
|
||||
(cond
|
||||
(or (vector? v) (map? v))
|
||||
[k (deep-mapm mfn v)]
|
||||
|
||||
:else
|
||||
(mfn [k v]))))]
|
||||
(cond
|
||||
(map? m)
|
||||
(into {} (map do-map) m)
|
||||
|
||||
(vector? m)
|
||||
(into [] (map (partial deep-mapm mfn)) m)
|
||||
|
||||
:else
|
||||
m)))
|
||||
|
||||
(defn not-empty?
|
||||
[coll]
|
||||
(boolean (seq coll)))
|
||||
|
||||
(defn kebab-keys [m]
|
||||
(->> m
|
||||
(deep-mapm
|
||||
@ -647,40 +692,6 @@
|
||||
[(keyword (str/kebab (name k))) v]
|
||||
[k v])))))
|
||||
|
||||
|
||||
(defn group-by
|
||||
([kf coll] (group-by kf identity [] coll))
|
||||
([kf vf coll] (group-by kf vf [] coll))
|
||||
([kf vf iv coll]
|
||||
(let [conj (fnil conj iv)]
|
||||
(reduce (fn [result item]
|
||||
(update result (kf item) conj (vf item)))
|
||||
{}
|
||||
coll))))
|
||||
|
||||
(defn iteration
|
||||
"Creates a totally lazy seqable via repeated calls to step, a
|
||||
function of some (continuation token) 'k'. The first call to step
|
||||
will be passed initk, returning 'ret'. If (somef ret) is true, (vf
|
||||
ret) will be included in the iteration, else iteration will
|
||||
terminate and vf/kf will not be called. If (kf ret) is non-nil it
|
||||
will be passed to the next step call, else iteration will terminate.
|
||||
|
||||
This can be used e.g. to consume APIs that return paginated or batched data.
|
||||
|
||||
step - (possibly impure) fn of 'k' -> 'ret'
|
||||
:somef - fn of 'ret' -> logical true/false, default 'some?'
|
||||
:vf - fn of 'ret' -> 'v', a value produced by the iteration, default 'identity'
|
||||
:kf - fn of 'ret' -> 'next-k' or nil (signaling 'do not continue'), default 'identity'
|
||||
:initk - the first value passed to step, default 'nil'
|
||||
|
||||
It is presumed that step with non-initk is
|
||||
unreproducible/non-idempotent. If step with initk is unreproducible
|
||||
it is on the consumer to not consume twice."
|
||||
[& args]
|
||||
(->> (apply c/iteration args)
|
||||
(concat-all)))
|
||||
|
||||
(defn toggle-selection
|
||||
([set value]
|
||||
(toggle-selection set value false))
|
||||
|
||||
@ -107,3 +107,15 @@
|
||||
(d/close! ~(first bindings))))))
|
||||
`(do ~@body)
|
||||
(reverse (partition 2 bindings))))
|
||||
|
||||
(defmacro get-prop
|
||||
"A macro based, optimized variant of `get` that access the property
|
||||
directly on CLJS, on CLJ works as get."
|
||||
[obj prop]
|
||||
;; `(do
|
||||
;; (when-not (record? ~obj)
|
||||
;; (js/console.trace (pr-str ~obj)))
|
||||
;; (c/get ~obj ~prop)))
|
||||
(if (:ns &env)
|
||||
(list (symbol ".") (with-meta obj {:tag 'js}) (symbol (str "-" (c/name prop))))
|
||||
`(c/get ~obj ~prop)))
|
||||
|
||||
@ -9,6 +9,7 @@
|
||||
#?(:cljs [cljs.pprint :as pp]
|
||||
:clj [clojure.pprint :as pp])
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.math :as mth]
|
||||
[app.common.spec :as us]
|
||||
@ -123,6 +124,35 @@
|
||||
([m1 m2 & others]
|
||||
(reduce multiply (multiply m1 m2) others)))
|
||||
|
||||
(defn multiply!
|
||||
[^Matrix m1 ^Matrix m2]
|
||||
(let [m1a (.-a m1)
|
||||
m1b (.-b m1)
|
||||
m1c (.-c m1)
|
||||
m1d (.-d m1)
|
||||
m1e (.-e m1)
|
||||
m1f (.-f m1)
|
||||
m2a (.-a m2)
|
||||
m2b (.-b m2)
|
||||
m2c (.-c m2)
|
||||
m2d (.-d m2)
|
||||
m2e (.-e m2)
|
||||
m2f (.-f m2)]
|
||||
#?@(:cljs [(set! (.-a m1) (+ (* m1a m2a) (* m1c m2b)))
|
||||
(set! (.-b m1) (+ (* m1b m2a) (* m1d m2b)))
|
||||
(set! (.-c m1) (+ (* m1a m2c) (* m1c m2d)))
|
||||
(set! (.-d m1) (+ (* m1b m2c) (* m1d m2d)))
|
||||
(set! (.-e m1) (+ (* m1a m2e) (* m1c m2f) m1e))
|
||||
(set! (.-f m1) (+ (* m1b m2e) (* m1d m2f) m1f))
|
||||
m1]
|
||||
:clj [(Matrix.
|
||||
(+ (* m1a m2a) (* m1c m2b))
|
||||
(+ (* m1b m2a) (* m1d m2b))
|
||||
(+ (* m1a m2c) (* m1c m2d))
|
||||
(+ (* m1b m2c) (* m1d m2d))
|
||||
(+ (* m1a m2e) (* m1c m2f) m1e)
|
||||
(+ (* m1b m2e) (* m1d m2f) m1f))])))
|
||||
|
||||
(defn add-translate
|
||||
"Given two TRANSLATE matrixes (only e and f have significative
|
||||
values), combine them. Quicker than multiplying them, for this
|
||||
@ -147,26 +177,31 @@
|
||||
(= v base))
|
||||
|
||||
(defn translate-matrix
|
||||
([{x :x y :y :as pt}]
|
||||
([pt]
|
||||
(assert (gpt/point? pt))
|
||||
(Matrix. 1 0 0 1 x y))
|
||||
(Matrix. 1 0 0 1
|
||||
(dm/get-prop pt :x)
|
||||
(dm/get-prop pt :y)))
|
||||
|
||||
([x y]
|
||||
(translate-matrix (gpt/point x y))))
|
||||
(Matrix. 1 0 0 1 x y)))
|
||||
|
||||
(defn scale-matrix
|
||||
([pt center]
|
||||
(multiply (translate-matrix center)
|
||||
(scale-matrix pt)
|
||||
(translate-matrix (gpt/negate center))))
|
||||
([{x :x y :y :as pt}]
|
||||
(-> (matrix)
|
||||
(multiply! (translate-matrix center))
|
||||
(multiply! (scale-matrix pt))
|
||||
(multiply! (translate-matrix (gpt/negate center)))))
|
||||
([pt]
|
||||
(assert (gpt/point? pt))
|
||||
(Matrix. x 0 0 y 0 0)))
|
||||
(Matrix. (dm/get-prop pt :x) 0 0 (dm/get-prop pt :y) 0 0)))
|
||||
|
||||
(defn rotate-matrix
|
||||
([angle point] (multiply (translate-matrix point)
|
||||
(rotate-matrix angle)
|
||||
(translate-matrix (gpt/negate point))))
|
||||
([angle point]
|
||||
(-> (matrix)
|
||||
(multiply! (translate-matrix point))
|
||||
(multiply! (rotate-matrix angle))
|
||||
(multiply! (translate-matrix (gpt/negate point)))))
|
||||
([angle]
|
||||
(let [a (mth/radians angle)]
|
||||
(Matrix. (mth/cos a)
|
||||
@ -200,11 +235,23 @@
|
||||
([m scale center]
|
||||
(multiply m (scale-matrix scale center))))
|
||||
|
||||
(defn scale!
|
||||
"Apply scale transformation to the matrix."
|
||||
([m scale]
|
||||
(multiply! m (scale-matrix scale)))
|
||||
([m scale center]
|
||||
(multiply! m (scale-matrix scale center))))
|
||||
|
||||
(defn translate
|
||||
"Apply translate transformation to the matrix."
|
||||
[m pt]
|
||||
(multiply m (translate-matrix pt)))
|
||||
|
||||
(defn translate!
|
||||
"Apply translate transformation to the matrix."
|
||||
[m pt]
|
||||
(multiply! m (translate-matrix pt)))
|
||||
|
||||
(defn skew
|
||||
"Apply translate transformation to the matrix."
|
||||
([m angle-x angle-y]
|
||||
|
||||
@ -11,6 +11,8 @@
|
||||
:clj [clojure.pprint :as pp])
|
||||
#?(:cljs [cljs.core :as c]
|
||||
:clj [clojure.core :as c])
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.math :as mth]
|
||||
[app.common.spec :as us]
|
||||
[clojure.spec.alpha :as s]
|
||||
@ -20,18 +22,20 @@
|
||||
|
||||
(defrecord Point [x y])
|
||||
|
||||
(defn s [{:keys [x y]}] (str "(" x "," y ")"))
|
||||
(defn s
|
||||
[pt]
|
||||
(dm/str "(" (dm/get-prop pt :x) "," (dm/get-prop pt :y) ")"))
|
||||
|
||||
(defn point?
|
||||
"Return true if `v` is Point instance."
|
||||
[v]
|
||||
(or (instance? Point v)
|
||||
(and (map? v) (contains? v :x) (contains? v :y))))
|
||||
(instance? Point v))
|
||||
|
||||
(s/def ::x ::us/safe-number)
|
||||
(s/def ::y ::us/safe-number)
|
||||
|
||||
(s/def ::point-attrs (s/keys :req-un [::x ::y]))
|
||||
(s/def ::point-attrs
|
||||
(s/keys :req-un [::x ::y]))
|
||||
|
||||
(s/def ::point
|
||||
(s/with-gen (s/and ::point-attrs point?)
|
||||
@ -40,10 +44,8 @@
|
||||
(defn point-like?
|
||||
[{:keys [x y] :as v}]
|
||||
(and (map? v)
|
||||
(not (nil? x))
|
||||
(not (nil? y))
|
||||
(number? x)
|
||||
(number? y)))
|
||||
(d/num? x)
|
||||
(d/num? y)))
|
||||
|
||||
(defn point
|
||||
"Create a Point instance."
|
||||
@ -51,13 +53,13 @@
|
||||
([v]
|
||||
(cond
|
||||
(point? v)
|
||||
(Point. (:x v) (:y v))
|
||||
v
|
||||
|
||||
(number? v)
|
||||
(point v v)
|
||||
|
||||
(point-like? v)
|
||||
(point (:x v) (:y v))
|
||||
(map->Point v)
|
||||
|
||||
:else
|
||||
(throw (ex-info "Invalid arguments" {:v v}))))
|
||||
@ -66,128 +68,178 @@
|
||||
|
||||
(defn close?
|
||||
[p1 p2]
|
||||
(and (mth/close? (:x p1) (:x p2))
|
||||
(mth/close? (:y p1) (:y p2))))
|
||||
(and (mth/close? (dm/get-prop p1 :x)
|
||||
(dm/get-prop p2 :x))
|
||||
(mth/close? (dm/get-prop p1 :y)
|
||||
(dm/get-prop p2 :y))))
|
||||
|
||||
(defn angle->point [{:keys [x y]} angle distance]
|
||||
(defn angle->point
|
||||
[pt angle distance]
|
||||
(point
|
||||
(+ x (* distance (mth/cos angle)))
|
||||
(- y (* distance (mth/sin angle)))))
|
||||
(+ (dm/get-prop pt :x) (* distance (mth/cos angle)))
|
||||
(- (dm/get-prop pt :y) (* distance (mth/sin angle)))))
|
||||
|
||||
(defn add
|
||||
"Returns the addition of the supplied value to both
|
||||
coordinates of the point as a new point."
|
||||
[{x :x y :y :as p} {ox :x oy :y :as other}]
|
||||
(assert (point? p))
|
||||
(assert (point? other))
|
||||
(Point. (+ x ox) (+ y oy)))
|
||||
[p1 p2]
|
||||
(assert (and (point? p1)
|
||||
(point? p2))
|
||||
"arguments should be pointer instance")
|
||||
(Point. (+ (dm/get-prop p1 :x)
|
||||
(dm/get-prop p2 :x))
|
||||
(+ (dm/get-prop p1 :y)
|
||||
(dm/get-prop p2 :y))))
|
||||
|
||||
(defn subtract
|
||||
"Returns the subtraction of the supplied value to both
|
||||
coordinates of the point as a new point."
|
||||
[{x :x y :y :as p} {ox :x oy :y :as other}]
|
||||
(assert (point? p))
|
||||
(assert (point? other))
|
||||
(Point. (- x ox) (- y oy)))
|
||||
[p1 p2]
|
||||
(assert (and (point? p1)
|
||||
(point? p2))
|
||||
"arguments should be pointer instance")
|
||||
(Point. (- (dm/get-prop p1 :x)
|
||||
(dm/get-prop p2 :x))
|
||||
(- (dm/get-prop p1 :y)
|
||||
(dm/get-prop p2 :y))))
|
||||
|
||||
(defn multiply
|
||||
"Returns the subtraction of the supplied value to both
|
||||
coordinates of the point as a new point."
|
||||
[{x :x y :y :as p} {ox :x oy :y :as other}]
|
||||
(assert (point? p))
|
||||
(assert (point? other))
|
||||
(Point. (* x ox) (* y oy)))
|
||||
[p1 p2]
|
||||
(assert (and (point? p1)
|
||||
(point? p2))
|
||||
"arguments should be pointer instance")
|
||||
(Point. (* (dm/get-prop p1 :x)
|
||||
(dm/get-prop p2 :x))
|
||||
(* (dm/get-prop p1 :y)
|
||||
(dm/get-prop p2 :y))))
|
||||
|
||||
(defn divide
|
||||
[{x :x y :y :as p} {ox :x oy :y :as other}]
|
||||
(assert (point? p))
|
||||
(assert (point? other))
|
||||
(Point. (/ x ox) (/ y oy)))
|
||||
[p1 p2]
|
||||
(assert (and (point? p1)
|
||||
(point? p2))
|
||||
"arguments should be pointer instance")
|
||||
(Point. (/ (dm/get-prop p1 :x)
|
||||
(dm/get-prop p2 :x))
|
||||
(/ (dm/get-prop p1 :y)
|
||||
(dm/get-prop p2 :y))))
|
||||
|
||||
(defn min
|
||||
([] (min nil nil))
|
||||
([p1] (min p1 nil))
|
||||
([{x1 :x y1 :y :as p1} {x2 :x y2 :y :as p2}]
|
||||
([] nil)
|
||||
([p1] p1)
|
||||
([p1 p2]
|
||||
(cond
|
||||
(nil? p1) p2
|
||||
(nil? p2) p1
|
||||
:else (Point. (c/min x1 x2) (c/min y1 y2)))))
|
||||
|
||||
:else (Point. (c/min (dm/get-prop p1 :x)
|
||||
(dm/get-prop p2 :x))
|
||||
(c/min (dm/get-prop p1 :y)
|
||||
(dm/get-prop p2 :y))))))
|
||||
(defn max
|
||||
([] (max nil nil))
|
||||
([p1] (max p1 nil))
|
||||
([{x1 :x y1 :y :as p1} {x2 :x y2 :y :as p2}]
|
||||
([] nil)
|
||||
([p1] p1)
|
||||
([p1 p2]
|
||||
(cond
|
||||
(nil? p1) p2
|
||||
(nil? p2) p1
|
||||
:else (Point. (c/max x1 x2) (c/max y1 y2)))))
|
||||
|
||||
:else (Point. (c/max (dm/get-prop p1 :x)
|
||||
(dm/get-prop p2 :x))
|
||||
(c/max (dm/get-prop p1 :y)
|
||||
(dm/get-prop p2 :y))))))
|
||||
(defn inverse
|
||||
[{:keys [x y] :as p}]
|
||||
(assert (point? p))
|
||||
(Point. (/ 1 x) (/ 1 y)))
|
||||
[pt]
|
||||
(assert (point? pt) "point instance expected")
|
||||
(Point. (/ 1.0 (dm/get-prop pt :x))
|
||||
(/ 1.0 (dm/get-prop pt :y))))
|
||||
|
||||
(defn negate
|
||||
[{x :x y :y :as p}]
|
||||
(assert (point? p))
|
||||
(Point. (- x) (- y)))
|
||||
[pt]
|
||||
(assert (point? pt) "point instance expected")
|
||||
(Point. (- (dm/get-prop pt :x))
|
||||
(- (dm/get-prop pt :y))))
|
||||
|
||||
(defn distance
|
||||
"Calculate the distance between two points."
|
||||
[{x :x y :y :as p} {ox :x oy :y :as other}]
|
||||
(assert (point? p))
|
||||
(assert (point? other))
|
||||
(let [dx (- x ox)
|
||||
dy (- y oy)]
|
||||
[p1 p2]
|
||||
(assert (and (point? p1)
|
||||
(point? p2))
|
||||
"arguments should be point instances")
|
||||
(let [dx (- (dm/get-prop p1 :x)
|
||||
(dm/get-prop p2 :x))
|
||||
dy (- (dm/get-prop p1 :y)
|
||||
(dm/get-prop p2 :y))]
|
||||
(mth/sqrt (+ (mth/pow dx 2)
|
||||
(mth/pow dy 2)))))
|
||||
|
||||
(defn distance-vector
|
||||
"Calculate the distance, separated x and y."
|
||||
[{x :x y :y :as p} {ox :x oy :y :as other}]
|
||||
(assert (point? p))
|
||||
(assert (point? other))
|
||||
(let [dx (mth/abs (- x ox))
|
||||
dy (mth/abs (- y oy))]
|
||||
(Point. dx dy)))
|
||||
[p1 p2]
|
||||
(assert (and (point? p1)
|
||||
(point? p2))
|
||||
"arguments should be point instances")
|
||||
(let [dx (- (dm/get-prop p1 :x)
|
||||
(dm/get-prop p2 :x))
|
||||
dy (- (dm/get-prop p1 :y)
|
||||
(dm/get-prop p2 :y))]
|
||||
(Point. (mth/abs dx)
|
||||
(mth/abs dy))))
|
||||
|
||||
(defn length
|
||||
[{x :x y :y :as p}]
|
||||
(assert (point? p))
|
||||
(mth/sqrt (+ (mth/pow x 2)
|
||||
(mth/pow y 2))))
|
||||
[pt]
|
||||
(assert (point? pt) "point instance expected")
|
||||
(let [x (dm/get-prop pt :x)
|
||||
y (dm/get-prop pt :y)]
|
||||
(mth/sqrt (+ (mth/pow x 2)
|
||||
(mth/pow y 2)))))
|
||||
|
||||
(defn angle
|
||||
"Returns the smaller angle between two vectors.
|
||||
If the second vector is not provided, the angle
|
||||
will be measured from x-axis."
|
||||
([{x :x y :y :as p}]
|
||||
(-> (mth/atan2 y x)
|
||||
(mth/degrees)))
|
||||
([p center]
|
||||
(angle (subtract p center))))
|
||||
([pt]
|
||||
(assert (point? pt) "point instance expected")
|
||||
(let [x (dm/get-prop pt :x)
|
||||
y (dm/get-prop pt :y)]
|
||||
(-> (mth/atan2 y x)
|
||||
(mth/degrees))))
|
||||
([pt center]
|
||||
(assert (point? pt) "point instance expected")
|
||||
(assert (point? center) "point instance expected")
|
||||
(let [x (- (dm/get-prop pt :x)
|
||||
(dm/get-prop center :x))
|
||||
y (- (dm/get-prop pt :y)
|
||||
(dm/get-prop center :y))]
|
||||
(-> (mth/atan2 y x)
|
||||
(mth/degrees)))))
|
||||
|
||||
(defn angle-with-other
|
||||
"Consider point as vector and calculate
|
||||
the angle between two vectors."
|
||||
[{x :x y :y :as p} {ox :x oy :y :as other}]
|
||||
(assert (point? p))
|
||||
(assert (point? other))
|
||||
|
||||
(let [length-p (length p)
|
||||
length-other (length other)]
|
||||
(if (or (mth/almost-zero? length-p)
|
||||
(mth/almost-zero? length-other))
|
||||
[p1 p2]
|
||||
(assert (and (point? p1)
|
||||
(point? p2))
|
||||
"arguments should be point instances")
|
||||
(let [length-p1 (length p1)
|
||||
length-p2 (length p2)]
|
||||
(if (or (mth/almost-zero? length-p1)
|
||||
(mth/almost-zero? length-p2))
|
||||
0
|
||||
(let [a (/ (+ (* x ox)
|
||||
(* y oy))
|
||||
(* length-p length-other))
|
||||
(let [a (/ (+ (* (dm/get-prop p1 :x)
|
||||
(dm/get-prop p2 :x))
|
||||
(* (dm/get-prop p1 :y)
|
||||
(dm/get-prop p2 :y)))
|
||||
(* length-p1 length-p2))
|
||||
a (mth/acos (if (< a -1) -1 (if (> a 1) 1 a)))
|
||||
d (mth/degrees a)]
|
||||
(if (mth/nan? d) 0 d)))))
|
||||
|
||||
(defn angle-sign [v1 v2]
|
||||
(if (> (* (:y v1) (:x v2)) (* (:x v1) (:y v2))) -1 1))
|
||||
(defn angle-sign
|
||||
[p1 p2]
|
||||
(if (> (* (dm/get-prop p1 :y) (dm/get-prop p2 :x))
|
||||
(* (dm/get-prop p1 :x) (dm/get-prop p2 :y)))
|
||||
-1
|
||||
1))
|
||||
|
||||
(defn signed-angle-with-other
|
||||
[v1 v2]
|
||||
@ -196,70 +248,89 @@
|
||||
(defn update-angle
|
||||
"Update the angle of the point."
|
||||
[p angle]
|
||||
(assert (point? p))
|
||||
(assert (number? angle))
|
||||
(let [len (length p)
|
||||
(assert (number? angle) "expected number")
|
||||
(let [len (length p)
|
||||
angle (mth/radians angle)]
|
||||
(Point. (* (mth/cos angle) len)
|
||||
(* (mth/sin angle) len))))
|
||||
|
||||
(defn quadrant
|
||||
"Return the quadrant of the angle of the point."
|
||||
[{:keys [x y] :as p}]
|
||||
(assert (point? p))
|
||||
(if (>= x 0)
|
||||
(if (>= y 0) 1 4)
|
||||
(if (>= y 0) 2 3)))
|
||||
[p]
|
||||
(assert (point? p) "expected point instance")
|
||||
(let [x (dm/get-prop p :x)
|
||||
y (dm/get-prop p :y)]
|
||||
(if (>= x 0)
|
||||
(if (>= y 0) 1 4)
|
||||
(if (>= y 0) 2 3))))
|
||||
|
||||
(defn round
|
||||
"Round the coordinates of the point to a precision"
|
||||
([point]
|
||||
(round point 0))
|
||||
|
||||
([{:keys [x y] :as p} decimals]
|
||||
(assert (point? p))
|
||||
(assert (number? decimals))
|
||||
(Point. (mth/precision x decimals)
|
||||
(mth/precision y decimals))))
|
||||
([pt decimals]
|
||||
(assert (point? pt) "expected point instance")
|
||||
(assert (number? decimals) "expected number instance")
|
||||
(Point. (mth/precision (dm/get-prop pt :x) decimals)
|
||||
(mth/precision (dm/get-prop pt :y) decimals))))
|
||||
|
||||
(defn half-round
|
||||
"Round the coordinates to the closest half-point"
|
||||
[{:keys [x y] :as p}]
|
||||
(assert (point? p))
|
||||
(Point. (mth/half-round x)
|
||||
(mth/half-round y)))
|
||||
[pt]
|
||||
(assert (point? pt) "expected point instance")
|
||||
(Point. (mth/half-round (dm/get-prop pt :x))
|
||||
(mth/half-round (dm/get-prop pt :y))))
|
||||
|
||||
(defn transform
|
||||
"Transform a point applying a matrix transformation."
|
||||
[{:keys [x y] :as p} {:keys [a b c d e f]}]
|
||||
(assert (point? p))
|
||||
(Point. (+ (* x a) (* y c) e)
|
||||
(+ (* x b) (* y d) f)))
|
||||
[p m]
|
||||
(when (point? p)
|
||||
(if (nil? m)
|
||||
p
|
||||
(let [x (dm/get-prop p :x)
|
||||
y (dm/get-prop p :y)
|
||||
a (dm/get-prop m :a)
|
||||
b (dm/get-prop m :b)
|
||||
c (dm/get-prop m :c)
|
||||
d (dm/get-prop m :d)
|
||||
e (dm/get-prop m :e)
|
||||
f (dm/get-prop m :f)]
|
||||
(Point. (+ (* x a) (* y c) e)
|
||||
(+ (* x b) (* y d) f))))))
|
||||
|
||||
|
||||
;; Vector functions
|
||||
(defn to-vec [p1 p2]
|
||||
(subtract p2 p1))
|
||||
|
||||
(defn scale [v scalar]
|
||||
(-> v
|
||||
(update :x * scalar)
|
||||
(update :y * scalar)))
|
||||
(defn scale
|
||||
[p scalar]
|
||||
(Point. (* (dm/get-prop p :x) scalar)
|
||||
(* (dm/get-prop p :y) scalar)))
|
||||
|
||||
(defn dot [{x1 :x y1 :y} {x2 :x y2 :y}]
|
||||
(+ (* x1 x2) (* y1 y2)))
|
||||
(defn dot
|
||||
[p1 p2]
|
||||
(+ (* (dm/get-prop p1 :x)
|
||||
(dm/get-prop p2 :x))
|
||||
(* (dm/get-prop p1 :y)
|
||||
(dm/get-prop p2 :y))))
|
||||
|
||||
(defn unit [v]
|
||||
(let [v-length (length v)]
|
||||
(divide v (point v-length v-length))))
|
||||
(defn unit
|
||||
[p1]
|
||||
(let [p-length (length p1)]
|
||||
(Point. (/ (dm/get-prop p1 :x) p-length)
|
||||
(/ (dm/get-prop p1 :y) p-length))))
|
||||
|
||||
(defn perpendicular
|
||||
[{:keys [x y]}]
|
||||
(Point. (- y) x))
|
||||
[pt]
|
||||
(Point. (- (dm/get-prop pt :y))
|
||||
(dm/get-prop pt :x)))
|
||||
|
||||
(defn project
|
||||
"V1 perpendicular projection on vector V2"
|
||||
[v1 v2]
|
||||
(let [v2-unit (unit v2)
|
||||
(let [v2-unit (unit v2)
|
||||
scalar-proj (dot v1 v2-unit)]
|
||||
(scale v2-unit scalar-proj)))
|
||||
|
||||
@ -282,43 +353,53 @@
|
||||
(defn point-line-distance
|
||||
"Returns the distance from a point to a line defined by two points"
|
||||
[point line-point1 line-point2]
|
||||
(let [{x0 :x y0 :y} point
|
||||
{x1 :x y1 :y} line-point1
|
||||
{x2 :x y2 :y} line-point2
|
||||
num (mth/abs
|
||||
(+ (* x0 (- y2 y1))
|
||||
(- (* y0 (- x2 x1)))
|
||||
(* x2 y1)
|
||||
(- (* y2 x1))))
|
||||
dist (distance line-point2 line-point1)]
|
||||
(/ num dist)))
|
||||
(let [x0 (dm/get-prop point :x)
|
||||
y0 (dm/get-prop point :y)
|
||||
x1 (dm/get-prop line-point1 :x)
|
||||
y1 (dm/get-prop line-point1 :y)
|
||||
x2 (dm/get-prop line-point2 :x)
|
||||
y2 (dm/get-prop line-point2 :y)]
|
||||
(/ (mth/abs (+ (* x0 (- y2 y1))
|
||||
(- (* y0 (- x2 x1)))
|
||||
(* x2 y1)
|
||||
(- (* y2 x1))))
|
||||
(distance line-point2 line-point1))))
|
||||
|
||||
(defn almost-zero? [{:keys [x y] :as p}]
|
||||
(assert (point? p))
|
||||
(and (mth/almost-zero? x)
|
||||
(mth/almost-zero? y)))
|
||||
(defn almost-zero?
|
||||
[p]
|
||||
(assert (point? p) "point instance expected")
|
||||
(and ^boolean (mth/almost-zero? (dm/get-prop p :x))
|
||||
^boolean (mth/almost-zero? (dm/get-prop p :y))))
|
||||
|
||||
(defn lerp
|
||||
"Calculates a linear interpolation between two points given a tvalue"
|
||||
[p1 p2 t]
|
||||
(let [x (mth/lerp (:x p1) (:x p2) t)
|
||||
y (mth/lerp (:y p1) (:y p2) t)]
|
||||
(point x y)))
|
||||
(let [x (mth/lerp (dm/get-prop p1 :x) (dm/get-prop p2 :x) t)
|
||||
y (mth/lerp (dm/get-prop p1 :y) (dm/get-prop p2 :y) t)]
|
||||
(Point. x y)))
|
||||
|
||||
(defn rotate
|
||||
"Rotates the point around center with an angle"
|
||||
[{px :x py :y} {cx :x cy :y} angle]
|
||||
[p c angle]
|
||||
(prn "ROTATE" p c angle)
|
||||
(assert (point? p) "point instance expected")
|
||||
(assert (point? c) "point instance expected")
|
||||
(let [angle (mth/radians angle)
|
||||
px (dm/get-prop p :x)
|
||||
py (dm/get-prop p :y)
|
||||
cx (dm/get-prop c :x)
|
||||
cy (dm/get-prop c :y)
|
||||
|
||||
x (+ (* (mth/cos angle) (- px cx))
|
||||
(* (mth/sin angle) (- py cy) -1)
|
||||
cx)
|
||||
|
||||
y (+ (* (mth/sin angle) (- px cx))
|
||||
(* (mth/cos angle) (- py cy))
|
||||
cy)]
|
||||
(point x y)))
|
||||
sa (mth/sin angle)
|
||||
ca (mth/cos angle)
|
||||
|
||||
x (+ (* ca (- px cx))
|
||||
(* sa (- py cy) -1)
|
||||
cx)
|
||||
y (+ (* sa (- px cx))
|
||||
(* ca (- py cy))
|
||||
cy)]
|
||||
(Point. x y)))
|
||||
|
||||
(defn scale-from
|
||||
"Moves a point in the vector that creates with center with a scale
|
||||
@ -331,10 +412,11 @@
|
||||
|
||||
(defn no-zeros
|
||||
"Remove zero values from either coordinate"
|
||||
[point]
|
||||
(-> point
|
||||
(update :x #(if (mth/almost-zero? %) 0.001 %))
|
||||
(update :y #(if (mth/almost-zero? %) 0.001 %))))
|
||||
[p]
|
||||
(let [x (dm/get-prop p :x)
|
||||
y (dm/get-prop p :y)]
|
||||
(Point. (if (mth/almost-zero? x) 0.001 x)
|
||||
(if (mth/almost-zero? y) 0.001 y))))
|
||||
|
||||
|
||||
(defn abs
|
||||
|
||||
@ -282,7 +282,7 @@
|
||||
(defn calc-child-modifiers
|
||||
[parent child modifiers ignore-constraints child-bounds parent-bounds transformed-parent-bounds]
|
||||
|
||||
(let [modifiers (ctm/select-child-modifiers modifiers)
|
||||
(let [modifiers (ctm/select-child modifiers)
|
||||
|
||||
constraints-h
|
||||
(if-not ignore-constraints
|
||||
@ -299,7 +299,7 @@
|
||||
|
||||
(let [transformed-parent-bounds @transformed-parent-bounds
|
||||
|
||||
modifiers (ctm/select-child-modifiers modifiers)
|
||||
modifiers (ctm/select-child modifiers)
|
||||
transformed-child-bounds (gtr/transform-bounds child-bounds modifiers)
|
||||
modifiers (normalize-modifiers constraints-h constraints-v
|
||||
modifiers parent
|
||||
|
||||
@ -34,7 +34,7 @@
|
||||
resize-origin (gpo/origin transformed-child-bounds)]
|
||||
|
||||
(-> modifiers
|
||||
(ctm/select-child-modifiers)
|
||||
(ctm/select-child)
|
||||
(ctm/resize
|
||||
resize-vector
|
||||
resize-origin
|
||||
|
||||
@ -107,7 +107,7 @@
|
||||
|
||||
;; Check the constraints, then resize
|
||||
(let [parent-id (:id parent)
|
||||
parent-bounds (gtr/transform-bounds @(get bounds parent-id) (ctm/select-parent-modifiers modifiers))]
|
||||
parent-bounds (gtr/transform-bounds @(get bounds parent-id) (ctm/select-parent modifiers))]
|
||||
(loop [modif-tree modif-tree
|
||||
children (seq children)]
|
||||
(if (empty? children)
|
||||
@ -236,7 +236,24 @@
|
||||
(and (some? auto-height) (ctl/auto-height? parent))
|
||||
(set-parent-auto-height auto-height))))
|
||||
|
||||
(defn- propagate-modifiers
|
||||
(defn- propagate-modifiers-constraints
|
||||
"Propagate modifiers to its children"
|
||||
[objects bounds ignore-constraints modif-tree parent]
|
||||
(let [parent-id (:id parent)
|
||||
root? (= uuid/zero parent-id)
|
||||
modifiers (-> (dm/get-in modif-tree [parent-id :modifiers])
|
||||
(ctm/select-geometry))
|
||||
has-modifiers? (ctm/child-modifiers? modifiers)
|
||||
layout? (ctl/layout? parent)
|
||||
parent? (or (cph/group-like-shape? parent) (cph/frame-shape? parent))
|
||||
|
||||
transformed-parent-bounds (delay (gtr/transform-bounds @(get bounds parent-id) modifiers))]
|
||||
|
||||
(cond-> modif-tree
|
||||
(and (not layout?) has-modifiers? parent? (not root?))
|
||||
(set-children-modifiers objects bounds parent transformed-parent-bounds ignore-constraints))))
|
||||
|
||||
(defn- propagate-modifiers-layout
|
||||
"Propagate modifiers to its children"
|
||||
[objects bounds ignore-constraints [modif-tree autolayouts] parent]
|
||||
(let [parent-id (:id parent)
|
||||
@ -248,14 +265,11 @@
|
||||
auto? (or (ctl/auto-height? parent) (ctl/auto-width? parent))
|
||||
parent? (or (cph/group-like-shape? parent) (cph/frame-shape? parent))
|
||||
|
||||
;; If the current child is inside the layout we ignore the constraints
|
||||
inside-layout? (ctl/inside-layout? objects parent)
|
||||
|
||||
transformed-parent-bounds (delay (gtr/transform-bounds @(get bounds parent-id) modifiers))]
|
||||
|
||||
[(cond-> modif-tree
|
||||
(and (not layout?) has-modifiers? parent? (not root?))
|
||||
(set-children-modifiers objects bounds parent transformed-parent-bounds (or ignore-constraints inside-layout?))
|
||||
(set-children-modifiers objects bounds parent transformed-parent-bounds ignore-constraints)
|
||||
|
||||
layout?
|
||||
(-> (process-layout-children objects bounds parent transformed-parent-bounds)
|
||||
@ -280,18 +294,19 @@
|
||||
other-tree))
|
||||
|
||||
(defn transform-bounds
|
||||
[bounds objects modif-tree]
|
||||
([bounds objects modif-tree]
|
||||
(transform-bounds bounds objects modif-tree (->> (keys modif-tree) (map #(get objects %)))))
|
||||
([bounds objects modif-tree tree-seq]
|
||||
|
||||
(loop [result bounds
|
||||
ids (keys modif-tree)]
|
||||
(if (empty? ids)
|
||||
result
|
||||
(loop [result bounds
|
||||
shapes (reverse tree-seq)]
|
||||
(if (empty? shapes)
|
||||
result
|
||||
|
||||
(let [id (first ids)
|
||||
shape (get objects id)
|
||||
new-bounds (delay (get-group-bounds objects bounds modif-tree shape))
|
||||
result (assoc result id new-bounds)]
|
||||
(recur result (rest ids))))))
|
||||
(let [shape (first shapes)
|
||||
new-bounds (delay (get-group-bounds objects bounds modif-tree shape))
|
||||
result (assoc result (:id shape) new-bounds)]
|
||||
(recur result (rest shapes)))))))
|
||||
|
||||
(defn sizing-auto-modifiers
|
||||
"Recalculates the layouts to adjust the sizing: auto new sizes"
|
||||
@ -308,7 +323,7 @@
|
||||
tree-seq (resolve-tree-sequence #{current} objects)
|
||||
|
||||
[resize-modif-tree _]
|
||||
(reduce #(propagate-modifiers objects bounds ignore-constraints %1 %2) [resize-modif-tree #{}] tree-seq)
|
||||
(reduce #(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [resize-modif-tree #{}] tree-seq)
|
||||
|
||||
bounds (transform-bounds bounds objects resize-modif-tree)
|
||||
|
||||
@ -320,12 +335,18 @@
|
||||
[modif-tree objects ignore-constraints snap-pixel?]
|
||||
|
||||
(let [objects (apply-structure-modifiers objects modif-tree)
|
||||
bounds (d/lazy-map (keys objects) #(dm/get-in objects [% :points]))
|
||||
|
||||
bounds (d/lazy-map (keys objects) #(dm/get-in objects [% :points]))
|
||||
shapes-tree (resolve-tree-sequence (-> modif-tree keys set) objects)
|
||||
|
||||
[modif-tree sizing-auto-layouts]
|
||||
(reduce #(propagate-modifiers objects bounds ignore-constraints %1 %2) [modif-tree #{}] shapes-tree)
|
||||
;; Calculate the input transformation and constraints
|
||||
modif-tree' (reduce #(propagate-modifiers-constraints objects bounds ignore-constraints %1 %2) modif-tree shapes-tree)
|
||||
bounds (transform-bounds bounds objects modif-tree' shapes-tree)
|
||||
|
||||
[modif-tree-layout sizing-auto-layouts]
|
||||
(reduce #(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [{} #{}] shapes-tree)
|
||||
|
||||
modif-tree (merge-modif-tree modif-tree' modif-tree-layout)
|
||||
|
||||
;; Calculate hug layouts positions
|
||||
modif-tree
|
||||
|
||||
@ -41,8 +41,8 @@
|
||||
corner (gpt/point bounds)
|
||||
target-corner (gpt/round corner)
|
||||
deltav (gpt/to-vec corner target-corner)]
|
||||
(-> modifiers
|
||||
(ctm/move deltav))))
|
||||
|
||||
(ctm/move modifiers deltav)))
|
||||
|
||||
(defn set-pixel-precision
|
||||
"Adjust modifiers so they adjust to the pixel grid"
|
||||
|
||||
@ -7,6 +7,7 @@
|
||||
(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]))
|
||||
|
||||
@ -83,13 +84,22 @@
|
||||
|
||||
(defn points->rect
|
||||
[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)
|
||||
(make-rect minx miny (- maxx minx) (- maxy miny))))))
|
||||
(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}]]
|
||||
|
||||
@ -483,9 +483,9 @@
|
||||
|
||||
([points center modifiers]
|
||||
(let [transform (ctm/modifiers->transform modifiers)]
|
||||
(cond-> points
|
||||
(some? transform)
|
||||
(gco/transform-points center transform)))))
|
||||
(cond-> points
|
||||
(some? transform)
|
||||
(gco/transform-points center transform)))))
|
||||
|
||||
(defn transform-selrect
|
||||
[selrect modifiers]
|
||||
|
||||
@ -19,10 +19,13 @@
|
||||
#?(:cljs (js/isNaN v)
|
||||
:clj (Double/isNaN v)))
|
||||
|
||||
;; NOTE: on cljs we don't need to check for `number?` so we explicitly
|
||||
;; ommit it for performance reasons.
|
||||
|
||||
(defn finite?
|
||||
[v]
|
||||
#?(:cljs (and (not (nil? v)) (js/isFinite v))
|
||||
:clj (and (not (nil? v)) (Double/isFinite v))))
|
||||
:clj (and (not (nil? v)) (number? v) (Double/isFinite v))))
|
||||
|
||||
(defn finite
|
||||
[v default]
|
||||
|
||||
@ -39,44 +39,123 @@
|
||||
;; * rotation
|
||||
;; * change-properties
|
||||
|
||||
(defrecord Modifiers
|
||||
[geometry-parent
|
||||
geometry-child
|
||||
structure-parent
|
||||
structure-child])
|
||||
|
||||
(defrecord GeometricOperation
|
||||
[type
|
||||
vector
|
||||
origin
|
||||
transform
|
||||
transform-inverse
|
||||
rotation
|
||||
center])
|
||||
|
||||
(defrecord StructureOperation
|
||||
[type
|
||||
property
|
||||
value
|
||||
index])
|
||||
|
||||
;; Record constructors
|
||||
|
||||
(defn move-op
|
||||
[vector]
|
||||
(GeometricOperation. :move vector nil nil nil nil nil))
|
||||
|
||||
(defn resize-op
|
||||
([vector origin]
|
||||
(GeometricOperation. :resize vector origin nil nil nil nil))
|
||||
([vector origin transform transform-inverse]
|
||||
(GeometricOperation. :resize vector origin transform transform-inverse nil nil)))
|
||||
|
||||
(defn rotation-geom-op
|
||||
[center angle]
|
||||
(GeometricOperation. :rotation nil nil nil nil angle center))
|
||||
|
||||
(defn rotation-struct-op
|
||||
[angle]
|
||||
(StructureOperation. :rotation nil angle nil))
|
||||
|
||||
(defn remove-children-op
|
||||
[shapes]
|
||||
(StructureOperation. :remove-children nil shapes nil))
|
||||
|
||||
(defn add-children-op
|
||||
[shapes index]
|
||||
(StructureOperation. :add-children nil shapes index))
|
||||
|
||||
(defn reflow-op
|
||||
[]
|
||||
(StructureOperation. :reflow nil nil nil))
|
||||
|
||||
(defn scale-content-op
|
||||
[value]
|
||||
(StructureOperation. :scale-content nil value nil))
|
||||
|
||||
(defn change-property-op
|
||||
[property value]
|
||||
(StructureOperation. :change-property property value nil))
|
||||
|
||||
|
||||
;; Private aux functions
|
||||
|
||||
(def conjv (fnil conj []))
|
||||
(defn- move-vec?
|
||||
[vector]
|
||||
(or (not (mth/almost-zero? (dm/get-prop vector :x)))
|
||||
(not (mth/almost-zero? (dm/get-prop vector :y)))))
|
||||
|
||||
(defn- move-vec? [vector]
|
||||
(or (not (mth/almost-zero? (:x vector)))
|
||||
(not (mth/almost-zero? (:y vector)))))
|
||||
|
||||
(defn- resize-vec? [vector]
|
||||
(or (not (mth/almost-zero? (- (:x vector) 1)))
|
||||
(not (mth/almost-zero? (- (:y vector) 1)))))
|
||||
(defn- resize-vec?
|
||||
[vector]
|
||||
(or (not (mth/almost-zero? (- (dm/get-prop vector :x) 1)))
|
||||
(not (mth/almost-zero? (- (dm/get-prop vector :y) 1)))))
|
||||
|
||||
(defn- mergeable-move?
|
||||
[op1 op2]
|
||||
(and (= :move (:type op1))
|
||||
(= :move (:type op2))))
|
||||
(let [type-op1 (dm/get-prop op1 :type)
|
||||
type-op2 (dm/get-prop op2 :type)]
|
||||
(and (= :move type-op1) (= :move type-op2))))
|
||||
|
||||
(defn- mergeable-resize?
|
||||
[op1 op2]
|
||||
(and (= :resize (:type op1))
|
||||
(= :resize (:type op2))
|
||||
(let [type-op1 (dm/get-prop op1 :type)
|
||||
transform-op1 (or (dm/get-prop op1 :transform) (gmt/matrix))
|
||||
transform-inv-op1 (or (dm/get-prop op1 :transform-inverse) (gmt/matrix))
|
||||
origin-op1 (dm/get-prop op1 :origin)
|
||||
|
||||
;; Same transforms
|
||||
(gmt/close? (or (:transform op1) (gmt/matrix)) (or (:transform op2) (gmt/matrix)))
|
||||
(gmt/close? (or (:transform-inverse op1) (gmt/matrix)) (or (:transform-inverse op2) (gmt/matrix)))
|
||||
type-op2 (dm/get-prop op2 :type)
|
||||
transform-op2 (or (dm/get-prop op2 :transform) (gmt/matrix))
|
||||
transform-inv-op2 (or (dm/get-prop op2 :transform-inverse) (gmt/matrix))
|
||||
origin-op2 (dm/get-prop op2 :origin)]
|
||||
(and (= :resize type-op1) (= :resize type-op2)
|
||||
|
||||
;; Same origin
|
||||
(gpt/close? (:origin op1) (:origin op2))))
|
||||
;; Same origin
|
||||
(gpt/close? origin-op1 origin-op2)
|
||||
|
||||
;; Same transforms
|
||||
(gmt/close? transform-op1 transform-op2)
|
||||
(gmt/close? transform-inv-op1 transform-inv-op2))))
|
||||
|
||||
(defn- merge-move
|
||||
[op1 op2]
|
||||
{:type :move
|
||||
:vector (gpt/add (:vector op1) (:vector op2))})
|
||||
(let [vector-op1 (dm/get-prop op1 :vector)
|
||||
vector-op2 (dm/get-prop op2 :vector)]
|
||||
(move-op (gpt/add vector-op1 vector-op2))))
|
||||
|
||||
(defn- merge-resize
|
||||
[op1 op2]
|
||||
(let [vector (gpt/point (* (-> op1 :vector :x) (-> op2 :vector :x))
|
||||
(* (-> op1 :vector :y) (-> op2 :vector :y)))]
|
||||
(let [op1-vector (dm/get-prop op1 :vector)
|
||||
op1-x (dm/get-prop op1-vector :x)
|
||||
op1-y (dm/get-prop op1-vector :y)
|
||||
|
||||
op2-vector (dm/get-prop op2 :vector)
|
||||
op2-x (dm/get-prop op2-vector :x)
|
||||
op2-y (dm/get-prop op2-vector :y)
|
||||
|
||||
vector (gpt/point (* op1-x op2-x) (* op1-y op2-y))]
|
||||
(assoc op1 :vector vector)))
|
||||
|
||||
(defn- maybe-add-move
|
||||
@ -88,7 +167,7 @@
|
||||
(if (mergeable-move? head op)
|
||||
(let [item (merge-move head op)]
|
||||
(cond-> (pop operations)
|
||||
(move-vec? (:vector item))
|
||||
(move-vec? (dm/get-prop item :vector))
|
||||
(conj item)))
|
||||
(conj operations op)))))
|
||||
|
||||
@ -102,21 +181,23 @@
|
||||
(if (mergeable-resize? head op)
|
||||
(let [item (merge-resize head op)]
|
||||
(cond-> (pop operations)
|
||||
(resize-vec? (:vector item))
|
||||
(resize-vec? (dm/get-prop item :vector))
|
||||
(conj item)))
|
||||
(conj operations op)))))
|
||||
|
||||
(defn valid-vector?
|
||||
[{:keys [x y]}]
|
||||
(and (some? x)
|
||||
(some? y)
|
||||
(not (mth/nan? x))
|
||||
(not (mth/nan? y))))
|
||||
[vector]
|
||||
(let [x (dm/get-prop vector :x)
|
||||
y (dm/get-prop vector :y)]
|
||||
(and (some? x)
|
||||
(some? y)
|
||||
(not (mth/nan? x))
|
||||
(not (mth/nan? y)))))
|
||||
|
||||
;; Public builder API
|
||||
|
||||
(defn empty []
|
||||
{})
|
||||
(Modifiers. [] [] [] []))
|
||||
|
||||
(defn move-parent
|
||||
([modifiers x y]
|
||||
@ -124,114 +205,118 @@
|
||||
|
||||
([modifiers vector]
|
||||
(assert (valid-vector? vector) (dm/str "Invalid move vector: " (:x vector) "," (:y vector)))
|
||||
(cond-> modifiers
|
||||
(cond-> (or modifiers (empty))
|
||||
(move-vec? vector)
|
||||
(update :geometry-parent maybe-add-move {:type :move :vector vector}))))
|
||||
(update :geometry-parent maybe-add-move (move-op vector)))))
|
||||
|
||||
(defn resize-parent
|
||||
([modifiers vector origin]
|
||||
(assert (valid-vector? vector) (dm/str "Invalid move vector: " (:x vector) "," (:y vector)))
|
||||
(cond-> modifiers
|
||||
(cond-> (or modifiers (empty))
|
||||
(resize-vec? vector)
|
||||
(update :geometry-parent maybe-add-resize {:type :resize
|
||||
:vector vector
|
||||
:origin origin})))
|
||||
(update :geometry-parent maybe-add-resize (resize-op vector origin))))
|
||||
|
||||
([modifiers vector origin transform transform-inverse]
|
||||
(assert (valid-vector? vector) (dm/str "Invalid move vector: " (:x vector) "," (:y vector)))
|
||||
(cond-> modifiers
|
||||
(cond-> (or modifiers (empty))
|
||||
(resize-vec? vector)
|
||||
(update :geometry-parent maybe-add-resize {:type :resize
|
||||
:vector vector
|
||||
:origin origin
|
||||
:transform transform
|
||||
:transform-inverse transform-inverse}))))
|
||||
(update :geometry-parent maybe-add-resize (resize-op vector origin transform transform-inverse)))))
|
||||
|
||||
(defn move
|
||||
([modifiers x y]
|
||||
(move modifiers (gpt/point x y)))
|
||||
|
||||
([modifiers vector]
|
||||
(assert (valid-vector? vector) (dm/str "Invalid move vector: " (:x vector) "," (:y vector)))
|
||||
(cond-> modifiers
|
||||
(cond-> (or modifiers (empty))
|
||||
(move-vec? vector)
|
||||
(update :geometry-child maybe-add-move {:type :move :vector vector}))))
|
||||
(update :geometry-child maybe-add-move (move-op vector)))))
|
||||
|
||||
(defn resize
|
||||
([modifiers vector origin]
|
||||
(assert (valid-vector? vector) (dm/str "Invalid move vector: " (:x vector) "," (:y vector)))
|
||||
(cond-> modifiers
|
||||
(cond-> (or modifiers (empty))
|
||||
(resize-vec? vector)
|
||||
(update :geometry-child maybe-add-resize {:type :resize
|
||||
:vector vector
|
||||
:origin origin})))
|
||||
(update :geometry-child maybe-add-resize (resize-op vector origin))))
|
||||
|
||||
([modifiers vector origin transform transform-inverse]
|
||||
(assert (valid-vector? vector) (dm/str "Invalid move vector: " (:x vector) "," (:y vector)))
|
||||
(cond-> modifiers
|
||||
(cond-> (or modifiers (empty))
|
||||
(resize-vec? vector)
|
||||
(update :geometry-child maybe-add-resize {:type :resize
|
||||
:vector vector
|
||||
:origin origin
|
||||
:transform transform
|
||||
:transform-inverse transform-inverse}))))
|
||||
(update :geometry-child maybe-add-resize (resize-op vector origin transform transform-inverse)))))
|
||||
|
||||
(defn rotation
|
||||
[modifiers center angle]
|
||||
(cond-> modifiers
|
||||
(cond-> (or modifiers (empty))
|
||||
(not (mth/close? angle 0))
|
||||
(-> (update :structure-child conjv {:type :rotation
|
||||
:rotation angle})
|
||||
(update :geometry-child conjv {:type :rotation
|
||||
:center center
|
||||
:rotation angle}))))
|
||||
(-> (update :structure-child conj (rotation-struct-op angle))
|
||||
(update :geometry-child conj (rotation-geom-op center angle)))))
|
||||
|
||||
(defn remove-children
|
||||
[modifiers shapes]
|
||||
(cond-> modifiers
|
||||
(cond-> (or modifiers (empty))
|
||||
(d/not-empty? shapes)
|
||||
(update :structure-parent conjv {:type :remove-children
|
||||
:value shapes})))
|
||||
(update :structure-parent conj (remove-children-op shapes))))
|
||||
|
||||
(defn add-children
|
||||
[modifiers shapes index]
|
||||
(cond-> modifiers
|
||||
(cond-> (or modifiers (empty))
|
||||
(d/not-empty? shapes)
|
||||
(update :structure-parent conjv {:type :add-children
|
||||
:value shapes
|
||||
:index index})))
|
||||
(update :structure-parent conj (add-children-op shapes index))))
|
||||
|
||||
(defn reflow
|
||||
[modifiers]
|
||||
(-> modifiers
|
||||
(update :structure-parent conjv {:type :reflow})))
|
||||
(-> (or modifiers (empty))
|
||||
(update :structure-parent conj (reflow-op))))
|
||||
|
||||
(defn scale-content
|
||||
[modifiers value]
|
||||
(-> modifiers
|
||||
(update :structure-child conjv {:type :scale-content :value value})))
|
||||
(-> (or modifiers (empty))
|
||||
(update :structure-child conj (scale-content-op value))))
|
||||
|
||||
(defn change-property
|
||||
[modifiers property value]
|
||||
(-> modifiers
|
||||
(update :structure-child conjv {:type :change-property
|
||||
:property property
|
||||
:value value})))
|
||||
(-> (or modifiers (empty))
|
||||
(update :structure-child conj (change-property-op property value))))
|
||||
|
||||
(defn- merge-geometry
|
||||
[operations other]
|
||||
|
||||
(cond
|
||||
(c/empty? operations)
|
||||
other
|
||||
|
||||
(c/empty? other)
|
||||
operations
|
||||
|
||||
:else
|
||||
(loop [result operations
|
||||
operations (seq other)]
|
||||
(if (c/empty? operations)
|
||||
result
|
||||
(let [current (first operations)
|
||||
result
|
||||
(cond
|
||||
(= :move (dm/get-prop current :type))
|
||||
(maybe-add-move result current)
|
||||
|
||||
(= :resize (dm/get-prop current :type))
|
||||
(maybe-add-resize result current)
|
||||
|
||||
:else
|
||||
(conj result current))]
|
||||
|
||||
(recur result (rest operations)))))))
|
||||
|
||||
(defn add-modifiers
|
||||
[modifiers new-modifiers]
|
||||
|
||||
(cond-> modifiers
|
||||
(some? (:geometry-child new-modifiers))
|
||||
(update :geometry-child #(d/concat-vec [] % (:geometry-child new-modifiers)))
|
||||
|
||||
(some? (:geometry-parent new-modifiers))
|
||||
(update :geometry-parent #(d/concat-vec [] % (:geometry-parent new-modifiers)))
|
||||
|
||||
(some? (:structure-parent new-modifiers))
|
||||
(update :structure-parent #(d/concat-vec [] % (:structure-parent new-modifiers)))
|
||||
|
||||
(some? (:structure-child new-modifiers))
|
||||
(update :structure-child #(d/concat-vec [] % (:structure-child new-modifiers)))))
|
||||
(let [modifiers (or modifiers (empty))
|
||||
new-modifiers (or new-modifiers (empty))]
|
||||
(-> modifiers
|
||||
(update :geometry-child merge-geometry (dm/get-prop new-modifiers :geometry-child))
|
||||
(update :geometry-parent merge-geometry (dm/get-prop new-modifiers :geometry-parent))
|
||||
(update :structure-parent #(d/concat-vec [] % (dm/get-prop new-modifiers :structure-parent)))
|
||||
(update :structure-child #(d/concat-vec [] % (dm/get-prop new-modifiers :structure-child))))))
|
||||
|
||||
|
||||
;; These are convenience methods to create single operation modifiers without the builder
|
||||
@ -355,27 +440,27 @@
|
||||
|
||||
(defn empty?
|
||||
[modifiers]
|
||||
(and (c/empty? (:geometry-child modifiers))
|
||||
(c/empty? (:geometry-parent modifiers))
|
||||
(c/empty? (:structure-parent modifiers))
|
||||
(c/empty? (:structure-child modifiers))))
|
||||
(and (c/empty? (dm/get-prop modifiers :geometry-child))
|
||||
(c/empty? (dm/get-prop modifiers :geometry-parent))
|
||||
(c/empty? (dm/get-prop modifiers :structure-parent))
|
||||
(c/empty? (dm/get-prop modifiers :structure-child))))
|
||||
|
||||
(defn child-modifiers?
|
||||
[{:keys [geometry-child structure-child]}]
|
||||
(or (d/not-empty? geometry-child)
|
||||
(d/not-empty? structure-child)))
|
||||
[modifiers]
|
||||
(or (d/not-empty? (dm/get-prop modifiers :geometry-child))
|
||||
(d/not-empty? (dm/get-prop modifiers :structure-child))))
|
||||
|
||||
(defn only-move?
|
||||
"Returns true if there are only move operations"
|
||||
[{:keys [geometry-child geometry-parent]}]
|
||||
(let [move-op? #(= :move (:type %))]
|
||||
(and (every? move-op? geometry-child)
|
||||
(every? move-op? geometry-parent))))
|
||||
[modifiers]
|
||||
(let [move-op? #(= :move (dm/get-prop % :type))]
|
||||
(and (every? move-op? (dm/get-prop modifiers :geometry-child))
|
||||
(every? move-op? (dm/get-prop modifiers :geometry-parent)))))
|
||||
|
||||
(defn has-geometry?
|
||||
[{:keys [geometry-parent geometry-child]}]
|
||||
(or (d/not-empty? geometry-parent)
|
||||
(d/not-empty? geometry-child)))
|
||||
[modifiers]
|
||||
(or (d/not-empty? (dm/get-prop modifiers :geometry-parent))
|
||||
(d/not-empty? (dm/get-prop modifiers :geometry-child))))
|
||||
|
||||
(defn has-structure?
|
||||
[{:keys [structure-parent structure-child]}]
|
||||
@ -384,25 +469,25 @@
|
||||
|
||||
;; Extract subsets of modifiers
|
||||
|
||||
(defn select-child-modifiers
|
||||
(defn select-child
|
||||
[modifiers]
|
||||
(select-keys modifiers [:geometry-child :structure-child]))
|
||||
(assoc (or modifiers (empty)) :geometry-parent [] :structure-parent []))
|
||||
|
||||
(defn select-child-geometry-modifiers
|
||||
(defn select-parent
|
||||
[modifiers]
|
||||
(select-keys modifiers [:geometry-child]))
|
||||
|
||||
(defn select-parent-modifiers
|
||||
[modifiers]
|
||||
(select-keys modifiers [:geometry-parent :structure-parent]))
|
||||
(assoc (or modifiers (empty)) :geometry-child [] :structure-child []))
|
||||
|
||||
(defn select-structure
|
||||
[modifiers]
|
||||
(select-keys modifiers [:structure-parent :structure-child]))
|
||||
(assoc (or modifiers (empty)) :geometry-child [] :geometry-parent []))
|
||||
|
||||
(defn select-geometry
|
||||
[modifiers]
|
||||
(select-keys modifiers [:geometry-parent :geometry-child]))
|
||||
(assoc (or modifiers (empty)) :structure-child [] :structure-parent []))
|
||||
|
||||
(defn select-child-geometry-modifiers
|
||||
[modifiers]
|
||||
(-> modifiers select-child select-geometry))
|
||||
|
||||
(defn added-children-frames
|
||||
"Returns the frames that have an 'add-children' operation"
|
||||
@ -426,39 +511,53 @@
|
||||
(defn modifiers->transform
|
||||
"Given a set of modifiers returns its transformation matrix"
|
||||
[modifiers]
|
||||
(letfn [(apply-modifier [matrix {:keys [type vector rotation center origin transform transform-inverse] :as modifier}]
|
||||
(case type
|
||||
:move
|
||||
(gmt/multiply (gmt/translate-matrix vector) matrix)
|
||||
(let [modifiers (concat (dm/get-prop modifiers :geometry-parent)
|
||||
(dm/get-prop modifiers :geometry-child))]
|
||||
|
||||
:resize
|
||||
(let [origin (cond-> origin
|
||||
(or (some? transform-inverse)(some? transform))
|
||||
(gpt/transform transform-inverse))]
|
||||
(gmt/multiply
|
||||
(-> (gmt/matrix)
|
||||
(cond-> (some? transform)
|
||||
(gmt/multiply transform))
|
||||
(gmt/translate origin)
|
||||
(gmt/scale vector)
|
||||
(gmt/translate (gpt/negate origin))
|
||||
(cond-> (some? transform-inverse)
|
||||
(gmt/multiply transform-inverse)))
|
||||
matrix))
|
||||
(loop [matrix (gmt/matrix)
|
||||
modifiers (seq modifiers)]
|
||||
(if (c/empty? modifiers)
|
||||
matrix
|
||||
(let [modifier (first modifiers)
|
||||
type (dm/get-prop modifier :type)
|
||||
|
||||
:rotation
|
||||
(gmt/multiply
|
||||
(-> (gmt/matrix)
|
||||
(gmt/translate center)
|
||||
(gmt/multiply (gmt/rotate-matrix rotation))
|
||||
(gmt/translate (gpt/negate center)))
|
||||
matrix)))]
|
||||
(let [modifiers (if (d/not-empty? (:geometry-parent modifiers))
|
||||
(d/concat-vec (:geometry-parent modifiers) (:geometry-child modifiers))
|
||||
(:geometry-child modifiers))]
|
||||
(when (d/not-empty? modifiers)
|
||||
(->> modifiers
|
||||
(reduce apply-modifier (gmt/matrix)))))))
|
||||
matrix
|
||||
(case type
|
||||
:move
|
||||
(-> (dm/get-prop modifier :vector)
|
||||
(gmt/translate-matrix)
|
||||
(gmt/multiply! matrix))
|
||||
|
||||
:resize
|
||||
(let [tf (dm/get-prop modifier :transform)
|
||||
tfi (dm/get-prop modifier :transform-inverse)
|
||||
vector (dm/get-prop modifier :vector)
|
||||
origin (dm/get-prop modifier :origin)
|
||||
origin (if ^boolean (some? tfi)
|
||||
(gpt/transform origin tfi)
|
||||
origin)]
|
||||
|
||||
(gmt/multiply!
|
||||
(-> (gmt/matrix)
|
||||
(cond-> ^boolean (some? tf)
|
||||
(gmt/multiply! tf))
|
||||
(gmt/translate! origin)
|
||||
(gmt/scale! vector)
|
||||
(gmt/translate! (gpt/negate origin))
|
||||
(cond-> ^boolean (some? tfi)
|
||||
(gmt/multiply! tfi)))
|
||||
matrix))
|
||||
|
||||
:rotation
|
||||
(let [center (dm/get-prop modifier :center)
|
||||
rotation (dm/get-prop modifier :rotation)]
|
||||
(gmt/multiply!
|
||||
(-> (gmt/matrix)
|
||||
(gmt/translate! center)
|
||||
(gmt/multiply! (gmt/rotate-matrix rotation))
|
||||
(gmt/translate! (gpt/negate center)))
|
||||
matrix)))]
|
||||
(recur matrix (next modifiers)))))))
|
||||
|
||||
(defn apply-structure-modifiers
|
||||
"Apply structure changes to a shape"
|
||||
@ -482,36 +581,48 @@
|
||||
(cond-> shape
|
||||
(cph/text-shape? shape)
|
||||
(update :content scale-text-content value)))]
|
||||
|
||||
(let [remove-children
|
||||
(fn [shapes children-to-remove]
|
||||
(let [remove? (set children-to-remove)]
|
||||
(d/removev remove? shapes)))
|
||||
|
||||
apply-modifier
|
||||
(fn [shape {:keys [type property value index rotation]}]
|
||||
(cond-> shape
|
||||
(= type :rotation)
|
||||
(update :rotation #(mod (+ % rotation) 360))
|
||||
(fn [shape operation]
|
||||
(let [type (dm/get-prop operation :type)]
|
||||
(case type
|
||||
:rotation
|
||||
(let [rotation (dm/get-prop operation :value)]
|
||||
(update shape :rotation #(mod (+ (or % 0) rotation) 360)))
|
||||
|
||||
(and (= type :add-children) (some? index))
|
||||
(update :shapes
|
||||
(fn [shapes]
|
||||
(if (vector? shapes)
|
||||
(cph/insert-at-index shapes index value)
|
||||
(d/concat-vec shapes value))))
|
||||
:add-children
|
||||
(let [value (dm/get-prop operation :value)
|
||||
index (dm/get-prop operation :index)]
|
||||
(if (some? index)
|
||||
(update shape :shapes
|
||||
(fn [shapes]
|
||||
(if (vector? shapes)
|
||||
(cph/insert-at-index shapes index value)
|
||||
(d/concat-vec shapes value))))
|
||||
(update shape :shapes d/concat-vec value)))
|
||||
|
||||
(and (= type :add-children) (nil? index))
|
||||
(update :shapes d/concat-vec value)
|
||||
:remove-children
|
||||
(let [value (dm/get-prop operation :value)]
|
||||
(update shape :shapes remove-children value))
|
||||
|
||||
(= type :remove-children)
|
||||
(update :shapes remove-children value)
|
||||
|
||||
(= type :scale-content)
|
||||
(apply-scale-content value)
|
||||
:scale-content
|
||||
(let [value (dm/get-prop operation :value)]
|
||||
(apply-scale-content shape value))
|
||||
|
||||
(= type :change-property)
|
||||
(assoc property value)))]
|
||||
:change-property
|
||||
(let [property (dm/get-prop operation :property)
|
||||
value (dm/get-prop operation :value)]
|
||||
(assoc shape property value))
|
||||
|
||||
;; :default => no change to shape
|
||||
shape)))]
|
||||
|
||||
(as-> shape $
|
||||
(reduce apply-modifier $ (:structure-parent modifiers))
|
||||
(reduce apply-modifier $ (:structure-child modifiers))))))
|
||||
(reduce apply-modifier $ (dm/get-prop modifiers :structure-parent))
|
||||
(reduce apply-modifier $ (dm/get-prop modifiers :structure-child))))))
|
||||
|
||||
@ -24,8 +24,10 @@ goog.scope(function() {
|
||||
};
|
||||
} else if (typeof require === "function") {
|
||||
const crypto = require("crypto");
|
||||
const randomBytes = crypto["randomBytes"];
|
||||
|
||||
return (buf) => {
|
||||
const bytes = crypto.randomBytes(buf.length);
|
||||
const bytes = randomBytes(buf.length);
|
||||
buf.set(bytes)
|
||||
return buf;
|
||||
};
|
||||
|
||||
@ -51,3 +51,17 @@
|
||||
(t/is (= [1 10 100 2 20 200 3 30 300]
|
||||
(d/join [1 2 3] [1 10 100] *))))
|
||||
|
||||
(t/deftest num-predicate
|
||||
(t/is (not (d/num? ##NaN)))
|
||||
(t/is (not (d/num? nil)))
|
||||
(t/is (d/num? 1))
|
||||
(t/is (d/num? -0.3))
|
||||
(t/is (not (d/num? {}))))
|
||||
|
||||
(t/deftest check-num-helper
|
||||
(t/is (= 1 (d/check-num 1 0)))
|
||||
(t/is (= 0 (d/check-num ##NaN 0)))
|
||||
(t/is (= 0 (d/check-num {} 0)))
|
||||
(t/is (= 0 (d/check-num [] 0)))
|
||||
(t/is (= 0 (d/check-num :foo 0)))
|
||||
(t/is (= 0 (d/check-num nil 0))))
|
||||
|
||||
296
common/test/common_tests/geom_point_test.cljc
Normal file
296
common/test/common_tests/geom_point_test.cljc
Normal file
@ -0,0 +1,296 @@
|
||||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns common-tests.geom-point-test
|
||||
(:require
|
||||
[app.common.math :as mth]
|
||||
[app.common.geom.point :as gpt]
|
||||
[clojure.test :as t]))
|
||||
|
||||
(t/deftest add-points
|
||||
(let [p1 (gpt/point 1 2)
|
||||
p2 (gpt/point 2 3)
|
||||
rs (gpt/add p1 p2)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 3 (:x rs)))
|
||||
(t/is (mth/close? 5 (:y rs)))))
|
||||
|
||||
(t/deftest substract-points
|
||||
(let [p1 (gpt/point 1 2)
|
||||
p2 (gpt/point 2 3)
|
||||
rs (gpt/subtract p1 p2)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? -1 (:x rs)))
|
||||
(t/is (mth/close? -1 (:y rs)))))
|
||||
|
||||
(t/deftest multiply-points
|
||||
(let [p1 (gpt/point 1 2)
|
||||
p2 (gpt/point 2 3)
|
||||
rs (gpt/multiply p1 p2)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 2 (:x rs)))
|
||||
(t/is (mth/close? 6 (:y rs)))))
|
||||
|
||||
(t/deftest divide-points
|
||||
(let [p1 (gpt/point 1 2)
|
||||
p2 (gpt/point 2 5)
|
||||
rs (gpt/divide p1 p2)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 0.5 (:x rs)))
|
||||
(t/is (mth/close? 0.4 (:y rs)))))
|
||||
|
||||
(t/deftest min-point
|
||||
(let [p1 (gpt/point 1 2)
|
||||
p2 (gpt/point 2 5)]
|
||||
|
||||
(let [rs (gpt/min)]
|
||||
(t/is (nil? rs)))
|
||||
|
||||
(let [rs (gpt/min p1)]
|
||||
(t/is (gpt/close? rs p1)))
|
||||
|
||||
(let [rs (gpt/min nil p1)]
|
||||
(t/is (gpt/close? rs p1)))
|
||||
|
||||
(let [rs (gpt/min p1 nil)]
|
||||
(t/is (gpt/close? rs p1)))
|
||||
|
||||
(let [rs (gpt/min p1 p2)]
|
||||
(t/is (gpt/close? rs p1)))
|
||||
|
||||
(let [rs (gpt/min p2 p1)]
|
||||
(t/is (gpt/close? rs p1)))
|
||||
))
|
||||
|
||||
(t/deftest max-point
|
||||
(let [p1 (gpt/point 1 2)
|
||||
p2 (gpt/point 2 5)]
|
||||
|
||||
(let [rs (gpt/max)]
|
||||
(t/is (nil? rs)))
|
||||
|
||||
(let [rs (gpt/max p1)]
|
||||
(t/is (gpt/close? rs p1)))
|
||||
|
||||
(let [rs (gpt/max nil p1)]
|
||||
(t/is (gpt/close? rs p1)))
|
||||
|
||||
(let [rs (gpt/max p1 nil)]
|
||||
(t/is (gpt/close? rs p1)))
|
||||
|
||||
(let [rs (gpt/max p1 p2)]
|
||||
(t/is (gpt/close? rs p2)))
|
||||
|
||||
(let [rs (gpt/max p2 p1)]
|
||||
(t/is (gpt/close? rs p2)))
|
||||
))
|
||||
|
||||
(t/deftest inverse-point
|
||||
(let [p1 (gpt/point 1 2)
|
||||
rs (gpt/inverse p1)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 1 (:x rs)))
|
||||
(t/is (mth/close? 0.5 (:y rs)))))
|
||||
|
||||
(t/deftest negate-point
|
||||
(let [p1 (gpt/point 1 2)
|
||||
rs (gpt/negate p1)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? -1 (:x rs)))
|
||||
(t/is (mth/close? -2 (:y rs)))))
|
||||
|
||||
(t/deftest distance-between-two-points
|
||||
(let [p1 (gpt/point 1 2)
|
||||
p2 (gpt/point 4 6)
|
||||
rs (gpt/distance p1 p2)]
|
||||
(t/is (number? rs))
|
||||
(t/is (mth/close? 5 rs))))
|
||||
|
||||
(t/deftest distance-vector-between-two-points
|
||||
(let [p1 (gpt/point 1 2)
|
||||
p2 (gpt/point 2 3)
|
||||
rs (gpt/distance-vector p1 p2)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 1 (:x rs)))
|
||||
(t/is (mth/close? 1 (:y rs)))))
|
||||
|
||||
(t/deftest point-length
|
||||
(let [p1 (gpt/point 1 10)
|
||||
rs (gpt/length p1)]
|
||||
(t/is (number? rs))
|
||||
(t/is (mth/close? 10.04987562112089 rs))))
|
||||
|
||||
(t/deftest point-angle-1
|
||||
(let [p1 (gpt/point 1 3)
|
||||
rs (gpt/angle p1)]
|
||||
(t/is (number? rs))
|
||||
(t/is (mth/close? 71.56505117707799 rs))))
|
||||
|
||||
(t/deftest point-angle-2
|
||||
(let [p1 (gpt/point 1 3)
|
||||
p2 (gpt/point 2 4)
|
||||
rs (gpt/angle p1 p2)]
|
||||
(t/is (number? rs))
|
||||
(t/is (mth/close? -135 rs))))
|
||||
|
||||
(t/deftest point-angle-with-other
|
||||
(let [p1 (gpt/point 1 3)
|
||||
p2 (gpt/point 1 5)
|
||||
rs (gpt/angle-with-other p1 p2)]
|
||||
(t/is (number? rs))
|
||||
(t/is (mth/close? 7.125016348901757 rs))))
|
||||
|
||||
(t/deftest point-angle-sign
|
||||
(let [p1 (gpt/point 1 3)
|
||||
p2 (gpt/point 1 5)
|
||||
rs (gpt/angle-sign p1 p2)]
|
||||
(t/is (number? rs))
|
||||
(t/is (mth/close? 1 rs)))
|
||||
|
||||
(let [p1 (gpt/point -11 -3)
|
||||
p2 (gpt/point 1 5)
|
||||
rs (gpt/angle-sign p1 p2)]
|
||||
(t/is (number? rs))
|
||||
(t/is (mth/close? -1 rs)))
|
||||
)
|
||||
|
||||
(t/deftest update-angle
|
||||
(let [p1 (gpt/point 1 3)
|
||||
rs (gpt/update-angle p1 10)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 3.1142355569111246 (:x rs)))
|
||||
(t/is (mth/close? 0.5491237529650835 (:y rs)))))
|
||||
|
||||
|
||||
(t/deftest point-quadrant
|
||||
(let [p1 (gpt/point 1 3)
|
||||
rs (gpt/quadrant p1)]
|
||||
(t/is (number? rs))
|
||||
(t/is (mth/close? 1 rs)))
|
||||
|
||||
(let [p1 (gpt/point 1 -3)
|
||||
rs (gpt/quadrant p1)]
|
||||
(t/is (number? rs))
|
||||
(t/is (mth/close? 4 rs)))
|
||||
|
||||
(let [p1 (gpt/point -1 3)
|
||||
rs (gpt/quadrant p1)]
|
||||
(t/is (number? rs))
|
||||
(t/is (mth/close? 2 rs)))
|
||||
|
||||
(let [p1 (gpt/point -1 -3)
|
||||
rs (gpt/quadrant p1)]
|
||||
(t/is (number? rs))
|
||||
(t/is (mth/close? 3 rs)))
|
||||
)
|
||||
|
||||
(t/deftest round-point
|
||||
(let [p1 (gpt/point 1.34567 3.34567)
|
||||
rs (gpt/round p1)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 1 (:x rs)))
|
||||
(t/is (mth/close? 3 (:y rs))))
|
||||
|
||||
(let [p1 (gpt/point 1.34567 3.34567)
|
||||
rs (gpt/round p1 2)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 1.35 (:x rs)))
|
||||
(t/is (mth/close? 3.35 (:y rs))))
|
||||
)
|
||||
|
||||
(t/deftest halft-round-point
|
||||
(let [p1 (gpt/point 1.34567 3.34567)
|
||||
rs (gpt/half-round p1)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 1.5 (:x rs)))
|
||||
(t/is (mth/close? 3.5 (:y rs)))))
|
||||
|
||||
(t/deftest transform-point
|
||||
;;todo
|
||||
)
|
||||
|
||||
(t/deftest scale-point
|
||||
(let [p1 (gpt/point 1.5 3)
|
||||
rs (gpt/scale p1 2)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 3 (:x rs)))
|
||||
(t/is (mth/close? 6 (:y rs)))))
|
||||
|
||||
(t/deftest dot-point
|
||||
(let [p1 (gpt/point 1.5 3)
|
||||
p2 (gpt/point 2 6)
|
||||
rs (gpt/dot p1 p2)]
|
||||
(t/is (number? rs))
|
||||
(t/is (mth/close? 21 rs))))
|
||||
|
||||
(t/deftest unit-point
|
||||
(let [p1 (gpt/point 2 3)
|
||||
rs (gpt/unit p1)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 0.5547001962252291 (:x rs)))
|
||||
(t/is (mth/close? 0.8320502943378437 (:y rs)))))
|
||||
|
||||
(t/deftest project-point
|
||||
(let [p1 (gpt/point 1 3)
|
||||
p2 (gpt/point 1 6)
|
||||
rs (gpt/project p1 p2)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 0.5135135135135135 (:x rs)))
|
||||
(t/is (mth/close? 3.081081081081081 (:y rs)))))
|
||||
|
||||
(t/deftest center-points
|
||||
(let [points [(gpt/point 0.5 0.5)
|
||||
(gpt/point -1 -2)
|
||||
(gpt/point 20 65.2)
|
||||
(gpt/point 12 -10)]
|
||||
rs (gpt/center-points points)]
|
||||
(t/is (mth/close? 7.875 (:x rs)))
|
||||
(t/is (mth/close? 13.425 (:y rs)))))
|
||||
|
||||
(t/deftest normal-left-point
|
||||
(let [p1 (gpt/point 2 3)
|
||||
rs (gpt/normal-left p1)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? -0.8320502943378437 (:x rs)))
|
||||
(t/is (mth/close? 0.5547001962252291 (:y rs)))))
|
||||
|
||||
(t/deftest normal-right-point
|
||||
(let [p1 (gpt/point 2 3)
|
||||
rs (gpt/normal-right p1)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 0.8320502943378437 (:x rs)))
|
||||
(t/is (mth/close? -0.5547001962252291 (:y rs)))))
|
||||
|
||||
(t/deftest point-line-distance
|
||||
(let [p1 (gpt/point 2 -3)
|
||||
p2 (gpt/point -1 4)
|
||||
p3 (gpt/point 5 6)
|
||||
rs (gpt/point-line-distance p1 p2 p3)]
|
||||
(t/is (number? rs))
|
||||
(t/is (mth/close? 7.58946638440411 rs))))
|
||||
|
||||
(t/deftest almost-zero-predicate
|
||||
(let [p1 (gpt/point 0.000001 0.0000002)
|
||||
p2 (gpt/point 0.001 -0.0003)]
|
||||
(t/is (gpt/almost-zero? p1))
|
||||
(t/is (not (gpt/almost-zero? p2)))))
|
||||
|
||||
(t/deftest lerp-point
|
||||
(let [p1 (gpt/point 1 2)
|
||||
p2 (gpt/point 2 3)
|
||||
rs (gpt/lerp p1 p2 2)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 3 (:x rs)))
|
||||
(t/is (mth/close? 4 (:y rs)))))
|
||||
|
||||
(t/deftest rotate-point
|
||||
(let [p1 (gpt/point 1 2)
|
||||
p2 (gpt/point 2 3)
|
||||
rs (gpt/rotate p1 p2 11)]
|
||||
(t/is (gpt/point? rs))
|
||||
(t/is (mth/close? 1.2091818119288809 (:x rs)))
|
||||
(t/is (mth/close? 1.8275638211757912 (:y rs)))))
|
||||
|
||||
@ -21,7 +21,8 @@
|
||||
{:command :curve-to :params {:x 40 :y 40 :c1x 35 :c1y 35 :c2x 45 :c2y 45}}
|
||||
{:command :close-path}])
|
||||
|
||||
(defn add-path-data [shape]
|
||||
(defn add-path-data
|
||||
[shape]
|
||||
(let [content (:content shape default-path)
|
||||
selrect (gsh/content->selrect content)
|
||||
points (gsh/rect->points selrect)]
|
||||
@ -30,7 +31,8 @@
|
||||
:selrect selrect
|
||||
:points points)))
|
||||
|
||||
(defn add-rect-data [shape]
|
||||
(defn add-rect-data
|
||||
[shape]
|
||||
(let [shape (-> shape
|
||||
(assoc :width 20 :height 20))
|
||||
selrect (gsh/rect->selrect shape)
|
||||
@ -49,7 +51,7 @@
|
||||
(not= type :path) (add-rect-data)))))
|
||||
|
||||
|
||||
(t/deftest transform-shape-tests
|
||||
(t/deftest transform-shapes
|
||||
(t/testing "Shape without modifiers should stay the same"
|
||||
(t/are [type]
|
||||
(let [shape-before (create-test-shape type)
|
||||
@ -138,7 +140,7 @@
|
||||
(t/testing "Transform shape with rotation modifiers"
|
||||
(t/are [type]
|
||||
(let [shape-before (create-test-shape type)
|
||||
modifiers (ctm/rotation-modifiers shape-before (gsh/center-shape shape-before) 30 )
|
||||
modifiers (ctm/rotation-modifiers shape-before (gsh/center-shape shape-before) 30)
|
||||
shape-before (assoc shape-before :modifiers modifiers)
|
||||
shape-after (gsh/transform-shape shape-before)]
|
||||
|
||||
@ -181,3 +183,18 @@
|
||||
:path {:x 0.0 :y 0.0 :x1 0.0 :y1 0.0 :x2 ##Inf :y2 ##Inf :width ##Inf :height ##Inf}
|
||||
:rect nil
|
||||
:path nil)))
|
||||
|
||||
(t/deftest points-to-selrect
|
||||
(let [points [(gpt/point 0.5 0.5)
|
||||
(gpt/point -1 -2)
|
||||
(gpt/point 20 65.2)
|
||||
(gpt/point 12 -10)]
|
||||
result (gsh/points->rect points)
|
||||
expect {:x -1, :y -10, :width 21, :height 75.2}]
|
||||
|
||||
(t/is (= (:x expect) (:x result)))
|
||||
(t/is (= (:y expect) (:y result)))
|
||||
(t/is (= (:width expect) (:width result)))
|
||||
(t/is (= (:height expect) (:height result)))
|
||||
))
|
||||
|
||||
|
||||
26
common/test/common_tests/types_modifiers_test.cljc
Normal file
26
common/test/common_tests/types_modifiers_test.cljc
Normal file
@ -0,0 +1,26 @@
|
||||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns common-tests.types-modifiers-test
|
||||
(:require
|
||||
[clojure.test :as t]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.types.modifiers :as ctm]))
|
||||
|
||||
(t/deftest test-modifiers->transform
|
||||
(let [modifiers
|
||||
(-> (ctm/empty)
|
||||
(ctm/move (gpt/point 100 200))
|
||||
(ctm/resize (gpt/point 100 200) (gpt/point 2.0 0.5))
|
||||
(ctm/move (gpt/point -100 -200))
|
||||
(ctm/resize (gpt/point 100 200) (gpt/point 2.0 0.5))
|
||||
(ctm/rotation (gpt/point 0 0) -100)
|
||||
(ctm/resize (gpt/point 100 200) (gpt/point 2.0 0.5)))
|
||||
|
||||
transform (ctm/modifiers->transform modifiers)]
|
||||
|
||||
(t/is (not (gmt/close? (gmt/matrix) transform)))))
|
||||
65
frontend/dev/bench.cljs
Normal file
65
frontend/dev/bench.cljs
Normal file
@ -0,0 +1,65 @@
|
||||
(ns bench
|
||||
(:require
|
||||
[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.shapes.rect :as gsr]
|
||||
[app.common.perf :as perf]
|
||||
[app.common.types.modifiers :as ctm]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.test.check.generators :as gen]))
|
||||
|
||||
(def points
|
||||
(gen/sample (s/gen ::gpt/point) 20))
|
||||
|
||||
(defn bench-points
|
||||
[]
|
||||
#_(perf/benchmark
|
||||
:f #(gpt/center-points-old points)
|
||||
:samples 20
|
||||
:max-iterations 500000
|
||||
:name "base")
|
||||
(perf/benchmark
|
||||
:f #(gpt/center-points points)
|
||||
:max-iterations 500000
|
||||
:samples 20
|
||||
:name "optimized"))
|
||||
|
||||
(def modifiers
|
||||
(-> (ctm/empty)
|
||||
(ctm/move (gpt/point 100 200))
|
||||
(ctm/resize (gpt/point 100 200) (gpt/point 2.0 0.5))
|
||||
(ctm/move (gpt/point -100 -200))
|
||||
(ctm/resize (gpt/point 100 200) (gpt/point 2.0 0.5))
|
||||
(ctm/rotation (gpt/point 0 0) -100)
|
||||
(ctm/resize (gpt/point 100 200) (gpt/point 2.0 0.5))))
|
||||
|
||||
(defn bench-modifiers
|
||||
[]
|
||||
(perf/benchmark
|
||||
:f #(ctm/modifiers->transform modifiers)
|
||||
:max-iterations 50000
|
||||
:samples 20
|
||||
:name "current")
|
||||
|
||||
#_(perf/benchmark
|
||||
:f #(ctm/modifiers->transform-2 modifiers)
|
||||
:max-iterations 50000
|
||||
:samples 20
|
||||
:name "optimized"))
|
||||
|
||||
;; (ctm/modifiers->transform-2 modifiers)
|
||||
|
||||
(defn ^:dev/after-load after-load
|
||||
[]
|
||||
#_(bench-modifiers))
|
||||
|
||||
(defn main
|
||||
[& [name]]
|
||||
(case name
|
||||
"points" (bench-points)
|
||||
"modifiers" (bench-modifiers)
|
||||
(println "available: points"))
|
||||
#_(.exit js/process 0))
|
||||
|
||||
@ -69,10 +69,10 @@
|
||||
{:target :node-script
|
||||
:output-to "target/bench.js"
|
||||
:output-dir "target/bench/"
|
||||
:main cljs.user/main
|
||||
:main bench/main
|
||||
|
||||
:compiler-options
|
||||
{:output-feature-set :es8
|
||||
{:output-feature-set :es2020
|
||||
:output-wrapper false
|
||||
:warnings {:fn-deprecated false}}
|
||||
|
||||
|
||||
@ -297,8 +297,8 @@
|
||||
(mapv (fn [[value points]]
|
||||
[(- value pval)
|
||||
(->> points (mapv #(vector point %)))])))))]
|
||||
{:x (query-coord point :x)
|
||||
:y (query-coord point :y)}))
|
||||
(gpt/point (query-coord point :x)
|
||||
(query-coord point :y))))
|
||||
|
||||
(defn merge-matches
|
||||
([] {:x nil :y nil})
|
||||
|
||||
@ -47,10 +47,8 @@
|
||||
(defn process-shape [modifiers {:keys [id] :as shape}]
|
||||
(let [modifier (dm/get-in modifiers [id :modifiers])]
|
||||
(-> shape
|
||||
(cond-> (and (some? modifier)
|
||||
(not (ctm/only-move? modifier)))
|
||||
(cond-> (and (some? modifier) (not (ctm/only-move? modifier)))
|
||||
(fix-position modifier))
|
||||
|
||||
(cond-> (nil? (:position-data shape))
|
||||
(assoc :migrate true))
|
||||
strip-position-data)))
|
||||
@ -132,6 +130,21 @@
|
||||
:shape shape
|
||||
:grow-type (:grow-type shape)}]))
|
||||
|
||||
(defn text-properties-equal?
|
||||
[shape other]
|
||||
(or (identical? shape other)
|
||||
(and
|
||||
;; Check if both shapes are equivalent removing their geometry data
|
||||
(= (dissoc shape :migrate :points :selrect :height :width :x :y)
|
||||
(dissoc other :migrate :points :selrect :height :width :x :y))
|
||||
|
||||
;; Check if the position and size is close. If any of these changes the shape has changed
|
||||
;; and if not there is no geometry relevant change
|
||||
(mth/close? (:x shape) (:x other))
|
||||
(mth/close? (:y shape) (:y other))
|
||||
(mth/close? (:width shape) (:width other))
|
||||
(mth/close? (:height shape) (:height other)))))
|
||||
|
||||
(mf/defc viewport-texts-wrapper
|
||||
{::mf/wrap-props false
|
||||
::mf/wrap [mf/memo #(mf/deferred % ts/idle-then-raf)]}
|
||||
@ -149,12 +162,9 @@
|
||||
old-modifiers (ctm/select-geometry (get prev-modifiers id))
|
||||
new-modifiers (ctm/select-geometry (get modifiers id))
|
||||
|
||||
remote? (some? (-> new-shape meta :session-id)) ]
|
||||
|
||||
remote? (some? (-> new-shape meta :session-id))]
|
||||
(or (and (not remote?)
|
||||
(not (identical? old-shape new-shape))
|
||||
(not= (dissoc old-shape :migrate)
|
||||
(dissoc new-shape :migrate)))
|
||||
(not (text-properties-equal? old-shape new-shape)))
|
||||
|
||||
(and (not= new-modifiers old-modifiers)
|
||||
(or (not (ctm/only-move? new-modifiers))
|
||||
@ -172,6 +182,7 @@
|
||||
|
||||
handle-update-modifier (mf/use-callback update-text-modifier)
|
||||
handle-update-shape (mf/use-callback update-text-shape)]
|
||||
|
||||
[:*
|
||||
(for [{:keys [id] :as shape} changed-texts]
|
||||
[:& text-container {:shape shape
|
||||
|
||||
53
frontend/test/frontend_tests/test_helpers_shapes.cljs
Normal file
53
frontend/test/frontend_tests/test_helpers_shapes.cljs
Normal file
@ -0,0 +1,53 @@
|
||||
(ns frontend-tests.test-helpers-shapes
|
||||
(:require
|
||||
[app.common.colors :as clr]
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.pages.helpers :as cph]
|
||||
[app.main.data.workspace.libraries :as dwl]
|
||||
[app.test-helpers.events :as the]
|
||||
[app.test-helpers.libraries :as thl]
|
||||
[app.test-helpers.pages :as thp]
|
||||
[beicon.core :as rx]
|
||||
[cljs.pprint :refer [pprint]]
|
||||
[cljs.test :as t :include-macros true]
|
||||
[clojure.stacktrace :as stk]
|
||||
[linked.core :as lks]
|
||||
[potok.core :as ptk]))
|
||||
|
||||
(t/use-fixtures :each
|
||||
{:before thp/reset-idmap!})
|
||||
|
||||
(t/deftest test-create-page
|
||||
(t/testing "create page"
|
||||
(let [state (-> thp/initial-state
|
||||
(thp/sample-page))
|
||||
page (thp/current-page state)]
|
||||
(t/is (= (:name page) "page1")))))
|
||||
|
||||
(t/deftest test-create-shape
|
||||
(t/testing "create shape"
|
||||
(let [state (-> thp/initial-state
|
||||
(thp/sample-page)
|
||||
(thp/sample-shape :shape1 :rect
|
||||
{:name "Rect 1"}))
|
||||
shape (thp/get-shape state :shape1)]
|
||||
(t/is (= (:name shape) "Rect 1")))))
|
||||
|
||||
(t/deftest asynctest
|
||||
(t/testing "asynctest"
|
||||
(t/async done
|
||||
(let [state {}
|
||||
color {:color clr/white}
|
||||
|
||||
store (the/prepare-store state done
|
||||
(fn [new-state]
|
||||
(t/is (= (get-in new-state [:workspace-data
|
||||
:recent-colors])
|
||||
[color]))))]
|
||||
|
||||
(ptk/emit!
|
||||
store
|
||||
(dwl/add-recent-color color)
|
||||
:the/end)))))
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user