diff --git a/common/src/app/common/data.cljc b/common/src/app/common/data.cljc index 03fe97ca38..ae52003c18 100644 --- a/common/src/app/common/data.cljc +++ b/common/src/app/common/data.cljc @@ -461,14 +461,6 @@ (->> (apply c/iteration args) (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 diff --git a/common/src/app/common/data/macros.cljc b/common/src/app/common/data/macros.cljc index 0d204e7efa..76a168459d 100644 --- a/common/src/app/common/data/macros.cljc +++ b/common/src/app/common/data/macros.cljc @@ -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))) diff --git a/common/src/app/common/geom/point.cljc b/common/src/app/common/geom/point.cljc index 5bc1d4e5e5..5421af3cef 100644 --- a/common/src/app/common/geom/point.cljc +++ b/common/src/app/common/geom/point.cljc @@ -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,61 +248,79 @@ (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]}] @@ -259,7 +329,7 @@ (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 +352,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 +411,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 diff --git a/common/src/app/common/geom/shapes/pixel_precision.cljc b/common/src/app/common/geom/shapes/pixel_precision.cljc index 7b44280641..f6451ab022 100644 --- a/common/src/app/common/geom/shapes/pixel_precision.cljc +++ b/common/src/app/common/geom/shapes/pixel_precision.cljc @@ -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" diff --git a/common/src/app/common/geom/shapes/rect.cljc b/common/src/app/common/geom/shapes/rect.cljc index 057687e1e1..ca400800e2 100644 --- a/common/src/app/common/geom/shapes/rect.cljc +++ b/common/src/app/common/geom/shapes/rect.cljc @@ -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])) @@ -90,8 +91,8 @@ maxy ##-Inf pts points] (if-let [pt (first pts)] - (let [x (d/get-prop pt :x) - y (d/get-prop pt :y)] + (let [x (dm/get-prop pt :x) + y (dm/get-prop pt :y)] (recur (min minx x) (min miny y) (max maxx x) diff --git a/common/test/common_tests/geom_point_test.cljc b/common/test/common_tests/geom_point_test.cljc new file mode 100644 index 0000000000..b83d70e7c7 --- /dev/null +++ b/common/test/common_tests/geom_point_test.cljc @@ -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))))) + diff --git a/frontend/src/app/main/snap.cljs b/frontend/src/app/main/snap.cljs index f9585b5bf0..b4984e6308 100644 --- a/frontend/src/app/main/snap.cljs +++ b/frontend/src/app/main/snap.cljs @@ -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}) diff --git a/frontend/test/frontend_tests/test_helpers_shapes.cljs b/frontend/test/frontend_tests/test_helpers_shapes.cljs new file mode 100644 index 0000000000..6b84b8dd42 --- /dev/null +++ b/frontend/test/frontend_tests/test_helpers_shapes.cljs @@ -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))))) +