Optimize point functions

This commit is contained in:
Andrey Antukh 2022-11-20 20:05:15 +01:00 committed by alonso.torres
parent c28534555b
commit fc4e755f2b
8 changed files with 589 additions and 155 deletions

View file

@ -461,14 +461,6 @@
(->> (apply c/iteration args) (->> (apply c/iteration args)
(concat-all))) (concat-all)))
(defmacro get-prop
"A macro based, optimized variant of `get` that access the property
directly on CLJS, on CLJ works as get."
[obj prop]
(if (:ns &env)
(list (symbol ".") (with-meta obj {:tag 'js}) (symbol (str "-" (c/name prop))))
`(c/get ~obj ~prop)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Parsing / Conversion ;; Data Parsing / Conversion

View file

@ -107,3 +107,15 @@
(d/close! ~(first bindings)))))) (d/close! ~(first bindings))))))
`(do ~@body) `(do ~@body)
(reverse (partition 2 bindings)))) (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)))

View file

@ -11,6 +11,8 @@
:clj [clojure.pprint :as pp]) :clj [clojure.pprint :as pp])
#?(:cljs [cljs.core :as c] #?(:cljs [cljs.core :as c]
:clj [clojure.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.math :as mth]
[app.common.spec :as us] [app.common.spec :as us]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
@ -20,18 +22,20 @@
(defrecord Point [x y]) (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? (defn point?
"Return true if `v` is Point instance." "Return true if `v` is Point instance."
[v] [v]
(or (instance? Point v) (instance? Point v))
(and (map? v) (contains? v :x) (contains? v :y))))
(s/def ::x ::us/safe-number) (s/def ::x ::us/safe-number)
(s/def ::y ::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/def ::point
(s/with-gen (s/and ::point-attrs point?) (s/with-gen (s/and ::point-attrs point?)
@ -40,10 +44,8 @@
(defn point-like? (defn point-like?
[{:keys [x y] :as v}] [{:keys [x y] :as v}]
(and (map? v) (and (map? v)
(not (nil? x)) (d/num? x)
(not (nil? y)) (d/num? y)))
(number? x)
(number? y)))
(defn point (defn point
"Create a Point instance." "Create a Point instance."
@ -51,13 +53,13 @@
([v] ([v]
(cond (cond
(point? v) (point? v)
(Point. (:x v) (:y v)) v
(number? v) (number? v)
(point v v) (point v v)
(point-like? v) (point-like? v)
(point (:x v) (:y v)) (map->Point v)
:else :else
(throw (ex-info "Invalid arguments" {:v v})))) (throw (ex-info "Invalid arguments" {:v v}))))
@ -66,128 +68,178 @@
(defn close? (defn close?
[p1 p2] [p1 p2]
(and (mth/close? (:x p1) (:x p2)) (and (mth/close? (dm/get-prop p1 :x)
(mth/close? (:y p1) (:y p2)))) (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 (point
(+ x (* distance (mth/cos angle))) (+ (dm/get-prop pt :x) (* distance (mth/cos angle)))
(- y (* distance (mth/sin angle))))) (- (dm/get-prop pt :y) (* distance (mth/sin angle)))))
(defn add (defn add
"Returns the addition of the supplied value to both "Returns the addition of the supplied value to both
coordinates of the point as a new point." coordinates of the point as a new point."
[{x :x y :y :as p} {ox :x oy :y :as other}] [p1 p2]
(assert (point? p)) (assert (and (point? p1)
(assert (point? other)) (point? p2))
(Point. (+ x ox) (+ y oy))) "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 (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."
[{x :x y :y :as p} {ox :x oy :y :as other}] [p1 p2]
(assert (point? p)) (assert (and (point? p1)
(assert (point? other)) (point? p2))
(Point. (- x ox) (- y oy))) "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 (defn multiply
"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."
[{x :x y :y :as p} {ox :x oy :y :as other}] [p1 p2]
(assert (point? p)) (assert (and (point? p1)
(assert (point? other)) (point? p2))
(Point. (* x ox) (* y oy))) "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 (defn divide
[{x :x y :y :as p} {ox :x oy :y :as other}] [p1 p2]
(assert (point? p)) (assert (and (point? p1)
(assert (point? other)) (point? p2))
(Point. (/ x ox) (/ y oy))) "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 (defn min
([] (min nil nil)) ([] nil)
([p1] (min p1 nil)) ([p1] p1)
([{x1 :x y1 :y :as p1} {x2 :x y2 :y :as p2}] ([p1 p2]
(cond (cond
(nil? p1) p2 (nil? p1) p2
(nil? p2) p1 (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 (defn max
([] (max nil nil)) ([] nil)
([p1] (max p1 nil)) ([p1] p1)
([{x1 :x y1 :y :as p1} {x2 :x y2 :y :as p2}] ([p1 p2]
(cond (cond
(nil? p1) p2 (nil? p1) p2
(nil? p2) p1 (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 (defn inverse
[{:keys [x y] :as p}] [pt]
(assert (point? p)) (assert (point? pt) "point instance expected")
(Point. (/ 1 x) (/ 1 y))) (Point. (/ 1.0 (dm/get-prop pt :x))
(/ 1.0 (dm/get-prop pt :y))))
(defn negate (defn negate
[{x :x y :y :as p}] [pt]
(assert (point? p)) (assert (point? pt) "point instance expected")
(Point. (- x) (- y))) (Point. (- (dm/get-prop pt :x))
(- (dm/get-prop pt :y))))
(defn distance (defn distance
"Calculate the distance between two points." "Calculate the distance between two points."
[{x :x y :y :as p} {ox :x oy :y :as other}] [p1 p2]
(assert (point? p)) (assert (and (point? p1)
(assert (point? other)) (point? p2))
(let [dx (- x ox) "arguments should be point instances")
dy (- y oy)] (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/sqrt (+ (mth/pow dx 2)
(mth/pow dy 2))))) (mth/pow dy 2)))))
(defn distance-vector (defn distance-vector
"Calculate the distance, separated x and y." "Calculate the distance, separated x and y."
[{x :x y :y :as p} {ox :x oy :y :as other}] [p1 p2]
(assert (point? p)) (assert (and (point? p1)
(assert (point? other)) (point? p2))
(let [dx (mth/abs (- x ox)) "arguments should be point instances")
dy (mth/abs (- y oy))] (let [dx (- (dm/get-prop p1 :x)
(Point. dx dy))) (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 (defn length
[{x :x y :y :as p}] [pt]
(assert (point? p)) (assert (point? pt) "point instance expected")
(mth/sqrt (+ (mth/pow x 2) (let [x (dm/get-prop pt :x)
(mth/pow y 2)))) y (dm/get-prop pt :y)]
(mth/sqrt (+ (mth/pow x 2)
(mth/pow y 2)))))
(defn angle (defn angle
"Returns the smaller angle between two vectors. "Returns the smaller angle between two vectors.
If the second vector is not provided, the angle If the second vector is not provided, the angle
will be measured from x-axis." will be measured from x-axis."
([{x :x y :y :as p}] ([pt]
(-> (mth/atan2 y x) (assert (point? pt) "point instance expected")
(mth/degrees))) (let [x (dm/get-prop pt :x)
([p center] y (dm/get-prop pt :y)]
(angle (subtract p center)))) (-> (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 (defn angle-with-other
"Consider point as vector and calculate "Consider point as vector and calculate
the angle between two vectors." the angle between two vectors."
[{x :x y :y :as p} {ox :x oy :y :as other}] [p1 p2]
(assert (point? p)) (assert (and (point? p1)
(assert (point? other)) (point? p2))
"arguments should be point instances")
(let [length-p (length p) (let [length-p1 (length p1)
length-other (length other)] length-p2 (length p2)]
(if (or (mth/almost-zero? length-p) (if (or (mth/almost-zero? length-p1)
(mth/almost-zero? length-other)) (mth/almost-zero? length-p2))
0 0
(let [a (/ (+ (* x ox) (let [a (/ (+ (* (dm/get-prop p1 :x)
(* y oy)) (dm/get-prop p2 :x))
(* length-p length-other)) (* (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))) a (mth/acos (if (< a -1) -1 (if (> a 1) 1 a)))
d (mth/degrees a)] d (mth/degrees a)]
(if (mth/nan? d) 0 d))))) (if (mth/nan? d) 0 d)))))
(defn angle-sign [v1 v2] (defn angle-sign
(if (> (* (:y v1) (:x v2)) (* (:x v1) (:y v2))) -1 1)) [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 (defn signed-angle-with-other
[v1 v2] [v1 v2]
@ -196,61 +248,79 @@
(defn update-angle (defn update-angle
"Update the angle of the point." "Update the angle of the point."
[p angle] [p angle]
(assert (point? p)) (assert (number? angle) "expected number")
(assert (number? angle)) (let [len (length p)
(let [len (length p)
angle (mth/radians angle)] angle (mth/radians angle)]
(Point. (* (mth/cos angle) len) (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."
[{:keys [x y] :as p}] [p]
(assert (point? p)) (assert (point? p) "expected point instance")
(if (>= x 0) (let [x (dm/get-prop p :x)
(if (>= y 0) 1 4) y (dm/get-prop p :y)]
(if (>= y 0) 2 3))) (if (>= x 0)
(if (>= y 0) 1 4)
(if (>= y 0) 2 3))))
(defn round (defn round
"Round the coordinates of the point to a precision" "Round the coordinates of the point to a precision"
([point] ([point]
(round point 0)) (round point 0))
([{:keys [x y] :as p} decimals] ([pt decimals]
(assert (point? p)) (assert (point? pt) "expected point instance")
(assert (number? decimals)) (assert (number? decimals) "expected number instance")
(Point. (mth/precision x decimals) (Point. (mth/precision (dm/get-prop pt :x) decimals)
(mth/precision y decimals)))) (mth/precision (dm/get-prop pt :y) decimals))))
(defn half-round (defn half-round
"Round the coordinates to the closest half-point" "Round the coordinates to the closest half-point"
[{:keys [x y] :as p}] [pt]
(assert (point? p)) (assert (point? pt) "expected point instance")
(Point. (mth/half-round x) (Point. (mth/half-round (dm/get-prop pt :x))
(mth/half-round y))) (mth/half-round (dm/get-prop pt :y))))
(defn transform (defn transform
"Transform a point applying a matrix transformation." "Transform a point applying a matrix transformation."
[{:keys [x y] :as p} {:keys [a b c d e f]}] [p m]
(assert (point? p)) (when (point? p)
(Point. (+ (* x a) (* y c) e) (if (nil? m)
(+ (* x b) (* y d) f))) 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 ;; Vector functions
(defn to-vec [p1 p2] (defn to-vec [p1 p2]
(subtract p2 p1)) (subtract p2 p1))
(defn scale [v scalar] (defn scale
(-> v [p scalar]
(update :x * scalar) (Point. (* (dm/get-prop p :x) scalar)
(update :y * scalar))) (* (dm/get-prop p :y) scalar)))
(defn dot [{x1 :x y1 :y} {x2 :x y2 :y}] (defn dot
(+ (* x1 x2) (* y1 y2))) [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] (defn unit
(let [v-length (length v)] [p1]
(divide v (point v-length v-length)))) (let [p-length (length p1)]
(Point. (/ (dm/get-prop p1 :x) p-length)
(/ (dm/get-prop p1 :y) p-length))))
(defn perpendicular (defn perpendicular
[{:keys [x y]}] [{:keys [x y]}]
@ -259,7 +329,7 @@
(defn project (defn project
"V1 perpendicular projection on vector V2" "V1 perpendicular projection on vector V2"
[v1 v2] [v1 v2]
(let [v2-unit (unit v2) (let [v2-unit (unit v2)
scalar-proj (dot v1 v2-unit)] scalar-proj (dot v1 v2-unit)]
(scale v2-unit scalar-proj))) (scale v2-unit scalar-proj)))
@ -282,43 +352,53 @@
(defn point-line-distance (defn point-line-distance
"Returns the distance from a point to a line defined by two points" "Returns the distance from a point to a line defined by two points"
[point line-point1 line-point2] [point line-point1 line-point2]
(let [{x0 :x y0 :y} point (let [x0 (dm/get-prop point :x)
{x1 :x y1 :y} line-point1 y0 (dm/get-prop point :y)
{x2 :x y2 :y} line-point2 x1 (dm/get-prop line-point1 :x)
num (mth/abs y1 (dm/get-prop line-point1 :y)
(+ (* x0 (- y2 y1)) x2 (dm/get-prop line-point2 :x)
(- (* y0 (- x2 x1))) y2 (dm/get-prop line-point2 :y)]
(* x2 y1) (/ (mth/abs (+ (* x0 (- y2 y1))
(- (* y2 x1)))) (- (* y0 (- x2 x1)))
dist (distance line-point2 line-point1)] (* x2 y1)
(/ num dist))) (- (* y2 x1))))
(distance line-point2 line-point1))))
(defn almost-zero? [{:keys [x y] :as p}] (defn almost-zero?
(assert (point? p)) [p]
(and (mth/almost-zero? x) (assert (point? p) "point instance expected")
(mth/almost-zero? y))) (and ^boolean (mth/almost-zero? (dm/get-prop p :x))
^boolean (mth/almost-zero? (dm/get-prop p :y))))
(defn lerp (defn lerp
"Calculates a linear interpolation between two points given a tvalue" "Calculates a linear interpolation between two points given a tvalue"
[p1 p2 t] [p1 p2 t]
(let [x (mth/lerp (:x p1) (:x p2) t) (let [x (mth/lerp (dm/get-prop p1 :x) (dm/get-prop p2 :x) t)
y (mth/lerp (:y p1) (:y p2) t)] y (mth/lerp (dm/get-prop p1 :y) (dm/get-prop p2 :y) t)]
(point x y))) (Point. x y)))
(defn rotate (defn rotate
"Rotates the point around center with an angle" "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) (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)) sa (mth/sin angle)
(* (mth/sin angle) (- py cy) -1) ca (mth/cos angle)
cx)
y (+ (* (mth/sin angle) (- px cx))
(* (mth/cos angle) (- py cy))
cy)]
(point x y)))
x (+ (* ca (- px cx))
(* sa (- py cy) -1)
cx)
y (+ (* sa (- px cx))
(* ca (- py cy))
cy)]
(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
@ -331,10 +411,11 @@
(defn no-zeros (defn no-zeros
"Remove zero values from either coordinate" "Remove zero values from either coordinate"
[point] [p]
(-> point (let [x (dm/get-prop p :x)
(update :x #(if (mth/almost-zero? %) 0.001 %)) y (dm/get-prop p :y)]
(update :y #(if (mth/almost-zero? %) 0.001 %)))) (Point. (if (mth/almost-zero? x) 0.001 x)
(if (mth/almost-zero? y) 0.001 y))))
(defn abs (defn abs

View file

@ -41,8 +41,8 @@
corner (gpt/point bounds) corner (gpt/point bounds)
target-corner (gpt/round corner) target-corner (gpt/round corner)
deltav (gpt/to-vec corner target-corner)] deltav (gpt/to-vec corner target-corner)]
(-> modifiers
(ctm/move deltav)))) (ctm/move modifiers deltav)))
(defn set-pixel-precision (defn set-pixel-precision
"Adjust modifiers so they adjust to the pixel grid" "Adjust modifiers so they adjust to the pixel grid"

View file

@ -7,6 +7,7 @@
(ns app.common.geom.shapes.rect (ns app.common.geom.shapes.rect
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.math :as mth])) [app.common.math :as mth]))
@ -90,8 +91,8 @@
maxy ##-Inf maxy ##-Inf
pts points] pts points]
(if-let [pt (first pts)] (if-let [pt (first pts)]
(let [x (d/get-prop pt :x) (let [x (dm/get-prop pt :x)
y (d/get-prop pt :y)] y (dm/get-prop pt :y)]
(recur (min minx x) (recur (min minx x)
(min miny y) (min miny y)
(max maxx x) (max maxx x)

View file

@ -0,0 +1,295 @@
;; 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.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 (= 3 (:x rs)))
(t/is (= 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 (= -1 (:x rs)))
(t/is (= -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 (= 2 (:x rs)))
(t/is (= 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 (= 0.5 (:x rs)))
(t/is (= 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 (= rs p1)))
(let [rs (gpt/min nil p1)]
(t/is (= rs p1)))
(let [rs (gpt/min p1 nil)]
(t/is (= rs p1)))
(let [rs (gpt/min p1 p2)]
(t/is (= rs p1)))
(let [rs (gpt/min p2 p1)]
(t/is (= 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 (= rs p1)))
(let [rs (gpt/max nil p1)]
(t/is (= rs p1)))
(let [rs (gpt/max p1 nil)]
(t/is (= rs p1)))
(let [rs (gpt/max p1 p2)]
(t/is (= rs p2)))
(let [rs (gpt/max p2 p1)]
(t/is (= rs p2)))
))
(t/deftest inverse-point
(let [p1 (gpt/point 1 2)
rs (gpt/inverse p1)]
(t/is (gpt/point? rs))
(t/is (= 1 (:x rs)))
(t/is (= 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 (= -1 (:x rs)))
(t/is (= -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 (= 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 (= 1 (:x rs)))
(t/is (= 1 (:y rs)))))
(t/deftest point-length
(let [p1 (gpt/point 1 10)
rs (gpt/length p1)]
(t/is (number? rs))
(t/is (= 10.04987562112089 rs))))
(t/deftest point-angle-1
(let [p1 (gpt/point 1 3)
rs (gpt/angle p1)]
(t/is (number? rs))
(t/is (= 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 (= -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 (= 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 (= 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 (= -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 (= 3.1142355569111246 (:x rs)))
(t/is (= 0.5491237529650835 (:y rs)))))
(t/deftest point-quadrant
(let [p1 (gpt/point 1 3)
rs (gpt/quadrant p1)]
(t/is (number? rs))
(t/is (= 1 rs)))
(let [p1 (gpt/point 1 -3)
rs (gpt/quadrant p1)]
(t/is (number? rs))
(t/is (= 4 rs)))
(let [p1 (gpt/point -1 3)
rs (gpt/quadrant p1)]
(t/is (number? rs))
(t/is (= 2 rs)))
(let [p1 (gpt/point -1 -3)
rs (gpt/quadrant p1)]
(t/is (number? rs))
(t/is (= 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 (= 1 (:x rs)))
(t/is (= 3 (:y rs))))
(let [p1 (gpt/point 1.34567 3.34567)
rs (gpt/round p1 2)]
(t/is (gpt/point? rs))
(t/is (= 1.35 (:x rs)))
(t/is (= 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 (= 1.5 (:x rs)))
(t/is (= 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 (= 3 (:x rs)))
(t/is (= 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 (= 21 rs))))
(t/deftest unit-point
(let [p1 (gpt/point 2 3)
rs (gpt/unit p1)]
(t/is (gpt/point? rs))
(t/is (= 0.5547001962252291 (:x rs)))
(t/is (= 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 (= 0.5135135135135135 (:x rs)))
(t/is (= 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 (= 7.875 (:x rs)))
(t/is (= 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 (= -0.8320502943378437 (:x rs)))
(t/is (= 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 (= 0.8320502943378437 (:x rs)))
(t/is (= -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 (= 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 (= 3 (:x rs)))
(t/is (= 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 (= 1.2091818119288809 (:x rs)))
(t/is (= 1.8275638211757912 (:y rs)))))

View file

@ -297,8 +297,8 @@
(mapv (fn [[value points]] (mapv (fn [[value points]]
[(- value pval) [(- value pval)
(->> points (mapv #(vector point %)))])))))] (->> points (mapv #(vector point %)))])))))]
{:x (query-coord point :x) (gpt/point (query-coord point :x)
:y (query-coord point :y)})) (query-coord point :y))))
(defn merge-matches (defn merge-matches
([] {:x nil :y nil}) ([] {:x nil :y nil})

View 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)))))