github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-08-06 04:48:39 +00:00
Code Issues Packages Projects Releases Wiki Activity

✨ Use new defrecord for geom data structures

Browse Source
This commit is contained in:
Andrey Antukh 2023-06-20 14:03:35 +02:00
parent 3f14308908
commit ea5b153578
3 changed files with 248 additions and 160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

194
common/src/app/common/geom/matrix.cljc
View File

@ -13,6 +13,7 @@
[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.math :as mth] [app.common.math :as mth]
[app.common.record :as cr]
[app.common.schema :as sm] [app.common.schema :as sm]
[app.common.schema.generators :as sg] [app.common.schema.generators :as sg]
[app.common.schema.openapi :as-alias oapi] [app.common.schema.openapi :as-alias oapi]
@ -27,21 +28,21 @@
(def precision 6) (def precision 6)
;; --- Matrix Impl ;; --- Matrix Impl
(defrecord Matrix [^double a (cr/defrecord Matrix [^double a
^double b ^double b
^double c ^double c
^double d ^double d
^double e ^double e
^double f] ^double f]
Object Object
(toString [_] (toString [this]
(dm/fmt "matrix(%, %, %, %, %, %)" (dm/fmt "matrix(%, %, %, %, %, %)"
(mth/to-fixed a precision) (mth/to-fixed (.-a this) precision)
(mth/to-fixed b precision) (mth/to-fixed (.-b this) precision)
(mth/to-fixed c precision) (mth/to-fixed (.-c this) precision)
(mth/to-fixed d precision) (mth/to-fixed (.-d this) precision)
(mth/to-fixed e precision) (mth/to-fixed (.-e this) precision)
(mth/to-fixed f precision)))) (mth/to-fixed (.-f this) precision))))
(defn matrix? (defn matrix?
"Return true if `v` is Matrix instance." "Return true if `v` is Matrix instance."
@ -51,9 +52,9 @@
(defn matrix (defn matrix
"Create a new matrix instance." "Create a new matrix instance."
([] ([]
(Matrix. 1 0 0 1 0 0)) (pos->Matrix 1 0 0 1 0 0))
([a b c d e f] ([a b c d e f]
(Matrix. a b c d e f))) (pos->Matrix a b c d e f)))
(def number-regex #"[+-]?\d*(\.\d+)?(e[+-]?\d+)?") (def number-regex #"[+-]?\d*(\.\d+)?(e[+-]?\d+)?")
@ -100,7 +101,7 @@
(sg/small-double) (sg/small-double)
(sg/small-double) (sg/small-double)
(sg/small-double) ) (sg/small-double) )
(sg/fmap #(apply ->Matrix %))) (sg/fmap #(apply pos->Matrix %)))
::oapi/type "string" ::oapi/type "string"
::oapi/format "matrix" ::oapi/format "matrix"
::oapi/decode decode ::oapi/decode decode
@ -120,24 +121,54 @@
(s/def ::matrix (s/def ::matrix
(s/and ::matrix-attrs matrix?)) (s/and ::matrix-attrs matrix?))
(defn close? (defn close?
[^Matrix m1 ^Matrix m2] [^Matrix m1 ^Matrix m2]
(and (mth/close? (.-a m1) (.-a m2)) (and ^boolean (mth/close? (.-a m1) (.-a m2))
(mth/close? (.-b m1) (.-b m2)) ^boolean (mth/close? (.-b m1) (.-b m2))
(mth/close? (.-c m1) (.-c m2)) ^boolean (mth/close? (.-c m1) (.-c m2))
(mth/close? (.-d m1) (.-d m2)) ^boolean (mth/close? (.-d m1) (.-d m2))
(mth/close? (.-e m1) (.-e m2)) ^boolean (mth/close? (.-e m1) (.-e m2))
(mth/close? (.-f m1) (.-f m2)))) ^boolean (mth/close? (.-f m1) (.-f m2))))
(defn unit? [^Matrix m1] (defn unit? [^Matrix m1]
(and (some? m1) (and ^boolean (some? m1)
(mth/close? (.-a m1) 1) ^boolean (mth/close? (.-a m1) 1)
(mth/close? (.-b m1) 0) ^boolean (mth/close? (.-b m1) 0)
(mth/close? (.-c m1) 0) ^boolean (mth/close? (.-c m1) 0)
(mth/close? (.-d m1) 1) ^boolean (mth/close? (.-d m1) 1)
(mth/close? (.-e m1) 0) ^boolean (mth/close? (.-e m1) 0)
(mth/close? (.-f m1) 0))) ^boolean (mth/close? (.-f m1) 0)))
(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
[(pos->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 multiply (defn multiply
([^Matrix m1 ^Matrix m2] ([^Matrix m1 ^Matrix m2]
@ -162,7 +193,7 @@
m2e (.-e m2) m2e (.-e m2)
m2f (.-f m2)] m2f (.-f m2)]
(Matrix. (pos->Matrix
(+ (* m1a m2a) (* m1c m2b)) (+ (* m1a m2a) (* m1c m2b))
(+ (* m1b m2a) (* m1d m2b)) (+ (* m1b m2a) (* m1d m2b))
(+ (* m1a m2c) (* m1c m2d)) (+ (* m1a m2c) (* m1c m2d))
@ -171,51 +202,28 @@
(+ (* m1b m2e) (* m1d m2f) m1f))))) (+ (* m1b m2e) (* m1d m2f) m1f)))))
([m1 m2 & others] ([m1 m2 & others]
(reduce multiply (multiply 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 (defn add-translate
"Given two TRANSLATE matrixes (only e and f have significative "Given two TRANSLATE matrixes (only e and f have significative
values), combine them. Quicker than multiplying them, for this values), combine them. Quicker than multiplying them, for this
precise case." precise case."
([{m1e :e m1f :f} {m2e :e m2f :f}] ([^Matrix m1 ^Matrix m2]
(Matrix. 1 0 0 1 (+ m1e m2e) (+ m1f m2f))) (let [m1e (dm/get-prop m1 :e)
m1f (dm/get-prop m1 :f)
m2e (dm/get-prop m2 :e)
m2f (dm/get-prop m2 :f)]
(pos->Matrix 1 0 0 1 (+ m1e m2e) (+ m1f m2f))))
([m1 m2 & others] ([m1 m2 & others]
(reduce add-translate (add-translate m1 m2) others))) (reduce add-translate (add-translate m1 m2) others)))
;; FIXME: optimize?
(defn substract (defn substract
[{m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f} [{m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f}
{m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f}] {m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f}]
(Matrix. (pos->Matrix
(- m1a m2a) (- m1b m2b) (- m1c m2c) (- m1a m2a) (- m1b m2b) (- m1c m2c)
(- m1d m2d) (- m1e m2e) (- m1f m2f))) (- m1d m2d) (- m1e m2e) (- m1f m2f)))
@ -227,13 +235,24 @@
(defn translate-matrix (defn translate-matrix
([pt] ([pt]
(assert (gpt/point? pt)) (dm/assert! (gpt/point? pt))
(Matrix. 1 0 0 1 (pos->Matrix 1 0 0 1
(dm/get-prop pt :x) (dm/get-prop pt :x)
(dm/get-prop pt :y))) (dm/get-prop pt :y)))
([x y] ([x y]
(Matrix. 1 0 0 1 x y))) (pos->Matrix 1 0 0 1 x y)))
(defn translate-matrix-neg
([pt]
(dm/assert! (gpt/point? pt))
(pos->Matrix 1 0 0 1
(- (dm/get-prop pt :x))
(- (dm/get-prop pt :y))))
([x y]
(pos->Matrix 1 0 0 1 (- x) (- y))))
(defn scale-matrix (defn scale-matrix
([pt center] ([pt center]
@ -241,10 +260,10 @@
sy (dm/get-prop pt :y) sy (dm/get-prop pt :y)
cx (dm/get-prop center :x) cx (dm/get-prop center :x)
cy (dm/get-prop center :y)] cy (dm/get-prop center :y)]
(Matrix. sx 0 0 sy (- cx (* cx sx)) (- cy (* cy sy))))) (pos->Matrix sx 0 0 sy (- cx (* cx sx)) (- cy (* cy sy)))))
([pt] ([pt]
(assert (gpt/point? pt)) (dm/assert! (gpt/point? pt))
(Matrix. (dm/get-prop pt :x) 0 0 (dm/get-prop pt :y) 0 0))) (pos->Matrix (dm/get-prop pt :x) 0 0 (dm/get-prop pt :y) 0 0)))
(defn rotate-matrix (defn rotate-matrix
([angle point] ([angle point]
@ -258,15 +277,15 @@
ns (- s) ns (- s)
tx (+ (* c nx) (* ns ny) cx) tx (+ (* c nx) (* ns ny) cx)
ty (+ (* s nx) (* c ny) cy)] ty (+ (* s nx) (* c ny) cy)]
(Matrix. c s ns c tx ty))) (pos->Matrix c s ns c tx ty)))
([angle] ([angle]
(let [a (mth/radians angle)] (let [a (mth/radians angle)]
(Matrix. (mth/cos a) (pos->Matrix (mth/cos a)
(mth/sin a) (mth/sin a)
(- (mth/sin a)) (- (mth/sin a))
(mth/cos a) (mth/cos a)
0 0
0)))) 0))))
(defn skew-matrix (defn skew-matrix
([angle-x angle-y point] ([angle-x angle-y point]
@ -276,7 +295,7 @@
([angle-x angle-y] ([angle-x angle-y]
(let [m1 (mth/tan (mth/radians angle-x)) (let [m1 (mth/tan (mth/radians angle-x))
m2 (mth/tan (mth/radians angle-y))] m2 (mth/tan (mth/radians angle-y))]
(Matrix. 1 m2 m1 1 0 0)))) (pos->Matrix 1 m2 m1 1 0 0))))
(defn rotate (defn rotate
"Apply rotation transformation to the matrix." "Apply rotation transformation to the matrix."
@ -337,6 +356,7 @@
(translate (gpt/negate pt))) (translate (gpt/negate pt)))
mtx)) mtx))
;; FIXME: performance
(defn determinant (defn determinant
"Determinant for the affinity transform" "Determinant for the affinity transform"
[{:keys [a b c d _ _]}] [{:keys [a b c d _ _]}]
@ -346,14 +366,14 @@
"Gets the inverse of the affinity transform `mtx`" "Gets the inverse of the affinity transform `mtx`"
[{:keys [a b c d e f] :as mtx}] [{:keys [a b c d e f] :as mtx}]
(let [det (determinant mtx)] (let [det (determinant mtx)]
(when-not (mth/almost-zero? det) (when-not ^boolean (mth/almost-zero? det)
(let [a' (/ d det) (let [a' (/ d det)
b' (/ (- b) det) b' (/ (- b) det)
c' (/ (- c) det) c' (/ (- c) det)
d' (/ a det) d' (/ a det)
e' (/ (- (* c f) (* d e)) det) e' (/ (- (* c f) (* d e)) det)
f' (/ (- (* b e) (* a f)) det)] f' (/ (- (* b e) (* a f)) det)]
(Matrix. a' b' c' d' e' f'))))) (pos->Matrix a' b' c' d' e' f')))))
(defn round (defn round
[mtx] [mtx]
@ -377,11 +397,11 @@
point)) point))
(defn move? (defn move?
[{:keys [a b c d _ _]}] [m]
(and (mth/almost-zero? (- a 1)) (and ^boolean (mth/almost-zero? (- (dm/get-prop m :a) 1))
(mth/almost-zero? b) ^boolean (mth/almost-zero? (dm/get-prop m :b))
(mth/almost-zero? c) ^boolean (mth/almost-zero? (dm/get-prop m :c))
(mth/almost-zero? (- d 1)))) ^boolean (mth/almost-zero? (- (dm/get-prop m :d) 1))))
#?(:clj #?(:clj
(fres/add-handlers! (fres/add-handlers!

157
common/src/app/common/geom/point.cljc
View File

@ -16,6 +16,7 @@
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.record :as cr]
[app.common.schema :as sm] [app.common.schema :as sm]
[app.common.schema.generators :as sg] [app.common.schema.generators :as sg]
[app.common.schema.openapi :as-alias oapi] [app.common.schema.openapi :as-alias oapi]
@ -29,7 +30,7 @@
;; --- Point Impl ;; --- Point Impl
(defrecord Point [x y]) (cr/defrecord Point [x y])
(defn s (defn s
[pt] [pt]
@ -62,7 +63,7 @@
(map->Point p) (map->Point p)
(if (string? p) (if (string? p)
(let [[x y] (->> (str/split p #",") (mapv parse-double))] (let [[x y] (->> (str/split p #",") (mapv parse-double))]
(Point. x y)) (pos->Point x y))
p))) p)))
(encode [p] (encode [p]
@ -76,7 +77,7 @@
:description "Point" :description "Point"
:error/message "expected a valid point" :error/message "expected a valid point"
:gen/gen (->> (sg/tuple (sg/small-int) (sg/small-int)) :gen/gen (->> (sg/tuple (sg/small-int) (sg/small-int))
(sg/fmap #(apply ->Point %))) (sg/fmap #(apply pos->Point %)))
::oapi/type "string" ::oapi/type "string"
::oapi/format "point" ::oapi/format "point"
::oapi/decode decode ::oapi/decode decode
@ -90,7 +91,7 @@
(defn point (defn point
"Create a Point instance." "Create a Point instance."
([] (Point. 0 0)) ([] (pos->Point 0 0))
([v] ([v]
(cond (cond
(point? v) (point? v)
@ -100,12 +101,12 @@
(point v v) (point v v)
(point-like? v) (point-like? v)
(Point. (:x v) (:y v)) (pos->Point (:x v) (:y v))
:else :else
(ex/raise :hint "invalid arguments (on pointer constructor)" :value v))) (ex/raise :hint "invalid arguments (on pointer constructor)" :value v)))
([x y] ([x y]
(Point. x y))) (pos->Point x y)))
(defn close? (defn close?
[p1 p2] [p1 p2]
@ -129,22 +130,24 @@
(and (point? p1) (and (point? p1)
(point? p2))) (point? p2)))
(Point. (+ (dm/get-prop p1 :x) (pos->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)
(dm/get-prop p2 :y)))) (dm/get-prop p2 :y))))
(defn subtract (defn subtract
"Returns the subtraction of the supplied value to both "Returns the subtraction 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 pointer instance"
"arguments should be pointer instance") (and (point? p1)
(Point. (- (dm/get-prop p1 :x) (point? p2)))
(dm/get-prop p2 :x))
(- (dm/get-prop p1 :y) (pos->Point (- (dm/get-prop p1 :x)
(dm/get-prop p2 :y)))) (dm/get-prop p2 :x))
(- (dm/get-prop p1 :y)
(dm/get-prop p2 :y))))
(defn multiply (defn multiply
"Returns the subtraction of the supplied value to both "Returns the subtraction of the supplied value to both
@ -153,20 +156,20 @@
(assert (and (point? p1) (assert (and (point? p1)
(point? p2)) (point? p2))
"arguments should be pointer instance") "arguments should be pointer instance")
(Point. (* (dm/get-prop p1 :x) (pos->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)
(dm/get-prop p2 :y)))) (dm/get-prop p2 :y))))
(defn divide (defn divide
[p1 p2] [p1 p2]
(assert (and (point? p1) (assert (and (point? p1)
(point? p2)) (point? p2))
"arguments should be pointer instance") "arguments should be pointer instance")
(Point. (/ (dm/get-prop p1 :x) (pos->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)
(dm/get-prop p2 :y)))) (dm/get-prop p2 :y))))
(defn min (defn min
([] nil) ([] nil)
@ -175,10 +178,10 @@
(cond (cond
(nil? p1) p2 (nil? p1) p2
(nil? p2) p1 (nil? p2) p1
:else (Point. (c/min (dm/get-prop p1 :x) :else (pos->Point (c/min (dm/get-prop p1 :x)
(dm/get-prop p2 :x)) (dm/get-prop p2 :x))
(c/min (dm/get-prop p1 :y) (c/min (dm/get-prop p1 :y)
(dm/get-prop p2 :y)))))) (dm/get-prop p2 :y))))))
(defn max (defn max
([] nil) ([] nil)
([p1] p1) ([p1] p1)
@ -186,21 +189,21 @@
(cond (cond
(nil? p1) p2 (nil? p1) p2
(nil? p2) p1 (nil? p2) p1
:else (Point. (c/max (dm/get-prop p1 :x) :else (pos->Point (c/max (dm/get-prop p1 :x)
(dm/get-prop p2 :x)) (dm/get-prop p2 :x))
(c/max (dm/get-prop p1 :y) (c/max (dm/get-prop p1 :y)
(dm/get-prop p2 :y)))))) (dm/get-prop p2 :y))))))
(defn inverse (defn inverse
[pt] [pt]
(assert (point? pt) "point instance expected") (assert (point? pt) "point instance expected")
(Point. (/ 1.0 (dm/get-prop pt :x)) (pos->Point (/ 1.0 (dm/get-prop pt :x))
(/ 1.0 (dm/get-prop pt :y)))) (/ 1.0 (dm/get-prop pt :y))))
(defn negate (defn negate
[pt] [pt]
(assert (point? pt) "point instance expected") (assert (point? pt) "point instance expected")
(Point. (- (dm/get-prop pt :x)) (pos->Point (- (dm/get-prop pt :x))
(- (dm/get-prop pt :y)))) (- (dm/get-prop pt :y))))
(defn distance (defn distance
"Calculate the distance between two points." "Calculate the distance between two points."
@ -224,8 +227,8 @@
(dm/get-prop p2 :x)) (dm/get-prop p2 :x))
dy (- (dm/get-prop p1 :y) dy (- (dm/get-prop p1 :y)
(dm/get-prop p2 :y))] (dm/get-prop p2 :y))]
(Point. (mth/abs dx) (pos->Point (mth/abs dx)
(mth/abs dy)))) (mth/abs dy))))
(defn length (defn length
[pt] [pt]
@ -292,8 +295,8 @@
(assert (number? angle) "expected number") (assert (number? angle) "expected number")
(let [len (length p) (let [len (length p)
angle (mth/radians angle)] angle (mth/radians angle)]
(Point. (* (mth/cos angle) len) (pos->Point (* (mth/cos angle) len)
(* (mth/sin angle) len)))) (* (mth/sin angle) len))))
(defn quadrant (defn quadrant
"Return the quadrant of the angle of the point." "Return the quadrant of the angle of the point."
@ -313,22 +316,21 @@
([pt decimals] ([pt decimals]
(assert (point? pt) "expected point instance") (assert (point? pt) "expected point instance")
(assert (number? decimals) "expected number instance") (assert (number? decimals) "expected number instance")
(Point. (mth/precision (dm/get-prop pt :x) decimals) (pos->Point (mth/precision (dm/get-prop pt :x) decimals)
(mth/precision (dm/get-prop pt :y) decimals)))) (mth/precision (dm/get-prop pt :y) decimals))))
(defn round-step (defn round-step
"Round the coordinates to the closest half-point" "Round the coordinates to the closest half-point"
[pt step] [pt step]
(assert (point? pt) "expected point instance") (assert (point? pt) "expected point instance")
(Point. (mth/round (dm/get-prop pt :x) step) (pos->Point (mth/round (dm/get-prop pt :x) step)
(mth/round (dm/get-prop pt :y) step))) (mth/round (dm/get-prop pt :y) step)))
(defn transform (defn transform
"Transform a point applying a matrix transformation." "Transform a point applying a matrix transformation."
[p m] [p m]
(when (point? p) (when (point? p)
(if (nil? m) (if (some? m)
p
(let [x (dm/get-prop p :x) (let [x (dm/get-prop p :x)
y (dm/get-prop p :y) y (dm/get-prop p :y)
a (dm/get-prop m :a) a (dm/get-prop m :a)
@ -337,18 +339,51 @@
d (dm/get-prop m :d) d (dm/get-prop m :d)
e (dm/get-prop m :e) e (dm/get-prop m :e)
f (dm/get-prop m :f)] f (dm/get-prop m :f)]
(Point. (+ (* x a) (* y c) e) (pos->Point (+ (* x a) (* y c) e)
(+ (* x b) (* y d) f)))))) (+ (* x b) (* y d) f)))
p)))
(defn transform!
[p m]
(dm/assert!
"expected valid rect and matrix instances"
(and (some? p) (some? m)))
(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)]
#?(:clj
(pos->Point (+ (* x a) (* y c) e)
(+ (* x b) (* y d) f))
:cljs
(do
(set! (.-x p) (+ (* x a) (* y c) e))
(set! (.-y p) (+ (* x b) (* y d) f))
p))))
(defn matrix->point
"Returns a result of transform an identity point with the provided
matrix instance"
[m]
(let [e (dm/get-prop m :e)
f (dm/get-prop m :f)]
(pos->Point e f)))
;; Vector functions ;; Vector functions
(defn to-vec [p1 p2] (defn to-vec [p1 p2]
(subtract p2 p1)) (subtract p2 p1))
(defn scale (defn scale
[p scalar] [p scalar]
(Point. (* (dm/get-prop p :x) scalar) (pos->Point (* (dm/get-prop p :x) scalar)
(* (dm/get-prop p :y) scalar))) (* (dm/get-prop p :y) scalar)))
(defn dot (defn dot
[p1 p2] [p1 p2]
@ -361,14 +396,14 @@
[p1] [p1]
(let [p-length (length p1)] (let [p-length (length p1)]
(if (mth/almost-zero? p-length) (if (mth/almost-zero? p-length)
(Point. 0 0) (pos->Point 0 0)
(Point. (/ (dm/get-prop p1 :x) p-length) (pos->Point (/ (dm/get-prop p1 :x) p-length)
(/ (dm/get-prop p1 :y) p-length))))) (/ (dm/get-prop p1 :y) p-length)))))
(defn perpendicular (defn perpendicular
[pt] [pt]
(Point. (- (dm/get-prop pt :y)) (pos->Point (- (dm/get-prop pt :y))
(dm/get-prop pt :x))) (dm/get-prop pt :x)))
(defn project (defn project
"V1 perpendicular projection on vector V2" "V1 perpendicular projection on vector V2"
@ -419,7 +454,7 @@
[p1 p2 t] [p1 p2 t]
(let [x (mth/lerp (dm/get-prop p1 :x) (dm/get-prop p2 :x) t) (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)] y (mth/lerp (dm/get-prop p1 :y) (dm/get-prop p2 :y) t)]
(Point. x y))) (pos->Point x y)))
(defn rotate (defn rotate
"Rotates the point around center with an angle" "Rotates the point around center with an angle"
@ -441,7 +476,7 @@
y (+ (* sa (- px cx)) y (+ (* sa (- px cx))
(* ca (- py cy)) (* ca (- py cy))
cy)] cy)]
(Point. x y))) (pos->Point x y)))
(defn scale-from (defn scale-from
"Moves a point in the vector that creates with center with a scale "Moves a point in the vector that creates with center with a scale
@ -457,10 +492,10 @@
[p] [p]
(let [x (dm/get-prop p :x) (let [x (dm/get-prop p :x)
y (dm/get-prop p :y)] y (dm/get-prop p :y)]
(Point. (if (mth/almost-zero? x) 0.001 x) (pos->Point (if (mth/almost-zero? x) 0.001 x)
(if (mth/almost-zero? y) 0.001 y)))) (if (mth/almost-zero? y) 0.001 y))))
;; FIXME: perfromance
(defn abs (defn abs
[point] [point]
(-> point (-> point

57
common/src/app/common/geom/rect.cljc
View File

@ -11,9 +11,10 @@
[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.math :as mth] [app.common.math :as mth]
[app.common.record :as rc]
[app.common.transit :as t])) [app.common.transit :as t]))
(defrecord Rect [x y width height x1 y1 x2 y2]) (rc/defrecord Rect [x y width height x1 y1 x2 y2])
(defn rect? (defn rect?
[o] [o]
@ -62,10 +63,7 @@
(when (d/num? x y width height) (when (d/num? x y width height)
(let [w (mth/max width 0.01) (let [w (mth/max width 0.01)
h (mth/max height 0.01)] h (mth/max height 0.01)]
(->Rect x y w h x y (+ x w) (+ y h))))) (pos->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 (def empty-rect
(make-rect 0 0 0.01 0.01)) (make-rect 0 0 0.01 0.01))
@ -104,6 +102,31 @@
:x2 (+ x w) :x2 (+ x w)
:y2 (+ y h))))) :y2 (+ y h)))))
(defn update-rect!
[rect type]
(case type
(:size :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)]
(rc/assoc! rect
:x1 x
:y1 y
: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)]
(rc/assoc! rect
:x (mth/min x1 x2)
:y (mth/min y1 y2)
:width (mth/abs (- x2 x1))
:height (mth/abs (- y2 y1))))))
(defn close-rect? (defn close-rect?
[rect1 rect2] [rect1 rect2]
@ -123,7 +146,6 @@
(defn rect->points (defn rect->points
[rect] [rect]
(dm/assert! (dm/assert!
"expected rect instance" "expected rect instance"
(rect? rect)) (rect? rect))
@ -140,6 +162,12 @@
(gpt/point (+ x w) (+ y h)) (gpt/point (+ x w) (+ y h))
(gpt/point x (+ y h))])))) (gpt/point x (+ y h))]))))
(defn rect->point
"Extract the position part of the rect"
[rect]
(gpt/point (dm/get-prop rect :x)
(dm/get-prop rect :y)))
(defn rect->center (defn rect->center
[rect] [rect]
(dm/assert! (rect? rect)) (dm/assert! (rect? rect))
@ -231,17 +259,22 @@
(when (d/num? minx miny maxx maxy) (when (d/num? minx miny maxx maxy)
(make-rect minx miny (- maxx minx) (- maxy miny)))))) (make-rect minx miny (- maxx minx) (- maxy miny))))))
(defn center->rect [{:keys [x y]} width height] (defn center->rect
(when (d/num? x y width height) [point w h]
(make-rect (- x (/ width 2)) (when (some? point)
(- y (/ height 2)) (let [x (dm/get-prop point :x)
width y (dm/get-prop point :y)]
height))) (when (d/num? x y w h)
(make-rect (- x (/ w 2))
(- y (/ h 2))
w
h)))))
(defn s= (defn s=
[a b] [a b]
(mth/almost-zero? (- a b))) (mth/almost-zero? (- a b)))
;; FIXME: performance
(defn overlaps-rects? (defn overlaps-rects?
"Check for two rects to overlap. Rects won't overlap only if "Check for two rects to overlap. Rects won't overlap only if
one of them is fully to the left or the top" one of them is fully to the left or the top"